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 }