File Coverage

blib/lib/Biblio/ILL/ISO/ENUMERATED.pm
Criterion Covered Total %
statement 9 67 13.4
branch 0 26 0.0
condition 0 3 0.0
subroutine 4 12 33.3
pod 6 6 100.0
total 19 114 16.6


line stmt bran cond sub pod time code
1             package Biblio::ILL::ISO::ENUMERATED;
2              
3             =head1 NAME
4              
5             Biblio::ILL::ISO::ENUMERATED
6              
7             =cut
8              
9 4     4   817 use Biblio::ILL::ISO::ILLASNtype;
  4         8  
  4         103  
10 4     4   24 use Carp;
  4         10  
  4         539  
11              
12             =head1 VERSION
13              
14             Version 0.01
15              
16             =cut
17              
18             our $VERSION = '0.01';
19             #---------------------------------------------------------------------------
20             # Mods
21             # 0.01 - 2003.07.15 - original version
22             #---------------------------------------------------------------------------
23              
24             =head1 DESCRIPTION
25              
26             Biblio::ILL::ISO::ENUMERATED is a derivation of Biblio::ILL::ISO::ILLASNtype.
27             It functions as a base class for any class that needs to handle enumerated types.
28             Any derived class must define it's own new() method, in which the list of possible/acceptable
29             values is defined.
30              
31             =head1 USES
32              
33             None.
34              
35             =head1 USED IN
36              
37             Biblio::ILL::ISO::ConditionalResultsCondition
38             Biblio::ILL::ISO::CurrentState
39             Biblio::ILL::ISO::ExpiryFlag
40             Biblio::ILL::ISO::Flag
41             Biblio::ILL::ISO::GeneralProblem
42             Biblio::ILL::ISO::ILLAPDUtype
43             Biblio::ILL::ISO::ILLServiceType
44             Biblio::ILL::ISO::IntermediaryProblem
45             Biblio::ILL::ISO::ItemType
46             Biblio::ILL::ISO::MediumType
47             Biblio::ILL::ISO::MostRecentService
48             Biblio::ILL::ISO::PlaceOnHoldType
49             Biblio::ILL::ISO::Preference
50             Biblio::ILL::ISO::ProtocolVersionNum
51             Biblio::ILL::ISO::ReasonLocsProvided
52             Biblio::ILL::ISO::ReasonNoReport
53             Biblio::ILL::ISO::ReasonNotAvailable
54             Biblio::ILL::ISO::ReasonUnfilled
55             Biblio::ILL::ISO::ReasonWillSupply
56             Biblio::ILL::ISO::ReportSource
57             Biblio::ILL::ISO::RequesterCHECKEDIN
58             Biblio::ILL::ISO::RequesterSHIPPED
59             Biblio::ILL::ISO::ResponderRECEIVED
60             Biblio::ILL::ISO::ResponderRETURNED
61             Biblio::ILL::ISO::ShippedConditions
62             Biblio::ILL::ISO::ShippedServiceType
63             Biblio::ILL::ISO::SupplyMediumType
64             Biblio::ILL::ISO::TransactionIdProblem
65             Biblio::ILL::ISO::TransactionResults
66             Biblio::ILL::ISO::TransactionType
67             Biblio::ILL::ISO::UnableToPerform
68              
69             =cut
70              
71 4     4   3849 BEGIN{@ISA = qw ( Biblio::ILL::ISO::ILLASNtype );} # inherit from ILLASNtype
72              
73             =head1 FROM THE ASN DEFINITION
74              
75             (as an example of an enumeration)
76              
77             ILL-Service-Type ::= ENUMERATED {
78             loan (1),
79             copy-non-returnable (2),
80             locations (3),
81             estimate (4),
82             responder-specific (5)
83             }
84              
85             =cut
86              
87             =head1 METHODS
88              
89             =cut
90              
91             #---------------------------------------------------------------
92             # Copy this into any derived class, changing the ENUM_LIST....
93             #---------------------------------------------------------------
94             =head1
95              
96             =head2 new( [$enumeration_value] )
97              
98             This will be overridden in any derived class.
99              
100             =cut
101             sub new {
102 0     0 1 0 my $class = shift;
103 0         0 my $self = {};
104              
105 0         0 my %ENUM_LIST = ("this" => 1,
106             "is" => 2,
107             "a base" => 3,
108             "class" => 4
109             );
110 0         0 $self->{"ENUM_LIST"} = %ENUM_LIST;
111              
112 0 0       0 if (@_) {
113 0         0 my $s = shift;
114            
115 0 0       0 if ( exists $self->{"ENUM_LIST"}->{$s} ) {
116 0         0 $self->{"ENUMERATED"} = $self->{"ENUM_LIST"}->{$s};
117             } else {
118 0         0 croak "invalid enumerated type: [$s]";
119             }
120             }
121              
122 0   0     0 bless($self, ref($class) || $class);
123 0         0 return ($self);
124             }
125              
126              
127             #---------------------------------------------------------------
128             #
129             #---------------------------------------------------------------
130             =head1
131              
132             =head2 set( $enumeration_value )
133              
134             Sets the object's "ENUMERATED" value by doing a lookup of the parameter
135             in the object's list of valid values. Croaks on invalid parameter values.
136              
137             =cut
138             sub set {
139 0     0 1 0 my $self = shift;
140 0         0 my $s = shift;
141              
142 0 0       0 if ( exists $self->{"ENUM_LIST"}->{$s} ) {
143 0         0 $self->{"ENUMERATED"} = $self->{"ENUM_LIST"}->{$s};
144             } else {
145 0         0 croak "invalid enumerated type: [$s]";
146             }
147              
148 0         0 return;
149             }
150              
151             #---------------------------------------------------------------
152             #
153             #---------------------------------------------------------------
154             =head1
155              
156             =head2 as_string( )
157              
158             Returns a stringified representation of the object.
159              
160             =cut
161             sub as_string {
162 0     0 1 0 my $self = shift;
163              
164 0         0 return $self->{"ENUMERATED"};
165             }
166              
167             #---------------------------------------------------------------
168             #
169             #---------------------------------------------------------------
170             =head1
171              
172             =head2 as_pretty_string( )
173              
174             Returns a more-formatted stringified representation of the object.
175              
176             =cut
177             sub as_pretty_string {
178 0     0 1 0 my $self = shift;
179              
180 0         0 return _debug_print($self->{"ENUMERATED"},4);
181             }
182              
183             #---------------------------------------------------------------
184             # This will return a structure usable by Convert::ASN1
185             #---------------------------------------------------------------
186             =head1
187              
188             =head2 as_asn( )
189              
190             Returns a structure usable by Convert::ASN1. Generally only called
191             from the parent's as_asn() method (or encode() method for top-level
192             message-type objects).
193              
194             =cut
195             sub as_asn {
196 53     53 1 82 my $self = shift;
197              
198 53         277 return $self->{"ENUMERATED"};
199             }
200              
201             #---------------------------------------------------------------
202             #
203             #---------------------------------------------------------------
204             =head1
205              
206             =head2 from_asn($href)
207              
208             Given a properly formatted hash, builds the object.
209              
210             =cut
211             sub from_asn {
212 0     0 1   my $self = shift;
213 0           my $val = shift;
214              
215 0           my $href = $self->{"ENUM_LIST"};
216 0           my %index = reverse %$href;
217              
218 0 0         if ( exists $index{$val} ) {
219             #print ref($self) . "...$val ($index{$val})\n";
220 0           $self->{"ENUMERATED"} = $val;
221             } else {
222 0           croak "from_asn error - invalid " . ref($self) . ": [$val]";
223             }
224 0           return $self;
225             }
226              
227              
228             #---------------------------------------------------------------
229             #
230             #---------------------------------------------------------------
231             sub _debug_print {
232             # my $self = shift;
233 0     0     my ($ref, $indent) = @_;
234 0           my $s = "";
235 0 0         $indent = 0 if (not defined($indent));
236              
237             # return _debug_print_hash($self) if (not defined $ref);
238              
239             # print ">>>" . ref($ref) . "<<<\n";
240              
241 0 0         return _debug_print_hash($ref, $indent) if (ref($ref) eq "HASH");
242 0 0         return _debug_print_array($ref, $indent) if (ref($ref) eq "ARRAY");
243              
244 0           for ($i=0; $i < $indent; $i++) {
245 0           $s .= " ";
246             #print "."; # DC - debugging
247             }
248             #print "\n"; # DC - debugging
249              
250 0 0         return ("$s$ref\n") if (not ref($ref));
251              
252             # If it's not any of the above, it is (should be?) an object,
253             # which we treat as a hash. Cheezy, I know - I can't think
254             # of a better way.
255 0           return _debug_print_hash($ref, $indent);
256             }
257              
258              
259             #---------------------------------------------------------------
260             #
261             #---------------------------------------------------------------
262             sub _debug_print_hash {
263 0     0     my ($href, $indent) = @_;
264 0           my $s = "";
265 0 0         $indent = 0 if (not defined($indent));
266              
267 0           foreach $key (sort keys %$href) {
268             # There's got to be a better way :-)
269 0           for ($i=0; $i < $indent; $i++) {
270 0           $s .= " ";
271             #print "."; # DC - debugging
272             }
273             #print "\n"; # DC - debugging
274              
275 0           $s .= "$key ";
276 0 0         $s .= "=>\n" unless (ref($href->{$key}) eq "HASH");
277 0 0         $s .= "\n" if (ref($href->{$key}) eq "HASH");
278 0 0         $s .= "\n" if (ref($href->{$key}) eq "ARRAY");
279 0           $s .= _debug_print($href->{$key}, $indent+4);
280             }
281 0           return $s;
282             }
283              
284              
285             #---------------------------------------------------------------
286             #
287             #---------------------------------------------------------------
288             sub _debug_print_array {
289 0     0     my ($aref, $indent) = @_;
290 0           my $s = "";
291 0 0         $indent = 0 if (not defined($indent));
292              
293 0           foreach $elm (@$aref) {
294             # There's got to be a better way :-)
295 0           for ($i=0; $i < $indent; $i++) {
296 0           $s .= " ";
297             #print "."; # DC - debugging
298             }
299             #print "\n"; # DC - debugging
300 0           $s .= _debug_print($elm, $indent+4);
301             }
302 0           return $s;
303             }
304              
305             =head1 SEE ALSO
306              
307             See the README for system design notes.
308             See the parent class(es) for other available methods.
309             See the derived classes for examples of use.
310              
311             For more information on Interlibrary Loan standards (ISO 10160/10161),
312             a good place to start is:
313              
314             http://www.nlc-bnc.ca/iso/ill/main.htm
315              
316             =cut
317              
318             =head1 AUTHOR
319              
320             David Christensen,
321              
322             =cut
323              
324              
325             =head1 COPYRIGHT AND LICENSE
326              
327             Copyright 2003 by David Christensen
328              
329             This library is free software; you can redistribute it and/or modify it
330             under the same terms as Perl itself.
331              
332             =cut
333              
334             1;