moving command 'list' in its module
authorYanick Champoux <yanick@babyl.dyndns.org>
Tue, 9 Sep 2008 02:03:53 +0000 (22:03 -0400)
committerAndrew Chilton <andychilton@gmail.com>
Mon, 22 Sep 2008 10:33:56 +0000 (22:33 +1200)
bin/cil
lib/CIL.pm
lib/CIL/Command.pm [new file with mode: 0644]
lib/CIL/Command/List.pm [new file with mode: 0644]

diff --git a/bin/cil b/bin/cil
index 648af93203fa869ca705e5e13e283d403542b0da..54f136a520916eff7a976e91f6f6f8987b3add66 100755 (executable)
--- a/bin/cil
+++ b/bin/cil
@@ -95,12 +95,11 @@ my %BOOLEAN_ARGS = (
     Getopt::Mixed::abortMsg('specify a command')
        if @ARGV == 0;
 
-    my $command = shift @ARGV;
-    $command =~ s{-}{_}gxms;
-    no strict 'refs';
-    if ( not defined &{"cmd_$command"} ) {
-       Getopt::Mixed::abortMsg("'$command' is not a valid cil command.");
-    }
+    my $command_name = shift @ARGV;
+    $command_name =~ s{-}{_}gxms;
+
+    my( $command ) =  grep { $command_name eq $_->name } CIL->commands
+        or Getopt::Mixed::abortMsg("'$command_name' is not a valid cil command.");
 
     my $cil = CIL->new();
     $cil->read_config_user();
@@ -110,7 +109,7 @@ my %BOOLEAN_ARGS = (
     # add any hooks we want
     # none yet
 
-    &{"cmd_$command"}($cil, $args, @ARGV);
+    $command->run($cil, $args, @ARGV);
 }
 
 ## ----------------------------------------------------------------------------
@@ -191,26 +190,6 @@ README
     msg("initialised empty issue list inside '$path/'");
 }
 
-sub cmd_list {
-    my ($cil, $args) = @_;
-
-    check_paths($cil);
-
-    # find all the issues
-    my $issues = $cil->get_issues();
-    $issues = filter_issues( $cil, $issues, $args );
-    if ( @$issues ) {
-        foreach my $issue ( sort { $a->Inserted cmp $b->Inserted } @$issues ) {
-            separator();
-            display_issue_headers($cil, $issue);
-        }
-        separator();
-    }
-    else {
-        msg('no issues found');
-    }
-}
-
 sub cmd_summary {
     my ($cil, $args) = @_;
 
@@ -821,69 +800,6 @@ sub add_comment_loop {
     return $comment;
 }
 
-sub check_paths {
-    my ($cil) = @_;
-
-    # make sure an issue directory is available
-    unless ( $cil->dir_exists($cil->IssueDir) ) {
-        fatal("couldn't find '" . $cil->IssueDir . "' directory");
-    }
-}
-
-sub filter_issues {
-    my ($cil, $issues, $args) = @_;
-
-    # don't filter if we haven't been given anything
-    return $issues unless %$args;
-
-    # check that they aren't filtering on both --assigned-to and --is-mine
-    if ( defined $args->{a} and defined $args->{'is-mine'} ) {
-        fatal("the --assigned-to and --is-mine filters are mutually exclusive");
-    }
-
-    # take a copy of the whole lot first (so we don't destroy the input list)
-    my @new_issues = @$issues;
-
-    # firstly, get out the Statuses we want
-    if ( defined $args->{s} ) {
-        @new_issues = grep { $_->Status eq $args->{s} } @new_issues;
-    }
-
-    # then see if we want a particular label (could be a bit nicer)
-    if ( defined $args->{l} ) {
-        my @tmp;
-        foreach my $issue ( @new_issues ) {
-            push @tmp, $issue
-                if grep { $_ eq $args->{l} } @{$issue->LabelList};
-        }
-        @new_issues = @tmp;
-    }
-
-    # filter out dependent on open/closed
-    if ( defined $args->{'is-open'} ) {
-        # just get the open issues
-        @new_issues = grep { $_->is_open($cil) } @new_issues;
-    }
-    if ( defined $args->{'is-closed'} ) {
-        # just get the closed issues
-        @new_issues = grep { $_->is_closed($cil) } @new_issues;
-    }
-
-    # filter out 'created by'
-    if ( defined $args->{c} ) {
-        @new_issues = grep { $args->{c} eq $_->created_by_email } @new_issues;
-    }
-
-    # filter out 'assigned to'
-    $args->{a} = $cil->UserEmail
-        if defined $args->{'is-mine'};
-    if ( defined $args->{a} ) {
-        @new_issues = grep { $args->{a} eq $_->assigned_to_email } @new_issues;
-    }
-
-    return \@new_issues;
-}
-
 sub print_fsck_errors {
     my ($entity, $errors) = @_;
     return unless keys %$errors;
@@ -905,32 +821,6 @@ sub print_fsck_errors {
 ## ----------------------------------------------------------------------------
 # input/output
 
-sub display_issue_summary {
-    my ($cil, $issue) = @_;
-
-    my $msg = $issue->name();
-    $msg .= "\t";
-    $msg .= $issue->Status();
-    $msg .= "\t";
-    $msg .= $issue->Summary();
-
-    msg($msg);
-}
-
-sub display_issue_headers {
-    my ($cil, $issue) = @_;
-
-    title( 'Issue ' . $issue->name() );
-    field( 'Summary', $issue->Summary() );
-    field( 'CreatedBy', $issue->CreatedBy() );
-    field( 'AssignedTo', $issue->AssignedTo() );
-    field( 'Inserted', $issue->Inserted() );
-    field( 'Status', $issue->Status() );
-    field( 'Labels', join(' ', @{$issue->LabelList()}) );
-    field( 'DependsOn', join(' ', @{$issue->DependsOnList()}) );
-    field( 'Precedes', join(' ', @{$issue->PrecedesList()}) );
-}
-
 sub display_issue {
     my ($cil, $issue) = @_;
 
@@ -1043,29 +933,6 @@ sub get_options {
     return $args;
 }
 
-sub msg {
-    print ( defined $_[0] ? $_[0] : '' );
-    print "\n";
-}
-
-sub separator {
-    msg('=' x 79);
-}
-
-sub title {
-    my ($title) = @_;
-    my $msg = "--- $title ";
-    $msg .= '-' x (74 - length($title));
-    msg($msg);
-}
-
-sub field {
-    my ($field, $value) = @_;
-    my $msg = "$field";
-    $msg .= " " x (12 - length($field));
-    msg("$msg: " . (defined $value ? $value : '') );
-}
-
 sub text {
     my ($field, $value) = @_;
     msg "";
index 02ddb31aa85f426f65ce4181164e5b3ba1aac311..29a144608839ba93b8132359df579c3209cbe4cb 100644 (file)
@@ -29,6 +29,11 @@ use File::Glob qw(:glob);
 use vars qw( $VERSION );
 $VERSION = '0.5.1';
 
+use Module::Pluggable 
+        sub_name    => 'commands',
+        search_path => [ 'CIL::Command' ],
+        require     => 1;
+
 use CIL::VCS::Factory;
 
 use base qw(Class::Accessor);
@@ -82,6 +87,14 @@ sub new {
     return $self;
 }
 
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub command_names {
+    return map { $_->name } $_[0]->commands;
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
 sub list_entities {
     my ($self, $prefix, $base) = @_;
 
@@ -375,5 +388,132 @@ sub UserEmail {
 }
 
 ## ----------------------------------------------------------------------------
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub check_paths {
+    my ($cil) = @_;
+
+    # make sure an issue directory is available
+    unless ( $cil->dir_exists($cil->IssueDir) ) {
+        fatal("couldn't find '" . $cil->IssueDir . "' directory");
+    }
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub filter_issues {
+    my ($cil, $issues, $args) = @_;
+
+    # don't filter if we haven't been given anything
+    return $issues unless %$args;
+
+    # check that they aren't filtering on both --assigned-to and --is-mine
+    if ( defined $args->{a} and defined $args->{'is-mine'} ) {
+        fatal("the --assigned-to and --is-mine filters are mutually exclusive");
+    }
+
+    # take a copy of the whole lot first (so we don't destroy the input list)
+    my @new_issues = @$issues;
+
+    # firstly, get out the Statuses we want
+    if ( defined $args->{s} ) {
+        @new_issues = grep { $_->Status eq $args->{s} } @new_issues;
+    }
+
+    # then see if we want a particular label (could be a bit nicer)
+    if ( defined $args->{l} ) {
+        my @tmp;
+        foreach my $issue ( @new_issues ) {
+            push @tmp, $issue
+                if grep { $_ eq $args->{l} } @{$issue->LabelList};
+        }
+        @new_issues = @tmp;
+    }
+
+    # filter out dependent on open/closed
+    if ( defined $args->{'is-open'} ) {
+        # just get the open issues
+        @new_issues = grep { $_->is_open($cil) } @new_issues;
+    }
+    if ( defined $args->{'is-closed'} ) {
+        # just get the closed issues
+        @new_issues = grep { $_->is_closed($cil) } @new_issues;
+    }
+
+    # filter out 'created by'
+    if ( defined $args->{c} ) {
+        @new_issues = grep { $args->{c} eq $_->created_by_email } @new_issues;
+    }
+
+    # filter out 'assigned to'
+    $args->{a} = $cil->UserEmail
+        if defined $args->{'is-mine'};
+    if ( defined $args->{a} ) {
+        @new_issues = grep { $args->{a} eq $_->assigned_to_email } @new_issues;
+    }
+
+    return \@new_issues;
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub separator {
+    msg('=' x 79);
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub msg {
+    print ( defined $_[0] ? $_[0] : '' );
+    print "\n";
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub display_issue_summary {
+    my ($cil, $issue) = @_;
+
+    my $msg = $issue->name();
+    $msg .= "\t";
+    $msg .= $issue->Status();
+    $msg .= "\t";
+    $msg .= $issue->Summary();
+
+    msg($msg);
+}
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub display_issue_headers {
+    my ($cil, $issue) = @_;
+
+    title( 'Issue ' . $issue->name() );
+    field( 'Summary', $issue->Summary() );
+    field( 'CreatedBy', $issue->CreatedBy() );
+    field( 'AssignedTo', $issue->AssignedTo() );
+    field( 'Inserted', $issue->Inserted() );
+    field( 'Status', $issue->Status() );
+    field( 'Labels', join(' ', @{$issue->LabelList()}) );
+    field( 'DependsOn', join(' ', @{$issue->DependsOnList()}) );
+    field( 'Precedes', join(' ', @{$issue->PrecedesList()}) );
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub title {
+    my ($title) = @_;
+    my $msg = "--- $title ";
+    $msg .= '-' x (74 - length($title));
+    msg($msg);
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub field {
+    my ($field, $value) = @_;
+    my $msg = "$field";
+    $msg .= " " x (12 - length($field));
+    msg("$msg: " . (defined $value ? $value : '') );
+}
+
 1;
-## ----------------------------------------------------------------------------
diff --git a/lib/CIL/Command.pm b/lib/CIL/Command.pm
new file mode 100644 (file)
index 0000000..194047b
--- /dev/null
@@ -0,0 +1,17 @@
+package CIL::Command;
+
+use strict;
+use warnings;
+
+sub name {
+    my $self = shift;
+
+    my $name = lc( ref $self || $self );
+
+    $name =~ s/^CIL::Command:://i;
+
+    return $name;
+}
+
+
+'end of package CIL::Command';
diff --git a/lib/CIL/Command/List.pm b/lib/CIL/Command/List.pm
new file mode 100644 (file)
index 0000000..9842466
--- /dev/null
@@ -0,0 +1,28 @@
+package CIL::Command::List;
+
+use strict;
+use warnings;
+
+use base 'CIL::Command';
+
+sub run {
+    my ($self, $cil, $args) = @_;
+
+    $cil->check_paths;
+
+    # find all the issues
+    my $issues = $cil->get_issues();
+    $issues = $cil->filter_issues( $issues, $args );
+    if ( @$issues ) {
+        foreach my $issue ( sort { $a->Inserted cmp $b->Inserted } @$issues ) {
+            $cil->separator();
+            $cil->display_issue_headers($issue);
+        }
+        $cil->separator();
+    }
+    else {
+        $cil->msg('no issues found');
+    }
+}
+
+'end of package CIL::Command::List';