From: Anders S. Mortensen Date: Tue, 13 Mar 2001 14:17:15 +0000 (+0000) Subject: Added support for GRS-1. X-Git-Tag: release.0.0.8.lau~64 X-Git-Url: http://git.indexdata.com/?p=simpleserver-moved-to-github.git;a=commitdiff_plain;h=10f7175c8c96ba07fa7902b9f36df5086f3ce02e;ds=sidebyside Added support for GRS-1. --- diff --git a/GRS1.pm b/GRS1.pm new file mode 100644 index 0000000..a06b0ec --- /dev/null +++ b/GRS1.pm @@ -0,0 +1,228 @@ +package Net::Z3950::GRS1; + +use strict; +use IO::Handle; +use Carp; + + +sub new { + my $class = shift; + my $self = {}; + + $self->{ELEMENTS} = []; + $self->{FH} = *STDOUT; ## Default output handle is STDOUT + bless $self, $class; + + return $self; +} + + +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::Record::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 + +Here goes the documentation. I guess, you'll have to wait for it! + +=head1 AUTHOR + +Anders Sønderberg Mortensen +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 + +#$Log: GRS1.pm,v $ +#Revision 1.1 2001-03-13 14:17:15 sondberg +#Added support for GRS-1. +# + diff --git a/MANIFEST b/MANIFEST index ee73cb7..68c301d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6,4 +6,5 @@ SimpleServer.xs test.pl ztest.pl OID.pm +GRS1.pm INSTALL diff --git a/Makefile b/Makefile index bd0acfa..0be2e5f 100644 --- a/Makefile +++ b/Makefile @@ -111,7 +111,8 @@ H_FILES = HTMLLIBPODS = HTMLSCRIPTPODS = MAN1PODS = -MAN3PODS = SimpleServer.pm +MAN3PODS = GRS1.pm \ + SimpleServer.pm HTMLEXT = html INST_MAN1DIR = blib/man1 INSTALLMAN1DIR = $(PREFIX)/man/man1 @@ -153,14 +154,20 @@ EXPORT_LIST = PERL_ARCHIVE = -TO_INST_PM = OID.pm \ +TO_INST_PM = GRS1.pm \ + OID.pm \ SimpleServer.pm \ + grs_test.pl \ ztest.pl -PM_TO_BLIB = ztest.pl \ +PM_TO_BLIB = GRS1.pm \ + $(INST_LIBDIR)/GRS1.pm \ + ztest.pl \ $(INST_LIBDIR)/ztest.pl \ OID.pm \ $(INST_LIBDIR)/OID.pm \ + grs_test.pl \ + $(INST_LIBDIR)/grs_test.pl \ SimpleServer.pm \ $(INST_LIBDIR)/SimpleServer.pm @@ -468,8 +475,11 @@ POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \ -e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\047t install $$m{$$_}\n";' \ -e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}' -manifypods : pure_all SimpleServer.pm +manifypods : pure_all GRS1.pm \ + SimpleServer.pm @$(POD2MAN) \ + GRS1.pm \ + $(INST_MAN3DIR)/Net::Z3950::GRS1.$(MAN3EXT) \ SimpleServer.pm \ $(INST_MAN3DIR)/Net::Z3950::SimpleServer.$(MAN3EXT) @@ -500,7 +510,7 @@ realclean purge :: clean rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR) rm -f $(INST_DYNAMIC) $(INST_BOOT) rm -f $(INST_STATIC) - rm -f $(INST_LIBDIR)/ztest.pl $(INST_LIBDIR)/OID.pm $(INST_LIBDIR)/SimpleServer.pm + rm -f $(INST_LIBDIR)/GRS1.pm $(INST_LIBDIR)/ztest.pl $(INST_LIBDIR)/OID.pm $(INST_LIBDIR)/grs_test.pl $(INST_LIBDIR)/SimpleServer.pm rm -rf Makefile Makefile.old diff --git a/SimpleServer.c b/SimpleServer.c index 34b7e1b..c243259 100644 --- a/SimpleServer.c +++ b/SimpleServer.c @@ -44,6 +44,7 @@ #include #include #include +#define GRS_MAX_FIELDS 50 #ifdef ASN_COMPILED #include #endif @@ -76,6 +77,95 @@ SV *delete_ref = NULL; SV *scan_ref = NULL; int MAX_OID = 15; + +Z_GenericRecord *read_grs1(char *str, ODR o) +{ + int type, ivalue; + char line[512], *buf, *ptr, *original; + char value[512]; + Z_GenericRecord *r = 0; + + original = str; + for (;;) + { + Z_TaggedElement *t; + Z_ElementData *c; + + ptr = strchr(str, '\n'); + if (!ptr) { + return r; + } + strncpy(line, str, ptr - str); + line[ptr - str] = 0; + buf = line; + str = ptr + 1; + while (*buf && isspace(*buf)) + buf++; + if (*buf == '}') { + memmove(original, str, strlen(str)); + return r; + } + if (sscanf(buf, "(%d,%[^)])", &type, value) != 2) + { + yaz_log(LOG_WARN, "Bad data in '%s'", buf); + return 0; + } + if (!type && *value == '0') + return r; + if (!(buf = strchr(buf, ')'))) + return 0; + buf++; + while (*buf && isspace(*buf)) + buf++; + if (!*buf) + return 0; + if (!r) + { + r = (Z_GenericRecord *)odr_malloc(o, sizeof(*r)); + r->elements = (Z_TaggedElement **) + odr_malloc(o, sizeof(Z_TaggedElement*) * GRS_MAX_FIELDS); + r->num_elements = 0; + } + r->elements[r->num_elements] = t = (Z_TaggedElement *) odr_malloc(o, sizeof(Z_TaggedElement)); + t->tagType = (int *)odr_malloc(o, sizeof(int)); + *t->tagType = type; + t->tagValue = (Z_StringOrNumeric *) + odr_malloc(o, sizeof(Z_StringOrNumeric)); + if ((ivalue = atoi(value))) + { + t->tagValue->which = Z_StringOrNumeric_numeric; + t->tagValue->u.numeric = (int *)odr_malloc(o, sizeof(int)); + *t->tagValue->u.numeric = ivalue; + } + else + { + t->tagValue->which = Z_StringOrNumeric_string; + t->tagValue->u.string = (char *)odr_malloc(o, strlen(value)+1); + strcpy(t->tagValue->u.string, value); + } + t->tagOccurrence = 0; + t->metaData = 0; + t->appliedVariant = 0; + t->content = c = (Z_ElementData *)odr_malloc(o, sizeof(Z_ElementData)); + if (*buf == '{') + { + c->which = Z_ElementData_subtree; + c->u.subtree = read_grs1(str, o); + } + else + { + c->which = Z_ElementData_string; +/* buf[strlen(buf)-1] = '\0';*/ + buf[strlen(buf)] = '\0'; + c->u.string = odr_strdup(o, buf); + } + r->num_elements++; + } +} + + + + static void oid2str(Odr_oid *o, WRBUF buf) { for (; *o >= 0; o++) { @@ -420,13 +510,13 @@ int bend_fetch(void *handle, bend_fetch_rr *rr) char *ODR_basename; char *ODR_errstr; int *ODR_oid_buf; + oident *oid; WRBUF oid_dotted; Zfront_handle *zhandle = (Zfront_handle *)handle; Z_RecordComposition *composition; Z_ElementSetNames *simple; STRLEN length; - int oid; dSP; ENTER; @@ -522,11 +612,19 @@ int bend_fetch(void *handle, bend_fetch_rr *rr) rr->output_format_raw = ODR_oid_buf; ptr = SvPV(record, length); - ODR_record = (char *)odr_malloc(rr->stream, length + 1); - strcpy(ODR_record, ptr); - rr->record = ODR_record; - rr->len = length; - + oid = oid_getentbyoid(ODR_oid_buf); + if (oid->value == VAL_GRS1) /* Treat GRS-1 records separately */ + { + rr->record = (char *) read_grs1(ptr, rr->stream); + rr->len = -1; + } + else + { + ODR_record = (char *)odr_malloc(rr->stream, length + 1); + strcpy(ODR_record, ptr); + rr->record = ODR_record; + rr->len = length; + } zhandle->handle = point; handle = zhandle; rr->last_in_set = SvIV(last); @@ -805,7 +903,7 @@ void bend_close(void *handle) } -#line 809 "SimpleServer.c" +#line 907 "SimpleServer.c" XS(XS_Net__Z3950__SimpleServer_set_init_handler) { dXSARGS; @@ -813,9 +911,9 @@ XS(XS_Net__Z3950__SimpleServer_set_init_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_init_handler(arg)"); { SV * arg = ST(0); -#line 805 "SimpleServer.xs" +#line 903 "SimpleServer.xs" init_ref = newSVsv(arg); -#line 819 "SimpleServer.c" +#line 917 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -827,9 +925,9 @@ XS(XS_Net__Z3950__SimpleServer_set_close_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_close_handler(arg)"); { SV * arg = ST(0); -#line 812 "SimpleServer.xs" +#line 910 "SimpleServer.xs" close_ref = newSVsv(arg); -#line 833 "SimpleServer.c" +#line 931 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -841,9 +939,9 @@ XS(XS_Net__Z3950__SimpleServer_set_sort_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_sort_handler(arg)"); { SV * arg = ST(0); -#line 819 "SimpleServer.xs" +#line 917 "SimpleServer.xs" sort_ref = newSVsv(arg); -#line 847 "SimpleServer.c" +#line 945 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -855,9 +953,9 @@ XS(XS_Net__Z3950__SimpleServer_set_search_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_search_handler(arg)"); { SV * arg = ST(0); -#line 825 "SimpleServer.xs" +#line 923 "SimpleServer.xs" search_ref = newSVsv(arg); -#line 861 "SimpleServer.c" +#line 959 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -869,9 +967,9 @@ XS(XS_Net__Z3950__SimpleServer_set_fetch_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_fetch_handler(arg)"); { SV * arg = ST(0); -#line 832 "SimpleServer.xs" +#line 930 "SimpleServer.xs" fetch_ref = newSVsv(arg); -#line 875 "SimpleServer.c" +#line 973 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -883,9 +981,9 @@ XS(XS_Net__Z3950__SimpleServer_set_present_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_present_handler(arg)"); { SV * arg = ST(0); -#line 839 "SimpleServer.xs" +#line 937 "SimpleServer.xs" present_ref = newSVsv(arg); -#line 889 "SimpleServer.c" +#line 987 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -897,9 +995,9 @@ XS(XS_Net__Z3950__SimpleServer_set_esrequest_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_esrequest_handler(arg)"); { SV * arg = ST(0); -#line 846 "SimpleServer.xs" +#line 944 "SimpleServer.xs" esrequest_ref = newSVsv(arg); -#line 903 "SimpleServer.c" +#line 1001 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -911,9 +1009,9 @@ XS(XS_Net__Z3950__SimpleServer_set_delete_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_delete_handler(arg)"); { SV * arg = ST(0); -#line 853 "SimpleServer.xs" +#line 951 "SimpleServer.xs" delete_ref = newSVsv(arg); -#line 917 "SimpleServer.c" +#line 1015 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -925,9 +1023,9 @@ XS(XS_Net__Z3950__SimpleServer_set_scan_handler) Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_scan_handler(arg)"); { SV * arg = ST(0); -#line 860 "SimpleServer.xs" +#line 958 "SimpleServer.xs" scan_ref = newSVsv(arg); -#line 931 "SimpleServer.c" +#line 1029 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -936,16 +1034,16 @@ XS(XS_Net__Z3950__SimpleServer_start_server) { dXSARGS; { -#line 866 "SimpleServer.xs" +#line 964 "SimpleServer.xs" char **argv; char **argv_buf; char *ptr; int i; STRLEN len; -#line 946 "SimpleServer.c" +#line 1044 "SimpleServer.c" int RETVAL; dXSTARG; -#line 872 "SimpleServer.xs" +#line 970 "SimpleServer.xs" argv_buf = (char **)xmalloc((items + 1) * sizeof(char *)); argv = argv_buf; for (i = 0; i < items; i++) @@ -957,7 +1055,7 @@ XS(XS_Net__Z3950__SimpleServer_start_server) *argv_buf = NULL; RETVAL = statserv_main(items, argv, bend_init, bend_close); -#line 961 "SimpleServer.c" +#line 1059 "SimpleServer.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); diff --git a/SimpleServer.pm b/SimpleServer.pm index f5b6866..523cf75 100644 --- a/SimpleServer.pm +++ b/SimpleServer.pm @@ -25,6 +25,11 @@ ## ## +## $Log: SimpleServer.pm,v $ +## Revision 1.6 2001-03-13 14:17:15 sondberg +## Added support for GRS-1. +## + package Net::Z3950::SimpleServer; use strict; diff --git a/SimpleServer.xs b/SimpleServer.xs index e99f570..aa020fa 100644 --- a/SimpleServer.xs +++ b/SimpleServer.xs @@ -24,6 +24,11 @@ * OF THIS SOFTWARE. */ +/*$Log: SimpleServer.xs,v $ +/*Revision 1.7 2001-03-13 14:17:15 sondberg +/*Added support for GRS-1. +/**/ + #include "EXTERN.h" #include "perl.h" @@ -35,6 +40,7 @@ #include #include #include +#define GRS_MAX_FIELDS 50 #ifdef ASN_COMPILED #include #endif @@ -67,6 +73,95 @@ SV *delete_ref = NULL; SV *scan_ref = NULL; int MAX_OID = 15; + +Z_GenericRecord *read_grs1(char *str, ODR o) +{ + int type, ivalue; + char line[512], *buf, *ptr, *original; + char value[512]; + Z_GenericRecord *r = 0; + + original = str; + for (;;) + { + Z_TaggedElement *t; + Z_ElementData *c; + + ptr = strchr(str, '\n'); + if (!ptr) { + return r; + } + strncpy(line, str, ptr - str); + line[ptr - str] = 0; + buf = line; + str = ptr + 1; + while (*buf && isspace(*buf)) + buf++; + if (*buf == '}') { + memmove(original, str, strlen(str)); + return r; + } + if (sscanf(buf, "(%d,%[^)])", &type, value) != 2) + { + yaz_log(LOG_WARN, "Bad data in '%s'", buf); + return 0; + } + if (!type && *value == '0') + return r; + if (!(buf = strchr(buf, ')'))) + return 0; + buf++; + while (*buf && isspace(*buf)) + buf++; + if (!*buf) + return 0; + if (!r) + { + r = (Z_GenericRecord *)odr_malloc(o, sizeof(*r)); + r->elements = (Z_TaggedElement **) + odr_malloc(o, sizeof(Z_TaggedElement*) * GRS_MAX_FIELDS); + r->num_elements = 0; + } + r->elements[r->num_elements] = t = (Z_TaggedElement *) odr_malloc(o, sizeof(Z_TaggedElement)); + t->tagType = (int *)odr_malloc(o, sizeof(int)); + *t->tagType = type; + t->tagValue = (Z_StringOrNumeric *) + odr_malloc(o, sizeof(Z_StringOrNumeric)); + if ((ivalue = atoi(value))) + { + t->tagValue->which = Z_StringOrNumeric_numeric; + t->tagValue->u.numeric = (int *)odr_malloc(o, sizeof(int)); + *t->tagValue->u.numeric = ivalue; + } + else + { + t->tagValue->which = Z_StringOrNumeric_string; + t->tagValue->u.string = (char *)odr_malloc(o, strlen(value)+1); + strcpy(t->tagValue->u.string, value); + } + t->tagOccurrence = 0; + t->metaData = 0; + t->appliedVariant = 0; + t->content = c = (Z_ElementData *)odr_malloc(o, sizeof(Z_ElementData)); + if (*buf == '{') + { + c->which = Z_ElementData_subtree; + c->u.subtree = read_grs1(str, o); + } + else + { + c->which = Z_ElementData_string; +/* buf[strlen(buf)-1] = '\0';*/ + buf[strlen(buf)] = '\0'; + c->u.string = odr_strdup(o, buf); + } + r->num_elements++; + } +} + + + + static void oid2str(Odr_oid *o, WRBUF buf) { for (; *o >= 0; o++) { @@ -411,13 +506,13 @@ int bend_fetch(void *handle, bend_fetch_rr *rr) char *ODR_basename; char *ODR_errstr; int *ODR_oid_buf; + oident *oid; WRBUF oid_dotted; Zfront_handle *zhandle = (Zfront_handle *)handle; Z_RecordComposition *composition; Z_ElementSetNames *simple; STRLEN length; - int oid; dSP; ENTER; @@ -513,11 +608,19 @@ int bend_fetch(void *handle, bend_fetch_rr *rr) rr->output_format_raw = ODR_oid_buf; ptr = SvPV(record, length); - ODR_record = (char *)odr_malloc(rr->stream, length + 1); - strcpy(ODR_record, ptr); - rr->record = ODR_record; - rr->len = length; - + oid = oid_getentbyoid(ODR_oid_buf); + if (oid->value == VAL_GRS1) /* Treat GRS-1 records separately */ + { + rr->record = (char *) read_grs1(ptr, rr->stream); + rr->len = -1; + } + else + { + ODR_record = (char *)odr_malloc(rr->stream, length + 1); + strcpy(ODR_record, ptr); + rr->record = ODR_record; + rr->len = length; + } zhandle->handle = point; handle = zhandle; rr->last_in_set = SvIV(last);