File Coverage

blib/lib/Biblio/ILL/ISO/Received.pm
Criterion Covered Total %
statement 71 98 72.4
branch 19 52 36.5
condition 1 9 11.1
subroutine 14 16 87.5
pod 13 13 100.0
total 118 188 62.7


line stmt bran cond sub pod time code
1             package Biblio::ILL::ISO::Received;
2              
3             =head1 NAME
4              
5             Biblio::ILL::ISO::Received - Perl extension for handling ISO 10161 interlibrary loan Received messages
6              
7             =cut
8              
9 2     2   2613 use Biblio::ILL::ISO::ISO;
  2         4  
  2         50  
10 2     2   11 use Carp;
  2         4  
  2         198  
11              
12             =head1 VERSION
13              
14             Version 0.02
15              
16             =cut
17              
18             our $VERSION = '0.02';
19             #---------------------------------------------------------------------------
20             # Mods
21             # 0.02 - 2003.09.07 - fixed the POD
22             # 0.01 - 2003.08.11 - original version
23             #---------------------------------------------------------------------------
24              
25             =head1 DESCRIPTION
26              
27             Biblio::ILL::ISO::Received is a derivation of the abstract
28             Biblio::ILL::ISO::ISO object, and handles the Received message type.
29              
30             =head1 EXPORT
31              
32             None.
33              
34             =head1 ERROR HANDLING
35              
36             Each of the set_() methods will croak on missing or invalid parameters.
37              
38             =cut
39              
40 2     2   2852 BEGIN{@ISA = qw ( Biblio::ILL::ISO::ISO ); }
41              
42             =head1 FROM THE ASN DEFINITION
43            
44             Received ::= [APPLICATION 8] SEQUENCE {
45             protocol-version-num [0] IMPLICIT INTEGER, -- {
46             -- version-1 (1),
47             -- version-2 (2)
48             -- },
49             transaction-id [1] IMPLICIT Transaction-Id,
50             service-date-time [2] IMPLICIT Service-Date-Time,
51             requester-id [3] IMPLICIT System-Id OPTIONAL,
52             -- mandatory when using store-and-forward communications
53             -- optional when using connection-oriented communications
54             responder-id [4] IMPLICIT System-Id OPTIONAL,
55             -- mandatory when using store-and-forward communications
56             -- optional when using connection-oriented communications
57             supplier-id [26] IMPLICIT System-Id OPTIONAL,
58             -- DC - 'EXTERNAL' definition (see Supplemental-Item-Description)
59             -- supplemental-item-description [17] IMPLICIT Supplemental-Item-Description OPTIONAL,
60             date-received [36] IMPLICIT ISO-Date,
61             shipped-service-type [27] IMPLICIT Shipped-Service-Type,
62             requester-note [46] ILL-String OPTIONAL,
63             received-extensions [49] IMPLICIT SEQUENCE OF Extension OPTIONAL
64             }
65              
66             =cut
67              
68             =head1 CONSTRUCTORS
69              
70             new()
71              
72             Base constructor for the class. It just returns a completely
73             empty message object, which you'll need to populate with the
74             various set_() methods, or use the read() method to read an
75             Received message from a file (followed by a call to
76             from_asn() to turn the read's returned hash into a proper
77             Received message.
78              
79             The constructor also initializes the Convert::ASN1 if it
80             hasn't been initialized.
81              
82             =cut
83             #---------------------------------------------------------------
84             #
85             #---------------------------------------------------------------
86             sub new {
87 2     2 1 17 my $class = shift;
88 2         3 my $self = {};
89              
90 2 50       5 Biblio::ILL::ISO::ISO::_init() if (not $Biblio::ILL::ISO::ISO::_asn_initialized);
91 2         4 $self->{"ASN_TYPE"} = "Received";
92              
93 2   33     11 bless($self, ref($class) || $class);
94 2         7 return ($self);
95             }
96              
97              
98             #---------------------------------------------------------------
99             #
100             #---------------------------------------------------------------
101             sub as_pretty_string {
102 0     0 1 0 my $self = shift;
103              
104 0         0 foreach my $key (sort keys %$self) {
105 0 0       0 if ($key ne "ASN_TYPE") {
106 0         0 print "\n[$key]\n";
107 0         0 print $self->{$key}->as_pretty_string();
108             }
109             }
110 0         0 return;
111             }
112              
113             #---------------------------------------------------------------
114             # This will return a structure usable by Convert::ASN1
115             #---------------------------------------------------------------
116             sub as_asn {
117 1     1 1 3 my $self = shift;
118              
119 1         4 my %h = ();
120 1         13 foreach my $key (sort keys %$self) {
121 10 100       28 if ($key ne "ASN_TYPE") {
122             #print "\n[$key]\n";
123 9         35 $h{$key} = $self->{$key}->as_asn();
124             }
125             }
126 1         5 return \%h;
127             }
128              
129             =head1 METHODS
130              
131             For any example code, assume the following:
132             my $msg = new Biblio::ILL::ISO::Received;
133              
134             =cut
135              
136             #---------------------------------------------------------------
137             #
138             #---------------------------------------------------------------
139             =head1
140              
141             =head2 from_asn($href)
142              
143             To read a message from a file, use the following:
144              
145             my $href = $msg->read("msg_08.received.ber");
146             $msg = $msg->from_asn($href);
147              
148             The from_asn() method turns the hash returned from read() into
149             a proper message-type object.
150              
151             =cut
152             sub from_asn {
153 0     0 1 0 my $self = shift;
154 0         0 my $href = shift;
155              
156 0         0 foreach my $k (keys %$href) {
157              
158 0 0 0     0 if ($k =~ /^protocol-version-num$/) {
    0 0        
    0          
    0          
    0          
    0          
    0          
159 0         0 $self->{$k} = new Biblio::ILL::ISO::ProtocolVersionNum();
160 0         0 $self->{$k}->from_asn($href->{$k});
161              
162             } elsif ($k =~ /^transaction-id$/) {
163 0         0 $self->{$k} = new Biblio::ILL::ISO::TransactionId();
164 0         0 $self->{$k}->from_asn($href->{$k});
165              
166             } elsif ($k =~ /^service-date-time$/) {
167 0         0 $self->{$k} = new Biblio::ILL::ISO::ServiceDateTime();
168 0         0 $self->{$k}->from_asn($href->{$k});
169              
170             } elsif (($k =~ /^requester-id$/)
171             || ($k =~ /^responder-id$/)
172             || ($k =~ /^supplier-id$/)
173             ) {
174 0         0 $self->{$k} = new Biblio::ILL::ISO::SystemId();
175 0         0 $self->{$k}->from_asn($href->{$k});
176              
177             } elsif ($k =~ /^date-received$/) {
178 0         0 $self->{$k} = new Biblio::ILL::ISO::ISODate();
179 0         0 $self->{$k}->from_asn($href->{$k});
180              
181             } elsif ($k =~ /^shipped-service-type$/) {
182 0         0 $self->{$k} = new Biblio::ILL::ISO::ShippedServiceType();
183 0         0 $self->{$k}->from_asn($href->{$k});
184              
185             } elsif ($k =~ /^requester-note$/) {
186 0         0 $self->{$k} = new Biblio::ILL::ISO::ILLString();
187 0         0 $self->{$k}->from_asn($href->{$k});
188              
189             } else {
190 0         0 croak "invalid " . ref($self) . " element: [$k]";
191             }
192              
193             }
194 0         0 return $self;
195             }
196              
197             #---------------------------------------------------------------
198             #
199             #---------------------------------------------------------------
200             =head1
201              
202             =head2 set_protocol_version_num($pvn)
203              
204             Sets the protocol version number.
205             Acceptable parameter values are the strings:
206             version-1
207             version-2
208              
209             =cut
210             sub set_protocol_version_num {
211 1     1 1 5 my $self = shift;
212 1         2 my ($parm) = shift;
213              
214 1 50       4 croak "missing protocol-version-num" unless $parm;
215              
216 1         4 $self->{"protocol-version-num"} = new Biblio::ILL::ISO::ProtocolVersionNum($parm);
217              
218 1         10 return;
219             }
220              
221             #---------------------------------------------------------------
222             #
223             #---------------------------------------------------------------
224             =head1
225              
226             =head2 set_transaction_id($tid)
227              
228             Sets the message's transaction-id.
229             Expects a valid Biblio::ILL::ISO::TransactionId.
230              
231             my $tid = new Biblio::ILL::ISO::TransactionId("PLS","001","",
232             new Biblio::ILL::ISO::SystemId("MWPL"));
233             $msg->set_transaction_id($tid);
234              
235             This is a mandatory field.
236              
237             =cut
238             sub set_transaction_id {
239 1     1 1 5 my $self = shift;
240 1         2 my ($parm) = shift;
241              
242 1 50       4 croak "missing transaction-id" unless $parm;
243 1 50       4 croak "invalid transaction-id" unless (ref($parm) eq "Biblio::ILL::ISO::TransactionId");
244              
245 1         13 $self->{"transaction-id"} = $parm;
246              
247 1         4 return;
248             }
249              
250             #---------------------------------------------------------------
251             #
252             #---------------------------------------------------------------
253             =head1
254              
255             =head2 set_service_date_time($sdt)
256              
257             Sets the message's service-date-time.
258             Expects a valid Biblio::ILL::ISO::ServiceDateTime.
259              
260             my $dt_this = new Biblio::ILL::ISO::DateTime("20030623","114400");
261             my $dt_orig = new Biblio::ILL::ISO::DateTime("20030623","114015")
262             my $sdt = new Biblio::ILL::ISO::ServiceDateTime( $dt_this, $dt_orig);
263             $msg->set_service_date_time($sdt);
264              
265             This is a mandatory field.
266              
267             =cut
268             sub set_service_date_time {
269 1     1 1 4 my $self = shift;
270 1         2 my ($sdt) = shift;
271              
272 1 50       4 croak "missing service-date-time" unless $sdt;
273 1 50       16 croak "invalid service-date-time" unless (ref($sdt) eq "Biblio::ILL::ISO::ServiceDateTime");
274              
275 1         2 $self->{"service-date-time"} = $sdt;
276              
277 1         2 return;
278             }
279              
280             #---------------------------------------------------------------
281             #
282             #---------------------------------------------------------------
283             =head1
284              
285             =head2 set_requester_id($reqid)
286              
287             Sets the message's requester-id.
288             Expects a valid Biblio::ILL::ISO::SystemId.
289              
290             my $reqid = new Biblio::ILL::ISO::SystemId();
291             $reqid->set_person_name("David A. Christensen");
292             $msg->set_requester_id($reqid);
293              
294             This is an optional field.
295              
296             =cut
297             sub set_requester_id {
298 1     1 1 5 my $self = shift;
299 1         2 my ($parm) = shift;
300              
301 1 50       3 croak "missing requester-id" unless $parm;
302 1 50       4 croak "invalid requester-id" unless (ref($parm) eq "Biblio::ILL::ISO::SystemId");
303              
304 1         2 $self->{"requester-id"} = $parm;
305              
306 1         2 return;
307             }
308              
309             #---------------------------------------------------------------
310             #
311             #---------------------------------------------------------------
312             =head1
313              
314             =head2 set_responder_id($resid)
315              
316             Sets the message's responder-id.
317             Expects a valid Biblio::ILL::ISO::SystemId.
318              
319             my $resid = new Biblio::ILL::ISO::SystemId("MWPL");
320             $msg->set_responder_id($resid);
321              
322             This is an optional field.
323              
324             =cut
325             sub set_responder_id {
326 1     1 1 4 my $self = shift;
327 1         5 my ($parm) = shift;
328              
329 1 50       4 croak "missing responder-id" unless $parm;
330 1 50       4 croak "invalid responder-id" unless (ref($parm) eq "Biblio::ILL::ISO::SystemId");
331              
332 1         4 $self->{"responder-id"} = $parm;
333              
334 1         3 return;
335             }
336              
337             #---------------------------------------------------------------
338             #
339             #---------------------------------------------------------------
340             =head1
341              
342             =head2 set_supplier_id($sid)
343              
344             Sets the message's supplier-id.
345             Expects a valid Biblio::ILL::ISO::SystemId.
346              
347             my $sid = new Biblio::ILL::ISO::SystemId("MBOM");
348             $msg->set_supplier_id($sid);
349              
350             This is an optional field.
351              
352             =cut
353             sub set_supplier_id {
354 1     1 1 12 my $self = shift;
355 1         3 my ($parm) = shift;
356              
357 1 50       4 croak "missing supplier-id" unless $parm;
358 1 50       4 croak "invalid supplier-id" unless (ref($parm) eq "Biblio::ILL::ISO::SystemId");
359              
360 1         3 $self->{"supplier-id"} = $parm;
361              
362 1         3 return;
363             }
364              
365             #---------------------------------------------------------------
366             # This is EXTERNAL, which we don't handle
367             #---------------------------------------------------------------
368             #sub set_supplemental_item_description {
369             # my $self = shift;
370             # my ($parm) = shift;
371             #
372             # croak "missing supplemental-item-description" unless $parm;
373             # croak "invalid supplemental-item-description" unless (ref($parm) eq "Biblio::ILL::ISO::SupplementalItemDescription");
374             #
375             # $self->{"supplemental-item-description"} = $parm;
376             #
377             # return;
378             #}
379              
380             #---------------------------------------------------------------
381             #
382             #---------------------------------------------------------------
383             =head1
384              
385             =head2 set_date_received($dr)
386              
387             Sets the message's date-received.
388             Expects a valid Biblio::ILL::ISO::ISODate.
389              
390             my $dr = new Biblio::ILL::ISO::ISODate("20030813");
391             $msg->set_date_received($dr);
392              
393             This is a mandatory field.
394              
395             =cut
396             sub set_date_received {
397 1     1 1 5 my $self = shift;
398 1         3 my ($parm) = shift;
399              
400 1 50       3 if (ref($parm) eq "Biblio::ILL::ISO::ISODate") {
401 1         3 $self->{"date-received"} = $parm;
402             } else {
403             # ISODate does the error checking....
404 0         0 $self->{"date-received"} = new Biblio::ILL::ISO::ISODate($parm);
405             }
406              
407 1         3 return;
408             }
409              
410             #---------------------------------------------------------------
411             #
412             #---------------------------------------------------------------
413             =head1
414              
415             =head2 set_shipped_service_type($sst)
416              
417             Sets the message's shipped-service-type.
418             Expects a valid Biblio::ILL::ISO::ShippedServiceType.
419              
420             my $sst = new Biblio::ILL::ISO::ShippedServiceType("loan");
421             $msg->set_shipped_service_type($sst);
422              
423             This is a mandatory field.
424              
425             =cut
426             sub set_shipped_service_type {
427 1     1 1 5 my $self = shift;
428 1         2 my ($parm) = shift;
429              
430 1 50       3 croak "missing shipped-service-type" unless $parm;
431 1 50       4 croak "invalid shipped-service-type" unless (ref($parm) eq "Biblio::ILL::ISO::ShippedServiceType");
432              
433 1         2 $self->{"shipped-service-type"} = $parm;
434              
435 1         2 return;
436             }
437              
438             #---------------------------------------------------------------
439             #
440             #---------------------------------------------------------------
441             =head1
442              
443             =head2 set_requester_note($note)
444              
445             Sets the message's requester-note.
446             Expects a simple text string.
447              
448             $msg->set_requester_note("This is a requester note");
449              
450             This is an optional field.
451              
452             =cut
453             sub set_requester_note {
454 1     1 1 6 my $self = shift;
455 1         2 my ($parm) = shift;
456              
457 1 50       4 croak "missing requester-note" unless $parm;
458 1 50       4 croak "invalid requester-note" unless (ref($parm) eq "Biblio::ILL::ISO::ILLString");
459              
460 1         3 $self->{"requester-note"} = $parm;
461              
462 1         3 return;
463             }
464              
465             =head1 RELATED MODULES
466              
467             Biblio::ILL::ISO::ISO
468             Biblio::ILL::ISO::Request
469             Biblio::ILL::ISO::ForwardNotification
470             Biblio::ILL::ISO::Shipped
471             Biblio::ILL::ISO::Answer
472             Biblio::ILL::ISO::ConditionalReply
473             Biblio::ILL::ISO::Cancel
474             Biblio::ILL::ISO::CancelReply
475             Biblio::ILL::ISO::Received
476             Biblio::ILL::ISO::Recall
477             Biblio::ILL::ISO::Returned
478             Biblio::ILL::ISO::CheckedIn
479             Biblio::ILL::ISO::Overdue
480             Biblio::ILL::ISO::Renew
481             Biblio::ILL::ISO::RenewAnswer
482             Biblio::ILL::ISO::Lost
483             Biblio::ILL::ISO::Damaged
484             Biblio::ILL::ISO::Message
485             Biblio::ILL::ISO::StatusQuery
486             Biblio::ILL::ISO::StatusOrErrorReport
487             Biblio::ILL::ISO::Expired
488              
489             =cut
490              
491             =head1 SEE ALSO
492              
493             See the README for system design notes.
494              
495             For more information on Interlibrary Loan standards (ISO 10160/10161),
496             a good place to start is:
497              
498             http://www.nlc-bnc.ca/iso/ill/main.htm
499              
500             =cut
501              
502             =head1 AUTHOR
503              
504             David Christensen,
505              
506             =cut
507              
508              
509             =head1 COPYRIGHT AND LICENSE
510              
511             Copyright 2003 by David Christensen
512              
513             This library is free software; you can redistribute it and/or modify it
514             under the same terms as Perl itself.
515              
516             =cut
517              
518             1;