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