File Coverage

blib/lib/Biblio/ILL/ISO/CancelReply.pm
Criterion Covered Total %
statement 59 83 71.0
branch 15 42 35.7
condition 1 6 16.6
subroutine 12 14 85.7
pod 11 11 100.0
total 98 156 62.8


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