/[webpac]/trunk/openisis/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

Annotation of /trunk/openisis/perl/demo.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (hide annotations)
Mon Mar 8 17:43:12 2004 UTC (17 years, 6 months ago) by dpavlin
Original Path: openisis/current/perl/demo.pl
File MIME type: text/plain
File size: 3322 byte(s)
initial import of openisis 0.9.0 vendor drop

1 dpavlin 237 #!/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