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