1 ## This file is part of simpleserver
2 ## Copyright (C) 2000-2015 Index Data.
3 ## All rights reserved.
4 ## Redistribution and use in source and binary forms, with or without
5 ## modification, are permitted provided that the following conditions are met:
7 ## * Redistributions of source code must retain the above copyright
8 ## notice, this list of conditions and the following disclaimer.
9 ## * Redistributions in binary form must reproduce the above copyright
10 ## notice, this list of conditions and the following disclaimer in the
11 ## documentation and/or other materials provided with the distribution.
12 ## * Neither the name of Index Data nor the names of its contributors
13 ## may be used to endorse or promote products derived from this
14 ## software without specific prior written permission.
16 ## THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
17 ## EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
18 ## WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
19 ## DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY
20 ## DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
21 ## (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
22 ## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
23 ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
24 ## (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
25 ## THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 package Net::Z3950::GRS1;
34 my ($class, $href, $map) = @_;
37 $self->{ELEMENTS} = [];
38 $self->{FH} = *STDOUT; ## Default output handle is STDOUT
41 if (defined($href) && ref($href) eq 'HASH') {
43 croak 'Usage: new Net::Z3950::GRS1($href, $map);';
45 $self->Hash2grs($href, $map);
53 my ($self, $href, $mapping) = @_;
59 $mapping = defined($mapping) ? $mapping : $self->{MAP};
60 $self->{MAP} = $mapping;
61 foreach $key (keys %$href) {
62 $content = $href->{$key};
63 next unless defined($content);
64 if (!defined($aref = $mapping->{$key})) {
65 print STDERR "Hash2grs: Unmapped key: '$key'\n";
68 if (ref($content) eq 'HASH') { ## Subtree?
69 my $subtree = new Net::Z3950::GRS1($content, $mapping);
70 $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::Subtree, $subtree);
71 } elsif (!ref($content)) { ## Regular string?
72 $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::String, $content);
73 } elsif (ref($content) eq 'ARRAY') {
74 my $issues = new Net::Z3950::GRS1;
75 foreach $issue (@$content) {
76 my $entry = new Net::Z3950::GRS1($issue, $mapping);
77 $issues->AddElement(5, 1, &Net::Z3950::GRS1::ElementData::Subtree, $entry);
79 $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::Subtree, $issues);
81 print STDERR "Hash2grs: Unsupported content type\n";
91 return $self->{ELEMENTS};
95 sub CreateTaggedElement {
96 my ($self, $type, $value, $element_data) = @_;
99 $tagged->{TYPE} = $type;
100 $tagged->{VALUE} = $value;
101 $tagged->{OCCURANCE} = undef;
102 $tagged->{META} = undef;
103 $tagged->{VARIANT} = undef;
104 $tagged->{ELEMENTDATA} = $element_data;
111 my ($self, $TaggedElement) = @_;
113 return ($TaggedElement->{TYPE}, $TaggedElement->{VALUE});
118 my ($self, $TaggedElement) = @_;
120 return $TaggedElement->{ELEMENTDATA};
125 my ($self, $which, $content) = @_;
127 if ($which == &Net::Z3950::GRS1::ElementData::String) {
128 if (ref($content) eq '') {
131 croak "Wrong content type, expected a scalar";
133 } elsif ($which == &Net::Z3950::GRS1::ElementData::Subtree) {
134 if (ref($content) eq __PACKAGE__) {
137 croak "Wrong content type, expected a blessed reference";
140 croak "Content type currently not supported";
145 sub CreateElementData {
146 my ($self, $which, $content) = @_;
147 my $ElementData = {};
149 $self->CheckTypes($which, $content);
150 $ElementData->{WHICH} = $which;
151 $ElementData->{CONTENT} = $content;
158 my ($self, $type, $value, $which, $content) = @_;
159 my $Elements = $self->GetElementList;
160 my $ElmData = $self->CreateElementData($which, $content);
161 my $TaggedElm = $self->CreateTaggedElement($type, $value, $ElmData);
163 push(@$Elements, $TaggedElm);
168 my ($self, $level) = @_;
171 foreach (1..$level - 1) {
180 my ($self, $level, $pool, @args) = @_;
181 my $fh = $self->{FH};
182 my $str = sprintf($self->_Indent($level) . shift(@args), @args);
185 if (defined($pool)) {
194 FORMAT => &Net::Z3950::GRS1::Render::Plain,
200 my @Elements = @{$self->GetElementList};
202 my $fh = $args{HANDLE};
203 my $level = ++$args{LEVEL};
204 my $ref = $args{POOL};
206 if (!defined($fh) && defined($args{FILE})) {
207 open(FH, '> ' . $args{FILE}) or croak "Render: Unable to open file '$args{FILE}' for writing: $!";
211 $self->{FH} = defined($fh) ? $fh : $self->{FH};
213 foreach $TaggedElement (@Elements) {
214 my ($type, $value) = $self->GetTypeValue($TaggedElement);
215 if ($self->GetElementData($TaggedElement)->{WHICH} == &Net::Z3950::GRS1::ElementData::String) {
216 $self->_RecordLine($level, $ref, "(%s,%s) %s\n", $type, $value, $self->GetElementData($TaggedElement)->{CONTENT});
217 } elsif ($self->GetElementData($TaggedElement)->{WHICH} == &Net::Z3950::GRS1::ElementData::Subtree) {
218 $self->_RecordLine($level, $ref, "(%s,%s) {\n", $type, $value);
219 $self->GetElementData($TaggedElement)->{CONTENT}->Render(%args);
220 $self->_RecordLine($level, $ref, "}\n");
224 $self->_RecordLine($level, $ref, "(0,0)\n");
229 package Net::Z3950::GRS1::ElementData;
231 ## Define some constants according to the GRS-1 specification
238 sub TrueOrFalse { 6 }
241 sub ElementNotThere { 9 }
242 sub ElementEmpty { 10 }
243 sub NoDataRequested { 11 }
244 sub Diagnostic { 12 }
248 package Net::Z3950::GRS1::Render;
250 ## Define various types of rendering formats
264 Net::Z3950::Record::GRS1 - Perl package used to encode GRS-1 records.
268 use Net::Z3950::GRS1;
270 my $a_grs1_record = new Net::Z3950::Record::GRS1;
271 my $another_grs1_record = new Net::Z3950::Record::GRS1;
273 $a_grs1_record->AddElement($type, $value, $content);
274 $a_grs1_record->Render();
278 This Perl module helps you to create and manipulate GRS-1 records (generic record syntax).
279 So far, you have only access to three methods:
283 Creates a new GRS-1 object,
285 my $grs1 = new Net::Z3950::GRS1;
289 Lets you add entries to a GRS-1 object. The method should be called this way,
291 $grs1->AddElement($type, $value, $which, $content);
293 where $type should be an integer, and $value is free text. The $which argument should
294 contain one of the constants listed in Appendix A. Finally, $content contains the "thing"
295 that should be stored in this entry. The structure of $content should match the chosen
296 element data type. For
298 $which == Net::Z3950::GRS1::ElementData::String;
300 $content should be some kind of scalar. If on the other hand,
302 $which == Net::Z3950::GRS1::ElementData::Subtree;
304 $content should be a GRS1 object.
308 This method digs through the GRS-1 data structure and renders the record. You call it
313 If you want to access the rendered record through a variable, you can do it like this,
315 my $record_as_string;
316 $grs1->Render(POOL => \$record_as_string);
318 If you want it stored in a file, Render should be called this way,
320 $grs1->Render(FILE => 'record.grs1');
322 When no file name is specified, you can choose to stream the rendered record, for instance,
324 $grs1->Render(HANDLE => *STDOUT); ## or
325 $grs1->Render(HANDLE => *STDERR); ## or
326 $grs1->Render(HANDLE => *MY_HANDLE);
330 This method converts a hash into a GRS-1 object. Scalar entries within the hash are converted
331 into GRS-1 string elements. A hash entry can itself be a reference to another hash. In this case,
332 the new referenced hash will be converted into a GRS-1 subtree. The method is called this way,
334 $grs1->Hash2grs($href, $mapping);
336 where $href is the hash to be converted and $mapping is referenced hash specifying the mapping
337 between keys in $href and (type, value) pairs in the $grs1 object. The $mapping hash could
338 for instance look like this,
346 If the $grs1 object contains data prior to the invocation of Hash2grs, the new data represented
347 by the hash is simply added.
352 These element data types are specified in the Z39.50 protocol:
354 Net::Z3950::GRS1::ElementData::Octets
355 Net::Z3950::GRS1::ElementData::Numeric
356 Net::Z3950::GRS1::ElementData::Date
357 Net::Z3950::GRS1::ElementData::Ext
358 Net::Z3950::GRS1::ElementData::String <---
359 Net::Z3950::GRS1::ElementData::TrueOrFalse
360 Net::Z3950::GRS1::ElementData::OID
361 Net::Z3950::GRS1::ElementData::IntUnit
362 Net::Z3950::GRS1::ElementData::ElementNotThere
363 Net::Z3950::GRS1::ElementData::ElementEmpty
364 Net::Z3950::GRS1::ElementData::NoDataRequested
365 Net::Z3950::GRS1::ElementData::Diagnostic
366 Net::Z3950::GRS1::ElementData::Subtree <---
368 Only the '<---' marked types are so far supported in this package.
372 Anders Sønderberg Mortensen <sondberg@indexdata.dk>
373 Index Data ApS, Copenhagen, Denmark.
378 Specification of the GRS-1 standard, for instance in the Z39.50 protocol specification.