From 42280f662d3ce4affb00eb68a22a081dfb951395 Mon Sep 17 00:00:00 2001 From: Francois Marier Date: Mon, 23 Jun 2008 23:47:09 +1200 Subject: Imported Upstream version 0.2.1 --- lib/CIL.pm | 114 ++++++++++++++++++++++++++++++ lib/CIL/Attachment.pm | 98 ++++++++++++++++++++++++++ lib/CIL/Base.pm | 189 ++++++++++++++++++++++++++++++++++++++++++++++++++ lib/CIL/Comment.pm | 80 +++++++++++++++++++++ lib/CIL/Issue.pm | 144 ++++++++++++++++++++++++++++++++++++++ lib/CIL/Utils.pm | 184 ++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 809 insertions(+) create mode 100644 lib/CIL.pm create mode 100644 lib/CIL/Attachment.pm create mode 100644 lib/CIL/Base.pm create mode 100644 lib/CIL/Comment.pm create mode 100644 lib/CIL/Issue.pm create mode 100644 lib/CIL/Utils.pm (limited to 'lib') 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 . +# +## ---------------------------------------------------------------------------- + +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 . +# +## ---------------------------------------------------------------------------- + +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 . +# +## ---------------------------------------------------------------------------- + +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 . +# +## ---------------------------------------------------------------------------- + +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 . +# +## ---------------------------------------------------------------------------- + +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 . +# +## ---------------------------------------------------------------------------- + +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; +## ---------------------------------------------------------------------------- -- cgit v1.2.3