Permalink
Browse files

Slurping up everything from my local repo

  • Loading branch information...
0 parents commit b428ba21ee16ecb3e85b9bd21683904596f78e90 @petdance committed Apr 16, 2007
Showing with 1,837 additions and 0 deletions.
  1. +69 −0 Changes
  2. +80 −0 HWD.pm
  3. +20 −0 MANIFEST
  4. +39 −0 Makefile.PL
  5. +29 −0 README
  6. +302 −0 Task.pm
  7. +150 −0 Work.pm
  8. +395 −0 bin/hwd
  9. +90 −0 bin/hwd-burnchart
  10. +259 −0 eg/sked.hwd
  11. +56 −0 etc/hwd.vim
  12. +10 −0 t/00-load.t
  13. +25 −0 t/burndown.t
  14. +46 −0 t/hwd.t
  15. +6 −0 t/pod-coverage.t
  16. +6 −0 t/pod.t
  17. +32 −0 t/simple.hwd
  18. +21 −0 t/started.t
  19. +150 −0 t/task.t
  20. +52 −0 t/work.t
69 Changes
@@ -0,0 +1,69 @@
+Revision history for App-HWD
+
+0.08 Tue Aug 30 16:43:54 CDT 2005
+ [THINGS THAT MIGHT BREAK YOUR CODE]
+ * Dates must now be in YYYY-MM-DD format.
+
+ [ENHANCEMENTS]
+ * Added --todo option to show only those items needing to be done.
+ * Now handles fractional estimates.
+ * Now handles deletion dates. We don't DO anything with them,
+ but they're legal, and burndown ignores them.
+ * Franctional estimates and velocities in the main listing now
+ show as "+" rather than the decimals. For example, "12"
+ shows as "12", but "12.5" shows as "12+".
+
+ [FIXES]
+ * No longer double-counts tasks worked on by multiple people
+ in --started.
+ * Doesn't print a total when a --started person is specified.
+
+0.07_01 Wed Aug 17 15:03:12 CDT 2005
+ [THINGS THAT MIGHT BREAK YOUR CODE]
+ * Previously, a task that was added after coding started was
+ noted like this:
+
+ --Implement widget (#251, 4hrs, @11/7/05)
+
+ Now, we use the word "added" instead of "@"
+
+ --Implement widget (#251, 4hrs, added 11/7/05)
+
+ [ENHANCEMENTS]
+ * Added whitespace to --started output.
+ * Gives total points open on --started.
+
+ [FIXES]
+ * Fixed potentially destructive bug in a test file:
+
+ unlink($started, qr#Chimp is working on.+ 107 - Refactor \(1/1\)#s);
+
+ That "unlink" is, of course, supposed to be "unlike". OOPS!
+
+ [INTERNALS]
+ * Removed code for handling --detail_level
+ * bin/hwd now has no globals.
+ * Added many items to TODO list.
+
+0.06 Sun Aug 14 21:52:55 CDT 2005
+ [ENHANCEMENTS]
+ * Added a vim syntax file in etc/hwd.vim.
+ * Added --burndown and starting on the burndown graphic.
+ Thanks to Neil & Luke again.
+ * Added a $task->date_added()
+
+0.04 Tue Aug 2 15:47:23 CDT 2005
+ [ENHANCEMENTS]
+ * Added --started feature. Thanks to Neil Watkiss and Luke
+ Closs from Sophos.
+
+0.02 Mon Aug 1 14:32:29 PDT 2005
+ [FIXES]
+ * Fixes silly syntax bummers.
+
+ [ENHANCEMENTS]
+ * Added --nextid
+
+0.01
+ First version, released on an unsuspecting world.
+
80 HWD.pm
@@ -0,0 +1,80 @@
+package App::HWD;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+App::HWD - The great new App::HWD!
+
+=head1 VERSION
+
+Version 0.08
+
+=cut
+
+our $VERSION = '0.08';
+
+=head1 SYNOPSIS
+
+This module is nothing more than a place-holder for the version info and the TODO list.
+
+=head1 TODO
+
+=over 4
+
+=item * Add support for HWDFILE environment variable so those of us who are only ever using one file don't have to keep retyping the name all the time.
+
+=item * Add support for deleting tasks
+
+=item * Add support for changing estimates on a task
+
+=item * Open tasks are doubling up if two people have it open.
+
+=item * Show task history
+
+=item * Show tasks that are too big.
+
+=item * Show tasks that have gone over
+
+=item * Add a way to delete tasks that we don't want.
+
+=item * Add a way to put in comment text.
+
+=item * BUG: Bruce's open tasks aren't complete
+
+=item * Weekly burndown
+
+The C<--burndown> flag gives totals as they happen. I want them to give
+a Monday-morning total since I like to plot weekly, not daily.
+
+=back
+
+=head1 AUTHOR
+
+Andy Lester, C<< <andy at petdance.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-app-hwd at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-HWD>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 ACKNOWLEDGEMENTS
+
+Thanks to
+Neil Watkiss
+and Luke Closs for features and patches.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2005 Andy Lester, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of App::HWD
20 MANIFEST
@@ -0,0 +1,20 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+HWD.pm
+Task.pm
+Work.pm
+bin/hwd
+bin/hwd-burnchart
+eg/sked.hwd
+etc/hwd.vim
+t/00-load.t
+t/burndown.t
+t/hwd.t
+t/pod-coverage.t
+t/pod.t
+t/simple.hwd
+t/started.t
+t/task.t
+t/work.t
39 Makefile.PL
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'App::HWD',
+ AUTHOR => 'Andy Lester <andy@petdance.com>',
+ VERSION_FROM => 'HWD.pm',
+ ABSTRACT_FROM => 'HWD.pm',
+ PL_FILES => {},
+ EXE_FILES => [ 'bin/hwd', 'bin/hwd-burnchart' ],
+ PM => {
+ 'HWD.pm' => '$(INST_LIBDIR)/HWD.pm',
+ 'Task.pm' => '$(INST_LIBDIR)/HWD/Task.pm',
+ 'Work.pm' => '$(INST_LIBDIR)/HWD/Work.pm',
+ },
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'Getopt::Long' => 0,
+ 'Pod::Usage' => 0,
+ 'DateTime' => 0,
+ 'DateTime::Format::Strptime' => 0,
+ },
+ MAN3PODS => { }, # no need for docs on these
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'App-HWD-*' },
+);
+
+sub MY::postamble {
+ return <<'MAKE_FRAG';
+.PHONY: tags
+
+tags:
+ ctags -f tags --recurse --totals \
+ --exclude=blib/ --exclude=t/lib \
+ --exclude=.svn --exclude='*~' \
+ --languages=Perl --langmap=Perl:+.t \
+MAKE_FRAG
+}
29 README
@@ -0,0 +1,29 @@
+App-HWD
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it get an idea of the modules uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2005 Andy Lester
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
302 Task.pm
@@ -0,0 +1,302 @@
+package App::HWD::Task;
+
+=head1 NAME
+
+App::HWD::Task - Tasks for HWD
+
+=head1 SYNOPSIS
+
+Used only by the F<hwd> application.
+
+Note that these functions are pretty fragile, and do almost no data
+checking.
+
+=head1 FUNCTIONS
+
+=head2 App::HWD::Task->parse()
+
+Returns an App::HWD::Task object from an input line
+
+=cut
+
+use warnings;
+use strict;
+use DateTime::Format::Strptime;
+
+sub parse {
+ my $class = shift;
+ my $line = shift;
+
+ my $line_regex = qr/
+ ^
+ (-+) # leading dashes
+ \s* # whitespace
+ (.+) # everything else
+ $
+ /x;
+
+ if ( $line =~ $line_regex ) {
+ my $level = length $1;
+ my $name = $2;
+ my $id;
+ my $estimate;
+ my %date;
+
+ if ( $name =~ s/\s*\(([^)]+)\)\s*$// ) {
+ my $parens = $1;
+ my $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d' );
+
+ my @subfields = split /,/, $parens;
+ for ( @subfields ) {
+ s/^\s+//;
+ s/\s+$//;
+ /^#(\d+)$/ and $id = $1, next;
+ /^((\d*\.)?\d+)h$/ and $estimate = $1, next;
+ /^(added|deleted) (\S+)$/i and do {
+ my ($type,$date) = ($1,$2);
+ $date{$type} = $parser->parse_datetime($date);
+ next if $date{$type};
+ };
+ warn qq{I don't understand "$_"\n};
+ }
+ }
+
+ my $task = $class->new( {
+ level => $level,
+ name => $name,
+ id => $id,
+ estimate => $estimate,
+ date_added_obj => $date{added},
+ date_deleted_obj => $date{deleted},
+ } );
+ }
+ else {
+ return;
+ }
+}
+
+=head2 App::HWD::Task->new( { args } )
+
+Creates a new task from the args passed in. They should include at
+least I<level>, I<name> and I<id>, even if I<id> is C<undef>.
+
+ my $task = App::HWD::Task->new( {
+ level => $level,
+ name => $name,
+ id => $id,
+ estimate => $estimate,
+ } );
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $args = shift;
+
+ my $self = bless {
+ %$args,
+ work => [],
+ }, $class;
+
+ return $self;
+}
+
+=head2 $task->level()
+
+Returns the level of the task
+
+=head2 $task->name()
+
+Returns the name of the task
+
+=head2 $task->id()
+
+Returns the ID of the task, or the empty string if there isn't one.
+
+=head2 $task->estimate()
+
+Returns the estimate, or 0 if it's not set.
+
+=head2 $task->date_added()
+
+Returns a string showing the date the task was added, or empty string if it's not set.
+
+=head2 $task->date_added_obj()
+
+Returns a DateTime object representing the date the task was added, or C<undef> if it's not set.
+
+=head2 $task->date_deleted()
+
+Returns a string showing the date the task was deleted, or empty string if it's not set.
+
+=head2 $task->date_deleted_obj()
+
+Returns a DateTime object representing the date the task was deleted, or C<undef> if it's not set.
+
+=head2 $task->work()
+
+Returns the array of App::HWD::Work applied to the task.
+
+=cut
+
+sub level { return shift->{level} }
+sub name { return shift->{name} }
+sub id { return shift->{id} || "" }
+sub estimate { return shift->{estimate} || 0 }
+sub work { return @{shift->{work}} }
+sub date_added_obj { return shift->{date_added_obj} }
+sub date_deleted_obj { return shift->{date_added_obj} }
+
+sub date_added {
+ my $self = shift;
+ my $obj = $self->{date_added_obj} or return '';
+
+ return $obj->strftime( "%F" );
+}
+
+sub date_deleted {
+ my $self = shift;
+ my $obj = $self->{date_deleted_obj} or return '';
+
+ return $obj->strftime( "%F" );
+}
+
+=head2 $task->is_todo()
+
+Returns true if the task still has things to be done on it. If the task
+has no estimates, because it's a roll-up or milestone task, this is false.
+
+=cut
+
+sub is_todo {
+ my $self = shift;
+
+ return 0 if !$self->estimate;
+
+ return 0 if $self->completed;
+ return 1;
+}
+
+=head2 $task->set( $key => $value )
+
+Sets the I<$key> field to I<$value>.
+
+=cut
+
+sub set {
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+
+ die "Dupe key $key" if exists $self->{$key};
+ $self->{$key} = $value;
+}
+
+=head2 add_work( $work )
+
+Adds a Work record to the task, for later accumulating
+
+=cut
+
+sub add_work {
+ my $self = shift;
+ my $work = shift;
+
+ push( @{$self->{work}}, $work );
+}
+
+=head2 hours_worked()
+
+Returns the number of hours worked, but counting up all the work records added in L</add_work>.
+
+=cut
+
+sub hours_worked {
+ my $self = shift;
+
+ my $hours = 0;
+ for my $work ( @{$self->{work}} ) {
+ $hours += $work->hours;
+ }
+ return $hours;
+}
+
+=head2 started()
+
+Returns whether the task has been started. Doesn't address the question
+of whether the task is completed or not, just whether work has been done
+on it.
+
+=cut
+
+sub started {
+ my $self = shift;
+
+ return @{$self->{work}} > 0;
+}
+
+=head2 completed()
+
+Returns whether the task has been completed.
+
+=cut
+
+sub completed {
+ my $self = shift;
+
+ my $completed = 0;
+ for my $work ( @{$self->{work}} ) {
+ $completed = $work->completed;
+ }
+
+ return $completed;
+}
+
+=head2 summary
+
+Returns a simple one line description of the Work.
+
+=cut
+
+sub summary {
+ my $self = shift;
+ my $sum;
+ $sum = $self->id . " - " if $self->id;
+ $sum .= sprintf( "%s (%s/%s)", $self->name, $self->estimate, $self->hours_worked );
+ return $sum;
+}
+
+=head2 sort_work
+
+Make sure all the work for a task is sorted so we can tell what was done when.
+
+=cut
+
+sub sort_work {
+ my $self = shift;
+
+ my $work = $self->{work};
+
+ @$work = sort {
+ $a->when cmp $b->when
+ ||
+ $a->completed cmp $b->completed
+ ||
+ $a->who cmp $b->who
+ } @$work;
+}
+
+=head1 AUTHOR
+
+Andy Lester, C<< <andy at petdance.com> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2005 Andy Lester, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of App::HWD::Task
150 Work.pm
@@ -0,0 +1,150 @@
+package App::HWD::Work;
+
+=head1 NAME
+
+App::HWD::Work - Work completed on HWD projects
+
+=head1 SYNOPSIS
+
+Used only by the F<hwd> application.
+
+Note that these functions are pretty fragile, and do almost no data
+checking.
+
+=cut
+
+use warnings;
+use strict;
+use DateTime::Format::Strptime;
+
+=head1 FUNCTIONS
+
+=head2 App::HWD::Work->parse()
+
+Returns an App::HWD::Work object from an input line
+
+=cut
+
+sub parse {
+ my $class = shift;
+ my $line = shift;
+
+ my @cols = split " ", $line, 5;
+ die "Invalid work line: $line" unless @cols >= 4;
+
+ my ($who, $when, $task, $hours, $comment) = @cols;
+ my $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d' );
+ $when = $parser->parse_datetime( $when );
+ my $completed;
+ if ( defined $comment ) {
+ if ( $comment =~ s/\s*X\s*//i ) {
+ $completed = 1;
+ }
+ $comment =~ s/^#\s*//;
+ $comment =~ s/\s+$//;
+ }
+ else {
+ $comment = '';
+ }
+
+ my $self =
+ $class->new( {
+ who => $who,
+ when => $when,
+ task => $task,
+ hours => $hours,
+ comment => $comment,
+ completed => $completed,
+ } );
+
+ return $self;
+}
+
+=head2 App::HWD::Work->new( { args } )
+
+Creates a new task from the args passed in. They should include at
+least I<level>, I<name> and I<id>, even if I<id> is C<undef>.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $args = shift;
+
+ my $self = bless { %$args }, $class;
+}
+
+
+=head2 $work->set( $key => $value )
+
+Sets the I<$key> field to I<$value>.
+
+=cut
+
+sub set {
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+
+ die "Dupe key $key" if exists $self->{$key};
+ $self->{$key} = $value;
+}
+
+=head2 $work->who()
+
+Returns who did the work
+
+=head2 $work->when()
+
+Returns the when of the work as a string.
+
+=head2 $work->when_obj()
+
+Returns the when of the work as a DateTime object.
+
+=head2 $work->task()
+
+Returns the ID of the work that was worked on.
+
+=head2 $work->hours()
+
+Returns the hours spent.
+
+=head2 $work->completed()
+
+Returns a boolean that says whether the work was completed or not.
+
+=head2 $work->comment()
+
+Returns the comment from the file, if any.
+
+=cut
+
+sub who { return shift->{who} }
+sub task { return shift->{task} }
+sub hours { return shift->{hours} }
+sub completed { return shift->{completed} || 0 }
+sub comment { return shift->{comment} }
+sub when_obj { return shift->{when} }
+sub when {
+ my $self = shift;
+
+ my $obj = $self->{when} or return '';
+
+ return $obj->strftime( "%F" );
+}
+
+=head1 AUTHOR
+
+Andy Lester, C<< <andy at petdance.com> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2005 Andy Lester, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of App::HWD::Task
395 bin/hwd
@@ -0,0 +1,395 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use App::HWD::Task;
+use App::HWD::Work;
+use Date::Manip;
+
+MAIN: {
+ my $show_nextid;
+ my $show_started;
+ my $show_tasks;
+ my $show_burndown;
+ my $show_todo;
+
+ Getopt::Long::Configure( "no_ignore_case" );
+ Getopt::Long::Configure( "bundling" );
+ GetOptions(
+ 'nextid' => \$show_nextid,
+ 'todo' => \$show_todo,
+ 'started:s' => \$show_started,
+ 'tasks:s' => \$show_tasks,
+ 'burndown' => \$show_burndown,
+ 'h|help|?' => sub { pod2usage({-verbose => 1}); exit; },
+ 'H|man' => sub { pod2usage({-verbose => 2}); exit; },
+ 'V|version' => sub { print_version(); exit; },
+ ) or exit 1;
+#die "Must specify input files\n" unless @ARGV;
+
+# XXX the --started and --tasks options with no argument eats the filename.
+# Attempt to compensate.
+ for my $var ($show_started, $show_tasks) {
+ if ($var and -e $var) {
+ unshift @ARGV, $var;
+ $var = '';
+ }
+ }
+
+ my ($tasks,$works,$tasks_by_id) = get_tasks_and_work();
+
+ if ( $show_nextid ) {
+ my $max = (sort {$a <=> $b} keys %$tasks_by_id )[-1];
+ $max = $max ? $max+1 : 101;
+ print "Next task ID: $max\n";
+ exit;
+ }
+
+ my $show_full_dump = 1;
+ if ( defined $show_tasks ) {
+ show_tasks( $show_tasks, $tasks, $works, $tasks_by_id );
+ $show_full_dump = 0;
+ }
+
+ if ( $show_burndown ) {
+ show_burndown( $tasks, $works, $tasks_by_id );
+ $show_full_dump = 0;
+ }
+
+ if ( defined $show_started ) {
+ show_started( $show_started, $tasks, $works, $tasks_by_id );
+ $show_full_dump = 0;
+ }
+
+ if ( $show_todo ) {
+ my $filter = sub {
+ my $task = shift;
+ return 1 if $task->is_todo;
+ return;
+ };
+ show_full_dump( $tasks, $filter );
+ $show_full_dump = 0;
+ }
+
+ if ( $show_full_dump ) {
+ show_full_dump( $tasks );
+ }
+}
+
+
+sub show_full_dump {
+ my $tasks = shift;
+ my $filter = shift;
+
+ my @fields = qw( estimated velocity started unstarted deleted );
+
+ my %total;
+ $total{$_} = 0 for @fields;
+ for my $task ( @$tasks ) {
+ my $points = $task->estimate || 0;
+ if ( $task->date_deleted ) {
+ $total{deleted} += $points;
+ }
+ else {
+ $total{estimated} += $points;
+ $total{velocity} += $points if $task->completed;
+ $total{started} += $points if $task->started && !$task->completed;
+ $total{unstarted} += $points if !$task->started;
+ if ( !$filter || $filter->( $task ) ) {
+ print_task( $task );
+ }
+ }
+ }
+ for my $type ( @fields ) {
+ print "Total $type: $total{$type}\n";
+ }
+}
+
+sub print_task {
+ my $task = shift;
+
+ my $level = $task->level;
+ my $name = $task->name;
+ my $id = $task->id;
+ my $indent = " " x (($level-1)*4);
+
+ if ( $id ) {
+ my $worked = fractiony( $task->hours_worked );
+ my $estimate = fractiony( $task->estimate );
+ my $x = $task->completed ? "X" : " ";
+ print_cols( $id, $estimate, $worked, $x, $indent, $name );
+ }
+ else {
+ print_cols( ("") x 4, $indent, $name );
+ }
+}
+
+sub fractiony {
+ my $n = shift;
+ my $str;
+
+ if ( $n ) {
+ my $frac = $n - int($n);
+ $str = sprintf( "%4d", int($n) );
+ $str .= $frac ? "+" : " ";
+ }
+ else {
+ $str = "";
+ }
+ return $str;
+}
+
+sub show_started {
+ my ( $who, $tasks, $works, $tasks_by_id ) = @_;
+
+ my %started;
+ foreach my $w (@$works) {
+ next if $who && ($who ne $w->who);
+ my $t = $tasks_by_id->{$w->task};
+ if ( !$t->completed() ) {
+ $started{$w->who}{$t->id}++;
+ }
+ }
+ my %unique_tasks;
+ foreach my $w (sort keys %started) {
+ print "$w is working on...\n";
+ my $points = 0;
+ foreach my $key (sort { $a <=> $b } keys %{$started{$w}}) {
+ my $task = $tasks_by_id->{$key};
+ print " " . $task->summary . "\n";
+ $points += $task->estimate;
+ $unique_tasks{ $key } = $task->estimate;
+ }
+ print "$w has $points points open\n";
+ print "\n";
+ }
+ if ( !$who ) {
+ my $total_points = 0;
+ $total_points += $unique_tasks{$_} for keys %unique_tasks;
+ print "$total_points points open on the project\n";
+ }
+} # show_started
+
+
+sub show_tasks {
+ my ( $who, $tasks, $works, $tasks_by_id ) = @_;
+
+ my %worker;
+ foreach my $t (@$tasks) {
+ foreach my $w ($t->work) {
+ $worker{ $w->who }{$t->id}++;
+ }
+ }
+
+ my @who = $who ? ($who) : keys %worker;
+ foreach my $w (@who) {
+ if ( !$worker{$w} ) {
+ print "$w has no tasks!\n";
+ next;
+ }
+ print "$w worked on:\n";
+ foreach my $id (keys %{$worker{$w}}) {
+ my $task = $tasks_by_id->{$id};
+ print " ", $task->summary, "\n";
+ }
+ print "\n";
+ }
+} # show_tasks
+
+
+sub show_burndown {
+ my ( $tasks, $works, $tasks_by_id ) = @_;
+
+ my %day;
+
+ # ASSUMPTION: projects will finish before Jan 1, 2100
+ my $earliest = ParseDate("2100/1/1");
+
+ # determine the earliest date work has been done and keep track
+ # of finished task points
+ foreach my $w (@$works) {
+ my $date = ParseDate($w->when)
+ or die "Work " . $w->task . " has an invalid date: " . $w->when;
+ if (Date_Cmp($date, $earliest) < 0) {
+ $earliest = $date;
+ }
+ if ( $w->completed ) {
+ my $est = $tasks_by_id->{ $w->task }->estimate;
+ $day{$date}{finished} += $est;
+ }
+ }
+
+ # determine the total for each date
+ foreach my $t (@$tasks) {
+ next if $t->date_deleted;
+ my $date = ParseDate( $t->date_added ) || $earliest;
+ if ( !$date ) {
+ die "Task " . $t->name . " has no date!";
+ }
+ $day{$date}{total} += $t->estimate;
+ }
+
+ # Print the running task and finished totals
+ my $total;
+ my $finished;
+ my $format = "\%10s\t\%-5s\t\%-s\n";
+ printf $format, qw(YYYY/MM/DD Total Todo);
+ foreach my $date (sort keys %day) {
+ $total += $day{$date}{total} || 0;
+ $finished += $day{$date}{finished} || 0;
+ $date =~ s#^(\d{4})(\d\d)(\d\d).+#$1/$2/$3#
+ or die "Invalid date ($date)";
+ printf $format, $date, $total, $total - $finished;
+ }
+}
+
+# Reads tasks and work, and applies the work to the tasks.
+sub get_tasks_and_work {
+ my @tasks;
+ my @work;
+ my %tasks_by_id;
+
+ while ( my $line = <> ) {
+ chomp $line;
+ next if $line =~ /^\s*#/;
+ next if $line !~ /./;
+
+ if ( $line =~ /^-/ ) {
+ my $task = App::HWD::Task->parse( $line );
+ die "Can't parse: $line\n" unless $task;
+ if ( $task->id ) {
+ if ( $tasks_by_id{ $task->id } ) {
+ die "Dupe task ID ", $task->id, "\n";
+ }
+ else {
+ $tasks_by_id{ $task->id } = $task;
+ }
+ }
+ push( @tasks, $task );
+ }
+ else {
+ my $work = App::HWD::Work->parse( $line );
+ push( @work, $work );
+ }
+ } # while
+
+ for my $work ( @work ) {
+ my $task = $tasks_by_id{ $work->task }
+ or die "No task ID ", $work->task, "\n";
+ $task->add_work( $work );
+ }
+
+ $_->sort_work() for @tasks;
+
+ return( \@tasks, \@work, \%tasks_by_id );
+}
+
+sub print_version {
+ printf( "hwd v%s\n", $App::HWD::VERSION, $^V );
+}
+
+sub print_cols {
+ my @cols = @_;
+
+ for ( @cols[0..0] ) {
+ $_ = $_ ? sprintf( "%4d", $_ ) : "";
+ }
+ for ( @cols[2..5] ) {
+ $_ = "" unless defined $_;
+ }
+ printf( "%4s %6.6s %6.6s %1s %s %s\n", @cols );
+}
+
+__END__
+
+=head1 NAME
+
+hwd -- The How We Doin'? project tracking tool
+
+=head1 SYNOPSIS
+
+hwd [options] schedule-file(s)
+
+Options:
+
+ --nextid Display the next highest task ID
+ --todo Displays tasks left to do, started or not.
+ --started Displays tasks that have been started
+ --started=person
+ Displays tasks started by person
+ --tasks Displays tasks sorted by person
+ --tasks[=person]
+ Displays tasks for a given user
+ --burndown Display a burn-down table
+
+ -h, --help Display this help
+ -H, --man Longer manpage for prove
+ -V, --version Display version info
+
+=head1 COMMAND LINE OPTIONS
+
+=head2 --todo
+
+Limit the dump of tasks to only those that are left to do, whether or
+not they've been started.
+
+=head2 --started[=who]
+
+Shows what tasks have been started by the person specified, or by everyone
+if no one one is specified.
+
+ Ape is working on...
+ 104 - Add FK constraints between FOOHEAD and BARDETAIL (2/2)
+
+ Chimp is working on...
+ 107 - Refactor (1/1)
+
+=head2 --tasks[=person]
+
+Shows the list of tasks and their status sorted by user. If a person is
+specified, only the tasks for that person will be shown.
+
+=head2 --nextid
+
+Shows the next ID available.
+
+=head2 --burndown
+
+Print a "burn down" graph:
+
+ YYYY/MM/DD Total Todo
+ 2005/07/15 100 98
+ 2005/07/17 100 77
+ 2005/07/18 100 75
+ 2005/07/19 100 70
+
+That is, how fast is the amount of work left "burning down" to zero?
+
+=head2 -V, --version
+
+Display version info.
+
+=head1 BUGS
+
+Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>.
+You can also mail bugs, fixes and enhancements to
+C<< <bug-app-hwd at rt.cpan.org> >>.
+
+=head1 AUTHORS
+
+Andy Lester C<< <andy at petdance.com> >>
+
+=head1 COPYRIGHT
+
+Copyright 2005 by Andy Lester C<< <andy at petdance.com> >>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>.
+
+=cut
+
+# vim: expandtab
90 bin/hwd-burnchart
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+use Chart::Graph::Gnuplot qw(gnuplot);
+use Getopt::Long;
+use Pod::Usage;
+use strict;
+use warnings;
+
+my $title = 'Burndown';
+my $pngname = 'burndown.png';
+GetOptions( 'title=s' => \$title,
+ 'pngname=s' => \$pngname,
+ 'help' => sub {pod2usage({-verbose => 1}); exit},
+ ) or do {pod2usage({-verbose => 1}); exit};
+
+my @dates;
+my @totals;
+my @todos;
+while(<>) {
+ next if /^YYYY/; # ignore header
+ my ($date, $total, $todo) = split /\s+/;
+ push @dates, $date;
+ push @totals, $total;
+ push @todos, $todo;
+}
+die "No data read!\n" unless @totals;
+
+# Make the y range 10% larger than the highest value
+my $ymax = (sort {$a <=> $b} @totals)[-1];
+$ymax *= 1.1;
+
+gnuplot({"title" => $title,
+ "x-axis label" => "Date",
+ "y-axis label" => "Points",
+ "output type" => "png",
+ "output file" => $pngname,
+ "yrange" => "[0:$ymax]",
+ "xdata" => "time",
+ "format" => ["x", "%m/%d"],
+ "timefmt" => '%Y/%m/%d',
+ },
+ [{title => "Total work",
+ style => "lines",
+ type => "columns"}, \@dates, \@totals],
+ [{title => "Remaining work",
+ style => "lines",
+ type => "columns"}, \@dates, \@todos],
+);
+
+__END__
+
+=head1 NAME
+
+hwd-burnchart -- Create burndown charts from hwd burndown output
+
+=head1 SYNOPSIS
+
+ hwd --burndown foo.txt | hwd-burnchart --title "Project Foo"
+
+Options:
+
+ --title Use the given title (defaults to "Burndown")
+ --pngname Write the chart to this filename (defaults to burndown.png)
+ --help Show this help
+
+=head1 OVERVIEW
+
+The burndown chart shows the history of the task totals and of how much
+work remains to be done. The remaining work should approach zero as the
+project completes.
+
+=head1 TODO
+
+=head2 Text based graphs
+
+=head1 AUTHORS
+
+Luke Closs C<< <lukec@activestate.com> >>
+
+=head1 COPYRIGHT
+
+Copyright 2005 by Luke Closs C<< <lukec@activestate.com> >>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>.
+
+=cut
+
+
259 eg/sked.hwd
@@ -0,0 +1,259 @@
+# This is an actual schedule and work, with specific names changed to
+# protect confidentiality. Anything that is "foo", "bar", "baz",
+# "quux" or "wango" has been changed from something else.
+
+
+-Infrastructure
+--FOO*
+---Add new columns to track by type (#101, 2h)
+---Add new columns to record new checkout features (#102, 2h)
+---Add FK constraints between FOOHEAD and FOODETAIL (#103, 2h)
+---Add FK constraints between FOOHEAD and BARDETAIL (#104, 2h)
+
+--ORDERFORM
+---Create migration script to modify table automatically (#105, 2h)
+
+-TW::DB::FooForm
+--Review (#106, 1h)
+--Refactor (#107, 1h)
+
+-TW::DB::FooDefault
+--Review (#108, 1h)
+--Refactor (#109, 1h)
+
+-Foo Entry Wizard
+--Handler
+---API Pod Docs (#110, 4h)
+---Review (#111, 1h)
+---Tests (#112, 8h)
+---Code (#113, 8h)
+---Refactor (#114, 4h)
+--Screens
+---Foo Summary Template Component (#115, 5h)
+---Foo Summary Template - CA & C&P (#228, 2h)
+---Wango Template (#116, 5h)
+---Wango Template - CA & C&P (#229, 2h)
+---Main and List page buttons (#117, 4h)
+---C&P Template (#118, 5h)
+---C&P Template - CA & C&P (#236, 2h)
+---Tango Options Template (#119, 5h)
+---Tango Options Template - CA & C&P (#230, 2h)
+---Ebook Options Template (#120, 5h)
+---Ebook Options Template - CA & C&P (#231, 2h)
+---Contact Information Template (#121, 5h)
+---Contact Information Template - CA & C&P (#232, 2h)
+---Baz Template (#122, 5h)
+---Baz Template - CA & C&P (#233, 2h)
+---Quux Template (#123, 5h)
+---Quux Template - CA & C&P (#234, 2h)
+---Confirm Template (#124, 5h)
+---Confirm Template - CA & C&P (#235, 2h)
+---Thank You Template (#125, 7h)
+--E-mail Confirmation (#126, 7h)
+
+-TW::FooWizard
+--Review (#127, 4h)
+--Tests (#128, 4h)
+--CA & C&P Tests (#226, 4h)
+--Code (#129, 8h)
+--CA & C&P Code (#227, 8h)
+--Refactor (#130, 2h)
+
+-TW::FooMaker
+--API Pod Docs (#131, 12h)
+--Review (#132, 4h)
+--Tests (#133, 8h)
+--Code (#134, 16h)
+---Bar Promotion (#135, 8h)
+--Refactor (#136, 2h)
+
+-TW::DB::FooHead
+--API Pod Docs (#137, 2h)
+--Review (#138, 1h)
+--Tests (#139, 4h)
+--Code (#140, 4h)
+--Refactor (#141, 1h)
+
+-TW::DB::FooDetail
+--API Pod Docs (#142, 2h)
+--Review (#143, 1h)
+--Tests (#144, 4h)
+--Code (#145, 4h)
+--Refactor (#146, 1h)
+
+-TW::DB::BarDetail
+--API Pod Docs (#147, 2h)
+--Review (#148, 1h)
+--Tests (#149, 4h)
+--Code (#150, 4h)
+--Refactor (#151, 1h)
+
+-TW::CP
+--API Pod Docs (#152, 7h)
+--Review (#153, 1h)
+--Tests (#154, 7h)
+--Code
+---Create "new" method for TW::CP (#155, 1h)
+---Refactor interfaces between TW::CP and TW::CPSet (#156, 7h)
+---Convert TW::CP class methods to instance methods (#157, 4h)
+---Change current TW::CP users to using instance methods (#158, 4h)
+---Create accessor methods which delegate appropriately (#160, 4h)
+---Create support for dynamically loading delegatees (#161, 2h)
+---Create method to invalidate dynamically loaded delegatees (#162, 1h)
+---Create method to invalidate dynamically calculated costs (#163, 1h)
+---Create interface definition module for Foo implementors (#164, 1h)
+---Create methods to return delegatees (#165, 1h)
+--Refactor (#166, 2h)
+
+-TW::DB::BarSubset
+--API Pod Docs (#167, 7h)
+--Review (#168, 1h)
+--Tests (#169, 7h)
+--Code
+---Create base Class::DBI module from POD (#170, 1h)
+---Calculate bar from aggregate totals of a supplied object (#171, 4h)
+---Create processing methods to format specs as text or HTML (#172, 8h)
+---Create methods to support delegated accessors interface for TW::CP (#173, 4h)
+--Refactor (#174, 2h)
+
+-TW::CPSet
+--API Pod Docs (#175, 7h)
+--Review (#176, 1h)
+--Tests (#177, 7h)
+--Code
+---Calculate Book C&P costs from aggregate totals of a supplied object (#178, 2h)
+---Create methods to support delegated accessors interface for TW::CP (#179, 4h)
+--Refactor (#180, 2h)
+
+-TW::List
+--Review (#181, 1h)
+--Add Code
+---Refactor (#182, 2h)
+
+-TW::TitleCounts
+--Review (#183, 1h)
+--Refactor (#184, 1h)
+
+-Bar Creation PL/SQL script (#185, 16h)
+
+-Foo Creation PL/SQL script (#186, 16h)
+
+-TW::BarMaker
+--API Pod docs (#223, 4h)
+--Review (#224, 1h)
+--Tests (#187, 7h)
+--Code (#188, 7h)
+--Refactor (#189, 4h)
+
+-TW::Bar
+--API Pod Docs (#190, 14h)
+--Review (#191, 4h)
+--Tests (#192, 14h)
+--Code (#193, 21h)
+--Refactor (#194, 4h)
+
+-TW::DB::BarItem
+--Tests (#195, 2h)
+--Code (#196, 3h)
+--Refactor (#197, 1h)
+
+-TW::DB::BarHead
+--API Pod Docs (#198, 4h)
+--Review (#199, 1h)
+--Tests (#200, 2h)
+--Code (#201, 3h)
+--Refactor (#202, 1h)
+
+-Bar Print
+--TW::Apache::Bar Handler
+---Select List & Request Bar (#203, 7h)
+---Bar Print Options (#204, 7h)
+---Bar Print (#205, 7h)
+--Select List & Request Bar Template
+---Bar Select Template (#207, 7h)
+---Bar Request email (#208, 7h)
+---Bar Request Confirm Template (#209, 7h)
+---Bar Print Options Template (#210, 7h)
+--Bar Print Screen
+---Main Bar Template (#211, 4h)
+---Standard Detail template (#212, 4h)
+---Single Line Detail template (#213, 4h)
+---Annotated Detail template (#214, 4h)
+-Spec Change E-mail (#217, 16h)
+-Custom Foo Email (#218, 16h)
+
+-Rollout
+--Run alter scripts against production database and verify OK (#219, 7h)
+--Merge to trunk (#221, 28h)
+--Rollout internally (#220, 1h)
+--Rollout (#222, 6h)
+
+
+Pete 7/11 195 2 X
+Pete 7/11 196 3 X
+Pete 7/11 198 2
+Pete 7/11 127 .5 X
+Pete 7/11 108 .25 X
+Pete 7/11 106 .25 X
+Pete 7/11 111 .5 X
+Pete 7/12 198 1.25 X
+Pete 7/13 200 2 X
+Pete 7/13 201 1
+Pete 7/13 175 2.75
+Pete 7/14 175 7.5
+Pete 7/15 167 5
+
+Bruce 7/11 185 5
+Bruce 7/11 127 .5 X
+Bruce 7/11 108 .25 X
+Bruce 7/11 106 .25 X
+Bruce 7/11 111 .5 X
+Bruce 7/12 185 6
+Bruce 7/13 185 5 x
+Bruce 7/13 223 1
+Bruce 7/14 185 2 x refactor
+Bruce 7/14 223 1.5
+Bruce 7/14 188 2
+Bruce 7/15 223 3 x
+Bruce 7/15 187 1
+Bruce 7/15 188 1
+
+Bob 7/11 127 .5
+Bob 7/11 108 .75 X
+Bob 7/11 106 .25 X
+Bob 7/11 111 .5 X
+Bob 7/11 127 1.5 X
+Bob 7/11 110 .25 X
+Bob 7/11 117 1
+Bob 7/11 113 1
+Bob 7/12 128 2
+Bob 7/12 129 3.75
+Bob 7/13 128 .75
+Bob 7/13 129 1
+Bob 7/13 116 .5
+Bob 7/13 115 .5
+Bob 7/13 118 .5
+Bob 7/13 119 .5
+Bob 7/13 120 .5
+Bob 7/13 121 .5
+Bob 7/13 122 .5
+Bob 7/13 123 .5
+Bob 7/13 124 .5
+Bob 7/14 128 1
+Bob 7/14 129 1
+Bob 7/14 116 .25 X
+Bob 7/14 115 .25 X
+Bob 7/14 118 .25 X
+Bob 7/14 119 .25 X
+Bob 7/14 120 .25 X
+Bob 7/14 121 .75
+Bob 7/14 122 .75
+Bob 7/14 123 .75
+Bob 7/14 124 .25
+Bob 7/15 128 1 X
+Bob 7/15 129 1 X
+Bob 7/15 113 1 X
+Bob 7/15 121 .25 X
+Bob 7/15 122 .25 X
+Bob 7/15 123 .25 X
+Bob 7/15 124 .25 X
56 etc/hwd.vim
@@ -0,0 +1,56 @@
+if version < 600
+ syntax clear
+elseif exists("b:current_syntax")
+ finish
+endif
+
+" the "done" detection could be better here... any X in the string will
+" highlight when we define it this way:
+syn match hwdWorkDone "X" contained
+syn match hwdWorkEnd ".*" contains=hwdWorkDone contained
+syn match hwdWorkTime "\d\+\(\.\d\+\)*h\?\>" nextgroup=hwdWorkEnd contained
+syn match hwdWorkId "\d\+\>" nextgroup=hwdWorkTime skipwhite contained
+syn match hwdWorkDate "\(\(\d\{1,2\}\)\{1,2\}/\)\?\d\{1,2\}/\d\{1,2\}\>" nextgroup=hwdWorkId skipwhite contained
+
+syn case ignore
+syn match hwdWork /^[a-z]\+\>/ nextgroup=hwdWorkDate skipwhite
+
+syn match hwdSpecId "#\d\+\>" contained
+syn match hwdSpecTime "\d\+\(\.\d\+\)*h\>" contained
+syn match hwdSpecWhence "added \(\(\d\{1,2\}\)\{1,2\}/\)\?\d\{1,2\}/\d\{1,2\}\>" contained
+syn cluster hwdSpec contains=hwdSpecId,hwdSpecTime,hwdSpecWhence
+syn match hwdTaskDesc ".*" contains=hwdTaskSpec contained skipwhite
+syn match hwdTaskSpec "(.\+,.\+\(,.\+\)\?)\s*$" contains=@hwdSpec contained skipwhite
+syn match hwdTask /^-\+/ nextgroup=hwdTaskDesc
+
+syn keyword hwdTodo contained TODO FIXME XXX
+syn match hwdComment /^#.*$/ contains=hwdTodo
+
+"
+" highlighting defs
+"
+hi def link hwdComment Comment
+hi def link hwdTodo Todo
+
+hi def link hwdTask Special
+hi def link hwdTaskDesc Normal
+hi def link hwdTaskSpec Normal
+hi def link hwdSpecTime hwdHiTime
+hi def link hwdSpecWhence hwdHiDate
+hi def link hwdSpecId hwdHiId
+
+hi def link hwdWork Special
+hi def link hwdWorkTime hwdHiTime
+hi def link hwdWorkDate hwdHiDate
+hi def link hwdWorkId hwdHiId
+hi def link hwdWorkDone SpecialChar
+hi def link hwdWorkEnd Normal
+"
+"
+" highlighting classes
+"
+hi def link hwdHiTime Number
+hi def link hwdHiDate Type
+hi def link hwdHiId Identifier
+
+let b:current_syntax = "hwd"
10 t/00-load.t
@@ -0,0 +1,10 @@
+#!perl -T
+
+use Test::More tests => 2;
+
+BEGIN {
+ use_ok( 'App::HWD' );
+ use_ok( 'App::HWD::Task' );
+}
+
+diag( "Testing App::HWD $App::HWD::VERSION, Perl $], $^X" );
25 t/burndown.t
@@ -0,0 +1,25 @@
+#!perl
+
+use Test::More skip_all => 'new date handling not working yet';
+use Test::More tests => 8;
+
+my @expected_burndown = split "\n", <<'EOT';
+YYYY/MM/DD\tTotal\tTodo
+2005/07/11\t8 \t6
+2005/07/13\t8 \t4
+2005/07/14\t8 \t2
+2005/07/15\t10 \t4
+2005/07/16\t12 \t6
+2005/07/17\t12 \t5
+2005/07/18\t12 \t3
+EOT
+
+my @output = `$^X -Mblib bin/hwd --burndown < t/simple.hwd`;
+chomp @output;
+# make tabs easier to see
+s/\t/\\t/g for @output;
+
+is(scalar(@output), scalar(@expected_burndown));
+for (my $i=0; $i<$#output; $i++) {
+ is($output[$i], $expected_burndown[$i]);
+}
46 t/hwd.t
@@ -0,0 +1,46 @@
+#!perl
+
+use Test::More tests => 15;
+
+my $cmd = "$^X -Mblib bin/hwd";
+my $hwd = 't/simple.hwd';
+
+NEXTID_OPTION: {
+ my $run = "$cmd --nextid $hwd";
+ # diag "Running: $run";
+ my $output = `$run`;
+ chomp $output;
+ is($output, "Next task ID: 108", "--nextid option");
+}
+
+TASKS_OPTION: {
+ my $run = "$cmd --tasks $hwd";
+ # diag "Running: $run";
+ my @output = `$run`;
+ chomp @output;
+ like(shift @output, qr(^Ape), "Ape's tasks");
+ like(shift @output, qr(104));
+ like(shift @output, qr(105));
+ shift @output;
+
+ like(shift @output, qr(^Chimp), "Chimp's tasks");
+ like(shift @output, qr(103));
+ like(shift @output, qr(106));
+ like(shift @output, qr(107));
+ shift @output;
+
+ like(shift @output, qr(^Monkey), "Monkey's tasks");
+ like(shift @output, qr(102));
+ like(shift @output, qr(101));
+}
+
+USER_TASKS_OPTION: {
+ my $run = "$cmd --tasks Chimp $hwd";
+ # diag "Running: $run";
+ my @output = `$run`;
+ chomp @output;
+ like(shift @output, qr(^Chimp), "Chimp's tasks");
+ like(shift @output, qr(103));
+ like(shift @output, qr(106));
+ like(shift @output, qr(107));
+}
6 t/pod-coverage.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
6 t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
32 t/simple.hwd
@@ -0,0 +1,32 @@
+# Simple Sample schedule
+
+# Things that start with a dash are Tasks
+-Infrastructure
+--FOO*
+---Startup task that is no longer useful (#100, 7h, deleted 2005-06-10)
+---Add new columns to track by type (#101, 2h)
+---Add new columns to record new checkout features (#102, 2h)
+---Add FK constraints between FOOHEAD and FOODETAIL (#103, 2h, added 2005-07-15)
+---Add FK constraints between FOOHEAD and BARDETAIL (#104, 2h, added 2005-07-16)
+
+--ORDERFORM
+---Create migration script to modify table automatically (#105, 2h)
+
+-TW::DB::FooForm
+--Review (#106, 1h)
+--Refactor (#107, 1h)
+
+# Thinks that start with a word are Work
+Monkey 2005-07-11 101 2 X
+Monkey 2005-07-12 102 1
+Monkey 2005-07-13 102 1.5 X
+
+Ape 2005-07-11 105 3
+Ape 2005-07-11 105 2 this is way harder than I thought
+Ape 2005-07-14 105 1 X
+Ape 2005-07-16 104 2
+
+Chimp 2005-07-12 106 1
+Chimp 2005-07-17 106 1 X
+Chimp 2005-07-18 103 2 X
+Chimp 2005-07-18 107 1 I still have more to do on this.
21 t/started.t
@@ -0,0 +1,21 @@
+#!perl
+
+use Test::More tests => 6;
+
+SIMPLE: { # Test using the simple example
+ my $started = `$^X -Mblib bin/hwd --started < t/simple.hwd`;
+ like( $started, qr#Ape is working on.+ 104 - Add .+\(2/2\)#s, "Found Ape's work" );
+ like( $started, qr#Chimp is working on.+ 107 - Refactor \(1/1\)#s, "Found Chimp's work" );
+
+ my @lines = split "\n", $started;
+ is(scalar @lines, 9, "Correct number of lines");
+}
+
+ONE_USER: { # Test for only one user
+ my $started = `$^X -Mblib bin/hwd --started Ape < t/simple.hwd`;
+ like( $started, qr#Ape is working on.+ 104 - Add .+\(2/2\)#s, "Found Ape's work" );
+ unlike( $started, qr#Chimp is working on.+ 107 - Refactor \(1/1\)#s, "No work for Chimp" );
+
+ my @lines = split "\n", $started;
+ is( scalar @lines, 3, "Correct number of lines");
+}
150 t/task.t
@@ -0,0 +1,150 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 90;
+
+BEGIN {
+ use_ok( 'App::HWD::Task' );
+}
+
+
+SIMPLE: {
+ my $str = '-Create TW::DB::QuoteHead';
+
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'Create TW::DB::QuoteHead' );
+ is( $task->level, 1 );
+ is( $task->estimate, 0 );
+ is( $task->id, '' );
+ is( $task->date_added, '' );
+ is( $task->summary, 'Create TW::DB::QuoteHead (0/0)', 'Summary');
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( !$task->is_todo );
+}
+
+WITH_ID: {
+ my $str = '--API Pod Docs (#198)';
+
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'API Pod Docs' );
+ is( $task->level, 2 );
+ is( $task->estimate, 0 );
+ is( $task->id, 198 );
+ is( $task->date_added, '' );
+ is( $task->summary, '198 - API Pod Docs (0/0)', 'Summary');
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( !$task->is_todo );
+}
+
+WITH_ESTIMATE: {
+ my $str = '---API Pod Docs (4h)';
+
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'API Pod Docs' );
+ is( $task->level, 3 );
+ is( $task->estimate, 4 );
+ is( $task->id, '' );
+ is( $task->date_added, '' );
+ is( $task->summary, 'API Pod Docs (4/0)', 'Summary');
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( $task->is_todo );
+}
+
+WITH_ID_AND_ESTIMATE: {
+ my $str = '----Retrofitting widgets (#142, 3h)';
+
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'Retrofitting widgets' );
+ is( $task->level, 4 );
+ is( $task->estimate, 3 );
+ is( $task->id, 142 );
+ is( $task->date_added, '' );
+ is( $task->summary, '142 - Retrofitting widgets (3/0)', 'Summary');
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( $task->is_todo );
+}
+
+WITH_ESTIMATE_AND_ID: {
+ my $str = '-Flargling dangows (9h ,#2112)';
+
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'Flargling dangows' );
+ is( $task->level, 1 );
+ is( $task->estimate, 9 );
+ is( $task->id, 2112 );
+ is( $task->date_added, '' );
+ is( $task->summary, '2112 - Flargling dangows (9/0)', 'Summary');
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( $task->is_todo );
+}
+
+WITH_PARENS: {
+ my $str = '-Voodoo Chile (Slight Return) (#43)';
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'Voodoo Chile (Slight Return)' );
+ is( $task->level, 1 );
+ is( $task->estimate, 0 );
+ is( $task->id, 43 );
+ is( $task->date_added, '' );
+ is( $task->summary, '43 - Voodoo Chile (Slight Return) (0/0)', 'Summary');
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( !$task->is_todo );
+}
+
+WITH_ID_AND_ESTIMATE_AND_DATE: {
+ my $str = '----Retrofitting widgets (#142, 3h, added 2005-12-07)';
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'Retrofitting widgets' );
+ is( $task->level, 4 );
+ is( $task->estimate, 3 );
+ is( $task->id, 142 );
+ isa_ok( $task->date_added_obj, 'DateTime', 'Task date object' );
+ is( $task->date_added, '2005-12-07', 'Task date string' );
+ is( $task->summary, '142 - Retrofitting widgets (3/0)', 'Summary' );
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( $task->is_todo );
+}
+
+WITH_FRACTIONAL_ESTIMATE: {
+ my $str = '----Retrofitting widgets (.25h)';
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'Retrofitting widgets' );
+ is( $task->level, 4 );
+ cmp_ok( $task->estimate, '==', 0.25 );
+ is( $task->id, '' );
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( $task->is_todo );
+}
+
+WITH_DELETION: {
+ my $str = '-Unnecessary task (14.5h, added 2005-11-07, deleted 2005-08-28, #2112)';
+ my $task = App::HWD::Task->parse( $str );
+ isa_ok( $task, 'App::HWD::Task' );
+ is( $task->name, 'Unnecessary task' );
+ is( $task->level, 1 );
+ cmp_ok( $task->estimate, '==', 14.5 );
+ is( $task->id, 2112 );
+ is( $task->date_added, '2005-11-07', "Add date" );
+ is( $task->date_deleted, '2005-08-28', "Delete date" );
+ ok( !$task->completed, 'Not completed' );
+ ok( !$task->started, 'Not started' );
+ ok( $task->is_todo );
+}
52 t/work.t
@@ -0,0 +1,52 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 25;
+
+BEGIN {
+ use_ok( 'App::HWD::Work' );
+}
+
+SIMPLE: {
+ my $str = 'Pete 2005-07-11 195 0000.250';
+ my $work = App::HWD::Work->parse( $str );
+ isa_ok( $work, 'App::HWD::Work' );
+
+ is( $work->who, 'Pete', 'Who' );
+ is( $work->when, '2005-07-11', 'When' );
+ isa_ok( $work->when_obj, 'DateTime', 'When' );
+ is( $work->task, 195, 'Task' );
+ cmp_ok( $work->hours, '==', .25, 'Hours match' );
+ is( $work->comment, '', 'no comment' );
+ ok( !$work->completed, 'not completed' );
+}
+
+COMPLETED: {
+ my $str = 'Pete 2005-07-11 195 2 x ';
+ my $work = App::HWD::Work->parse( $str );
+ isa_ok( $work, 'App::HWD::Work' );
+
+ is( $work->who, 'Pete', 'Who' );
+ is( $work->when, '2005-07-11', 'When' );
+ isa_ok( $work->when_obj, 'DateTime', 'When' );
+ is( $work->task, 195, 'Task' );
+ cmp_ok( $work->hours, '==', 2, 'Hours match' );
+ is( $work->comment, '', 'no commment' );
+ ok( $work->completed, 'completed' );
+}
+
+COMPLETED: {
+ my $str = 'Bob 2005-08-11 1 .75 X # Refactoring ';
+ my $work = App::HWD::Work->parse( $str );
+ isa_ok( $work, 'App::HWD::Work' );
+
+ is( $work->who, 'Bob', 'Who' );
+ is( $work->when, '2005-08-11', 'When' );
+ isa_ok( $work->when_obj, 'DateTime', 'When' );
+ is( $work->task, 1, 'task' );
+ cmp_ok( $work->hours, '==', .75, 'Hours match' );
+ is( $work->comment, 'Refactoring', 'Non-empty comment' );
+ ok( $work->completed, 'Completed' );
+}

0 comments on commit b428ba2

Please sign in to comment.