Note implementation details.
[irspy-moved-to-github.git] / zebra / ezeerex2pqfproperties.pl
1 #! /usr/bin/perl -w
2
3 # $Id: ezeerex2pqfproperties.pl,v 1.7 2006-06-20 11:24:22 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 my %setmap = print_sets($xc);
21 print_default_set($xc, \%setmap);
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 lot of work for marginal gain.
34 #
35 sub print_sets {
36     my($xc) = @_;
37
38     my %setmap;
39     my(@nodes) = $xc->findnodes('z:indexInfo/z:set');
40     foreach my $node (@nodes) {
41         my $name = $node->findvalue('@name');
42         my $identifier = $node->findvalue('@identifier');
43         print "set.$name = $identifier\n";
44         $setmap{$name} = $identifier;
45     }
46
47     return %setmap;
48 }
49
50 sub print_default_set {
51     my($xc, $setmap) = @_;
52
53     my (@nodes) = $xc->findnodes('z:configInfo/' .
54                                  'z:default[@type="contextSet"]');
55     foreach my $node (@nodes) {
56         my $name = $node->findvalue('.');
57         my $identifier = $setmap->{$name}
58             or die "no identifier for default context-set name '$name'";
59
60         print "# default context-set name '$name'\n";
61         print "set = $identifier\n";
62     }
63 }
64
65 sub print_indexes {
66     my($xc) = @_;
67
68     foreach my $node ($xc->findnodes('z:indexInfo/' .
69                                      'z:index[@search="true"]')) {
70         my @pqf = $xc->findnodes("z:map[z:attr]", $node);
71         die("no PQF mapping for index '" .
72             $xc->findvalue("z:title", $node) . "'")
73             if @pqf == 0;
74         # Just pick one if there's more than one: they all work
75
76         my $attrstr = "";
77         foreach my $attr ($xc->findnodes("z:attr", $pqf[0])) {
78             my $ptype = $xc->findvalue('@type', $attr);
79             my $pval = $xc->findvalue(".", $attr);
80             $attrstr .= " $ptype=$pval";
81         }
82
83         foreach my $map ($xc->findnodes("z:map", $node)) {
84             my $setname = $xc->findvalue('z:name/@set', $map);
85             my $indexname = $xc->findvalue('z:name', $map);
86             print "index.$setname.$indexname =$attrstr\n"
87                 if $indexname ne "";
88         }
89     }
90 }
91
92 # I don't think these are affected by the ZeeRex record
93 sub print_relations {
94     my($xc) = @_;
95
96     print <<__EOT__;
97 relation.< = 2=1
98 relation.le = 2=2
99 relation.eq = 2=3
100 relation.exact = 2=3
101 relation.ge = 2=4
102 relation.> = 2=5
103 relation.<> = 2=6
104 relation.scr = 2=3
105 __EOT__
106 }
107
108 # I don't think these are affected by the ZeeRex record
109 sub print_relation_modifiers {
110     my($xc) = @_;
111
112     print <<__EOT__;
113 relationModifier.relevant = 2=102
114 relationModifier.fuzzy = 5=103
115 relationModifier.stem = 2=101
116 relationModifier.phonetic = 2=100
117 relationModifier.regexp = 5=102
118 __EOT__
119 }
120
121 # I don't think these are affected by the ZeeRex record
122 sub print_positions {
123     my($xc) = @_;
124
125     print <<__EOT__;
126 position.first = 3=1 6=1
127 position.any = 3=3 6=1
128 position.last = 3=4 6=1
129 position.firstAndLast = 3=3 6=3
130 __EOT__
131 }
132
133 # I don't think these are affected by the ZeeRex record
134 sub print_structures {
135     my($xc) = @_;
136
137     print <<__EOT__;
138 structure.exact = 4=108
139 structure.all = 4=2
140 structure.any = 4=2
141 structure.* = 4=1
142 __EOT__
143 }
144
145 # I don't think these are affected by the ZeeRex record
146 sub print_truncations {
147     my($xc) = @_;
148
149     print <<__EOT__;
150 truncation.right = 5=1
151 truncation.left = 5=2
152 truncation.both = 5=3
153 truncation.none = 5=100
154 truncation.regexp = 5=102
155 truncation.z3958 = 5=104
156 __EOT__
157 }