/[webpac]/openisis/current/perl/demo.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/current/perl/demo.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years ago) by dpavlin
File MIME type: text/plain
File size: 3322 byte(s)
initial import of openisis 0.9.0 vendor drop

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 }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26