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