git.rot13.org Git - webpac/blob - openisis/perl/demo.pl

   1 #!/usr/bin/perl
   2 #/*
   3 #       openisis - an open implementation of the CDS/ISIS database
   4 #       Version 0.8.x (patchlevel see file Version)
   5 #       Copyright (C) 2001-2003 by Erik Grziwotz, erik@openisis.org
   6 #
   7 #       This library is free software; you can redistribute it and/or
   8 #       modify it under the terms of the GNU Lesser General Public
   9 #       License as published by the Free Software Foundation; either
  10 #       version 2.1 of the License, or (at your option) any later version.
  11 #
  12 #       This library is distributed in the hope that it will be useful,
  13 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 #       Lesser General Public License for more details.
  16 #
  17 #       You should have received a copy of the GNU Lesser General Public
  18 #       License along with this library; if not, write to the Free Software
  19 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20 #
  21 #       see README for more information
  22 #EOH */
  23 #
  24 #       $Id: demo.pl,v 1.4 2003/04/08 00:20:53 kripke Exp $
  25 #       demo script for openisis perl XSUB
  26 #
  27 #       usage:
  28 #       perl/demo.pl db/cds/cds
  29 #
  30
  31 BEGIN {
  32         # prepend OpenIsis dir to INClude array
  33         # OpenIsis dir should contain OpenIsis.pm and auto/OpenIsis/OpenIsis.so
  34         # get dir of script, ending with /
  35         my ($dir) = ($0 =~ /(.*\/)/);
  36         # example of OpenIsis dir relative to script dir, e.g. cgi-bin/../OpenIsis
  37         # unshift @INC, $dir.'../OpenIsis';
  38         # include the build dirs
  39         # unshift @INC, $dir.'perl/blib/arch', $dir.'perl/blib';
  40         # include the tmptree created by 'make perltree'
  41         unshift @INC, $dir.'tmptree';
  42         # prepend hardcoded absolute directory
  43         # unshift @INC, '/tmp/OpenIsis';
  44         # print STDERR "INC is ", join( ':', @INC ), "\n";
  45         # now 'use OpenIsis' should do ...
  46 }
  47 use OpenIsis;
  48
  49 my $mode = 'dump';
  50
  51 sub pr {
  52         my $rec = shift;
  53         return unless $rec->{'mfn'};
  54         print '<isisrec id="', $rec->{'mfn'}, '">', "\n";
  55         for $t (keys(%$rec)) {
  56                 my $flds = $rec->{$t}; # all fields for tag
  57                 for $f (@$flds) {
  58                         # encoding conversion generated by encoding.pl
  59                         # convert cp850 to Latin1
  60                         $f =~ y/\x80-\xff/\xc7\xfc\xe9\xe2\xe4\xe0\xe5\xe7\xea\xeb\xe8\xef\xee\xec\xc4\xc5\xc9\xe6\xc6\xf4\xf6\xf2\xfb\xf9\xff\xd6\xdc\xf8\xa3\xd8\xd7?\xe1\xed\xf3\xfa\xf1\xd1\xaa\xba\xbf\xae\xac\xbd\xbc\xa1\xab\xbb?????\xc1\xc2\xc0\xa9????\xa2\xa5???????\xe3\xc3???????\xa4\xf0\xd0\xca\xcb\xc8?\xcd\xce\xcf????\xa6\xcc?\xd3\xdf\xd4\xd2\xf5\xd5\xb5\xfe\xde\xda\xdb\xd9\xfd\xdd\xaf\xb4\xad\xb1?\xbe\xb6\xa7\xf7\xb8\xb0\xa8\xb7\xb9\xb3\xb2?\xa0/;
  61                         print "\t<v$t";
  62                         if ( $f =~ /\^/ ) { # split subfields
  63                                 $ind = '';
  64                                 $sub = OpenIsis::subfields( $f );
  65                                 for $s (keys(%$sub)) {
  66                                         if ( $s ) {
  67                                                 print ' ', $s, '="', $sub->{$s}, '"';
  68                                         } else {
  69                                                 $ind = $sub->{$s};
  70                                         }
  71                                 }
  72                                 if ( '' eq $ind ) {
  73                                         print "/>\n";
  74                                 } else {
  75                                         print ">$ind</v$t>\n";
  76                                 }
  77                         } elsif ( $f =~ /^<.*>$/ ) { # probably <kw><kw>
  78                                 print ">\n";
  79                                 for $kw (split(/>[^<]*</,substr($f,1,-1))) {
  80                                         print "\t\t<key>", $kw, "</key>\n";
  81                                 }
  82                                 print "\t</v$t>\n";
  83                         } else {
  84                                 OpenIsis::MHL( $f );
  85                                 print '>', $f, '</v', $t, ">\n";
  86                         }
  87                 }
  88         }
  89         print '</isisrec>', "\n";
  90 }       # pr
  91
  92
  93 # OpenIsis::log(0,''); # turn off logging
  94 $db = OpenIsis::open( $ARGV[0] || 'db/cds/cds' );
  95
  96 if ( 'dump' eq $mode ) {
  97         for (1..OpenIsis::maxRowid( $db )) {
  98                 pr OpenIsis::read( $db, $_ );
  99         }
 100 }