redesign id mapping and add ticket preparation

lib/Redmine/CLI.pm

@@ -73,7 +73,7 @@ EOPOD
 my $default_config_fnm= 'redmine.json';
 my @default_home_dirs= ('etc', undef, 'bin');
 
-my @env_vars= qw(project_name ticket_number out_csv);
+my @env_vars= qw(project_name tracker_name ticket_number out_csv subject);
 my %env_vars= map { $_ => 1 } @env_vars;
 
 sub new
@@ -86,6 +86,7 @@ sub new
      'cfg_stanza'   => 'Redmine',
      'op_mode'      => undef,
      # 'project_name' => undef,
+     'tracker_name' => 'Task',
   };
 
   my @cfg_fnm= (
@@ -116,14 +117,14 @@ sub new
 
 sub set
 {
-  my $obj= shift;
+  my $self= shift;
   my %par= @_;
 
   my %res;
   foreach my $par (keys %par)
   {
-    $res{$par}= $obj->{$par};
-    $obj->{$par}= $par{$par};
+    $res{$par}= $self->{$par};
+    $self->{$par}= $par{$par};
   }
 
   (wantarray) ? %res : \%res;
@@ -207,6 +208,13 @@ sub init
   ($cfg, $mRM);
 }
 
+sub get_wrapper
+{
+  my $self= shift;
+
+  my $mRM= $self->{_rm_wrapper};
+}
+
 sub main_part2
 {
   my $self= shift;
@@ -335,6 +343,15 @@ sub interpret
       print "no parent issue found for $ticket_number\n";
     }
   }
+  elsif ($op_mode eq 'prepare')
+  {
+    my $project_name= $self->{project_name};
+    my $tracker_name= $self->{tracker_name};
+    my $subject= $self->{subject};
+    my $description;
+
+    my $t= prepare_ticket ($mRM, $project_name, $tracker_name, $subject, $description);
+  }
 
 =begin comment
 
@@ -382,12 +399,17 @@ sub interact
   }
 }
 
+=head1 methods belonging WebService::Redmine
+
+=cut
+
 sub show_issues
 {
   my $rm= shift;
   my $proj_name= shift;
   my $save_as_tsv= shift;
 
+  print "rm=[$rm]\n";
   my $proj= $rm->project($proj_name);
   print "proj_name=[$proj_name] proj: ", Dumper ($proj);
 
@@ -461,6 +483,47 @@ sub filter1
   (\@dx, \%dy);
 }
 
+=head1 methods belonging Redmine::Wrapper
+
+=cut
+
+sub prepare_ticket
+{
+  my $mRM= shift;
+  my $project_name= shift;
+  my $tracker_name= shift;
+  my $subject= shift;
+  my $description= shift;
+
+  my $rm= $mRM->attach();
+
+  # print "rm=[$rm]\n";
+
+  my $proj_id= $mRM->get_project_id($project_name);
+  # my $proj_id= $proj->{'project'}->{'id'};
+  print "project_name=[$project_name] proj_id=[$proj_id]\n";
+
+  my $tr_id= $mRM->get_tracker_id($tracker_name);
+  # print "tr: ", Dumper ($tr);
+  # my $tr_id= $tr->{'tracker'}->{'id'};
+  print "tracker_name=[Task] tr_id=[$tr_id]\n";
+
+  my $ticket=
+  {
+    issue => my $issue=
+    {
+      'project_id' => $proj_id,
+      'tracker_id' => $tr_id,
+      'subject' => $subject,
+      'description' => $description,
+    }
+  };
+
+  # print "ticket: ", Dumper ($ticket);
+
+  $ticket;
+}
+
 sub show_issue
 {
   my $rm= shift;
@@ -509,7 +572,7 @@ __END__
 
 =over 1
 
-=item There command line options need to be evolved
+=item The command line options need to be evolved
 
 =back
 

lib/Redmine/Wrapper.pm

@@ -5,9 +5,13 @@ use strict;
 
 use WebService::Redmine;
 
+sub get_project_info;
+sub get_tracker_map;
+
 my %automapping=
 (
-  'project_ids' => 1,
+  'project_ids' => { automap => 1, object => 'project', info => \&get_project_info },
+  'tracker_ids' => { automap => 1, object => 'tracker', map => \&get_tracker_map },
 );
 
 my %USER_NAMES= map { $_ => 1 } qw(assigned_to);
@@ -57,41 +61,73 @@ sub get_mapped_id
   my $map_name= shift;
   my $name= shift;
 
-  my $c= $self->{'cfg'};
-  # print "cfg: ", main::Dumper ($c);
+  my $cfg= $self->{'cfg'};
+  # print "cfg: ", main::Dumper ($cfg);
 
-  $map_name= 'user' if (exists ($USER_NAMES{$map_name}));
-  my $m= $c->{$map_name.'_ids'};
+  $map_name= 'user_ids' if (exists ($USER_NAMES{$map_name}));
+  my $m= $self->{$map_name};
+  if (!defined ($m) && exists ($cfg->{$map_name}))
+  {
+    $m= $self->{$map_name}= { %$m }; # copy from config
+  }
 
   # print "map_name=[$map_name] name=[$name] m=", main::Dumper ($m);
 
   my $id;
-  my $perform_lookup= 0;
+  my $perform_lookup= 1;
   if (exists ($m->{$name}))
   {
     $id= $m->{$name};
-    print "ATTN: no id known for $map_name=[$name]\n";
+    # print "ATTN: no id known for $map_name=[$name]\n";
+
+=begin comment
 
-    if (exists ($self->{automapping}) && $self->{automapping} >= 1)
+    if (exists ($cfg->{automapping}) && $cfg->{automapping} >= 1)
     { # TODO: add an *optional* lookup ...
       $perform_lookup= 1;
     }
+
+=end comment
+=cut
+
   }
   else
   {
-    print "ATTN: no *map* named [$map_name] available\n";
-    if (exists ($self->{automapping}) && $self->{automapping} >= 2 && exists ($automapping{$map_name}))
-    { # TODO: allow dynamically fetched maps, when the map name is valied, e.g. project_ids etc..
-      if ($name eq 'project')
+    # print "ATTN: no *map* named [$map_name] available\n";
+
+=begin comment
+
+    if (exists ($cfg->{automapping}) && $cfg->{automapping} >= 2)
     {
-        my $pi= $self->get_project_info ($name);
-        $perform_lookup= 1 if (defined ($pi));
-      }
+      $perform_lookup= 1;
     }
+
+=end comment
+=cut
+
   }
 
   if (!defined ($id) && $perform_lookup)
   {
+    # print "map_name=[$map_name] id not found, perform_lookup=[$perform_lookup]\n";
+
+    if (exists ($automapping{$map_name}))
+    { # TODO: allow dynamically fetched maps, when the map name is valid, e.g. project_ids etc..
+      my $automap= $automapping{$map_name};
+      # print "NOTE: checking automap: ", main::Dumper ($automap);
+      if (defined (my $c_i= $automap->{info}))
+      {
+        my $pi= &$c_i ($self, $name);
+        # print "pi: ", main::Dumper ($pi);
+        $id= $pi->{id} if (defined ($pi));
+      }
+      elsif (defined (my $c_m= $automap->{map}))
+      {
+        my $map= &$c_m ($self);
+        # print "map: ", main::Dumper ($map);
+        $id= $map->{$name} if (defined ($map));
+      }
+    }
   }
 
   $id;
@@ -105,6 +141,25 @@ sub get_tracker_id
   $self->get_mapped_id ('tracker_ids', $tracker_name);
 }
 
+# Note: for some reason, receiving info for one tracker is not possible
+sub get_tracker_map
+{
+  my $self= shift;
+
+  my $rm= $self->attach();
+  my $tracker_list= $rm->trackers();
+  # print __LINE__, " tracker_list: ", main::Dumper ($tracker_list);
+
+  my %trackers;
+  if (defined ($tracker_list))
+  {
+    %trackers= map { $_->{name} => $_->{id} } @{$tracker_list->{trackers}};
+    $self->{tracker_ids}= \%trackers;
+  }
+
+  \%trackers;
+}
+
 sub get_project_id
 {
   my $self= shift;
@@ -120,7 +175,11 @@ sub get_project_info
 
   my $rm= $self->attach();
   my $proj= $rm->project( $name );
-  print __LINE__, " get_project_info: name=[$name] proj: ", main::Dumper ($proj);
+
+  return undef unless (defined ($proj));
+
+  # print __LINE__, " get_project_info: name=[$name] proj: ", main::Dumper ($proj);
+  return $proj->{'project'};
 }
 
 sub fixup_issue