package Net::Z3950::GRS1;
## $Id: GRS1.pm,v 1.6 2004/05/28 20:14:28 sondberg Exp $
##
## Copyright (c) 2000-2004, Index Data.
##
## Permission to use, copy, modify, distribute, and sell this software and
## its documentation, in whole or in part, for any purpose, is hereby granted,
## provided that:
##
## 1. This copyright and permission notice appear in all copies of the
## software and its documentation. Notices of copyright or attribution
## which appear at the beginning of any file must remain unchanged.
##
## 2. The name of Index Data or the individual authors may not be used to
## endorse or promote products derived from this software without specific
## prior written permission.
##
## THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
## EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
## WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
## IN NO EVENT SHALL INDEX DATA BE LIABLE FOR ANY SPECIAL, INCIDENTAL,
## INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES
## WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER OR
## NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND ON ANY THEORY OF
## LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
## OF THIS SOFTWARE.
##
use strict;
use IO::Handle;
use Carp;
sub new {
my ($class, $href, $map) = @_;
my $self = {};
$self->{ELEMENTS} = [];
$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;
return $self->{ELEMENTS};
}
sub CreateTaggedElement {
my ($self, $type, $value, $element_data) = @_;
my $tagged = {};
$tagged->{TYPE} = $type;
$tagged->{VALUE} = $value;
$tagged->{OCCURANCE} = undef;
$tagged->{META} = undef;
$tagged->{VARIANT} = undef;
$tagged->{ELEMENTDATA} = $element_data;
return $tagged;
}
sub GetTypeValue {
my ($self, $TaggedElement) = @_;
return ($TaggedElement->{TYPE}, $TaggedElement->{VALUE});
}
sub GetElementData {
my ($self, $TaggedElement) = @_;
return $TaggedElement->{ELEMENTDATA};
}
sub CheckTypes {
my ($self, $which, $content) = @_;
if ($which == &Net::Z3950::GRS1::ElementData::String) {
if (ref($content) eq '') {
return 1;
} else {
croak "Wrong content type, expected a scalar";
}
} elsif ($which == &Net::Z3950::GRS1::ElementData::Subtree) {
if (ref($content) eq __PACKAGE__) {
return 1;
} else {
croak "Wrong content type, expected a blessed reference";
}
} else {
croak "Content type currently not supported";
}
}
sub CreateElementData {
my ($self, $which, $content) = @_;
my $ElementData = {};
$self->CheckTypes($which, $content);
$ElementData->{WHICH} = $which;
$ElementData->{CONTENT} = $content;
return $ElementData;
}
sub AddElement {
my ($self, $type, $value, $which, $content) = @_;
my $Elements = $self->GetElementList;
my $ElmData = $self->CreateElementData($which, $content);
my $TaggedElm = $self->CreateTaggedElement($type, $value, $ElmData);
push(@$Elements, $TaggedElm);
}
sub _Indent {
my ($self, $level) = @_;
my $space = "";
foreach (1..$level - 1) {
$space .= " ";
}
return $space;
}
sub _RecordLine {
my ($self, $level, $pool, @args) = @_;
my $fh = $self->{FH};
my $str = sprintf($self->_Indent($level) . shift(@args), @args);
print $fh $str;
if (defined($pool)) {
$$pool .= $str;
}
}
sub Render {
my $self = shift;
my %args = (
FORMAT => &Net::Z3950::GRS1::Render::Plain,
FILE => '/dev/null',
LEVEL => 0,
HANDLE => undef,
POOL => undef,
@_ );
my @Elements = @{$self->GetElementList};
my $TaggedElement;
my $fh = $args{HANDLE};
my $level = ++$args{LEVEL};
my $ref = $args{POOL};
if (!defined($fh) && defined($args{FILE})) {
open(FH, '> ' . $args{FILE}) or croak "Render: Unable to open file '$args{FILE}' for writing: $!";
FH->autoflush(1);
$fh = *FH;
}
$self->{FH} = defined($fh) ? $fh : $self->{FH};
$args{HANDLE} = $fh;
foreach $TaggedElement (@Elements) {
my ($type, $value) = $self->GetTypeValue($TaggedElement);
if ($self->GetElementData($TaggedElement)->{WHICH} == &Net::Z3950::GRS1::ElementData::String) {
$self->_RecordLine($level, $ref, "(%s,%s) %s\n", $type, $value, $self->GetElementData($TaggedElement)->{CONTENT});
} elsif ($self->GetElementData($TaggedElement)->{WHICH} == &Net::Z3950::GRS1::ElementData::Subtree) {
$self->_RecordLine($level, $ref, "(%s,%s) {\n", $type, $value);
$self->GetElementData($TaggedElement)->{CONTENT}->Render(%args);
$self->_RecordLine($level, $ref, "}\n");
}
}
if ($level == 1) {
$self->_RecordLine($level, $ref, "(0,0)\n");
}
}
package Net::Z3950::GRS1::ElementData;
## Define some constants according to the GRS-1 specification
sub Octets { 1 }
sub Numeric { 2 }
sub Date { 3 }
sub Ext { 4 }
sub String { 5 }
sub TrueOrFalse { 6 }
sub OID { 7 }
sub IntUnit { 8 }
sub ElementNotThere { 9 }
sub ElementEmpty { 10 }
sub NoDataRequested { 11 }
sub Diagnostic { 12 }
sub Subtree { 13 }
package Net::Z3950::GRS1::Render;
## Define various types of rendering formats
sub Plain { 1 }
sub XML { 2 }
sub Raw { 3 }
1;
__END__
=head1 NAME
Net::Z3950::Record::GRS1 - Perl package used to encode GRS-1 records.
=head1 SYNOPSIS
use Net::Z3950::GRS1;
my $a_grs1_record = new Net::Z3950::Record::GRS1;
my $another_grs1_record = new Net::Z3950::Record::GRS1;
$a_grs1_record->AddElement($type, $value, $content);
$a_grs1_record->Render();
=head1 DESCRIPTION
This Perl module helps you to create and manipulate GRS-1 records (generic record syntax).
So far, you have only access to three methods:
=head2 new
Creates a new GRS-1 object,
my $grs1 = new Net::Z3950::GRS1;
=head2 AddElement
Lets you add entries to a GRS-1 object. The method should be called this way,
$grs1->AddElement($type, $value, $which, $content);
where $type should be an integer, and $value is free text. The $which argument should
contain one of the constants listed in Appendix A. Finally, $content contains the "thing"
that should be stored in this entry. The structure of $content should match the chosen
element data type. For
$which == Net::Z3950::GRS1::ElementData::String;
$content should be some kind of scalar. If on the other hand,
$which == Net::Z3950::GRS1::ElementData::Subtree;
$content should be a GRS1 object.
=head2 Render
This method digs through the GRS-1 data structure and renders the record. You call it
this way,
$grs1->Render();
If you want to access the rendered record through a variable, you can do it like this,
my $record_as_string;
$grs1->Render(POOL => \$record_as_string);
If you want it stored in a file, Render should be called this way,
$grs1->Render(FILE => 'record.grs1');
When no file name is specified, you can choose to stream the rendered record, for instance,
$grs1->Render(HANDLE => *STDOUT); ## or
$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:
Net::Z3950::GRS1::ElementData::Octets
Net::Z3950::GRS1::ElementData::Numeric
Net::Z3950::GRS1::ElementData::Date
Net::Z3950::GRS1::ElementData::Ext
Net::Z3950::GRS1::ElementData::String <---
Net::Z3950::GRS1::ElementData::TrueOrFalse
Net::Z3950::GRS1::ElementData::OID
Net::Z3950::GRS1::ElementData::IntUnit
Net::Z3950::GRS1::ElementData::ElementNotThere
Net::Z3950::GRS1::ElementData::ElementEmpty
Net::Z3950::GRS1::ElementData::NoDataRequested
Net::Z3950::GRS1::ElementData::Diagnostic
Net::Z3950::GRS1::ElementData::Subtree <---
Only the '<---' marked types are so far supported in this package.
=head1 AUTHOR
Anders Sønderberg Mortensen <sondberg@indexdata.dk>
Index Data ApS, Copenhagen, Denmark.
2001/03/09
=head1 SEE ALSO
Specification of the GRS-1 standard, for instance in the Z39.50 protocol specification.
=cut