Open-ILS/src/extras/openurl_map.pl

   1 #!/usr/bin/perl
   2 #
   3
   4 $|=1;
   5
   6 while (my $openurl = <>) {
   7         my $opensearch = '/opac/extras/opensearch/1.1/-/marcxml/-/?';
   8         my @parts = split('&', $openurl);
   9
  10         my %params = (
  11                 kw => '',
  12                 au => '',
  13                 ti => '',
  14         );
  15
  16         for (@parts) {
  17                 if (/^au[^=]+=(.*)$/o) {
  18                         $params{au} .= $1 . ' ';
  19                 } elsif (/^[sa]?title=(.*)$/o) {
  20                         $params{ti} .= $1 . ' ';
  21                 } elsif (/^e?is.n=(.*)$/o) {
  22                         $params{kw} .= $1 . ' ';
  23                 } elsif (/^[^=]+=(.*)$/o) {
  24                         $params{kw} .= $1 . ' ';
  25                 }
  26         }
  27
  28         $opensearch .= join('&', map { "$_=$params{$_}" } keys %params );
  29
  30         print $opensearch . "\n";
  31
  32 };