a10c3f90839e5e72b5085b7215ec06b6e5c61f30
[irspy-moved-to-github.git] / zebra / ezeerex2pqfproperties.pl
1 #! /usr/bin/perl -w
2
3 # $Id: ezeerex2pqfproperties.pl,v 1.4 2006-06-19 16:41:03 mike Exp $
4 #
5 # Run like this:
6 #       ./ezeerex2pqfproperties.pl zeerex.xml
7
8 use strict;
9 use warnings;
10 use XML::LibXML;
11 use XML::LibXML::XPathContext;
12
13 my $text = join('', <>);
14 my $parser = new XML::LibXML();
15 my $doc = $parser->parse_string($text);
16 my $root = $doc->getDocumentElement();
17 my $xc = XML::LibXML::XPathContext->new($root);
18 $xc->registerNs(z => 'http://explain.z3950.org/dtd/2.0/');
19
20 print_sets($xc);
21 print_default_set($xc);
22 print_indexes($xc);
23 print_relations($xc);
24 print_relation_modifiers($xc);
25 print_positions($xc);
26 print_structures($xc);
27 print_truncations($xc);
28
29 # We could limit the sets output to those that are actually used by an
30 # SRU index: that way we could avoid defining
31 #       set.bib1 = 1.2.840.10003.3.1
32 # which is a Z39.50 attribute set that we don't need for CQL.  But
33 # doing that would be a marginal gain.
34 #
35 sub print_sets {
36     my($xc) = @_;
37
38     my(@nodes) = $xc->findnodes('z:indexInfo/z:set');
39     foreach my $node (@nodes) {
40         my $name = $node->findvalue('@name');
41         my $identifier = $node->findvalue('@identifier');
42         print "set.$name = $identifier\n";
43     }
44 }
45
46 sub print_default_set {
47     my($xc) = @_;
48
49     my (@nodes) = $xc->findnodes('z:configInfo/' .
50                                  'z:default[@type="contextSet"]');
51     foreach my $node (@nodes) {
52         ### Look this up and render as a URI
53         print "set = ", $node->findvalue('.'), "\n";
54     }
55 }
56
57 sub print_indexes {
58     my($xc) = @_;
59
60     foreach my $node ($xc->findnodes('z:indexInfo/' .
61                                      'z:index[@search="true"]')) {
62         my @pqf = $xc->findnodes("z:map/z:attr", $node);
63         die("no PQF mapping for index '" .
64             $xc->findvalue("z:title", $node) . "'")
65             if @pqf == 0;
66         my $ptype = $xc->findvalue('@type', $pqf[0]);
67         my $pval = $xc->findvalue(".", $pqf[0]);
68
69         foreach my $map ($xc->findnodes("z:map", $node)) {
70             my $setname = $xc->findvalue('z:name/@set', $map);
71             my $indexname = $xc->findvalue('z:name', $map);
72             print "index.$setname.$indexname = $ptype=$pval\n"
73                 if $indexname ne "";
74         }
75     }
76 }
77
78 # I don't think these are affected by the ZeeRex record
79 sub print_relations {
80     my($xc) = @_;
81
82     print <<__EOT__;
83 relation.< = 2=1
84 relation.le = 2=2
85 relation.eq = 2=3
86 relation.exact = 2=3
87 relation.ge = 2=4
88 relation.> = 2=5
89 relation.<> = 2=6
90 relation.scr = 2=3
91 __EOT__
92 }
93
94 # I don't think these are affected by the ZeeRex record
95 sub print_relation_modifiers {
96     my($xc) = @_;
97
98     print <<__EOT__;
99 relationModifier.relevant = 2=102
100 relationModifier.fuzzy = 5=103
101 relationModifier.stem = 2=101
102 relationModifier.phonetic = 2=100
103 relationModifier.regexp = 5=102
104 __EOT__
105 }
106
107 # I don't think these are affected by the ZeeRex record
108 sub print_positions {
109     my($xc) = @_;
110
111     print <<__EOT__;
112 position.first = 3=1 6=1
113 position.any = 3=3 6=1
114 position.last = 3=4 6=1
115 position.firstAndLast = 3=3 6=3
116 __EOT__
117 }
118
119 # I don't think these are affected by the ZeeRex record
120 sub print_structures {
121     my($xc) = @_;
122
123     print <<__EOT__;
124 structure.exact = 4=108
125 structure.all = 4=2
126 structure.any = 4=2
127 structure.* = 4=1
128 __EOT__
129 }
130
131 # I don't think these are affected by the ZeeRex record
132 sub print_truncations {
133     my($xc) = @_;
134
135     print <<__EOT__;
136 truncation.right = 5=1
137 truncation.left = 5=2
138 truncation.both = 5=3
139 truncation.none = 5=100
140 truncation.regexp = 5=102
141 truncation.z3958 = 5=104
142 __EOT__
143 }