1 package Net::Z3950::GRS1;
12 $self->{ELEMENTS} = [];
13 $self->{FH} = *STDOUT; ## Default output handle is STDOUT
23 return $self->{ELEMENTS};
27 sub CreateTaggedElement {
28 my ($self, $type, $value, $element_data) = @_;
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;
43 my ($self, $TaggedElement) = @_;
45 return ($TaggedElement->{TYPE}, $TaggedElement->{VALUE});
50 my ($self, $TaggedElement) = @_;
52 return $TaggedElement->{ELEMENTDATA};
57 my ($self, $which, $content) = @_;
59 if ($which == &Net::Z3950::GRS1::ElementData::String) {
60 if (ref($content) eq '') {
63 croak "Wrong content type, expected a scalar";
65 } elsif ($which == &Net::Z3950::GRS1::ElementData::Subtree) {
66 if (ref($content) eq __PACKAGE__) {
69 croak "Wrong content type, expected a blessed reference";
72 croak "Content type currently not supported";
77 sub CreateElementData {
78 my ($self, $which, $content) = @_;
81 $self->CheckTypes($which, $content);
82 $ElementData->{WHICH} = $which;
83 $ElementData->{CONTENT} = $content;
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);
95 push(@$Elements, $TaggedElm);
100 my ($self, $level) = @_;
103 foreach (1..$level - 1) {
112 my ($self, $level, $pool, @args) = @_;
113 my $fh = $self->{FH};
114 my $str = sprintf($self->_Indent($level) . shift(@args), @args);
117 if (defined($pool)) {
126 FORMAT => &Net::Z3950::GRS1::Render::Plain,
132 my @Elements = @{$self->GetElementList};
134 my $fh = $args{HANDLE};
135 my $level = ++$args{LEVEL};
136 my $ref = $args{POOL};
138 if (!defined($fh) && defined($args{FILE})) {
139 open(FH, '> ' . $args{FILE}) or croak "Render: Unable to open file '$args{FILE}' for writing: $!";
143 $self->{FH} = defined($fh) ? $fh : $self->{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");
156 $self->_RecordLine($level, $ref, "(0,0)\n");
161 package Net::Z3950::GRS1::ElementData;
163 ## Define some constants according to the GRS-1 specification
170 sub TrueOrFalse { 6 }
173 sub ElementNotThere { 9 }
174 sub ElementEmpty { 10 }
175 sub NoDataRequested { 11 }
176 sub Diagnostic { 12 }
180 package Net::Z3950::GRS1::Render;
182 ## Define various types of rendering formats
196 Net::Z3950::Record::GRS1 - Perl package used to encode GRS-1 records.
200 use Net::Z3950::Record::GRS1;
202 my $a_grs1_record = new Net::Z3950::Record::GRS1;
203 my $another_grs1_record = new Net::Z3950::Record::GRS1;
205 $a_grs1_record->AddElement($type, $value, $content);
206 $a_grs1_record->render();
210 Here goes the documentation. I guess, you'll have to wait for it!
214 Anders Sønderberg Mortensen <sondberg@indexdata.dk>
215 Index Data ApS, Copenhagen, Denmark.
220 Specification of the GRS-1 standard, for instance in the Z39.50 protocol specification.
225 #Revision 1.1 2001-03-13 14:17:15 sondberg
226 #Added support for GRS-1.