use warnings;
use Getopt::Mixed "nextOption";
-use Digest::MD5 qw(md5_hex);
use File::Touch;
use File::Glob ':glob';
use File::Basename;
## ----------------------------------------------------------------------------
# constants
-my $y = 'y';
-
my @IN_OPTS = (
# strings
'p=s', # p = path
$command->run($cil, $args, @ARGV);
}
-## ----------------------------------------------------------------------------
-# commands
-
-sub cmd_init {
- my ($cil, $args) = @_;
-
- my $path = $args->{p} || '.'; # default path is right here
-
- # error if $path doesn't exist
- unless ( -d $path ) {
- fatal("path '$path' doesn't exist");
- }
-
- # error if issues/ already exists
- my $issues_dir = "$path/issues";
- if ( -d $issues_dir ) {
- fatal("issues directory '$issues_dir' already exists, not initialising issues");
- }
-
- # error if .cil already exists
- my $config = "$path/.cil";
- if ( -f $config ) {
- fatal("config file '$config' already exists, not initialising issues");
- }
-
- # try to create the issues/ dir
- unless ( mkdir $issues_dir ) {
- fatal("Couldn't create '$issues_dir' directory: $!");
- }
-
- # are we in a Git repository?
- my $VCSconfig = '';
- if ( -d '.git' ) {
- msg( 'git repository detected, setting VCS accordingly' );
- $VCSconfig = 'VCS: git';
- my $vcs = CIL::VCS::Factory->new( 'Git' );
- }
-
- # create a .cil file here also
- if ( $args->{bare} ) {
- unless ( touch $config ) {
- rmdir $issues_dir;
- fatal("couldn't create a '$config' file");
- }
- }
- else {
- # write a default .cil file
- write_file($config, <<"CONFIG");
-$VCSconfig
-StatusStrict: 1
-StatusAllowedList: New
-StatusAllowedList: InProgress
-StatusAllowedList: Finished
-StatusOpenList: New
-StatusOpenList: InProgress
-StatusClosedList: Finished
-LabelStrict: 1
-LabelAllowedList: Type-Enhancement
-LabelAllowedList: Type-Defect
-LabelAllowedList: Priority-High
-LabelAllowedList: Priority-Medium
-LabelAllowedList: Priority-Low
-CONFIG
- }
-
- # add a README.txt so people know what this is about
- unless ( -f "$issues_dir/README.txt" ) {
- write_file("$issues_dir/README.txt", <<'README');
-This directory is used by CIL to track issues and feature requests.
-
-The home page for CIL is at http://kapiti.geek.nz/software/cil.html
-README
- }
-
- # $path/issues/ and $path/.cil create correctly
- msg("initialised empty issue list inside '$path/'");
-}
-
-sub cmd_summary {
- my ($cil, $args) = @_;
-
- check_paths($cil);
-
- # find all the issues
- my $issues = $cil->get_issues();
- $issues = filter_issues( $cil, $issues, $args );
- if ( @$issues ) {
- separator();
- foreach my $issue ( @$issues ) {
- display_issue_summary($cil, $issue);
- }
- separator();
- }
- else {
- msg('no issues found');
- }
-}
-
-sub cmd_show {
- my ($cil, undef, $issue_name) = @_;
-
- # firstly, read the issue in
- my $issue = load_issue_fuzzy( $cil, $issue_name );
- display_issue_full($cil, $issue);
-}
-
-sub cmd_status {
- my ($cil, undef, $issue_name, $status) = @_;
-
- unless ( defined $status ) {
- fatal("provide a status to set this issue to");
- }
-
- # firstly, read the issue in
- my $issue = load_issue_fuzzy( $cil, $issue_name );
-
- # set the status for this issue
- $issue->Status( $status );
- $issue->save($cil);
-
- display_issue($cil, $issue);
-}
-
-sub cmd_steal {
- my ($cil, undef, $issue_name) = @_;
-
- # firstly, read the issue in
- my $issue = load_issue_fuzzy( $cil, $issue_name );
-
- # set the AssignedTo for this issue to you (because you're stealing it)
- $issue->AssignedTo( user($cil) );
- $issue->save($cil);
-
- display_issue($cil, $issue);
-}
-
-sub cmd_add {
- my ($cil, undef, @argv ) = @_;
-
- CIL::Utils->ensure_interactive();
-
- my $user = user($cil);
-
- my $issue = CIL::Issue->new('tmpname');
- $issue->Summary( join ' ', @argv );
- $issue->Status('New');
- $issue->CreatedBy( $user );
- $issue->Description("Description ...");
-
- add_issue_loop($cil, undef, $issue);
-}
-
-sub cmd_edit {
- my ($cil, undef, $issue_name) = @_;
-
- my $issue = load_issue_fuzzy( $cil, $issue_name );
-
- CIL::Utils->ensure_interactive();
-
- my $edit = $y;
-
- # keep going until we get a valid issue or we want to quit
- while ( $edit eq $y ) {
- # read in the new issue text
- my $fh = CIL::Utils->solicit( $issue->as_output );
- $issue = CIL::Issue->new_from_fh( $issue->name, $fh );
-
- # check if the issue is valid
- if ( $issue->is_valid($cil) ) {
- $edit = 'n';
- }
- else {
- msg($_) foreach @{ $issue->errors };
- $edit = ans('Would you like to re-edit (y/n): ');
- }
- }
-
- # if the issue is still invalid, they quit without correcting it
- return unless $issue->is_valid( $cil );
-
- # save it
- $issue->save($cil);
- display_issue($cil, $issue);
-}
-
-sub cmd_comment {
- my ($cil, undef, $issue_name) = @_;
-
- my $issue = load_issue_fuzzy( $cil, $issue_name );
-
- CIL::Utils->ensure_interactive();
-
- # create the new comment
- my $comment = CIL::Comment->new('tmpname');
- $comment->Issue( $issue->name );
- $comment->CreatedBy( user($cil) );
- $comment->Description("Description ...");
-
- add_comment_loop($cil, undef, $issue, $comment);
-}
-
-sub cmd_attach {
- my ($cil, undef, $issue_name, $filename) = @_;
-
- my $issue = load_issue_fuzzy( $cil, $issue_name );
-
- # check to see if the file exists
- unless ( -r $filename ) {
- fatal("couldn't read file '$filename'");
- }
-
- my $basename = basename( $filename );
- my $user = user($cil);
-
- my $add_attachment_text = <<"EOF";
-Filename : $basename
-CreatedBy : $user
-
-File goes here ... this will be overwritten.
-EOF
-
- # read in the new issue text
- CIL::Utils->ensure_interactive();
- my $fh = CIL::Utils->solicit( $add_attachment_text );
-
- my $attachment = CIL::Attachment->new_from_fh( 'tmp', $fh );
- unless ( defined $attachment ) {
- fatal("could not create new attachment");
- }
-
- # now add the file itself
- my $contents = read_file( $filename );
- $attachment->set_file_contents( $contents );
-
- # set the size
- my ($size) = (stat($filename))[7];
- $attachment->Size( $size );
-
- # we've got the attachment, so let's name it
- my $unique_str = time . $attachment->Inserted . $attachment->File;
- $attachment->set_name( substr(md5_hex($unique_str), 0, 8) );
-
- # finally, tell it who it's parent is and then save
- $attachment->Issue( $issue->name );
- $attachment->save($cil);
-
- # add the comment to the issue, update it's timestamp and save it out
- $issue->add_attachment( $attachment );
- $issue->save($cil);
- display_issue_full($cil, $issue);
-}
-
-sub cmd_extract {
- my ($cil, $args, $attachment_name) = @_;
-
- my $attachment = load_attachment_fuzzy($cil, $attachment_name);
-
- my $filename = $args->{f} || $attachment->Filename();
- write_file( $filename, $attachment->as_binary );
-}
-
-sub cmd_track {
- my ($cil, $args, $issue_name) = @_;
-
- fatal("the 'VCS' option in your .cil file is not set")
- unless defined $cil->VCS;
-
- fatal("the 'VCS' option currently only supports values of 'Git'")
- unless $cil->VCS eq 'Git';
-
- my $issue = load_issue_fuzzy($cil, $issue_name);
-
- # add the issue to Git
- my $issue_dir = $cil->IssueDir();
- my @files;
- push @files, "$issue_dir/i_" . $issue->name . '.cil';
- push @files, map { "$issue_dir/c_${_}.cil" } @{ $issue->CommentList };
- push @files, map { "$issue_dir/a_${_}.cil" } @{ $issue->AttachmentList };
- msg("git add @files");
-}
-
-sub cmd_fsck {
- my ($cil, $args) = @_;
-
- # this looks at all the issues it can find and checks for:
- # * validity
- # * all the comments are there
- # * all the attachments are there
- # then it checks each individual comment/attachment for:
- # * ToDo: validity
- # * it's parent exists
-
- check_paths($cil);
-
- # find all the issues, comments and attachments
- my $issues = $cil->get_issues();
- my $issue = {};
- foreach my $i ( @$issues ) {
- $issue->{$i->name} = $i;
- }
- my $comments = $cil->get_comments();
- my $comment = {};
- foreach my $c ( @$comments ) {
- $comment->{$c->name} = $c;
- }
- my $attachments = $cil->get_attachments();
- my $attachment = {};
- foreach my $a ( @$attachments ) {
- $attachment->{$a->name} = $a;
- }
-
- # ------
- # issues
- my $errors = {};
- if ( @$issues ) {
- foreach my $i ( sort { $a->Inserted cmp $b->Inserted } @$issues ) {
- my $name = $i->name;
-
- unless ( $i->is_valid($cil) ) {
- foreach ( @{ $i->errors } ) {
- push @{$errors->{$name}}, $_;
- }
- }
-
- # check that all it's comments are there and that they have this parent
- my $comments = $i->CommentList;
- foreach my $c ( @$comments ) {
- # see if this comment exists at all
- if ( exists $comment->{$c} ) {
- # check the parent is this issue
- push @{$errors->{$name}}, "comment '$c' is listed under issue '" . $i->name . "' but does not reciprocate"
- unless $comment->{$c}->Issue eq $i->name;
- }
- else {
- push @{$errors->{$name}}, "comment '$c' listed in issue '" . $i->name . "' does not exist";
- }
- }
-
- # check that all it's attachments are there and that they have this parent
- my $attachments = $i->AttachmentList;
- foreach my $a ( @$attachments ) {
- # see if this attachment exists at all
- if ( exists $attachment->{$a} ) {
- # check the parent is this issue
- push @{$errors->{$name}}, "attachment '$a' is listed under issue '" . $i->name . "' but does not reciprocate"
- unless $attachment->{$a}->Issue eq $i->name;
- }
- else {
- push @{$errors->{$name}}, "attachment '$a' listed in issue '" . $i->name . "' does not exist";
- }
- }
-
- # check that all it's 'DependsOn' are there and that they have this under 'Precedes'
- my $depends_on = $i->DependsOnList;
- foreach my $d ( @$depends_on ) {
- # see if this issue exists at all
- if ( exists $issue->{$d} ) {
- # check the 'Precedes' is this issue
- my %precedes = map { $_ => 1 } @{$issue->{$d}->PrecedesList};
- push @{$errors->{$name}}, "issue '$d' should precede '" . $i->name . "' but doesn't"
- unless exists $precedes{$i->name};
- }
- else {
- push @{$errors->{$name}}, "issue '$d' listed as a dependency of issue '" . $i->name . "' does not exist";
- }
- }
-
- # check that all it's 'Precedes' are there and that they have this under 'DependsOn'
- my $precedes = $i->PrecedesList;
- foreach my $p ( @$precedes ) {
- # see if this issue exists at all
- if ( exists $issue->{$p} ) {
- # check the 'DependsOn' is this issue
- my %depends_on = map { $_ => 1 } @{$issue->{$p}->DependsOnList};
- push @{$errors->{$name}}, "issue '$p' should depend on '" . $i->name . "' but doesn't"
- unless exists $depends_on{$i->name};
- }
- else {
- push @{$errors->{$name}}, "issue '$p' listed as preceding issue '" . $i->name . "' does not exist";
- }
- }
- }
- }
- print_fsck_errors('Issue', $errors);
-
- # --------
- # comments
- $errors = {};
- # loop through all the comments
- if ( @$comments ) {
- # check that their parent issues exist
- foreach my $c ( sort { $a->Inserted cmp $b->Inserted } @$comments ) {
- # check that the parent of each comment exists
- unless ( exists $issue->{$c->Issue} ) {
- push @{$errors->{$c->name}}, "comment '" . $c->name . "' refers to issue '" . $c->Issue . "' but issue does not exist";
- }
- }
- }
- print_fsck_errors('Comment', $errors);
-
- # -----------
- # attachments
- $errors = {};
- # loop through all the attachments
- if ( @$attachments ) {
- # check that their parent issues exist
- foreach my $a ( sort { $a->Inserted cmp $b->Inserted } @$attachments ) {
- # check that the parent of each attachment exists
- unless ( exists $issue->{$a->Issue} ) {
- push @{$errors->{$a->name}}, "attachment '" . $a->name . "' refers to issue '" . $a->Issue . "' but issue does not exist";
- }
- }
- }
- print_fsck_errors('Attachment', $errors);
-
- # ------------
- # nothing left
- separator();
-}
-
-sub cmd_am {
- my ($cil, $args, $email_filename) = @_;
-
- unless ( -f $email_filename ) {
- fatal("couldn't load email '$email_filename'");
- }
-
- my $msg_text = read_file($email_filename);
-
- my $email = Email::Simple->new($msg_text);
- unless ( defined $email ) {
- fatal("email file '$email_filename' didn't look like an email");
- }
-
- # extract some fields
- my $subject = $email->header('Subject');
- my $from = $email->header('From');
- my $date = find_date($email)->datetime;
- my $body = $email->body;
-
- # see if we can find any issue names in either the subject or the body
- my @issue_names;
- foreach my $text ( $subject, $body ) {
- my @new = ( $text =~ /\b\#?([0-9a-f]{8})\b/gxms );
- push @issue_names, @new;
- }
-
- msg("Found possible issue names in email: ", ( join(' ', @issue_names) || '[none]' ));
-
- my %issue;
- foreach ( @issue_names ) {
- my $i = eval { CIL::Issue->new_from_name($cil, $_) };
- next unless defined $i;
-
- $issue{$i->name} = $i;
- }
-
- if ( keys %issue ) {
- msg( "Found actual issues: " . (join(' ', keys %issue)) );
-
- # create the new comment
- my $comment = CIL::Comment->new('tmpname');
- $comment->Issue( '...' );
- $comment->CreatedBy( $from );
- $comment->Inserted( $date );
- # $comment->Updated( $date );
- $comment->Description( $body );
-
- # display
- display_comment($cil, $comment);
-
- # found at least one issue, so this might be a comment
- my $issue;
- if ( keys %issue == 1 ) {
- $issue = (values %issue)[0];
- }
- else {
- my $ans = ans('To which issue would you like to add this comment: ');
-
- # ToDo: decide whether we let them choose an arbitrary issue, for
- # now quit unless they choose one from the list
- return unless exists $issue{$ans};
-
- # got a valid issue_name, so set the parent name
- $issue = $issue{$ans};
- }
-
- # set the parent issue
- $comment->Issue( $issue->name );
-
- add_comment_loop($cil, undef, $issue, $comment);
- }
- else {
- msg("Couldn't find reference to any issues in the email.");
-
- # no issue found so make up the issue first
- my $issue = CIL::Issue->new('tmpname');
- $issue->Summary( $subject );
- $issue->Status( 'New' );
- $issue->CreatedBy( $from );
- $issue->AssignedTo( user($cil) );
- $issue->Inserted( $date );
- $issue->Updated( $date );
- $issue->Description( $body );
-
- # display
- display_issue_full($cil, $issue);
-
- # then ask if the user would like to add it
- msg("Couldn't find any likely issues, so this might be a new one.");
- my $ans = ans('Would you like to add this message as an issue shown above (y/n): ');
- return unless $ans eq 'y';
-
- add_issue_loop($cil, undef, $issue);
- }
-}
-
-sub cmd_depends_on {
- my ($cil, undef, $issue_name, $depends_name) = @_;
-
- my $issue = load_issue_fuzzy($cil, $issue_name);
- my $depends = load_issue_fuzzy($cil, $depends_name);
-
- $issue->add_depends_on( $depends->name );
- $depends->add_precedes( $issue->name );
-
- $issue->save($cil);
- $depends->save($cil);
-}
-
-sub cmd_precedes {
- my ($cil, undef, $issue_name, $depends_name) = @_;
-
- # switch them round and call 'DependsOn'
- cmd_depends_on($cil, undef, $depends_name, $issue_name);
-}
-
-## ----------------------------------------------------------------------------
-# helpers
-
-sub load_issue_fuzzy {
- my ($cil, $partial_name) = @_;
-
- my $issues = $cil->list_issues_fuzzy( $partial_name );
- unless ( defined $issues ) {
- fatal("Couldn't find any issues using '$partial_name'");
- }
-
- if ( @$issues > 1 ) {
- fatal('found multiple issues which match that name: ' . join(' ', map { $_->{name} } @$issues));
- }
-
- my $issue_name = $issues->[0]->{name};
- my $issue = CIL::Issue->new_from_name($cil, $issue_name);
- unless ( defined $issue ) {
- fatal("Couldn't load issue '$issue_name'");
- }
-
- return $issue;
-}
-
-sub load_comment_fuzzy {
- my ($cil, $partial_name) = @_;
-
- my $comments = $cil->list_comments_fuzzy( $partial_name );
- unless ( defined $comments ) {
- fatal("Couldn't find any comments using '$partial_name'");
- }
-
- if ( @$comments > 1 ) {
- fatal('found multiple comments which match that name: ' . join(' ', map { $_->{name} } @$comments));
- }
-
- my $comment_name = $comments->[0]->{name};
- my $comment = CIL::comment->new_from_name($cil, $comment_name);
- unless ( defined $comment ) {
- fatal("Couldn't load comment '$comment_name'");
- }
-
- return $comment;
-}
-
-sub load_attachment_fuzzy {
- my ($cil, $partial_name) = @_;
-
- my $attachments = $cil->list_attachments_fuzzy( $partial_name );
- unless ( defined $attachments ) {
- fatal("Couldn't find any attachments using '$partial_name'");
- }
-
- if ( @$attachments > 1 ) {
- fatal('found multiple attachments which match that name: ' . join(' ', map { $_->{name} } @$attachments));
- }
-
- my $attachment_name = $attachments->[0]->{name};
- my $attachment = CIL::Attachment->new_from_name($cil, $attachment_name);
- unless ( defined $attachment ) {
- fatal("Couldn't load attachment '$partial_name'");
- }
-
- return $attachment;
-}
-
-sub ans {
- my ($msg) = @_;
- print $msg;
- my $ans = <STDIN>;
- chomp $ans;
- print "\n";
- return $ans;
-}
-
-sub add_issue_loop {
- my ($cil, undef, $issue) = @_;
-
- my $edit = $y;
-
- # keep going until we get a valid issue or we want to quit
- while ( $edit eq $y ) {
- # read in the new issue text
- my $fh = CIL::Utils->solicit( $issue->as_output );
- $issue = CIL::Issue->new_from_fh( 'tmp', $fh );
-
- # check if the issue is valid
- if ( $issue->is_valid($cil) ) {
- $edit = 'n';
- }
- else {
- msg($_) foreach @{ $issue->errors };
- $edit = ans('Would you like to re-edit (y/n): ');
- }
- }
-
- # if the issue is still invalid, they quit without correcting it
- return unless $issue->is_valid( $cil );
-
- # we've got the issue, so let's name it
- my $unique_str = time . $issue->Inserted . $issue->Summary . $issue->Description;
- $issue->set_name( substr(md5_hex($unique_str), 0, 8) );
- $issue->save($cil);
-
- # should probably be run from with $cil
- $cil->run_hook('issue_post_save', $issue);
-
- display_issue($cil, $issue);
-
- return $issue;
-}
-
-sub add_comment_loop {
- my ($cil, undef, $issue, $comment) = @_;
-
- my $edit = $y;
-
- # keep going until we get a valid issue or we want to quit
- while ( $edit eq $y ) {
- # read in the new comment text
- my $fh = CIL::Utils->solicit( $comment->as_output );
- $comment = CIL::Comment->new_from_fh( 'tmp', $fh );
-
- # check if the comment is valid
- if ( $comment->is_valid($cil) ) {
- $edit = 'n';
- }
- else {
- msg($_) foreach @{ $issue->errors };
- $edit = ans('Would you like to re-edit (y/n): ');
- }
- }
-
- # if the comment is still invalid, they quit without correcting it
- return unless $comment->is_valid( $cil );
-
- # we've got the comment, so let's name it
- my $unique_str = time . $comment->Inserted . $issue->Description;
- $comment->set_name( substr(md5_hex($unique_str), 0, 8) );
-
- # finally, save it
- $comment->save($cil);
-
- # add the comment to the issue, update it's timestamp and save it out
- $issue->add_comment( $comment );
- $issue->save($cil);
- display_issue_full($cil, $issue);
-
- return $comment;
-}
-
-sub print_fsck_errors {
- my ($entity, $errors) = @_;
- return unless keys %$errors;
-
- separator();
- foreach my $issue_name ( keys %$errors ) {
- title( "$entity $issue_name ");
- foreach my $error ( @{$errors->{$issue_name}} ) {
- msg("* $error");
- }
- }
-}
-
## ----------------------------------------------------------------------------
# hooks
# none yet
-## ----------------------------------------------------------------------------
-# input/output
-
-sub display_issue {
- my ($cil, $issue) = @_;
-
- separator();
- title( 'Issue ' . $issue->name() );
- field( 'Summary', $issue->Summary() );
- field( 'Status', $issue->Status() );
- field( 'CreatedBy', $issue->CreatedBy() );
- field( 'AssignedTo', $issue->AssignedTo() );
- field( 'Label', $_ )
- foreach sort @{$issue->LabelList()};
- field( 'Comment', $_ )
- foreach sort @{$issue->CommentList()};
- field( 'Attachment', $_ )
- foreach sort @{$issue->AttachmentList()};
- field( 'DependsOn', $_ )
- foreach sort @{$issue->DependsOnList()};
- field( 'Precedes', $_ )
- foreach sort @{$issue->PrecedesList()};
- field( 'Inserted', $issue->Inserted() );
- field( 'Updated', $issue->Inserted() );
- text('Description', $issue->Description());
- separator();
-}
-
-sub display_issue_full {
- my ($cil, $issue) = @_;
-
- separator();
- title( 'Issue ' . $issue->name() );
- field( 'Summary', $issue->Summary() );
- field( 'Status', $issue->Status() );
- field( 'CreatedBy', $issue->CreatedBy() );
- field( 'AssignedTo', $issue->AssignedTo() );
- field( 'Label', $_ )
- foreach sort @{$issue->Label()};
- field( 'DependsOn', $_ )
- foreach sort @{$issue->DependsOnList()};
- field( 'Precedes', $_ )
- foreach sort @{$issue->PrecedesList()};
- field( 'Inserted', $issue->Inserted() );
- field( 'Updated', $issue->Inserted() );
- text('Description', $issue->Description());
-
- my $comments = $cil->get_comments_for( $issue );
- foreach my $comment ( @$comments ) {
- display_comment( $cil, $comment );
- }
-
- my $attachments = $cil->get_attachments_for( $issue );
- foreach my $attachment ( @$attachments ) {
- display_attachment( $cil, $attachment );
- msg();
- }
-
- separator();
-}
-
-sub display_comment {
- my ($cil, $comment) = @_;
-
- title( 'Comment ' . $comment->name() );
- field( 'CreatedBy', $comment->CreatedBy() );
- field( 'Inserted', $comment->Inserted() );
- field( 'Updated', $comment->Inserted() );
- text('Description', $comment->Description());
-}
-
-sub display_attachment {
- my ($cil, $attachment) = @_;
-
- title( 'Attachment ' . $attachment->name() );
- field( 'Filename', $attachment->Filename() );
- field( 'CreatedBy', $attachment->CreatedBy() );
- field( 'Inserted', $attachment->Inserted() );
- field( 'Updated', $attachment->Inserted() );
-}
-
-sub user {
- my ($cil) = @_;
- return $cil->UserName . ' <' . $cil->UserEmail . '>';
-}
-
## ----------------------------------------------------------------------------
# helper functions for this command line tool
return $args;
}
-sub text {
- my ($field, $value) = @_;
- msg "";
- msg($value);
- msg "";
-}
-
-sub err {
- print STDERR ( defined $_[0] ? $_[0] : '' );
- print STDERR "\n";
-}
-
-sub fatal {
- my ($msg) = @_;
- chomp $msg;
- print STDERR $msg, "\n";
- exit 2;
-}
-
## ----------------------------------------------------------------------------
# program info
sub run_hook {
my ($self, $hook_name, @rest) = @_;
- print "s=$self, hn=$hook_name, r=@rest\n";
-
unless ( defined $allowed->{hook}{$hook_name} ) {
croak "hook '$hook_name' not allowed";
}
}
## ----------------------------------------------------------------------------
-
-#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-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;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Add;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'add' }
+
+sub run {
+ my ($self, $cil, undef, @argv) = @_;
+
+ CIL::Utils->ensure_interactive();
+
+ my $user = CIL::Utils->user($cil);
+
+ my $issue = CIL::Issue->new('tmpname');
+ $issue->Summary( join ' ', @argv );
+ $issue->Status('New');
+ $issue->CreatedBy( $user );
+ $issue->Description("Description ...");
+
+ CIL::Utils->add_issue_loop($cil, undef, $issue);
+}
+
+1;
+
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Am;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'am' }
+
+sub run {
+ my ($self, $cil, undef, $email_filename) = @_;
+
+ unless ( -f $email_filename ) {
+ $cil->fatal("couldn't load email '$email_filename'");
+ }
+
+ my $msg_text = read_file($email_filename);
+
+ my $email = Email::Simple->new($msg_text);
+ unless ( defined $email ) {
+ $cil->fatal("email file '$email_filename' didn't look like an email");
+ }
+
+ # extract some fields
+ my $subject = $email->header('Subject');
+ my $from = $email->header('From');
+ my $date = find_date($email)->datetime;
+ my $body = $email->body;
+
+ # see if we can find any issue names in either the subject or the body
+ my @issue_names;
+ foreach my $text ( $subject, $body ) {
+ my @new = ( $text =~ /\b\#?([0-9a-f]{8})\b/gxms );
+ push @issue_names, @new;
+ }
+
+ $cil->msg("Found possible issue names in email: ", ( join(' ', @issue_names) || '[none]' ));
+
+ my %issue;
+ foreach ( @issue_names ) {
+ my $i = eval { CIL::Issue->new_from_name($cil, $_) };
+ next unless defined $i;
+
+ $issue{$i->name} = $i;
+ }
+
+ if ( keys %issue ) {
+ $cil->msg( "Found actual issues: " . (join(' ', keys %issue)) );
+
+ # create the new comment
+ my $comment = CIL::Comment->new('tmpname');
+ $comment->Issue( '...' );
+ $comment->CreatedBy( $from );
+ $comment->Inserted( $date );
+ # $comment->Updated( $date );
+ $comment->Description( $body );
+
+ # display
+ CIL::Utils->display_comment($cil, $comment);
+
+ # found at least one issue, so this might be a comment
+ my $issue;
+ if ( keys %issue == 1 ) {
+ $issue = (values %issue)[0];
+ }
+ else {
+ my $ans = ans('To which issue would you like to add this comment: ');
+
+ # ToDo: decide whether we let them choose an arbitrary issue, for
+ # now quit unless they choose one from the list
+ return unless exists $issue{$ans};
+
+ # got a valid issue_name, so set the parent name
+ $issue = $issue{$ans};
+ }
+
+ # set the parent issue
+ $comment->Issue( $issue->name );
+
+ add_comment_loop($cil, undef, $issue, $comment);
+ }
+ else {
+ $cil->msg("Couldn't find reference to any issues in the email.");
+
+ # no issue found so make up the issue first
+ my $issue = CIL::Issue->new('tmpname');
+ $issue->Summary( $subject );
+ $issue->Status( 'New' );
+ $issue->CreatedBy( $from );
+ $issue->AssignedTo( user($cil) );
+ $issue->Inserted( $date );
+ $issue->Updated( $date );
+ $issue->Description( $body );
+
+ # display
+ CIL::Utils->display_issue_full($cil, $issue);
+
+ # then ask if the user would like to add it
+ $cil->msg("Couldn't find any likely issues, so this might be a new one.");
+ my $ans = ans('Would you like to add this message as an issue shown above (y/n): ');
+ return unless $ans eq 'y';
+
+ CIL::Utils->add_issue_loop($cil, undef, $issue);
+ }
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Attach;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'attach' }
+
+sub run {
+ my ($self, $cil, undef, $issue_name, $filename) = @_;
+
+ my $issue = load_issue_fuzzy( $cil, $issue_name );
+
+ # check to see if the file exists
+ unless ( -r $filename ) {
+ $cil->fatal("couldn't read file '$filename'");
+ }
+
+ my $basename = basename( $filename );
+ my $user = user($cil);
+
+ my $add_attachment_text = <<"EOF";
+Filename : $basename
+CreatedBy : $user
+
+File goes here ... this will be overwritten.
+EOF
+
+ # read in the new issue text
+ CIL::Utils->ensure_interactive();
+ my $fh = CIL::Utils->solicit( $add_attachment_text );
+
+ my $attachment = CIL::Attachment->new_from_fh( 'tmp', $fh );
+ unless ( defined $attachment ) {
+ $cil->fatal("could not create new attachment");
+ }
+
+ # now add the file itself
+ my $contents = read_file( $filename );
+ $attachment->set_file_contents( $contents );
+
+ # set the size
+ my ($size) = (stat($filename))[7];
+ $attachment->Size( $size );
+
+ # we've got the attachment, so let's name it
+ my $unique_str = time . $attachment->Inserted . $attachment->File;
+ $attachment->set_name( substr(md5_hex($unique_str), 0, 8) );
+
+ # finally, tell it who it's parent is and then save
+ $attachment->Issue( $issue->name );
+ $attachment->save($cil);
+
+ # add the comment to the issue, update it's timestamp and save it out
+ $issue->add_attachment( $attachment );
+ $issue->save($cil);
+ CIL::Utils->display_issue_full($cil, $issue);
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Comment;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'comment' }
+
+sub run {
+ my ($self, $cil, undef, $issue_name) = @_;
+
+ my $issue = load_issue_fuzzy( $cil, $issue_name );
+
+ CIL::Utils->ensure_interactive();
+
+ # create the new comment
+ my $comment = CIL::Comment->new('tmpname');
+ $comment->Issue( $issue->name );
+ $comment->CreatedBy( user($cil) );
+ $comment->Description("Description ...");
+
+ CIL::Utils->add_comment_loop($cil, undef, $issue, $comment);
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::DependsOn;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'depends-on' }
+
+sub run {
+ my ($self, $cil, $args, $issue_name, $depends_name) = @_;
+
+ my $issue = CIL::Utils->load_issue_fuzzy($cil, $issue_name);
+ my $depends = CIL::Utils->load_issue_fuzzy($cil, $depends_name);
+
+ $issue->add_depends_on( $depends->name );
+ $depends->add_precedes( $issue->name );
+
+ $issue->save($cil);
+ $depends->save($cil);
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Edit;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+my $y = 'y';
+
+## ----------------------------------------------------------------------------
+
+sub name { 'edit' }
+
+sub run {
+ my ($self, $cil, undef, $issue_name) = @_;
+
+ my $issue = CIL::Utils->load_issue_fuzzy( $cil, $issue_name );
+
+ CIL::Utils->ensure_interactive();
+
+ my $edit = $y;
+
+ # keep going until we get a valid issue or we want to quit
+ while ( $edit eq $y ) {
+ # read in the new issue text
+ my $fh = CIL::Utils->solicit( $issue->as_output );
+ $issue = CIL::Issue->new_from_fh( $issue->name, $fh );
+
+ # check if the issue is valid
+ if ( $issue->is_valid($cil) ) {
+ $edit = 'n';
+ }
+ else {
+ msg($_) foreach @{ $issue->errors };
+ $edit = ans('Would you like to re-edit (y/n): ');
+ }
+ }
+
+ # if the issue is still invalid, they quit without correcting it
+ return unless $issue->is_valid( $cil );
+
+ # save it
+ $issue->save($cil);
+ CIL::Utils->display_issue($cil, $issue);
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Extract;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'extract' }
+
+sub run {
+ my ($self, $cil, $args, $attachment_name) = @_;
+
+ my $attachment = CIL::Utils->load_attachment_fuzzy($cil, $attachment_name);
+
+ my $filename = $args->{f} || $attachment->Filename();
+ write_file( $filename, $attachment->as_binary );
+}
+
+1;
+
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Fsck;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'fsck' }
+
+sub run {
+ my ($self, $cil, $args) = @_;
+
+
+ # this looks at all the issues it can find and checks for:
+ # * validity
+ # * all the comments are there
+ # * all the attachments are there
+ # then it checks each individual comment/attachment for:
+ # * ToDo: validity
+ # * it's parent exists
+
+ check_paths($cil);
+
+ # find all the issues, comments and attachments
+ my $issues = $cil->get_issues();
+ my $issue = {};
+ foreach my $i ( @$issues ) {
+ $issue->{$i->name} = $i;
+ }
+ my $comments = $cil->get_comments();
+ my $comment = {};
+ foreach my $c ( @$comments ) {
+ $comment->{$c->name} = $c;
+ }
+ my $attachments = $cil->get_attachments();
+ my $attachment = {};
+ foreach my $a ( @$attachments ) {
+ $attachment->{$a->name} = $a;
+ }
+
+ # ------
+ # issues
+ my $errors = {};
+ if ( @$issues ) {
+ foreach my $i ( sort { $a->Inserted cmp $b->Inserted } @$issues ) {
+ my $name = $i->name;
+
+ unless ( $i->is_valid($cil) ) {
+ foreach ( @{ $i->errors } ) {
+ push @{$errors->{$name}}, $_;
+ }
+ }
+
+ # check that all it's comments are there and that they have this parent
+ my $comments = $i->CommentList;
+ foreach my $c ( @$comments ) {
+ # see if this comment exists at all
+ if ( exists $comment->{$c} ) {
+ # check the parent is this issue
+ push @{$errors->{$name}}, "comment '$c' is listed under issue '" . $i->name . "' but does not reciprocate"
+ unless $comment->{$c}->Issue eq $i->name;
+ }
+ else {
+ push @{$errors->{$name}}, "comment '$c' listed in issue '" . $i->name . "' does not exist";
+ }
+ }
+
+ # check that all it's attachments are there and that they have this parent
+ my $attachments = $i->AttachmentList;
+ foreach my $a ( @$attachments ) {
+ # see if this attachment exists at all
+ if ( exists $attachment->{$a} ) {
+ # check the parent is this issue
+ push @{$errors->{$name}}, "attachment '$a' is listed under issue '" . $i->name . "' but does not reciprocate"
+ unless $attachment->{$a}->Issue eq $i->name;
+ }
+ else {
+ push @{$errors->{$name}}, "attachment '$a' listed in issue '" . $i->name . "' does not exist";
+ }
+ }
+
+ # check that all it's 'DependsOn' are there and that they have this under 'Precedes'
+ my $depends_on = $i->DependsOnList;
+ foreach my $d ( @$depends_on ) {
+ # see if this issue exists at all
+ if ( exists $issue->{$d} ) {
+ # check the 'Precedes' is this issue
+ my %precedes = map { $_ => 1 } @{$issue->{$d}->PrecedesList};
+ push @{$errors->{$name}}, "issue '$d' should precede '" . $i->name . "' but doesn't"
+ unless exists $precedes{$i->name};
+ }
+ else {
+ push @{$errors->{$name}}, "issue '$d' listed as a dependency of issue '" . $i->name . "' does not exist";
+ }
+ }
+
+ # check that all it's 'Precedes' are there and that they have this under 'DependsOn'
+ my $precedes = $i->PrecedesList;
+ foreach my $p ( @$precedes ) {
+ # see if this issue exists at all
+ if ( exists $issue->{$p} ) {
+ # check the 'DependsOn' is this issue
+ my %depends_on = map { $_ => 1 } @{$issue->{$p}->DependsOnList};
+ push @{$errors->{$name}}, "issue '$p' should depend on '" . $i->name . "' but doesn't"
+ unless exists $depends_on{$i->name};
+ }
+ else {
+ push @{$errors->{$name}}, "issue '$p' listed as preceding issue '" . $i->name . "' does not exist";
+ }
+ }
+ }
+ }
+ print_fsck_errors('Issue', $errors);
+
+ # --------
+ # comments
+ $errors = {};
+ # loop through all the comments
+ if ( @$comments ) {
+ # check that their parent issues exist
+ foreach my $c ( sort { $a->Inserted cmp $b->Inserted } @$comments ) {
+ # check that the parent of each comment exists
+ unless ( exists $issue->{$c->Issue} ) {
+ push @{$errors->{$c->name}}, "comment '" . $c->name . "' refers to issue '" . $c->Issue . "' but issue does not exist";
+ }
+ }
+ }
+ print_fsck_errors('Comment', $errors);
+
+ # -----------
+ # attachments
+ $errors = {};
+ # loop through all the attachments
+ if ( @$attachments ) {
+ # check that their parent issues exist
+ foreach my $a ( sort { $a->Inserted cmp $b->Inserted } @$attachments ) {
+ # check that the parent of each attachment exists
+ unless ( exists $issue->{$a->Issue} ) {
+ push @{$errors->{$a->name}}, "attachment '" . $a->name . "' refers to issue '" . $a->Issue . "' but issue does not exist";
+ }
+ }
+ }
+ print_fsck_errors('Attachment', $errors);
+
+ # ------------
+ # nothing left
+ separator();
+}
+
+sub print_fsck_errors {
+ my ($entity, $errors) = @_;
+ return unless keys %$errors;
+
+ separator();
+ foreach my $issue_name ( keys %$errors ) {
+ title( "$entity $issue_name ");
+ foreach my $error ( @{$errors->{$issue_name}} ) {
+ msg("* $error");
+ }
+ }
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Init;
+
+use strict;
+use warnings;
+use File::Slurp qw(read_file write_file);
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'init' }
+
+sub run {
+ my ($self, $cil, $args) = @_;
+
+ my $path = $args->{p} || '.'; # default path is right here
+
+ # error if $path doesn't exist
+ unless ( -d $path ) {
+ CIL::Utils->fatal("path '$path' doesn't exist");
+ }
+
+ # error if issues/ already exists
+ my $issues_dir = "$path/issues";
+ if ( -d $issues_dir ) {
+ CIL::Utils->fatal("issues directory '$issues_dir' already exists, not initialising issues");
+ }
+
+ # error if .cil already exists
+ my $config = "$path/.cil";
+ if ( -f $config ) {
+ CIL::Utils->fatal("config file '$config' already exists, not initialising issues");
+ }
+
+ # try to create the issues/ dir
+ unless ( mkdir $issues_dir ) {
+ CIL::Utils->fatal("Couldn't create '$issues_dir' directory: $!");
+ }
+
+ # are we in a Git repository?
+ my $VCSconfig = '';
+ if ( -d '.git' ) {
+ $cil->msg( 'git repository detected, setting VCS accordingly' );
+ $VCSconfig = 'VCS: git';
+ my $vcs = CIL::VCS::Factory->new( 'Git' );
+ }
+
+ # create a .cil file here also
+ if ( $args->{bare} ) {
+ unless ( touch $config ) {
+ rmdir $issues_dir;
+ CIL::Utils->fatal("couldn't create a '$config' file");
+ }
+ }
+ else {
+ # write a default .cil file
+ write_file($config, <<"CONFIG");
+$VCSconfig
+StatusStrict: 1
+StatusAllowedList: New
+StatusAllowedList: InProgress
+StatusAllowedList: Finished
+StatusOpenList: New
+StatusOpenList: InProgress
+StatusClosedList: Finished
+LabelStrict: 1
+LabelAllowedList: Type-Enhancement
+LabelAllowedList: Type-Defect
+LabelAllowedList: Priority-High
+LabelAllowedList: Priority-Medium
+LabelAllowedList: Priority-Low
+CONFIG
+ }
+
+ # add a README.txt so people know what this is about
+ unless ( -f "$issues_dir/README.txt" ) {
+ write_file("$issues_dir/README.txt", <<'README');
+This directory is used by CIL to track issues and feature requests.
+
+The home page for CIL is at http://kapiti.geek.nz/software/cil.html
+README
+ }
+
+ # $path/issues/ and $path/.cil create correctly
+ CIL::Utils->msg("initialised empty issue list inside '$path/'");
+}
+
+1;
+
+## ----------------------------------------------------------------------------
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
package CIL::Command::List;
use strict;
use warnings;
-use base 'CIL::Command';
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'list' }
sub run {
my ($self, $cil, $args) = @_;
- $cil->check_paths;
+ CIL::Utils->check_paths($cil);
# find all the issues
my $issues = $cil->get_issues();
- $issues = $cil->filter_issues( $issues, $args );
+ $issues = CIL::Utils->filter_issues( $cil, $issues, $args );
if ( @$issues ) {
foreach my $issue ( sort { $a->Inserted cmp $b->Inserted } @$issues ) {
- $cil->separator();
- $cil->display_issue_headers($issue);
+ CIL::Utils->separator();
+ CIL::Utils->display_issue_headers($issue);
}
- $cil->separator();
+ CIL::Utils->separator();
}
else {
- $cil->msg('no issues found');
+ CIL::Utils->msg('no issues found');
}
}
-'end of package CIL::Command::List';
+1;
+
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Precedes;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'precedes' }
+
+sub run {
+ my ($self, $cil, $args, $issue_name, $precedes_name) = @_;
+
+ my $issue = CIL::Utils->load_issue_fuzzy($cil, $issue_name);
+ my $precedes = CIL::Utils->load_issue_fuzzy($cil, $precedes_name);
+
+ $issue->add_precedes( $precedes->name );
+ $precedes->add_depends_on( $issue->name );
+
+ $issue->save($cil);
+ $precedes->save($cil);
+}
+
+1;
+
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Show;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'show' }
+
+sub run {
+ my ($self, $cil, undef, $issue_name) = @_;
+
+ # firstly, read the issue in
+ my $issue = CIL::Utils->load_issue_fuzzy( $cil, $issue_name );
+ CIL::Utils->display_issue_full($cil, $issue);
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Status;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'status' }
+
+sub run {
+ my ($self, $cil, undef, $issue_name, $status) = @_;
+
+ unless ( defined $status ) {
+ $cil->fatal("provide a status to set this issue to");
+ }
+
+ # firstly, read the issue in
+ my $issue = CIL::Utils->load_issue_fuzzy( $cil, $issue_name );
+
+ # set the status for this issue
+ $issue->Status( $status );
+ $issue->save($cil);
+
+ CIL::Utils->display_issue($cil, $issue);
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Steal;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'steal' }
+
+sub run {
+ my ($self, $cil, $args, $issue_name) = @_;
+
+ # firstly, read the issue in
+ my $issue = CIL::Utils->load_issue_fuzzy( $cil, $issue_name );
+
+ # set the AssignedTo for this issue to you (because you're stealing it)
+ $issue->AssignedTo( user($cil) );
+ $issue->save($cil);
+
+ CIL::Utils->display_issue($cil, $issue);
+}
+
+1;
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Summary;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'summary' }
+
+sub run {
+ my ($self, $cil, $args) = @_;
+
+ CIL::Utils->check_paths($cil);
+
+ # find all the issues
+ my $issues = $cil->get_issues();
+ $issues = CIL::Utils->filter_issues( $cil, $issues, $args );
+ if ( @$issues ) {
+ CIL::Utils->separator();
+ foreach my $issue ( @$issues ) {
+ CIL::Utils->display_issue_summary($issue);
+ }
+ CIL::Utils->separator();
+ }
+ else {
+ CIL::Utils->msg('no issues found');
+ }
+}
+
+1;
+
+## ----------------------------------------------------------------------------
--- /dev/null
+## ----------------------------------------------------------------------------
+# cil is a Command line Issue List
+# Copyright (C) 2008 Andrew Chilton
+#
+# This file is part of 'cil'.
+#
+# cil is free software: you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+#
+## ----------------------------------------------------------------------------
+
+package CIL::Command::Track;
+
+use strict;
+use warnings;
+
+use base qw(CIL::Command);
+
+## ----------------------------------------------------------------------------
+
+sub name { 'track' }
+
+sub run {
+ my ($self, $cil, undef, $issue_name) = @_;
+
+ CIL::Utils->fatal("the 'VCS' option in your .cil file is not set")
+ unless defined $cil->VCS;
+
+ CIL::Utils->fatal("the 'VCS' option currently only supports values of 'Git'")
+ unless $cil->VCS eq 'Git';
+
+ my $issue = CIL::Utils->load_issue_fuzzy($cil, $issue_name);
+
+ # add the issue to Git
+ my $issue_dir = $cil->IssueDir();
+ my @files;
+ push @files, "$issue_dir/i_" . $issue->name . '.cil';
+ push @files, map { "$issue_dir/c_${_}.cil" } @{ $issue->CommentList };
+ push @files, map { "$issue_dir/a_${_}.cil" } @{ $issue->AttachmentList };
+ CIL::Utils->msg("git add @files");
+}
+
+1;
+## ----------------------------------------------------------------------------
use Email::Find;
use POSIX qw(getpgrp tcgetpgrp);
use Fcntl qw(:DEFAULT :flock);
+use Digest::MD5 qw(md5_hex);
## ----------------------------------------------------------------------------
# setup some globals
my $editor = $ENV{EDITOR} || 'vi';
+my $y = 'y';
## ----------------------------------------------------------------------------
write_file($filename, $lines);
}
+## ----------------------------------------------------------------------------
+# input
+
# this method based on Term::CallEditor(v0.11)'s solicit method
# original: Copyright 2004 by Jeremy Mates
# copied under the terms of the GPL
return;
}
+sub add_issue_loop {
+ my ($class, $cil, undef, $issue) = @_;
+
+ my $edit = $y;
+
+ # keep going until we get a valid issue or we want to quit
+ while ( $edit eq $y ) {
+ # read in the new issue text
+ my $fh = $class->solicit( $issue->as_output );
+ $issue = CIL::Issue->new_from_fh( 'tmp', $fh );
+
+ # check if the issue is valid
+ if ( $issue->is_valid($cil) ) {
+ $edit = 'n';
+ }
+ else {
+ $class->msg($_) foreach @{ $issue->errors };
+ $edit = ans('Would you like to re-edit (y/n): ');
+ }
+ }
+
+ # if the issue is still invalid, they quit without correcting it
+ return unless $issue->is_valid( $cil );
+
+ # we've got the issue, so let's name it
+ my $unique_str = time . $issue->Inserted . $issue->Summary . $issue->Description;
+ $issue->set_name( substr(md5_hex($unique_str), 0, 8) );
+ $issue->save($cil);
+
+ # should probably be run from with $cil
+ $cil->run_hook('issue_post_save', $issue);
+
+ $class->display_issue($cil, $issue);
+
+ return $issue;
+}
+
+sub add_comment_loop {
+ my ($class, $cil, undef, $issue, $comment) = @_;
+
+ my $edit = $y;
+
+ # keep going until we get a valid issue or we want to quit
+ while ( $edit eq $y ) {
+ # read in the new comment text
+ my $fh = CIL::Utils->solicit( $comment->as_output );
+ $comment = CIL::Comment->new_from_fh( 'tmp', $fh );
+
+ # check if the comment is valid
+ if ( $comment->is_valid($cil) ) {
+ $edit = 'n';
+ }
+ else {
+ $class->msg($_) foreach @{ $issue->errors };
+ $edit = $class->ans('Would you like to re-edit (y/n): ');
+ }
+ }
+
+ # if the comment is still invalid, they quit without correcting it
+ return unless $comment->is_valid( $cil );
+
+ # we've got the comment, so let's name it
+ my $unique_str = time . $comment->Inserted . $issue->Description;
+ $comment->set_name( substr(md5_hex($unique_str), 0, 8) );
+
+ # finally, save it
+ $comment->save($cil);
+
+ # add the comment to the issue, update it's timestamp and save it out
+ $issue->add_comment( $comment );
+ $issue->save($cil);
+ $class->display_issue_full($cil, $issue);
+
+ return $comment;
+}
+
+## ----------------------------------------------------------------------------
+# loading
+
+sub load_issue_fuzzy {
+ my ($class, $cil, $partial_name) = @_;
+
+ my $issues = $cil->list_issues_fuzzy( $partial_name );
+ unless ( defined $issues ) {
+ $class->fatal("Couldn't find any issues using '$partial_name'");
+ }
+
+ if ( @$issues > 1 ) {
+ $class->fatal('found multiple issues which match that name: ' . join(' ', map { $_->{name} } @$issues));
+ }
+
+ my $issue_name = $issues->[0]->{name};
+ my $issue = CIL::Issue->new_from_name($cil, $issue_name);
+ unless ( defined $issue ) {
+ $class->fatal("Couldn't load issue '$issue_name'");
+ }
+
+ return $issue;
+}
+
+sub load_comment_fuzzy {
+ my ($class, $cil, $partial_name) = @_;
+
+ my $comments = $cil->list_comments_fuzzy( $partial_name );
+ unless ( defined $comments ) {
+ $class->fatal("Couldn't find any comments using '$partial_name'");
+ }
+
+ if ( @$comments > 1 ) {
+ $class->fatal('found multiple comments which match that name: ' . join(' ', map { $_->{name} } @$comments));
+ }
+
+ my $comment_name = $comments->[0]->{name};
+ my $comment = CIL::comment->new_from_name($cil, $comment_name);
+ unless ( defined $comment ) {
+ $class->fatal("Couldn't load comment '$comment_name'");
+ }
+
+ return $comment;
+}
+
+sub load_attachment_fuzzy {
+ my ($class, $cil, $partial_name) = @_;
+
+ my $attachments = $cil->list_attachments_fuzzy( $partial_name );
+ unless ( defined $attachments ) {
+ $class->fatal("Couldn't find any attachments using '$partial_name'");
+ }
+
+ if ( @$attachments > 1 ) {
+ $class->fatal('found multiple attachments which match that name: ' . join(' ', map { $_->{name} } @$attachments));
+ }
+
+ my $attachment_name = $attachments->[0]->{name};
+ my $attachment = CIL::Attachment->new_from_name($cil, $attachment_name);
+ unless ( defined $attachment ) {
+ $class->fatal("Couldn't load attachment '$partial_name'");
+ }
+
+ return $attachment;
+}
+
+## ----------------------------------------------------------------------------
+# display
+
+sub display_issue {
+ my ($class, $cil, $issue) = @_;
+
+ $class->separator();
+ $class->title( 'Issue ' . $issue->name() );
+ $class->field( 'Summary', $issue->Summary() );
+ $class->field( 'Status', $issue->Status() );
+ $class->field( 'CreatedBy', $issue->CreatedBy() );
+ $class->field( 'AssignedTo', $issue->AssignedTo() );
+ $class->field( 'Label', $_ )
+ foreach sort @{$issue->LabelList()};
+ $class->field( 'Comment', $_ )
+ foreach sort @{$issue->CommentList()};
+ $class->field( 'Attachment', $_ )
+ foreach sort @{$issue->AttachmentList()};
+ $class->field( 'DependsOn', $_ )
+ foreach sort @{$issue->DependsOnList()};
+ $class->field( 'Precedes', $_ )
+ foreach sort @{$issue->PrecedesList()};
+ $class->field( 'Inserted', $issue->Inserted() );
+ $class->field( 'Updated', $issue->Inserted() );
+ $class->text('Description', $issue->Description());
+ $class->separator();
+}
+
+sub display_issue_full {
+ my ($class, $cil, $issue) = @_;
+
+ $class->separator();
+ $class->title( 'Issue ' . $issue->name() );
+ $class->field( 'Summary', $issue->Summary() );
+ $class->field( 'Status', $issue->Status() );
+ $class->field( 'CreatedBy', $issue->CreatedBy() );
+ $class->field( 'AssignedTo', $issue->AssignedTo() );
+ $class->field( 'Label', $_ )
+ foreach sort @{$issue->Label()};
+ $class->field( 'DependsOn', $_ )
+ foreach sort @{$issue->DependsOnList()};
+ $class->field( 'Precedes', $_ )
+ foreach sort @{$issue->PrecedesList()};
+ $class->field( 'Inserted', $issue->Inserted() );
+ $class->field( 'Updated', $issue->Inserted() );
+ $class->text('Description', $issue->Description());
+
+ my $comments = $cil->get_comments_for( $issue );
+ foreach my $comment ( @$comments ) {
+ $class->display_comment( $cil, $comment );
+ }
+
+ my $attachments = $cil->get_attachments_for( $issue );
+ foreach my $attachment ( @$attachments ) {
+ $class->display_attachment( $cil, $attachment );
+ $class->msg();
+ }
+
+ $class->separator();
+}
+
+sub display_comment {
+ my ($class, $cil, $comment) = @_;
+
+ $class->title( 'Comment ' . $comment->name() );
+ $class->field( 'CreatedBy', $comment->CreatedBy() );
+ $class->field( 'Inserted', $comment->Inserted() );
+ $class->field( 'Updated', $comment->Inserted() );
+ $class->text('Description', $comment->Description());
+}
+
+sub display_attachment {
+ my ($class, $cil, $attachment) = @_;
+
+ $class->title( 'Attachment ' . $attachment->name() );
+ $class->field( 'Filename', $attachment->Filename() );
+ $class->field( 'CreatedBy', $attachment->CreatedBy() );
+ $class->field( 'Inserted', $attachment->Inserted() );
+ $class->field( 'Updated', $attachment->Inserted() );
+}
+
+sub filter_issues {
+ my ($class, $cil, $issues, $args) = @_;
+
+ # don't filter if we haven't been given anything
+ return $issues unless defined $args;
+ 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'} ) {
+ $class->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 {
+ my ($class) = @_;
+ $class->msg('=' x 79);
+}
+
+sub msg {
+ my ($class, $msg) = @_;
+ print ( defined $msg ? $msg : '' );
+ print "\n";
+}
+
+sub display_issue_summary {
+ my ($class, $issue) = @_;
+
+ my $msg = $issue->name();
+ $msg .= "\t";
+ $msg .= $issue->Status();
+ $msg .= "\t";
+ $msg .= $issue->Summary();
+
+ $class->msg($msg);
+}
+
+sub display_issue_headers {
+ my ($class, $issue) = @_;
+
+ # $class->title( 'Issue ' . $issue->name() );
+ $class->field( 'Summary', $issue->Summary() );
+ $class->field( 'CreatedBy', $issue->CreatedBy() );
+ $class->field( 'AssignedTo', $issue->AssignedTo() );
+ $class->field( 'Inserted', $issue->Inserted() );
+ $class->field( 'Status', $issue->Status() );
+ $class->field( 'Labels', join(' ', @{$issue->LabelList()}) );
+ $class->field( 'DependsOn', join(' ', @{$issue->DependsOnList()}) );
+ $class->field( 'Precedes', join(' ', @{$issue->PrecedesList()}) );
+}
+
+sub title {
+ my ($class, $title) = @_;
+ my $msg = "--- $title ";
+ $msg .= '-' x (74 - length($title));
+ $class->msg($msg);
+}
+
+sub field {
+ my ($class, $field, $value) = @_;
+ my $msg = "$field";
+ $msg .= " " x (12 - length($field));
+ $class->msg("$msg: " . (defined $value ? $value : '') );
+}
+
+sub text {
+ my ($class, $field, $value) = @_;
+ $class->msg();
+ $class->msg($value);
+ $class->msg();
+}
+
+## ----------------------------------------------------------------------------
+# system
+
+sub check_paths {
+ my ($class, $cil) = @_;
+
+ # make sure an issue directory is available
+ unless ( $cil->dir_exists($cil->IssueDir) ) {
+ $class->fatal("couldn't find '" . $cil->IssueDir . "' directory");
+ }
+}
+
+sub ans {
+ my ($msg) = @_;
+ print $msg;
+ my $ans = <STDIN>;
+ chomp $ans;
+ print "\n";
+ return $ans;
+}
+
+sub err {
+ my ($class, $msg) = @_;
+ print STDERR ( defined $msg ? $msg : '' );
+ print STDERR "\n";
+}
+
+sub fatal {
+ my ($class, $msg) = @_;
+ chomp $msg;
+ print STDERR $msg, "\n";
+ exit 2;
+}
+
+## ----------------------------------------------------------------------------
+# helpers
+
sub extract_email_address {
my ($class, $text) = @_;
return $email_address;
}
+sub user {
+ my ($class, $cil) = @_;
+ return $cil->UserName . ' <' . $cil->UserEmail . '>';
+}
+
## ----------------------------------------------------------------------------
1;
## ----------------------------------------------------------------------------
projects / cil.git / commitdiff