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