File Coverage

blib/lib/Biblio/ILL/ISO/Damaged.pm
Criterion Covered Total %
statement 54 78 69.2
branch 14 40 35.0
condition 1 6 16.6
subroutine 11 13 84.6
pod 10 10 100.0
total 90 147 61.2


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