From c45d363a720b2dba9b09e85908974c5674830c4b Mon Sep 17 00:00:00 2001
From: Gerhard Gonter <ggonter@gmail.com>
Date: Sun, 28 Aug 2016 20:05:35 +0200
Subject: [PATCH] more functions for the Redmine CLI
---
lib/Redmine/CLI.pm | 295 ++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 268 insertions(+), 27 deletions(-)
diff --git a/lib/Redmine/CLI.pm b/lib/Redmine/CLI.pm
index f0b651a..c698ba6 100644
--- a/lib/Redmine/CLI.pm
+++ b/lib/Redmine/CLI.pm
@@ -3,7 +3,7 @@
=head1 NAME
- REdmine::CLI
+ Redmine::CLI
=head1 DESCRIPTION
@@ -15,17 +15,66 @@ package Redmine::CLI;
use strict;
+use Data::Dumper;
+use Pod::Simple::Text;
+use FileHandle;
+
+autoflush STDOUT 1;
+
use Util::JSON;
use Util::Simple_CSV;
use Util::Matrix;
use Redmine::Wrapper;
-use Data::Dumper;
+=head1 HELP TOPICS
+
+=cut
+
+my %HELP=
+(
+ 'topics' => <<EOPOD,
+=head2 TOPICS
+
+The following help topics are available
+
+=over 1
+
+=item overview
+
+=item environment
+
+=back
+
+=cut
+EOPOD
+ 'overview' => <<EOPOD,
+=head2 Overview
+
+ help [topic] (this overview)
+ list
+ show ticket
+=cut
+EOPOD
+
+ 'env' => <<EOPOD,
+=head2 Enivironment
+
+=head3 default attributes
+
+ project_name
+ ticket_number
+
+=cut
+EOPOD
+);
my $default_config_fnm= 'redmine.json';
my @default_home_dirs= ('etc', undef, 'bin');
+my @env_vars= qw(project_name ticket_number);
+my %env_vars= map { $_ => 1 } @env_vars;
+
sub new
{
my $class= shift;
@@ -34,8 +83,8 @@ sub new
{
# defaults
'cfg_stanza' => 'Redmine',
- 'op_mode' => 'list',
- 'project_name' => undef,
+ 'op_mode' => undef,
+ # 'project_name' => undef,
};
my @cfg_fnm= (
@@ -51,7 +100,7 @@ sub new
# print "NOTE: trying [$f] as config filen name\n";
if (-f $f)
{
- print "NOTE: picked [$f] as config filen name\n";
+ # print "NOTE: picked [$f] as config filen name\n";
$obj->{'cfg_fnm'}= $f;
last;
}
@@ -99,22 +148,22 @@ sub parse_args
{
my ($opt, $val)= split ('=', $1, $2);
- if ($opt eq 'help') { usage(); }
+ if ($opt eq 'help') { usage('help', 'usage'); exit(0); }
elsif ($opt eq 'config') { $self->{cfg_fnm}= $val || shift (@ARGV); }
elsif ($opt eq 'stanza') { $self->{cfg_stanza}= $val || shift (@ARGV); }
elsif ($opt eq 'project') { $self->{project_name}= $val || shift (@ARGV); }
- elsif ($opt eq 'show') { $self->{op_mode}= 'show'; }
- elsif ($opt eq 'list') { $self->{op_mode}= 'list'; }
+ # elsif ($opt eq 'show') { $self->{op_mode}= 'show'; }
+ # elsif ($opt eq 'list') { $self->{op_mode}= 'list'; }
# TODO: allow extra arguments
- else { usage(); }
+ else { usage('error', "unknown option --${arg}"); exit(0); }
}
elsif ($arg =~ /^-(.+)/)
{
foreach my $opt (split ('', $1))
{
- if ($opt eq 'h') { usage(); exit (0); }
+ if ($opt eq 'h') { usage('help', 'usage'); exit (0); exit(0); }
# elsif ($opt eq 'x') { $x_flag= 1; }
- else { usage(); }
+ else { usage('error', "unknown option -{$arg}"); }
}
}
else
@@ -123,6 +172,11 @@ sub parse_args
}
}
+ unless (defined ($self->{op_mode}))
+ {
+ $self->{op_mode}= (@PARS) ? shift (@PARS) : 'help';
+ }
+
$self->{_pars}= \@PARS;
1;
@@ -137,6 +191,17 @@ sub init
$self->{_rm_cfg}= my $rm_cfg= $cfg->{$self->{cfg_stanza}};
+ # TODO: set defaults?
+
+ foreach my $an (@env_vars)
+ {
+ if (!defined ($self->{$an}) && exists ($rm_cfg->{$an}))
+ {
+ my $av= $self->{$an}= $rm_cfg->{$an};
+ # print "transcribing attribute='$an' ($av)\n";
+ }
+ }
+
$self->{_rm_wrapper}= my $mRM= new Redmine::Wrapper ('cfg' => $rm_cfg);
($cfg, $mRM);
@@ -148,17 +213,15 @@ sub main_part2
# print __LINE__, " self: ", Dumper ($self);
- my ($mRM, $rm_cfg, $op_mode, $pars)= map { $self->{$_} } qw(_rm_wrapper _rm_cfg op_mode _pars);
- unless (defined ($mRM))
- {
- print "ATTN: Redmine::Wrapper not defined!\n";
- return undef;
- }
+ my ($op_mode, $pars)= map { $self->{$_} } qw(op_mode _pars);
+
+ # print "op_mode=[$op_mode]\n";
+
+=begin comment
# print __LINE__, " mRM: ", Dumper ($mRM);
- print "op_mode=[$op_mode]\n";
- my $project_name= $self->{'project_name'} || $rm_cfg->{'project-name'};
+ my $project_name= $self->{'project_name'} || $rm_cfg->{'project_name'};
unless (defined ($project_name))
{ # TODO: look up project id in Redmine itself
print "ATTN: no project name found in configuration!\n";
@@ -173,20 +236,149 @@ sub main_part2
print "ATTN: no project_id found in config for project_name=[$project_name]\n";
}
- if ($op_mode eq 'show')
+=end comment
+=cut
+
+ interpret($self, $op_mode, $pars);
+}
+
+sub interpret
+{
+ my $self= shift;
+ my $op_mode= shift;
+ my $pars= shift;
+
+ my $mRM= $self->{_rm_wrapper};
+
+ unless (defined ($mRM))
{
- my $rm= $mRM->attach();
- foreach my $ticket_number (@$pars)
+ print "ATTN: Redmine::Wrapper not defined!\n";
+ return undef;
+ }
+
+ if ($op_mode eq 'help') { usage('help', (@$pars) ? shift (@$pars) : 'overview'); }
+ elsif ($op_mode eq 'exit') { return 0; }
+ elsif ($op_mode eq 'interact' || $op_mode eq 'i')
+ {
+ $self->interact ();
+ }
+ elsif ($op_mode eq 'env')
+ {
+ foreach my $an (@env_vars)
{
- Redmine::CLI::show_issue ($rm, $ticket_number);
+ printf ("%12s = '%s'\n", $an, $self->{$an});
+ }
+ }
+ elsif ($op_mode eq 'set')
+ {
+ my $an= shift (@$pars);
+
+ if (exists ($env_vars{$an}))
+ {
+ $self->{$an}= join (' ', @$pars);
+ }
+ else
+ {
+ usage ('error', "unknown environment variable '$an'", 'help', 'environment');
}
}
elsif ($op_mode eq 'list')
{
my $rm= $mRM->attach();
+
+ my $project_name= (@$pars) ? shift (@$pars) : $self->{project_name};
+
print "project_name=[$project_name]\n";
Redmine::CLI::show_issues ($rm, $project_name);
}
+ elsif ($op_mode eq 'show')
+ {
+ my $rm= $mRM->attach();
+ push (@$pars, $self->{ticket_number}) if (!@$pars && exists ($self->{ticket_number}));
+ foreach my $ticket_number (@$pars)
+ {
+ Redmine::CLI::show_issue ($rm, $ticket_number);
+ $self->{ticket_number}= $ticket_number;
+ }
+ }
+ elsif ($op_mode eq 'browse' || $op_mode eq 'display')
+ {
+ my $rm_cfg= $self->{_rm_cfg};
+ my $base_url= sprintf ("%s://%s/issues/", map { $rm_cfg->{$_} } qw(protocol host));
+
+ push (@$pars, $self->{ticket_number}) if (!@$pars && exists ($self->{ticket_number}));
+ foreach my $ticket_number (@$pars)
+ {
+ my $url= $base_url . $ticket_number;
+ system ('xdg-open', $url);
+ }
+ }
+ elsif ($op_mode eq 'parent')
+ {
+ my $rm= $mRM->attach();
+ my $ticket_number= (@$pars) ? shift (@$pars) : $self->{ticket_number};
+
+ print "ticket_number: $ticket_number\n";
+ my $issue= $rm->issue( $ticket_number );
+
+ if (defined ($issue) && exists ($issue->{issue}->{parent}))
+ {
+ print "issue: ", join (' ', sort keys %{$issue->{issue}}), "\n";
+ my $parent= $issue->{issue}->{parent};
+ print "parent issue: $parent ", Dumper ($parent);
+ my $parent_issue= $parent->{id};
+ $self->interpret ('show', [ $parent_issue ]);
+ }
+ else
+ {
+ print "no parent issue found for $ticket_number\n";
+ }
+ }
+
+=begin comment
+
+not needed?
+ elsif ($op_mode eq 'related')
+ {
+ my $rm= $mRM->attach();
+ my $ticket_number= (@$pars) ? shift (@$pars) : $self->{ticket_number};
+
+ print "ticket_number: $ticket_number\n";
+ my $issue= $rm->issue( $ticket_number, { include => 'relations,changesets' } );
+
+ if (defined ($issue))
+ {
+ print "issue: ", Dumper ($issue);
+ }
+ }
+
+=end comment
+=cut
+
+ return 1;
+}
+
+sub interact
+{
+ my $self= shift;
+
+ my $last_line;
+ LINE: while (1)
+ {
+ print "rcli> ";
+ my $l= <STDIN>;
+ last unless (defined ($l));
+ chop ($l);
+
+ if ($l eq '.') { $l= $last_line }
+ elsif ($l eq '') { next LINE; }
+ else { $last_line= $l }
+
+ my ($op, @pars)= split (' ', $l);
+ print "op=[$op]\n";
+ my $continue= interpret ($self, $op, \@pars);
+ last unless ($continue);
+ }
}
sub show_issues
@@ -266,15 +458,64 @@ sub show_issue
my $rm= shift;
my $ticket_number= shift;
- my $issues= $rm->issue( $ticket_number );
- print "issues: ", Dumper ($issues);
+ my $issue= $rm->issue( $ticket_number, { include => 'children,attachments,relations,changesets,journals' } );
+ print "issue: ", Dumper ($issue);
+ $issue;
}
sub usage
{
- system ('perldoc', __FILE__);
- exit (0);
+ my $type= shift || 'help';
+ my $message= shift || 'usage';
+
+ my $pod= new Pod::Simple::Text();
+ my $y= $pod->output_fh (*STDOUT);
+
+ # print "usage: type=[$type] message=[$message]\n";
+
+ my $was_error= 0;
+ while (1)
+ {
+ if ($type eq 'error')
+ {
+ $was_error= 1;
+ print "ERROR: ", $message, "\n\n";
+ }
+ elsif ($type eq 'help')
+ {
+ $message= 'overview' unless (exists ($HELP{$message}));
+ $pod->parse_string_document ($HELP{$message});
+ }
+
+ last unless (@_);
+ }
+
+ # system ('perldoc', __FILE__);
}
1;
+__END__
+
+=head1 TODOS
+
+=over 1
+
+=item There command line options need to be evolved
+
+=back
+
+=head1 AUTHOR
+
+Gerhard Gonter E<lt>ggonter@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2016 by Gerhard Gonter
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
+
--
GitLab