1 package Net::Z3950::GRS1;
3 ## $Id: GRS1.pm,v 1.6 2004-05-28 20:14:28 sondberg Exp $
5 ## Copyright (c) 2000-2004, Index Data.
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,
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.
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.
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
37 my ($class, $href, $map) = @_;
40 $self->{ELEMENTS} = [];
41 $self->{FH} = *STDOUT; ## Default output handle is STDOUT
44 if (defined($href) && ref($href) eq 'HASH') {
46 croak 'Usage: new Net::Z3950::GRS1($href, $map);';
48 $self->Hash2grs($href, $map);
56 my ($self, $href, $mapping) = @_;
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";
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);
82 $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::Subtree, $issues);
84 print STDERR "Hash2grs: Unsupported content type\n";
94 return $self->{ELEMENTS};
98 sub CreateTaggedElement {
99 my ($self, $type, $value, $element_data) = @_;
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;
114 my ($self, $TaggedElement) = @_;
116 return ($TaggedElement->{TYPE}, $TaggedElement->{VALUE});
121 my ($self, $TaggedElement) = @_;
123 return $TaggedElement->{ELEMENTDATA};
128 my ($self, $which, $content) = @_;
130 if ($which == &Net::Z3950::GRS1::ElementData::String) {
131 if (ref($content) eq '') {
134 croak "Wrong content type, expected a scalar";
136 } elsif ($which == &Net::Z3950::GRS1::ElementData::Subtree) {
137 if (ref($content) eq __PACKAGE__) {
140 croak "Wrong content type, expected a blessed reference";
143 croak "Content type currently not supported";
148 sub CreateElementData {
149 my ($self, $which, $content) = @_;
150 my $ElementData = {};
152 $self->CheckTypes($which, $content);
153 $ElementData->{WHICH} = $which;
154 $ElementData->{CONTENT} = $content;
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);
166 push(@$Elements, $TaggedElm);
171 my ($self, $level) = @_;
174 foreach (1..$level - 1) {
183 my ($self, $level, $pool, @args) = @_;
184 my $fh = $self->{FH};
185 my $str = sprintf($self->_Indent($level) . shift(@args), @args);
188 if (defined($pool)) {
197 FORMAT => &Net::Z3950::GRS1::Render::Plain,
203 my @Elements = @{$self->GetElementList};
205 my $fh = $args{HANDLE};
206 my $level = ++$args{LEVEL};
207 my $ref = $args{POOL};
209 if (!defined($fh) && defined($args{FILE})) {
210 open(FH, '> ' . $args{FILE}) or croak "Render: Unable to open file '$args{FILE}' for writing: $!";
214 $self->{FH} = defined($fh) ? $fh : $self->{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");
227 $self->_RecordLine($level, $ref, "(0,0)\n");
232 package Net::Z3950::GRS1::ElementData;
234 ## Define some constants according to the GRS-1 specification
241 sub TrueOrFalse { 6 }
244 sub ElementNotThere { 9 }
245 sub ElementEmpty { 10 }
246 sub NoDataRequested { 11 }
247 sub Diagnostic { 12 }
251 package Net::Z3950::GRS1::Render;
253 ## Define various types of rendering formats
267 Net::Z3950::Record::GRS1 - Perl package used to encode GRS-1 records.
271 use Net::Z3950::GRS1;
273 my $a_grs1_record = new Net::Z3950::Record::GRS1;
274 my $another_grs1_record = new Net::Z3950::Record::GRS1;
276 $a_grs1_record->AddElement($type, $value, $content);
277 $a_grs1_record->Render();
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:
286 Creates a new GRS-1 object,
288 my $grs1 = new Net::Z3950::GRS1;
292 Lets you add entries to a GRS-1 object. The method should be called this way,
294 $grs1->AddElement($type, $value, $which, $content);
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
301 $which == Net::Z3950::GRS1::ElementData::String;
303 $content should be some kind of scalar. If on the other hand,
305 $which == Net::Z3950::GRS1::ElementData::Subtree;
307 $content should be a GRS1 object.
311 This method digs through the GRS-1 data structure and renders the record. You call it
316 If you want to access the rendered record through a variable, you can do it like this,
318 my $record_as_string;
319 $grs1->Render(POOL => \$record_as_string);
321 If you want it stored in a file, Render should be called this way,
323 $grs1->Render(FILE => 'record.grs1');
325 When no file name is specified, you can choose to stream the rendered record, for instance,
327 $grs1->Render(HANDLE => *STDOUT); ## or
328 $grs1->Render(HANDLE => *STDERR); ## or
329 $grs1->Render(HANDLE => *MY_HANDLE);
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,
337 $grs1->Hash2grs($href, $mapping);
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,
349 If the $grs1 object contains data prior to the invocation of Hash2grs, the new data represented
350 by the hash is simply added.
355 These element data types are specified in the Z39.50 protocol:
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 <---
371 Only the '<---' marked types are so far supported in this package.
375 Anders Sønderberg Mortensen <sondberg@indexdata.dk>
376 Index Data ApS, Copenhagen, Denmark.
381 Specification of the GRS-1 standard, for instance in the Z39.50 protocol specification.