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