oai-proxy

#!/usr/bin/perl

# https://validator.oaipmh.com/

use strict;

# use LWP::Simple;
use IPC::Run3;

use Data::Dumper;
$Data::Dumper::Indent= 1;

use FileHandle;

binmode( STDOUT, ':utf8' ); autoflush STDOUT 1;
binmode( STDERR, ':utf8' ); autoflush STDERR 1;
binmode( STDIN,  ':utf8' );

if (exists ($ENV{'GATEWAY_INTERFACE'}))
{ # CGI evaluation

  # open (LOG, '|/usr/bin/logger -t oai-proxy');
  open (LOG, '>>:utf8', '/tmp/oai-proxy');
  autoflush LOG 1;

  print <<'EOX';
Content-Type: text/xml;charset=UTF-8

EOX

  my ($method, $query_string)= map { $ENV{$_} } qw(REQUEST_METHOD QUERY_STRING);

  # print LOG "<pre>\n", "env: ", Dumper (\%ENV), "</pre>\n";
  my %vars= map { my ($an, $av)= split('=', $_, 2); $av =~ s#%([\dA-Fa-f]{2})#chr(hex($1))#ge; $an => $av } split ('&', $query_string);
  # print LOG "<pre>\nvars: ", Dumper(\%vars), "</pre>\n";

  my $verb= $vars{verb};
  if ($verb eq 'ListSets')
  {
    delete($vars{metadataPrefix}) if (exists ($vars{metadataPrefix}));
  }
  elsif ($verb eq 'ListIdentifiers')
  {
    $vars{set}= 'all_published' unless (exists ($vars{set}) || exists($vars{resumptionToken}));
    $vars{metadataPrefix}= 'oai_ddi' if (!exists ($vars{metadataPrefix}) || $vars{metadataPrefix} eq 'ddi');
  }

  my $real_url= 'https://data.aussda.at/oai?' . join ('&', map { join ('=', $_, $vars{$_}) } keys %vars);
  print LOG "oai-proxy: real_url=[$real_url]\n";

  # my $content= get($real_url);
  my $content= curl_get($real_url);

  my @res= split ("\n", $content);
  splice(@res, 0, 0, "<?xml version='1.0' encoding='UTF-8'?>",
                     '<?xml-stylesheet type="text/xsl" href="/static/oai2.xsl"?>');

    foreach my $l (@res)
    {
      # only E-Mail address allowed: $l =~ s#<adminEmail>.*</adminEmail>#<adminEmail>AUSSDA Team info\@aussda.at</adminEmail>#;
      $l =~ s#data.aussda.at#data2.aussda.at#g;
      print $l, "\n";
    }
}
else
{
  print "sorry\n";
}

sub curl_get
{
  my $real_url= shift;
  my ($in, $out, $err);
  IPC::Run3::run3([qw(curl --silent), $real_url], \$in, \$out, \$err);
  print LOG $err, "\n" if ($err);
  $out;
}


__END__