Add Ubuntu raring, Debian jessie
[simpleserver-moved-to-github.git] / GRS1.pm
diff --git a/GRS1.pm b/GRS1.pm
index 89a8c9f..990d787 100644 (file)
--- a/GRS1.pm
+++ b/GRS1.pm
@@ -1,22 +1,90 @@
+## This file is part of simpleserver
+## Copyright (C) 2000-2013 Index Data.
+## All rights reserved.
+## Redistribution and use in source and binary forms, with or without
+## modification, are permitted provided that the following conditions are met:
+##
+##     * Redistributions of source code must retain the above copyright
+##       notice, this list of conditions and the following disclaimer.
+##     * Redistributions in binary form must reproduce the above copyright
+##       notice, this list of conditions and the following disclaimer in the
+##       documentation and/or other materials provided with the distribution.
+##     * Neither the name of Index Data nor the names of its contributors
+##       may be used to endorse or promote products derived from this
+##       software without specific prior written permission.
+##
+## THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
+## EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+## WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+## DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY
+## DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+## (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+## (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+## THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
 package Net::Z3950::GRS1;
 
 use strict;
 use IO::Handle;
 use Carp;
 
-
 sub new {
-       my $class = shift;
+       my ($class, $href, $map) = @_;
        my $self = {};
 
        $self->{ELEMENTS} = [];
-       $self->{FH} = *STDOUT;          ## Default output handle is STDOUT
+       $self->{FH} = *STDOUT;                          ## Default output handle is STDOUT
+       $self->{MAP} = $map;
        bless $self, $class;
+       if (defined($href) && ref($href) eq 'HASH') {
+               if (!defined($map)) {
+                       croak 'Usage: new Net::Z3950::GRS1($href, $map);';
+               }
+               $self->Hash2grs($href, $map);
+       }
 
        return $self;
 }
 
 
+sub Hash2grs {
+       my ($self, $href, $mapping) = @_;
+       my $key;
+       my $content;
+       my $aref;
+       my $issue;
+
+       $mapping = defined($mapping) ? $mapping : $self->{MAP};
+       $self->{MAP} = $mapping;
+       foreach $key (keys %$href) {
+               $content = $href->{$key};
+               next unless defined($content);
+               if (!defined($aref = $mapping->{$key})) {
+                       print STDERR "Hash2grs: Unmapped key: '$key'\n";
+                       next;
+               }
+               if (ref($content) eq 'HASH') {                                  ## Subtree?
+                       my $subtree = new Net::Z3950::GRS1($content, $mapping);
+                       $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::Subtree, $subtree);
+               } elsif (!ref($content)) {                                      ## Regular string?
+                       $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::String, $content);
+               } elsif (ref($content) eq 'ARRAY') {
+                       my $issues = new Net::Z3950::GRS1;
+                       foreach $issue (@$content) {
+                               my $entry = new Net::Z3950::GRS1($issue, $mapping);
+                               $issues->AddElement(5, 1, &Net::Z3950::GRS1::ElementData::Subtree, $entry);
+                       }
+                       $self->AddElement($aref->[0], $aref->[1], &Net::Z3950::GRS1::ElementData::Subtree, $issues);
+               } else {
+                       print STDERR "Hash2grs: Unsupported content type\n";
+                       next;
+               }
+       }
+}
+
+
 sub GetElementList {
        my $self = shift;
 
@@ -84,7 +152,7 @@ sub CreateElementData {
 
        return $ElementData;
 }
-       
+
 
 sub AddElement {
        my ($self, $type, $value, $which, $content) = @_;
@@ -124,7 +192,7 @@ sub Render {
        my $self = shift;
        my %args = (
                        FORMAT  =>      &Net::Z3950::GRS1::Render::Plain,
-                       FILE    =>      '/dev/null',    
+                       FILE    =>      '/dev/null',
                        LEVEL   =>      0,
                        HANDLE  =>      undef,
                        POOL    =>      undef,
@@ -154,10 +222,10 @@ sub Render {
        }
        if ($level == 1) {
                $self->_RecordLine($level, $ref, "(0,0)\n");
-       }       
-}              
+       }
+}
+
 
-       
 package Net::Z3950::GRS1::ElementData;
 
 ## Define some constants according to the GRS-1 specification
@@ -235,7 +303,7 @@ $content should be some kind of scalar. If on the other hand,
 
 $content should be a GRS1 object.
 
-=head3 Render
+=head2 Render
 
 This method digs through the GRS-1 data structure and renders the record. You call it
 this way,
@@ -257,6 +325,28 @@ When no file name is specified, you can choose to stream the rendered record, fo
   $grs1->Render(HANDLE => *STDERR);            ## or
   $grs1->Render(HANDLE => *MY_HANDLE);
 
+=head2 Hash2grs
+
+This method converts a hash into a GRS-1 object. Scalar entries within the hash are converted
+into GRS-1 string elements. A hash entry can itself be a reference to another hash. In this case,
+the new referenced hash will be converted into a GRS-1 subtree. The method is called this way,
+
+  $grs1->Hash2grs($href, $mapping);
+
+where $href is the hash to be converted and $mapping is referenced hash specifying the mapping
+between keys in $href and (type, value) pairs in the $grs1 object. The $mapping hash could
+for instance look like this,
+
+  my $mapping =        {
+                       title   =>      [2, 1],
+                       author  =>      [1, 1],
+                       issn    =>      [3, 1]
+               };
+
+If the $grs1 object contains data prior to the invocation of Hash2grs, the new data represented
+by the hash is simply added.
+
+
 =head1 APPENDIX A
 
 These element data types are specified in the Z39.50 protocol:
@@ -288,12 +378,3 @@ Index Data ApS, Copenhagen, Denmark.
 Specification of the GRS-1 standard, for instance in the Z39.50 protocol specification.
 
 =cut
-
-#$Log: GRS1.pm,v $
-#Revision 1.2  2001-03-13 14:53:15  sondberg
-#Added a few lines of documentation into GRS1.pm.
-#
-#Revision 1.1  2001/03/13 14:17:15  sondberg
-#Added support for GRS-1.
-#
-