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