Preparing for release.
[simpleserver-moved-to-github.git] / GRS1.pm
1 package Net::Z3950::GRS1;
2
3 ##  $Id: GRS1.pm,v 1.6 2004-05-28 20:14:28 sondberg Exp $
4 ##
5 ##  Copyright (c) 2000-2004, Index Data.
6 ##
7 ##  Permission to use, copy, modify, distribute, and sell this software and
8 ##  its documentation, in whole or in part, for any purpose, is hereby granted,
9 ##  provided that:
10 ##
11 ##  1. This copyright and permission notice appear in all copies of the
12 ##  software and its documentation. Notices of copyright or attribution
13 ##  which appear at the beginning of any file must remain unchanged.
14 ##
15 ##  2. The name of Index Data or the individual authors may not be used to
16 ##  endorse or promote products derived from this software without specific
17 ##  prior written permission.
18 ##
19 ##  THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
20 ##  EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
21 ##  WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
22 ##  IN NO EVENT SHALL INDEX DATA BE LIABLE FOR ANY SPECIAL, INCIDENTAL,
23 ##  INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES
24 ##  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER OR
25 ##  NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND ON ANY THEORY OF
26 ##  LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
27 ##  OF THIS SOFTWARE.
28 ##
29
30 use strict;
31 use IO::Handle;
32 use Carp;
33
34
35
36 sub new {
37         my ($class, $href, $map) = @_;
38         my $self = {};
39
40         $self->{ELEMENTS} = [];
41         $self->{FH} = *STDOUT;                          ## Default output handle is STDOUT
42         $self->{MAP} = $map;
43         bless $self, $class;
44         if (defined($href) && ref($href) eq 'HASH') {
45                 if (!defined($map)) {
46                         croak 'Usage: new Net::Z3950::GRS1($href, $map);';
47                 }       
48                 $self->Hash2grs($href, $map);
49         }
50
51         return $self;
52 }
53
54
55 sub Hash2grs {
56         my ($self, $href, $mapping) = @_;
57         my $key;
58         my $content;
59         my $aref;
60         my $issue;
61
62         $mapping = defined($mapping) ? $mapping : $self->{MAP};
63         $self->{MAP} = $mapping;
64         foreach $key (keys %$href) {
65                 $content = $href->{$key};
66                 next unless defined($content);
67                 if (!defined($aref = $mapping->{$key})) {
68                         print STDERR "Hash2grs: Unmapped key: '$key'\n";
69                         next;
70                 }
71                 if (ref($content) eq 'HASH') {                                  ## Subtree?
72                         my $subtree = new Net::Z3950::GRS1($content, $mapping);
73                         $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::Subtree, $subtree);
74                 } elsif (!ref($content)) {                                      ## Regular string?
75                         $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::String, $content);
76                 } elsif (ref($content) eq 'ARRAY') {
77                         my $issues = new Net::Z3950::GRS1;
78                         foreach $issue (@$content) {
79                                 my $entry = new Net::Z3950::GRS1($issue, $mapping);
80                                 $issues->AddElement(5, 1, &Net::Z3950::GRS1::ElementData::Subtree, $entry);
81                         }
82                         $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::Subtree, $issues);
83                 } else {
84                         print STDERR "Hash2grs: Unsupported content type\n";
85                         next;
86                 }
87         }
88 }
89
90
91 sub GetElementList {
92         my $self = shift;
93
94         return $self->{ELEMENTS};
95 }
96
97
98 sub CreateTaggedElement {
99         my ($self, $type, $value, $element_data) = @_;
100         my $tagged = {};
101
102         $tagged->{TYPE} = $type;
103         $tagged->{VALUE} = $value;
104         $tagged->{OCCURANCE} = undef;
105         $tagged->{META} = undef;
106         $tagged->{VARIANT} = undef;
107         $tagged->{ELEMENTDATA} = $element_data;
108
109         return $tagged;
110 }
111
112
113 sub GetTypeValue {
114         my ($self, $TaggedElement) = @_;
115
116         return ($TaggedElement->{TYPE}, $TaggedElement->{VALUE});
117 }
118
119
120 sub GetElementData {
121         my ($self, $TaggedElement) = @_;
122
123         return $TaggedElement->{ELEMENTDATA};
124 }
125
126
127 sub CheckTypes {
128         my ($self, $which, $content) = @_;
129
130         if ($which == &Net::Z3950::GRS1::ElementData::String) {
131                 if (ref($content) eq '') {
132                         return 1;
133                 } else {
134                         croak "Wrong content type, expected a scalar";
135                 }
136         } elsif ($which == &Net::Z3950::GRS1::ElementData::Subtree) {
137                 if (ref($content) eq __PACKAGE__) {
138                         return 1;
139                 } else {
140                         croak "Wrong content type, expected a blessed reference";
141                 }
142         } else {
143                 croak "Content type currently not supported";
144         }
145 }
146
147
148 sub CreateElementData {
149         my ($self, $which, $content) = @_;
150         my $ElementData = {};
151
152         $self->CheckTypes($which, $content);
153         $ElementData->{WHICH} = $which;
154         $ElementData->{CONTENT} = $content;
155
156         return $ElementData;
157 }
158         
159
160 sub AddElement {
161         my ($self, $type, $value, $which, $content) = @_;
162         my $Elements = $self->GetElementList;
163         my $ElmData = $self->CreateElementData($which, $content);
164         my $TaggedElm = $self->CreateTaggedElement($type, $value, $ElmData);
165
166         push(@$Elements, $TaggedElm);
167 }
168
169
170 sub _Indent {
171         my ($self, $level) = @_;
172         my $space = "";
173
174         foreach (1..$level - 1) {
175                 $space .= "    ";
176         }
177
178         return $space;
179 }
180
181
182 sub _RecordLine {
183         my ($self, $level, $pool, @args) = @_;
184         my $fh = $self->{FH};
185         my $str = sprintf($self->_Indent($level) . shift(@args), @args);
186
187         print $fh $str;
188         if (defined($pool)) {
189                 $$pool .= $str;
190         }
191 }
192
193
194 sub Render {
195         my $self = shift;
196         my %args = (
197                         FORMAT  =>      &Net::Z3950::GRS1::Render::Plain,
198                         FILE    =>      '/dev/null',    
199                         LEVEL   =>      0,
200                         HANDLE  =>      undef,
201                         POOL    =>      undef,
202                         @_ );
203         my @Elements = @{$self->GetElementList};
204         my $TaggedElement;
205         my $fh = $args{HANDLE};
206         my $level = ++$args{LEVEL};
207         my $ref = $args{POOL};
208
209         if (!defined($fh) && defined($args{FILE})) {
210                 open(FH, '> ' . $args{FILE}) or croak "Render: Unable to open file '$args{FILE}' for writing: $!";
211                 FH->autoflush(1);
212                 $fh = *FH;
213         }
214         $self->{FH} = defined($fh) ? $fh : $self->{FH};
215         $args{HANDLE} = $fh;
216         foreach $TaggedElement (@Elements) {
217                 my ($type, $value) = $self->GetTypeValue($TaggedElement);
218                 if ($self->GetElementData($TaggedElement)->{WHICH} == &Net::Z3950::GRS1::ElementData::String) {
219                         $self->_RecordLine($level, $ref, "(%s,%s) %s\n", $type, $value, $self->GetElementData($TaggedElement)->{CONTENT});
220                 } elsif ($self->GetElementData($TaggedElement)->{WHICH} == &Net::Z3950::GRS1::ElementData::Subtree) {
221                         $self->_RecordLine($level, $ref, "(%s,%s) {\n", $type, $value);
222                         $self->GetElementData($TaggedElement)->{CONTENT}->Render(%args);
223                         $self->_RecordLine($level, $ref, "}\n");
224                 }
225         }
226         if ($level == 1) {
227                 $self->_RecordLine($level, $ref, "(0,0)\n");
228         }       
229 }               
230
231         
232 package Net::Z3950::GRS1::ElementData;
233
234 ## Define some constants according to the GRS-1 specification
235
236 sub Octets              { 1 }
237 sub Numeric             { 2 }
238 sub Date                { 3 }
239 sub Ext                 { 4 }
240 sub String              { 5 }
241 sub TrueOrFalse         { 6 }
242 sub OID                 { 7 }
243 sub IntUnit             { 8 }
244 sub ElementNotThere     { 9 }
245 sub ElementEmpty        { 10 }
246 sub NoDataRequested     { 11 }
247 sub Diagnostic          { 12 }
248 sub Subtree             { 13 }
249
250
251 package Net::Z3950::GRS1::Render;
252
253 ## Define various types of rendering formats
254
255 sub Plain               { 1 }
256 sub XML                 { 2 }
257 sub Raw                 { 3 }
258
259
260 1;
261
262 __END__
263
264
265 =head1 NAME
266
267 Net::Z3950::Record::GRS1 - Perl package used to encode GRS-1 records.
268
269 =head1 SYNOPSIS
270
271   use Net::Z3950::GRS1;
272
273   my $a_grs1_record = new Net::Z3950::Record::GRS1;
274   my $another_grs1_record = new Net::Z3950::Record::GRS1;
275
276   $a_grs1_record->AddElement($type, $value, $content);
277   $a_grs1_record->Render();
278
279 =head1 DESCRIPTION
280
281 This Perl module helps you to create and manipulate GRS-1 records (generic record syntax).
282 So far, you have only access to three methods:
283
284 =head2 new
285
286 Creates a new GRS-1 object,
287
288   my $grs1 = new Net::Z3950::GRS1;
289
290 =head2 AddElement
291
292 Lets you add entries to a GRS-1 object. The method should be called this way,
293
294   $grs1->AddElement($type, $value, $which, $content);
295
296 where $type should be an integer, and $value is free text. The $which argument should
297 contain one of the constants listed in Appendix A. Finally, $content contains the "thing"
298 that should be stored in this entry. The structure of $content should match the chosen
299 element data type. For
300
301   $which == Net::Z3950::GRS1::ElementData::String;
302
303 $content should be some kind of scalar. If on the other hand,
304
305   $which == Net::Z3950::GRS1::ElementData::Subtree;
306
307 $content should be a GRS1 object.
308
309 =head2 Render
310
311 This method digs through the GRS-1 data structure and renders the record. You call it
312 this way,
313
314   $grs1->Render();
315
316 If you want to access the rendered record through a variable, you can do it like this,
317
318   my $record_as_string;
319   $grs1->Render(POOL => \$record_as_string);
320
321 If you want it stored in a file, Render should be called this way,
322
323   $grs1->Render(FILE => 'record.grs1');
324
325 When no file name is specified, you can choose to stream the rendered record, for instance,
326
327   $grs1->Render(HANDLE => *STDOUT);             ## or
328   $grs1->Render(HANDLE => *STDERR);             ## or
329   $grs1->Render(HANDLE => *MY_HANDLE);
330
331 =head2 Hash2grs
332
333 This method converts a hash into a GRS-1 object. Scalar entries within the hash are converted
334 into GRS-1 string elements. A hash entry can itself be a reference to another hash. In this case,
335 the new referenced hash will be converted into a GRS-1 subtree. The method is called this way,
336
337   $grs1->Hash2grs($href, $mapping);
338
339 where $href is the hash to be converted and $mapping is referenced hash specifying the mapping
340 between keys in $href and (type, value) pairs in the $grs1 object. The $mapping hash could
341 for instance look like this,
342
343   my $mapping = {
344                         title   =>      [2, 1],
345                         author  =>      [1, 1],
346                         issn    =>      [3, 1]
347                 };
348
349 If the $grs1 object contains data prior to the invocation of Hash2grs, the new data represented
350 by the hash is simply added.
351
352
353 =head1 APPENDIX A
354
355 These element data types are specified in the Z39.50 protocol:
356
357   Net::Z3950::GRS1::ElementData::Octets
358   Net::Z3950::GRS1::ElementData::Numeric
359   Net::Z3950::GRS1::ElementData::Date
360   Net::Z3950::GRS1::ElementData::Ext
361   Net::Z3950::GRS1::ElementData::String                 <---
362   Net::Z3950::GRS1::ElementData::TrueOrFalse
363   Net::Z3950::GRS1::ElementData::OID
364   Net::Z3950::GRS1::ElementData::IntUnit
365   Net::Z3950::GRS1::ElementData::ElementNotThere
366   Net::Z3950::GRS1::ElementData::ElementEmpty
367   Net::Z3950::GRS1::ElementData::NoDataRequested
368   Net::Z3950::GRS1::ElementData::Diagnostic
369   Net::Z3950::GRS1::ElementData::Subtree                <---
370
371 Only the '<---' marked types are so far supported in this package.
372
373 =head1 AUTHOR
374
375 Anders S√łnderberg Mortensen <sondberg@indexdata.dk>
376 Index Data ApS, Copenhagen, Denmark.
377 2001/03/09
378
379 =head1 SEE ALSO
380
381 Specification of the GRS-1 standard, for instance in the Z39.50 protocol specification.
382
383 =cut