Imported Upstream version 0.2.1upstream/0.2.1

6 files changed, 809 insertions, 0 deletions

diff --git a/lib/CIL.pm b/lib/CIL.pm
new file mode 100644
index 0000000..b85f2fb
--- /dev/null
+++ b/lib/CIL.pm
@@ -0,0 +1,114 @@
+## ----------------------------------------------------------------------------
+# 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;
+
+use strict;
+use warnings;
+use File::Glob qw(:glob);
+
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw(issue_dir));
+
+my $defaults = {
+    issue_dir => 'issues',
+};
+
+## ----------------------------------------------------------------------------
+
+sub new {
+    my ($proto, $cfg) = @_;
+
+    $cfg ||= {};
+
+    my $class = ref $proto || $proto;
+    my $self = bless {}, $class;
+
+    # save the settings for various bits of info
+    foreach my $key ( keys %$defaults ) {
+        # if we have been passed it in, use it, else use the default
+        $self->$key( $cfg->{$key} || $defaults->{$key} ); 
+    }
+    return $self;
+}
+
+sub list_issues {
+    my ($self) = @_;
+
+    my $globpath = $self->issue_dir . "/i_*.cil";
+    my @filenames = bsd_glob($globpath);
+
+    my @issues;
+    foreach my $filename ( sort @filenames ) {
+        my ($name) = $filename =~ m{/i_(.*)\.cil$}xms;
+        push @issues, {
+            name => $name,
+            filename => $filename,
+        };
+    }
+    return \@issues;
+}
+
+sub get_issues {
+    my ($self) = @_;
+
+    my $issue_list = $self->list_issues();
+
+    my @issues;
+    foreach my $issue ( @$issue_list ) {
+        push @issues, CIL::Issue->new_from_name( $self, $issue->{name} );
+    }
+    return \@issues;
+}
+
+sub get_comments_for {
+    my ($self, $issue) = @_;
+
+    my @comments;
+    foreach my $comment_name ( @{$issue->Comments} ) {
+        my $comment = CIL::Comment->new_from_name( $self, $comment_name );
+        push @comments, $comment;
+    }
+
+    # sort them in cronological order
+    @comments = sort { $a->Inserted cmp $b->Inserted } @comments;
+
+    return \@comments;
+}
+
+sub get_attachments_for {
+    my ($self, $issue) = @_;
+
+    my @attachments;
+    foreach my $attachment_name ( @{$issue->Attachments} ) {
+        my $attachment = CIL::Attachment->new_from_name( $self, $attachment_name );
+        push @attachments, $attachment;
+    }
+
+    # sort them in cronological order
+    @attachments = sort { $a->Inserted cmp $b->Inserted } @attachments;
+
+    return \@attachments;
+}
+
+## ----------------------------------------------------------------------------
+1;
+## ----------------------------------------------------------------------------
diff --git a/lib/CIL/Attachment.pm b/lib/CIL/Attachment.pm
new file mode 100644
index 0000000..337ed1a
--- /dev/null
+++ b/lib/CIL/Attachment.pm
@@ -0,0 +1,98 @@
+## ----------------------------------------------------------------------------
+# 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::Attachment;
+
+use strict;
+use warnings;
+use Carp;
+
+use MIME::Base64;
+
+use base qw(CIL::Base);
+
+# fields specific to Attachment
+__PACKAGE__->mk_accessors(qw(Issue Filename Size File));
+
+# all fields
+my @FIELDS = ( qw(Issue Filename Size CreatedBy Inserted Updated File) );
+
+## ----------------------------------------------------------------------------
+
+sub new {
+    my ($proto, $name) = @_;
+
+    croak 'please provide an attachment name'
+        unless defined $name;
+
+    my $class = ref $proto || $proto;
+    my $self = {};
+    bless $self, $class;
+
+    $self->set_name( $name );
+    $self->{data}    = {
+        Issue       => '',
+        Filename    => '',
+        Size        => '',
+        CreatedBy   => '',
+        Inserted    => '',
+        Updated     => '',
+        File        => '',
+    };
+    $self->{Changed} = 0;
+
+    $self->set_inserted_now;
+
+    return $self;
+}
+
+sub set_file_contents {
+    my ($self, $contents) = @_;
+
+    # $contents will be binary
+    $self->{data}{File} = encode_base64( $contents );
+}
+
+sub as_binary {
+    my ($self) = @_;
+
+    return decode_base64( $self->{data}{File} );
+}
+
+sub prefix {
+    return 'a';
+}
+
+sub fields {
+    return \@FIELDS;
+}
+
+sub array_fields {
+    return {};
+}
+
+sub last_field {
+    return 'File';
+}
+
+## ----------------------------------------------------------------------------
+1;
+## ----------------------------------------------------------------------------
diff --git a/lib/CIL/Base.pm b/lib/CIL/Base.pm
new file mode 100644
index 0000000..ed5c3a8
--- /dev/null
+++ b/lib/CIL/Base.pm
@@ -0,0 +1,189 @@
+## ----------------------------------------------------------------------------
+# 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::Base;
+
+use strict;
+use warnings;
+use Carp;
+use DateTime;
+
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw(CreatedBy Inserted Updated));
+
+## ----------------------------------------------------------------------------
+
+sub new_from_name {
+    my ($class, $cil, $name) = @_;
+
+    croak 'provide a name'
+        unless defined $name;
+
+    my $filename = $class->create_filename($cil, $name);
+    croak "filename '$filename' does no exist"
+        unless -f $filename;
+
+    my $data = CIL::Utils->parse_cil_file($filename, $class->last_field);
+    my $issue = $class->new_from_data( $name, $data );
+    return $issue;
+}
+
+sub new_from_data {
+    my ($class, $name, $data) = @_;
+
+    croak 'please provide an issue name'
+        unless defined $name;
+
+    # ToDo: check we have all the other correct fields
+
+    # create the issue
+    my $self = $class->new( $name );
+
+    my $fields = $class->fields();
+    my $array_fields = $class->array_fields();
+
+    # save each field
+    foreach my $field ( @$fields ) {
+        next unless defined $data->{$field};
+
+        # make it an array if it should be one
+        if ( exists $array_fields->{$field} and ref $data->{$field} ne 'ARRAY' ) {
+            $data->{$field} = [ $data->{$field} ];
+        }
+
+        # modify the data directly, otherwise Updated will kick in
+        $self->set_no_update($field, $data->{$field});
+    }
+    $self->set_no_update('Changed', 0);
+
+    return $self;
+}
+
+sub new_from_fh {
+    my ($class, $name, $fh) = @_;
+
+    croak 'please provide name'
+        unless defined $name;
+
+    my $data = CIL::Utils->parse_from_fh( $fh, $class->last_field );
+    return $class->new_from_data( $name, $data );
+}
+
+sub save {
+    my ($self, $cil) = @_;
+
+    my $filename = $self->create_filename($cil, $self->name);
+
+    my $fields = $self->fields();
+    CIL::Utils->write_cil_file( $filename, $self->{data}, @$fields );
+}
+
+sub create_filename {
+    my ($class, $cil, $name) = @_;
+
+    # create the filename from it's parts
+    my $prefix    = $class->prefix();
+    my $issue_dir = $cil->issue_dir;
+    my $filename  = "${issue_dir}/${prefix}_${name}.cil";
+
+    return $filename;
+}
+
+# override Class::Accessor's get
+sub get {
+    my ($self, $field) = @_;
+    croak "provide a field name"
+        unless defined $field;
+    $self->{data}{$field};
+}
+
+# override Class::Accessor's set
+sub set {
+    my ($self, $field, $value) = @_;
+    croak "provide a field name"
+        unless defined $field;
+
+    my $orig = $self->get($field);
+
+    # finish if both are defined and they're the same
+    if ( defined $orig and defined $value ) {
+        return if eval { $orig eq $value };
+    }
+
+    # finish if neither are defined
+    return unless ( defined $orig or defined $value );
+
+    # since we're actually changing the field, say we updated something
+    $self->{data}{$field} = $value;
+    $self->set_updated_now;
+}
+
+# so that we can update fields without 'Updated' being changed
+sub set_no_update {
+    my ($self, $field, $value) = @_;
+
+    my $saved_update_time = $self->Updated;
+    $self->set( $field, $value );
+    $self->Updated( $saved_update_time );
+}
+
+sub set_inserted_now {
+    my ($self) = @_;
+    my $time = DateTime->now;
+    $self->{data}{Inserted} = $time;
+    $self->{data}{Updated} = $time;
+    $self->{Changed} = 1;
+}
+
+sub set_updated_now {
+    my ($self) = @_;
+    my $time = DateTime->now;
+    $self->{data}{Updated} = $time;
+    $self->{Changed} = 1;
+}
+
+sub flag_as_updated {
+    my ($self) = @_;
+    $self->{Changed} = 1;
+}
+
+sub changed {
+    my ($self) = @_;
+    return $self->{Changed};
+}
+
+sub set_name {
+    my ($self, $name) = @_;
+
+    croak 'provide a name'
+        unless defined $name;
+
+    $self->{name} = $name;
+}
+
+sub name {
+    my ($self) = @_;
+    return $self->{name};
+}
+
+## ----------------------------------------------------------------------------
+1;
+## ----------------------------------------------------------------------------
diff --git a/lib/CIL/Comment.pm b/lib/CIL/Comment.pm
new file mode 100644
index 0000000..9d0398c
--- /dev/null
+++ b/lib/CIL/Comment.pm
@@ -0,0 +1,80 @@
+## ----------------------------------------------------------------------------
+# 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::Comment;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw(CIL::Base);
+
+# fields specific to Comment
+__PACKAGE__->mk_accessors(qw(Issue Description));
+
+my @FIELDS = ( qw(Issue CreatedBy Inserted Updated Description) );
+
+## ----------------------------------------------------------------------------
+
+sub new {
+    my ($proto, $name) = @_;
+
+    croak 'please provide a comment name'
+        unless defined $name;
+
+    my $class = ref $proto || $proto;
+    my $self = {};
+    bless $self, $class;
+
+    $self->set_name( $name );
+    $self->{data}    = {
+        Issue       => '',
+        CreatedBy   => '',
+        Inserted    => '',
+        Updated     => '',
+        Description => '',
+    };
+    $self->{Changed} = 0;
+
+    $self->set_inserted_now;
+
+    return $self;
+}
+
+sub prefix {
+    return 'c';
+}
+
+sub fields {
+    return \@FIELDS;
+}
+
+sub array_fields {
+    return {};
+}
+
+sub last_field {
+    return 'Description';
+}
+
+## ----------------------------------------------------------------------------
+1;
+## ----------------------------------------------------------------------------
diff --git a/lib/CIL/Issue.pm b/lib/CIL/Issue.pm
new file mode 100644
index 0000000..0dfaf53
--- /dev/null
+++ b/lib/CIL/Issue.pm
@@ -0,0 +1,144 @@
+## ----------------------------------------------------------------------------
+# 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::Issue;
+
+use strict;
+use warnings;
+use Carp;
+
+use CIL;
+use CIL::Utils;
+
+use base qw(CIL::Base);
+
+# fields specific to Issue
+__PACKAGE__->mk_accessors(qw(Summary Status AssignedTo Label Comment Attachment Description));
+
+my @FIELDS = ( qw(Summary Status CreatedBy AssignedTo Label Comment Attachment Inserted Updated Description) );
+my $cfg = {
+    array => {
+        Label      => 1,
+        Comment    => 1,
+        Attachment => 1,
+    },
+};
+
+## ----------------------------------------------------------------------------
+
+sub new {
+    my ($proto, $name) = @_;
+
+    croak 'please provide an issue name'
+        unless defined $name;
+
+    my $class = ref $proto || $proto;
+    my $self = {};
+    bless $self, $class;
+
+    $self->set_name( $name );
+    $self->{data}    = {
+        Summary     => '',
+        Status      => '',
+        CreatedBy   => '',
+        AssignedTo  => '',
+        Inserted    => '',
+        Updated     => '',
+        Label       => [],
+        Comment     => [],
+        Attachment  => [],
+        Description => '',
+    };
+    $self->{Changed} = 0;
+
+    $self->set_inserted_now;
+
+    return $self;
+}
+
+sub prefix {
+    return 'i';
+}
+
+sub fields {
+    return \@FIELDS;
+}
+
+sub array_fields {
+    return $cfg->{array};
+}
+
+sub last_field {
+    return 'Description';
+}
+
+sub add_label {
+    my ($self, $label) = @_;
+
+    croak 'provide a label when adding one'
+        unless defined $label;
+
+    push @{$self->{data}{Label}}, $label;
+    $self->flag_as_updated();
+}
+
+sub add_comment {
+    my ($self, $comment) = @_;
+
+    croak "can only add comments of type CIL::Comment"
+        unless $comment->isa( 'CIL::Comment' );
+
+    # add the comment name and set this issue's updated time
+    push @{$self->{data}{Comment}}, $comment->name;
+    $self->Updated( $comment->Updated );
+    $self->flag_as_updated();
+}
+
+sub add_attachment {
+    my ($self, $attachment) = @_;
+
+    croak "can only add attachments of type CIL::Attachment"
+        unless $attachment->isa( 'CIL::Attachment' );
+
+    # add the attachment name and set this issue's updated time
+    push @{$self->{data}{Attachment}}, $attachment->name;
+    $self->Updated( $attachment->Updated );
+    $self->flag_as_updated();
+}
+
+sub as_output {
+    my ($self) = @_;
+    return CIL::Utils->format_data_as_output( $self->{data}, @FIELDS );
+}
+
+sub Comments {
+    my ($self) = @_;
+    return $self->{data}{Comment};
+}
+
+sub Attachments {
+    my ($self) = @_;
+    return $self->{data}{Attachment};
+}
+
+## ----------------------------------------------------------------------------
+1;
+## ----------------------------------------------------------------------------
diff --git a/lib/CIL/Utils.pm b/lib/CIL/Utils.pm
new file mode 100644
index 0000000..a0e165c
--- /dev/null
+++ b/lib/CIL/Utils.pm
@@ -0,0 +1,184 @@
+## ----------------------------------------------------------------------------
+# 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::Utils;
+
+use strict;
+use warnings;
+use Carp;
+use File::Slurp;
+use File::Temp qw(tempfile);
+use POSIX qw(getpgrp tcgetpgrp);
+use Fcntl qw(:DEFAULT :flock);
+
+## ----------------------------------------------------------------------------
+# setup some globals
+
+my $editor = $ENV{EDITOR} || 'vi';
+
+## ----------------------------------------------------------------------------
+
+sub parse_cil_file {
+    my ($class, $filename, $last_field) = @_;
+
+    my @lines = read_file($filename);
+    return unless @lines;
+
+    return $class->parse_from_lines( $last_field, @lines );
+}
+
+sub parse_from_fh {
+    my ($class, $fh, $last_field) = @_;
+
+    my @lines = <$fh>;
+    return unless @lines;
+
+    return $class->parse_from_lines( $last_field, @lines );
+}
+
+sub parse_from_lines {
+    my ($class, $last_field, @lines) = @_;
+    return unless @lines;
+    chomp @lines;
+
+    my $data = {};
+
+    # read all the initial fields
+    while ( my $line = shift @lines ) {
+        my ($key, $value) = split(/\s*:\s*/, $line, 2);
+
+        if ( defined $data->{$key} ) {
+            unless ( ref $data->{$key} eq 'ARRAY' ) {
+                $data->{$key} = [ $data->{$key} ];
+            };
+            push @{$data->{$key}}, $value;
+        }
+        else {
+            $data->{$key} = $value;
+        }
+    }
+    
+    # now read everything that's left into the $last_field field
+    $data->{$last_field} = join("\n", @lines);
+
+    return $data;
+}
+
+sub format_data_as_output {
+    my ($class, $data, @fields) = @_;
+
+    # we format the last field differently, so pop it off now
+    my $last_field = pop @fields;
+
+    my @lines;
+    foreach my $field ( @fields ) {
+        next if $field eq $last_field;
+
+        if ( ref $data->{$field} eq 'ARRAY' ) {
+            # don't output this field if there is nothing in it
+            next unless @{$data->{$field}};
+
+            foreach ( sort @{$data->{$field}} ) {
+                push @lines, "$field: $_\n";
+            }
+        }
+        else {
+            push @lines, "$field: $data->{$field}\n";
+        }
+    }
+
+    # finally, output the last field on it's own
+    push @lines, "\n";
+    push @lines, $data->{$last_field}, "\n";
+
+    return \@lines;
+}
+
+sub write_cil_file {
+    my ($class, $filename, $data, @fields) = @_;
+
+    # get the output format
+    my $lines = $class->format_data_as_output($data, @fields);
+
+    # ... and save
+    write_file($filename, $lines);
+}
+
+# this method based on Term::CallEditor(v0.11)'s solicit method
+# original: Copyright 2004 by Jeremy Mates
+# copied under the terms of the GPL
+sub solicit {
+    my ($class, $message) = @_;
+
+    # when calling this, assume we're already interactive
+
+    File::Temp->safe_level(File::Temp::HIGH);
+    my ( $fh, $filename ) = tempfile( UNLINK => 1 );
+
+    # since File::Temp returns both, check both
+    unless ( $fh and $filename ) {
+        croak "couldn't create temporary file";
+    }
+
+    select( ( select($fh), $|++ )[0] );
+    print $fh $message;
+
+    # need to unlock for external editor
+    flock $fh, LOCK_UN;
+
+    # run the editor
+    my $status = system($editor, $filename);
+
+    # check its return value
+    if ( $status != 0 ) {
+        croak $status != -1
+            ? "external editor ($editor) failed: $?"
+            : "could not launch ($editor) program: $!";
+    }
+
+    unless ( seek $fh, 0, 0 ) {
+        croak "could not seek on temp file: errno=$!";
+    }
+
+    return $fh;
+}
+
+# this method based on Recipe 15.2
+sub ensure_interactive {
+    my $tty;
+    open($tty, "/dev/tty")
+        or croak "program not running interactively (can't open /dev/tty): $!";
+
+    my $tpgrp = tcgetpgrp( fileno($tty) );
+    my $pgrp = getpgrp();
+    close $tty;
+
+    unless ( $tpgrp == $pgrp ) {
+        croak "can't get exclusive control of tty: tpgrp=$tpgrp, pgrp=$pgrp";
+    }
+
+    # if we are here, then we have ensured what we wanted
+    return;
+}
+
+## ----------------------------------------------------------------------------
+1;
+## ----------------------------------------------------------------------------