File Coverage

blib/lib/Biblio/ILL/ISO/Expired.pm
Criterion Covered Total %
statement 48 68 70.5
branch 12 32 37.5
condition 1 6 16.6
subroutine 10 12 83.3
pod 9 9 100.0
total 80 127 62.9


line stmt bran cond sub pod time code
1             package Biblio::ILL::ISO::Expired;
2              
3             =head1 NAME
4              
5             Biblio::ILL::ISO::Expired - Perl extension for handling ISO 10161 interlibrary loan Expired messages
6              
7             =cut
8              
9 2     2   8786 use Biblio::ILL::ISO::ISO;
  2         6  
  2         106  
10 2     2   17 use Carp;
  2         5  
  2         305  
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.01.11 - original version
22             #---------------------------------------------------------------------------
23              
24             =head1 DESCRIPTION
25              
26             Biblio::ILL::ISO::Expired is a derivation of the abstract
27             Biblio::ILL::ISO::ISO object, and handles the Expired message type.
28              
29             =head1 EXPORT
30              
31             None.
32              
33             =head1 ERROR HANDLING
34              
35             Each of the set_() methods will croak on missing or invalid parameters.
36              
37             =cut
38              
39 2     2   2535 BEGIN{@ISA = qw ( Biblio::ILL::ISO::ISO ); }
40              
41             =head1 FROM THE ASN DEFINITION
42            
43             Expired ::= [APPLICATION 20] SEQUENCE {
44             protocol-version-num [0] IMPLICIT INTEGER, -- {
45             -- version-1 (1),
46             --version-2 (2)
47             -- },
48             transaction-id [1] IMPLICIT Transaction-Id,
49             service-date-time [2] IMPLICIT Service-Date-Time,
50             requester-id [3] IMPLICIT System-Id OPTIONAL,
51             -- mandatory when using store-and-forward communications
52             -- optional when using connection-oriented communications
53             responder-id [4] IMPLICIT System-Id OPTIONAL,
54             -- mandatory when using store-and-forward communications
55             -- optional when using connection-oriented communications
56             expired-extensions [49] IMPLICIT SEQUENCE OF Extension OPTIONAL
57             }
58              
59             =cut
60              
61             =head1 CONSTRUCTORS
62              
63             new()
64              
65             Base constructor for the class. It just returns a completely
66             empty message object, which you'll need to populate with the
67             various set_() methods, or use the read() method to read an
68             Expired message from a file (followed by a call to
69             from_asn() to turn the read's returned hash into a proper
70             Expired message.
71              
72             The constructor also initializes the Convert::ASN1 if it
73             hasn't been initialized.
74              
75             =cut
76              
77             #---------------------------------------------------------------
78             #
79             #---------------------------------------------------------------
80             sub new {
81 2     2 1 12 my $class = shift;
82 2         4 my $self = {};
83              
84 2 50       5 Biblio::ILL::ISO::ISO::_init() if (not $Biblio::ILL::ISO::ISO::_asn_initialized);
85 2         3 $self->{"ASN_TYPE"} = "Expired";
86              
87 2   33     10 bless($self, ref($class) || $class);
88 2         3 return ($self);
89             }
90              
91              
92             #---------------------------------------------------------------
93             #
94             #---------------------------------------------------------------
95             sub as_pretty_string {
96 0     0 1 0 my $self = shift;
97              
98 0         0 foreach my $key (sort keys %$self) {
99 0 0       0 if ($key ne "ASN_TYPE") {
100 0         0 print "\n[$key]\n";
101 0         0 print $self->{$key}->as_pretty_string();
102             }
103             }
104 0         0 return;
105             }
106              
107             #---------------------------------------------------------------
108             # This will return a structure usable by Convert::ASN1
109             #---------------------------------------------------------------
110             sub as_asn {
111 1     1 1 4 my $self = shift;
112              
113 1         3 my %h = ();
114 1         10 foreach my $key (sort keys %$self) {
115 6 100       18 if ($key ne "ASN_TYPE") {
116             #print "\n[$key]\n";
117 5         25 $h{$key} = $self->{$key}->as_asn();
118             }
119             }
120 1         6 return \%h;
121             }
122              
123             =head1 METHODS
124              
125             For any example code, assume the following:
126             my $msg = new Biblio::ILL::ISO::Expired;
127              
128             =cut
129              
130             #---------------------------------------------------------------
131             #
132             #---------------------------------------------------------------
133             =head1
134              
135             =head2 from_asn($href)
136              
137             To read a message from a file, use the following:
138              
139             my $href = $msg->read("msg_20.expired.ber");
140             $msg = $msg->from_asn($href);
141              
142             The from_asn() method turns the hash returned from read() into
143             a proper message-type object.
144              
145             =cut
146             sub from_asn {
147 0     0 1 0 my $self = shift;
148 0         0 my $href = shift;
149              
150 0         0 foreach my $k (keys %$href) {
151              
152 0 0 0     0 if ($k =~ /^protocol-version-num$/) {
    0          
    0          
    0          
153 0         0 $self->{$k} = new Biblio::ILL::ISO::ProtocolVersionNum();
154 0         0 $self->{$k}->from_asn($href->{$k});
155              
156             } elsif ($k =~ /^transaction-id$/) {
157 0         0 $self->{$k} = new Biblio::ILL::ISO::TransactionId();
158 0         0 $self->{$k}->from_asn($href->{$k});
159              
160             } elsif ($k =~ /^service-date-time$/) {
161 0         0 $self->{$k} = new Biblio::ILL::ISO::ServiceDateTime();
162 0         0 $self->{$k}->from_asn($href->{$k});
163              
164             } elsif (($k =~ /^requester-id$/)
165             || ($k =~ /^responder-id$/)
166             ) {
167 0         0 $self->{$k} = new Biblio::ILL::ISO::SystemId();
168 0         0 $self->{$k}->from_asn($href->{$k});
169              
170             } else {
171 0         0 croak "invalid " . ref($self) . " element: [$k]";
172             }
173              
174             }
175 0         0 return $self;
176             }
177              
178             #---------------------------------------------------------------
179             #
180             #---------------------------------------------------------------
181             =head1
182              
183             =head2 set_protocol_version_num($pvn)
184              
185             Sets the protocol version number.
186             Acceptable parameter values are the strings:
187             version-1
188             version-2
189              
190             =cut
191             sub set_protocol_version_num {
192 1     1 1 4 my $self = shift;
193 1         7 my ($parm) = shift;
194              
195 1 50       3 croak "missing protocol-version-num" unless $parm;
196              
197 1         4 $self->{"protocol-version-num"} = new Biblio::ILL::ISO::ProtocolVersionNum($parm);
198              
199 1         2 return;
200             }
201              
202             #---------------------------------------------------------------
203             #
204             #---------------------------------------------------------------
205             =head1
206              
207             =head2 set_transaction_id($tid)
208              
209             Sets the message's transaction-id.
210             Expects a valid Biblio::ILL::ISO::TransactionId.
211              
212             my $tid = new Biblio::ILL::ISO::TransactionId("PLS","001","",
213             new Biblio::ILL::ISO::SystemId("MWPL"));
214             $msg->set_transaction_id($tid);
215              
216             This is a mandatory field.
217              
218             =cut
219             sub set_transaction_id {
220 1     1 1 5 my $self = shift;
221 1         2 my ($parm) = shift;
222              
223 1 50       4 croak "missing transaction-id" unless $parm;
224 1 50       4 croak "invalid transaction-id" unless (ref($parm) eq "Biblio::ILL::ISO::TransactionId");
225              
226 1         2 $self->{"transaction-id"} = $parm;
227              
228 1         3 return;
229             }
230              
231             #---------------------------------------------------------------
232             #
233             #---------------------------------------------------------------
234             =head1
235              
236             =head2 set_service_date_time($sdt)
237              
238             Sets the message's service-date-time.
239             Expects a valid Biblio::ILL::ISO::ServiceDateTime.
240              
241             my $dt_this = new Biblio::ILL::ISO::DateTime("20030623","114400");
242             my $dt_orig = new Biblio::ILL::ISO::DateTime("20030623","114015")
243             my $sdt = new Biblio::ILL::ISO::ServiceDateTime( $dt_this, $dt_orig);
244             $msg->set_service_date_time($sdt);
245              
246             This is a mandatory field.
247              
248             =cut
249             sub set_service_date_time {
250 1     1 1 3 my $self = shift;
251 1         2 my ($sdt) = shift;
252              
253 1 50       3 croak "missing service-date-time" unless $sdt;
254 1 50       4 croak "invalid service-date-time" unless (ref($sdt) eq "Biblio::ILL::ISO::ServiceDateTime");
255              
256 1         2 $self->{"service-date-time"} = $sdt;
257              
258 1         7 return;
259             }
260              
261             #---------------------------------------------------------------
262             #
263             #---------------------------------------------------------------
264             =head1
265              
266             =head2 set_requester_id($reqid)
267              
268             Sets the message's requester-id.
269             Expects a valid Biblio::ILL::ISO::SystemId.
270              
271             my $reqid = new Biblio::ILL::ISO::SystemId();
272             $reqid->set_person_name("David A. Christensen");
273             $msg->set_requester_id($reqid);
274              
275             This is an optional field.
276              
277             =cut
278             sub set_requester_id {
279 1     1 1 4 my $self = shift;
280 1         2 my ($parm) = shift;
281              
282 1 50       3 croak "missing requester-id" unless $parm;
283 1 50       4 croak "invalid requester-id" unless (ref($parm) eq "Biblio::ILL::ISO::SystemId");
284              
285 1         2 $self->{"requester-id"} = $parm;
286              
287 1         7 return;
288             }
289              
290             #---------------------------------------------------------------
291             #
292             #---------------------------------------------------------------
293             =head1
294              
295             =head2 set_responder_id($resid)
296              
297             Sets the message's responder-id.
298             Expects a valid Biblio::ILL::ISO::SystemId.
299              
300             my $resid = new Biblio::ILL::ISO::SystemId("MWPL");
301             $msg->set_responder_id($resid);
302              
303             This is an optional field.
304              
305             =cut
306             sub set_responder_id {
307 1     1 1 4 my $self = shift;
308 1         2 my ($parm) = shift;
309              
310 1 50       3 croak "missing responder-id" unless $parm;
311 1 50       4 croak "invalid responder-id" unless (ref($parm) eq "Biblio::ILL::ISO::SystemId");
312              
313 1         3 $self->{"responder-id"} = $parm;
314              
315 1         2 return;
316             }
317              
318             =head1 RELATED MODULES
319              
320             Biblio::ILL::ISO::ISO
321             Biblio::ILL::ISO::Request
322             Biblio::ILL::ISO::ForwardNotification
323             Biblio::ILL::ISO::Shipped
324             Biblio::ILL::ISO::Answer
325             Biblio::ILL::ISO::ConditionalReply
326             Biblio::ILL::ISO::Cancel
327             Biblio::ILL::ISO::CancelReply
328             Biblio::ILL::ISO::Received
329             Biblio::ILL::ISO::Recall
330             Biblio::ILL::ISO::Returned
331             Biblio::ILL::ISO::CheckedIn
332             Biblio::ILL::ISO::Overdue
333             Biblio::ILL::ISO::Renew
334             Biblio::ILL::ISO::RenewAnswer
335             Biblio::ILL::ISO::Lost
336             Biblio::ILL::ISO::Damaged
337             Biblio::ILL::ISO::Message
338             Biblio::ILL::ISO::StatusQuery
339             Biblio::ILL::ISO::StatusOrErrorReport
340             Biblio::ILL::ISO::Expired
341              
342             =cut
343              
344             =head1 SEE ALSO
345              
346             See the README for system design notes.
347              
348             For more information on Interlibrary Loan standards (ISO 10160/10161),
349             a good place to start is:
350              
351             http://www.nlc-bnc.ca/iso/ill/main.htm
352              
353             =cut
354              
355             =head1 AUTHOR
356              
357             David Christensen,
358              
359             =cut
360              
361              
362             =head1 COPYRIGHT AND LICENSE
363              
364             Copyright 2003 by David Christensen
365              
366             This library is free software; you can redistribute it and/or modify it
367             under the same terms as Perl itself.
368              
369             =cut
370              
371             1;