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