File Coverage

blib/lib/Slackware/Slackget/Status.pm
Criterion Covered Total %
statement 6 42 14.2
branch 0 18 0.0
condition n/a
subroutine 2 12 16.6
pod 10 10 100.0
total 18 82 21.9


line stmt bran cond sub pod time code
1             package Slackware::Slackget::Status;
2              
3 1     1   6 use warnings;
  1         3  
  1         30  
4 1     1   6 use strict;
  1         2  
  1         713  
5              
6             =head1 NAME
7              
8             Slackware::Slackget::Status - A class for returning a status code with its explanations
9              
10             =head1 VERSION
11              
12             Version 1.0.100
13              
14             =cut
15              
16             our $VERSION = '1.0.100';
17              
18             =head1 SYNOPSIS
19              
20             This class is used at a status object which can tell more informations to user. In this object are stored couples of integer (the return code of the function which return the status object), and string (the human readable description of the error)
21              
22             use Slackware::Slackget::Status;
23              
24             my $status = Slackware::Slackget::Status->new(
25             codes => {
26             0 => "All operations goes well",
27             1 => "Parameters unexpected",
28             2 => "Network error"
29             }
30             );
31             print "last error message was: ",$status->to_string,"\n";
32             if($status->is_error)
33             {
34             die "Error: ",$status->to_string,"\n";
35             }
36             elsif($status->is_success)
37             {
38             print $status->to_string,"\n";
39             }
40              
41             Please note that you must see at the documentation of a class to know the returned codes.
42              
43             =cut
44              
45             sub new
46             {
47 0     0 1   my ($class,%arg) = @_ ;
48 0           my $self={ CURRENT_CODE => undef };
49             # return undef if(!defined($arg{'codes'}) && ref($arg{codes}) ne 'HASH');
50 0           $self->{CODES} = $arg{'codes'} ;
51 0 0         $self->{ERROR_CODES} = $arg{'error_codes'} if($arg{'error_codes'}) ;
52 0 0         $self->{SUCCESS_CODES} = $arg{'success_codes'} if($arg{'success_codes'}) ;
53 0           bless($self,$class);
54 0           return $self;
55             }
56              
57             =head1 CONSTRUCTOR
58              
59             =head2 new
60              
61             You need to pass to the constructor a parameter 'codes' wich contain a hashref with number return code as keys and explanation strings as values :
62              
63             my $status = new Slackware::Slackget::Status (
64             codes => {
65             0 => "All good\n",
66             1 => "Network unreachable\n",
67             2 => "Host unreachable\n",
68             3 => "Remote file seems not exist\n"
69             }
70             );
71              
72             You can, optionnally, give to more parameters : success_codes and error_codes within the same format than codes. It'll allow you to control the current status via the is_success() and is_error() methods.
73              
74             =head1 FUNCTIONS
75              
76             =head2 to_string
77              
78             Return the explanation string of the current status.
79              
80             if($connection->fetch_file($remote_file,$local_file) > 0)
81             {
82             print "ERROR : ",$status->to_string ;
83             return undef;
84             }
85             else
86             {
87             ...
88             }
89              
90             =cut
91              
92             sub to_string {
93 0     0 1   my $self = shift;
94 0 0         return $self->{SUCCESS_CODES}->{$self->{CURRENT_CODE}} if($self->{SUCCESS_CODES}->{$self->{CURRENT_CODE}}) ;
95 0 0         return $self->{ERROR_CODES}->{$self->{CURRENT_CODE}} if($self->{ERROR_CODES}->{$self->{CURRENT_CODE}}) ;
96 0           return $self->{CODES}->{$self->{CURRENT_CODE}} ;
97             }
98              
99             =head2 to_int
100              
101             Same as to_string but return the code number.
102              
103             =cut
104              
105             sub to_int {
106 0     0 1   my $self = shift;
107 0           return $self->{CURRENT_CODE} ;
108             }
109              
110             =head2 to_XML (deprecated)
111              
112             Same as to_xml(), provided for backward compatibility.
113              
114             =cut
115              
116             sub to_XML {
117 0     0 1   return to_xml(@_);
118             }
119              
120             =head2 to_xml
121              
122             return an xml ecoded string, represented the current status. The XML string will be like that :
123              
124            
125              
126             $xml_file->Add($status->to_xml) ;
127              
128             =cut
129              
130             sub to_xml
131             {
132 0     0 1   my $self = shift ;
133 0           return "to_int()."\" description=\"".$self->to_string()."\" />";
134             }
135              
136             =head2 to_HTML (deprecated)
137              
138             Same as to_html(), provided for backward compatibility.
139              
140             =cut
141              
142             sub to_HTML {
143 0     0 1   return to_html(@_);
144             }
145              
146             =head2 to_html
147              
148             return the status as an HTML encoded string
149              
150             =cut
151              
152             sub to_html
153             {
154 0     0 1   my $self = shift ;
155 0           return "

Status

code : ".$self->to_int()."
description : ".$self->to_string()."
\n

\n";
156             }
157              
158             =head2 current
159              
160             Called wihtout argument, just call to_int(), call with an integer argument, set the current status code to this int.
161              
162             my $code = $status->current ; # same effect as my $code = $status->to_int ;
163             or
164             $status->current(12);
165            
166             Warning : call current() with a non-integer argument will fail ! The error code MUST BE AN INTEGER.
167              
168             =cut
169              
170             sub current
171             {
172 0     0 1   my ($self,$code) = @_;
173 0 0         if(!defined($code))
174             {
175 0           return $self->to_int ;
176             }
177             else
178             {
179 0 0         if($code=~ /^\d+$/)
180             {
181 0 0         print "[Slackware::Slackget::Status] (debug) setting current status code to $code.\n" if($ENV{SG_DAEMON_DEBUG});
182 0           $self->{CURRENT_CODE} = $code;
183 0           return 1;
184             }
185             else
186             {
187 0           warn "[Slackware::Slackget::Status] '$code' is not an integer.\n";
188 0           return undef;
189             }
190             }
191             }
192              
193             =head2 is_success
194              
195             return true (1) if the current() code is declared as a success code (constructor's parameter: success_codes). Return false otherwise (particularly if you have only set codes and not success_codes).
196              
197             =cut
198              
199             sub is_success {
200 0     0 1   my $self = shift;
201             # return 1 if($self->{SUCCESS_CODES}->{$self->{CURRENT_CODE}});
202 0           foreach my $code ( keys(%{$self->{SUCCESS_CODES}}) ){
  0            
203             # print "[Slackware::Slackget::Status] comparing success code '$code' to current status code '".$self->{CURRENT_CODE}."'.\n";
204 0 0         return 1 if($code == $self->{CURRENT_CODE})
205             }
206 0           return 0;
207             }
208              
209              
210             =head2 is_error
211              
212             return true (1) if the current() code is declared as an error code (constructor's parameter: error_codes). Return false otherwise (particularly if you have only set codes and not error_codes).
213              
214             =cut
215              
216             sub is_error {
217 0     0 1   my $self = shift;
218 0 0         return 1 if($self->{ERROR_CODES}->{$self->{CURRENT_CODE}});
219 0           return 0;
220             }
221              
222             =head1 AUTHOR
223              
224             DUPUIS Arnaud, C<< >>
225              
226             =head1 BUGS
227              
228             Please report any bugs or feature requests to
229             C, or through the web interface at
230             L.
231             I will be notified, and then you'll automatically be notified of progress on
232             your bug as I make changes.
233              
234             =head1 SUPPORT
235              
236             You can find documentation for this module with the perldoc command.
237              
238             perldoc Slackware::Slackget::Status
239              
240              
241             You can also look for information at:
242              
243             =over 4
244              
245             =item * Infinity Perl website
246              
247             L
248              
249             =item * slack-get specific website
250              
251             L
252              
253             =item * RT: CPAN's request tracker
254              
255             L
256              
257             =item * AnnoCPAN: Annotated CPAN documentation
258              
259             L
260              
261             =item * CPAN Ratings
262              
263             L
264              
265             =item * Search CPAN
266              
267             L
268              
269             =back
270              
271             =head1 ACKNOWLEDGEMENTS
272              
273             Thanks to Bertrand Dupuis (yes my brother) for his contribution to the documentation.
274              
275             =head1 COPYRIGHT & LICENSE
276              
277             Copyright 2005 DUPUIS Arnaud, All Rights Reserved.
278              
279             This program is free software; you can redistribute it and/or modify it
280             under the same terms as Perl itself.
281              
282             =cut
283              
284             1; # End of Slackware::Slackget::Status