File Coverage

blib/lib/Data/CTable/ProgressLogger.pm
Criterion Covered Total %
statement 24 26 92.3
branch 1 2 50.0
condition 1 2 50.0
subroutine 7 8 87.5
pod 0 4 0.0
total 33 42 78.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             ## Emacs: -*- tab-width: 4; -*-
3              
4 1     1   791 use strict;
  1         3  
  1         65  
5              
6             package Data::CTable::ProgressLogger;
7              
8 1     1   6 use vars qw($VERSION); $VERSION = '0.1';
  1         2  
  1         70  
9              
10             =pod
11              
12             =head1 NAME
13              
14             Data::CTable::ProgressLogger - CTable that stores messages in the object
15              
16             =head1 SYNOPSIS
17              
18             my $Table = Data::CTable::ProgressLogger->new("mydata.txt");
19             # ... do stuff...
20             $Table->write();
21             $Table->show_log();
22              
23             =head1 OVERVIEW
24              
25             ProgressLogger is a subclass of Data::CTable.
26              
27             The only difference is that it enables per-instance progress by
28             defaul, but it stores progress messages in the object instead of
29             sending them to STDERR.
30              
31             Later, they can be gotten in an array by calling the log() method
32             or dumped with show_log().
33              
34             =cut
35              
36 1     1   7 use Data::CTable;
  1         4  
  1         41  
37 1     1   6 use vars qw(@ISA); @ISA=qw(Data::CTable);
  1         1  
  1         338  
38              
39             sub initialize ## Add a new param; change one default
40             {
41 1     1 0 3 my $this = shift;
42 1 50       15 $this->{_Progress} = 1 unless exists($this->{_Progress});
43 1   50     10 $this->{_ProgrLog} ||= [];
44 1         11 $this->SUPER::initialize();
45             }
46              
47             sub progress_default ## Log message to object's ProgMsgs list
48             {
49 2     2 0 6 my $this = shift;
50 2         4 my ($msg) = @_;
51 2         5 chomp $msg;
52 2         4 push @{$this->{_ProgrLog}}, localtime() . " $msg";
  2         76  
53            
54 2         9 return(1);
55             }
56              
57             sub log
58             {
59 1     1 0 7 my $this = shift;
60              
61 1         4 return($this->{_ProgrLog});
62             }
63              
64             sub show_log ## Use Dumper to spit out the log list
65             {
66 0     0 0   my $this = shift;
67 0           $this->dump($this->log());
68             }
69              
70             1;