File Coverage

lib/CPANPLUS/Error.pm
Criterion Covered Total %
statement 55 55 100.0
branch 11 14 78.6
condition 4 6 66.7
subroutine 14 14 100.0
pod 5 5 100.0
total 89 94 94.7


line stmt bran cond sub pod time code
1             package CPANPLUS::Error;
2              
3 15     15   300 use strict;
  15         244  
  15         208  
4              
5 15     15   559 use Log::Message private => 0;;
  15         178  
  15         387  
6              
7             =pod
8            
9             =head1 NAME
10            
11             CPANPLUS::Error
12            
13             =head1 SYNOPSIS
14            
15             use CPANPLUS::Error qw[cp_msg cp_error];
16            
17             =head1 DESCRIPTION
18            
19             This module provides the error handling code for the CPANPLUS
20             libraries, and is mainly intended for internal use.
21            
22             =head1 FUNCTIONS
23            
24             =head2 cp_msg("message string" [,VERBOSE])
25            
26             Records a message on the stack, and prints it to C<STDOUT> (or actually
27             C<$MSG_FH>, see the C<GLOBAL VARIABLES> section below), if the
28             C<VERBOSE> option is true.
29             The C<VERBOSE> option defaults to false.
30            
31             =head2 msg()
32            
33             An alias for C<cp_msg>.
34            
35             =head2 cp_error("error string" [,VERBOSE])
36            
37             Records an error on the stack, and prints it to C<STDERR> (or actually
38             C<$ERROR_FH>, see the C<GLOBAL VARIABLES> sections below), if the
39             C<VERBOSE> option is true.
40             The C<VERBOSE> options defaults to true.
41            
42             =head2 error()
43            
44             An alias for C<cp_error>.
45            
46             =head1 CLASS METHODS
47            
48             =head2 CPANPLUS::Error->stack()
49            
50             Retrieves all the items on the stack. Since C<CPANPLUS::Error> is
51             implemented using C<Log::Message>, consult its manpage for the
52             function C<retrieve> to see what is returned and how to use the items.
53            
54             =head2 CPANPLUS::Error->stack_as_string([TRACE])
55            
56             Returns the whole stack as a printable string. If the C<TRACE> option is
57             true all items are returned with C<Carp::longmess> output, rather than
58             just the message.
59             C<TRACE> defaults to false.
60            
61             =head2 CPANPLUS::Error->flush()
62            
63             Removes all the items from the stack and returns them. Since
64             C<CPANPLUS::Error> is implemented using C<Log::Message>, consult its
65             manpage for the function C<retrieve> to see what is returned and how
66             to use the items.
67            
68             =cut
69              
70             BEGIN {
71 15     15   290     use Exporter;
  15         214  
  15         250  
72 15     15   315     use Params::Check qw[check];
  15         138  
  15         254  
73 15     15   321     use vars qw[@EXPORT @ISA $ERROR_FH $MSG_FH];
  15         248  
  15         462  
74              
75 15     15   354     @ISA = 'Exporter';
76 15         278     @EXPORT = qw[cp_error cp_msg error msg];
77              
78 15         222     my $log = new Log::Message;
79              
80 15         165     for my $func ( @EXPORT ) {
81 15     15   255         no strict 'refs';
  15         169  
  15         248  
82                     
83 60         588         my $prefix = 'cp_';
84 60         659         my $name = $func;
85 60         963         $name =~ s/^$prefix//g;
86                     
87                     *$func = sub {
88 417     417   39507                         my $msg = shift;
89                                     
90             ### no point storing non-messages
91 417 50       6273                         return unless defined $msg;
92                                     
93 417         24219                         $log->store(
94                                             message => $msg,
95                                             tag => uc $name,
96                                             level => $prefix . $name,
97                                             extra => [@_]
98                                     );
99 60         1662                 };
100                 }
101              
102                 sub flush {
103 28     28 1 9566         return reverse $log->flush;
104                 }
105              
106                 sub stack {
107 37     37 1 1216         return $log->retrieve( chrono => 1 );
108                 }
109              
110                 sub stack_as_string {
111 34     34 1 5773         my $class = shift;
112 34 100       484         my $trace = shift() ? 1 : 0;
113              
114 508 100       91991         return join $/, map {
115 34         486                         '[' . $_->tag . '] [' . $_->when . '] ' .
116                                     ($trace ? $_->message . ' ' . $_->longmess
117                                             : $_->message);
118                                 } __PACKAGE__->stack;
119                 }
120             }
121              
122             =head1 GLOBAL VARIABLES
123            
124             =over 4
125            
126             =item $ERROR_FH
127            
128             This is the filehandle all the messages sent to C<error()> are being
129             printed. This defaults to C<*STDERR>.
130            
131             =item $MSG_FH
132            
133             This is the filehandle all the messages sent to C<msg()> are being
134             printed. This default to C<*STDOUT>.
135            
136             =cut
137             local $| = 1;
138             $ERROR_FH   = \*STDERR;
139             $MSG_FH     = \*STDOUT;
140              
141             package Log::Message::Handlers;
142 15     15   304 use Carp ();
  15         176  
  15         143  
143              
144             {
145              
146                 sub cp_msg {
147 371     371 1 68983         my $self = shift;
148 371         4222         my $verbose = shift;
149              
150             ### so you don't want us to print the msg? ###
151 371 100 66     7936         return if defined $verbose && $verbose == 0;
152              
153 2         26         my $old_fh = select $CPANPLUS::Error::MSG_FH;
154              
155 2         35         print '['. $self->tag . '] ' . $self->message . "\n";
156 2         24         select $old_fh;
157              
158 2         26         return;
159                 }
160              
161                 sub cp_error {
162 46     46 1 8272         my $self = shift;
163 46         525         my $verbose = shift;
164              
165             ### so you don't want us to print the error? ###
166 46 50 66     784         return if defined $verbose && $verbose == 0;
167              
168 46         988         my $old_fh = select $CPANPLUS::Error::ERROR_FH;
169              
170             ### is only going to be 1 for now anyway ###
171 46         1617         my $cb = (CPANPLUS::Internals->_return_all_objects)[0];
172              
173             ### maybe we didn't initialize an internals object (yet) ###
174 46 100       1096         my $debug = $cb ? $cb->configure_object->get_conf('debug') : 0;
175 46         1015         my $msg = '['. $self->tag . '] ' . $self->message . "\n";
176              
177             ### i'm getting this warning in the test suite:
178             ### Ambiguous call resolved as CORE::warn(), qualify as such or
179             ### use & at CPANPLUS/Error.pm line 57.
180             ### no idea where it's coming from, since there's no 'sub warn'
181             ### anywhere to be found, but i'll mark it explicitly nonetheless
182             ### --kane
183 46 50       6565         print $debug ? Carp::shortmess($msg) : $msg . "\n";
184              
185 46         1343         select $old_fh;
186              
187 46         686         return;
188                 }
189             }
190              
191             1;
192              
193             # Local variables:
194             # c-indentation-style: bsd
195             # c-basic-offset: 4
196             # indent-tabs-mode: nil
197             # End:
198             # vim: expandtab shiftwidth=4:
199