#!/usr/local/bin/perl 
#
###########################################################################
##
##  Program:  iop-access.pl
##
##  Purpose:  CGI script for journal-level access to the Institute of
##            Physics full-text journal system
##
##  Date:     15 Mar 1996
##
##  Author:   Peter Murray, Library Information Technologies
##            Case Western Reserve University
##            pem@po.cwru.edu
##
##  Legalities:
##            Copyright 1994-1996 by Case Western Reserve University. 
##            All rights reserved.
## 
##  Revision History:
##     15-Mar-1996  PEM   Initial Release
##     18-Apr-1996  PEM   Made more general and ready for distribution
##
###########################################################################

##
## See http://www.perl.com/CPAN if you need to pick up any of these modules.
use URI::URL;
use LWP::UserAgent;
use CGI::Carp;

$hostIP     =  $ENV{'REMOTE_ADDR'};
$hostDNS    =  $ENV{'REMOTE_HOST'};
$ServName   =  $ENV{'SERVER_NAME'};
$ServPort   =  $ENV{'SERVER_PORT'};
$ServScript =  $ENV{'SCRIPT_NAME'};
$Browser    =  $ENV{'HTTP_USER_AGENT'};
$formAction =  "http://$ServName$ServScript";

###
### Below are the two lines that are user configurable.
###
## $configFile points to the configuration text file
$configFile = "./iop-access.conf";
##
## Replace the conditional part of this line with any IP-address restrictions
## you wish to put on the script
&denyAccess if (($hostIP !~ /^129.22./)&&($hostIP !~ /^193.131.119/)&&($hostIP !~ /^193.61.87./));
###
### Generally, everything below here does not need to be configured.
###

&readConfigFile;

($junk,$journal,$action)=split('/',lc($ENV{'PATH_INFO'}));
&doList if ($journal eq "");
&Die("UnknownJournal") if (!defined($jDB{$journal}));
$action="main" if ($action eq "");

# Each one of these subroutines will exit the script, so if we get to
# the bottom, the user entered an unknown action.
&doMain if ($action eq "main");
&doSubsc if ($action eq "register");
&goURL($jDB{$journal}{'url'}) if ($action eq "access");
&goURL($lostPasswdURL) if ($action eq "lostpassword");
&goURL($changeInfoURL) if ($action eq "changedetails");
&goURL($topURL) if ($action eq "top");
&goURL($indexURL) if ($action eq "index");
&goURL("mailto:$adminEmail") if ($action eq "emailadmin");
&goURL($helpURL) if ($action eq "help");
&goURL($searchURL) if ($action eq "searchall");
&Die("UnknownAction");
exit;   ## Should Never Be Reached.


sub doMain {
  $jFrag="$formAction/$journal";
  print "HTTP/1.0 200 Data Follows\n";
  print "Content-type: text/html\n\n";
  print pageHeader("$jDB{$journal}{'title'} Access Page",' ');
  print <<"EOM";
  <P><IMG SRC="$topURL/icons/Journals/$journal.gif" ALT="$jDB{$journal}{'title'}"></P>
  <P>Copyright  IOP  PUBLISHING LIMITED 1995,1996 ALL RIGHTS RESERVED<BR>
  The whole and every part of this Service belongs to IOP Publishing Limited
  ('the Owner')... As a user of this service you MUST read and accept the
  <A HREF="$copyURL">copyright notice</A> before continuing to use this 
  service.
  By using this service it is agreed that you understand and agree to the
  Owner's Copyright Notice.</P>

  <P>To access this journal, <STRONG>you must have an account username and
  password registered</STRONG> with the Institute of Physics (IOP) Publishing.
  A link is provided below to the registration form.</P>
  <DL>
  <DT><H2>Access <A HREF="$jFrag/access">$jDB{$journal}{'title'}</H2></A>
  <DD><EM>Remember:</EM>  Access is restricted to those who have already
  registered with IOP.  A link to the registration form is provided below.
  <DT><H2><A HREF="$jFrag/register">Register a personal account</A> with the IOP</H2>
  <DD>During the registration process, you will be asked to provide a
  username and password.  We strongly recommend that you use your 
  <EM>CWRUnet ID</EM>for the username, but <STRONG>not</STRONG> your
  <EM>CWRUnet Password</EM>.  The password is sent across the Internet
  unencrypted and is stored on an unsecured server not affiliated with
  CWRU.  Again, for your protection, <STRONG>do not</STRONG> use your
  <EM>CWRUnet Password</EM>.  Also, IOP Publishing offers several different
  journals, but you only need to register and account and password once, not
  one for each journal.
  </DL>
  <H2>Other helpful links</H2>
  <DL>
  <DT><A HREF="$jFrag/help">Assistance with the IOP Journals</A>
  <DT><A HREF="$jFrag/LostPassword">Assistance with Lost Passwords</A>
  <DT><A HREF="$jFrag/ChangeDetails">Change Your User Details and Password</A>
  <DD>IOP provides these services for helping with forgotten passwords and
  for changing your password and user details.  CWRU staff cannot help you
  with lost or forgotten passwords.
  <DT><A HREF="$jFrag/searchall">Search</A> Subscribed Journals Database 
  <DD>Search all IOP Journals for which the library holds a subscription
  <DT><A HREF="$jFrag/index">Index</A> of all IOP Journals
  <DT>Home Page for the <A HREF="$jFrag/top">Institute of Physics Publishing</A>
  </DL>
EOM
  print pageFooter($adminEmail,"mailto:$adminEmail");
  exit;
}


sub doSubsc {
  my(%formData);

  $formData{'site'}=$siteCode;
  $formData{'userid'}=$siteUserid;
  $formData{'passwd'}=$sitePassword;

  $ua = new LWP::UserAgent;
  $curl = url("http:");
  $curl->query_form(%formData);
  my $req = new HTTP::Request 'POST', $registerURL;
  $req->content_type('application/x-www-form-urlencoded');
  $req->content($curl->equery);
  print "Content-type: text/html\n\n";
  $temp = $ua->request($req)->content;
  $temp =~ s%</HEAD>%<BASE HREF=\"http://www.iop.org/cgi-bin/EJ/register\"></HEAD>%;
  print $temp;
  exit;
}

sub doList {
  print "Content-type: text/html\n\n";
  print pageHeader("List of IOP Journals");
  print "<P>Below is the list of IOP Journals for with the library subscribes.</P>\n";
  print "<UL>\n";
  foreach $item (sort { $jDB{$a} <=> $jDB{$b} } keys %jDB) {
    print "<LI><A HREF=\"$formAction/$item\">$jDB{$item}{'title'}</A>\n";
  }
  print "</UL>\n";
  print pageFooter($adminEmail,"mailto:$adminEmail");
  exit;
}

sub goURL {
  my($gotoURL)=@_;

  print "Location: $gotoURL\n";
  print "Content-type: text/html\n\n";
  print pageHeader("Jump to $gotoURL");
  print "<P>The data you seek is at URL:</P>\n";
  print "<UL><LI><A HREF=\"$gotoURL\">$gotoURL</A></UL>\n";
  print "<P>A more modern browser would have automatically taken you there.</P>\n";
  print pageFooter($adminEmail,"mailto:$adminEmail");
  exit;
}

sub readConfigFile {
  open(CONFIGFILE,$configFile)  || die "Can't open config file: $!\n";
  while ($line=<CONFIGFILE>) {
    chop($line);                     # get rid of the newline
    $line =~ s/#.*//;                # chew up comment lines
    next if ($line=~/^\s*$/);        # keep going if the line is blank
    if ($line =~ /^admin\s+(.*)$/i) {
      $adminEmail = $1; next;
    }
    if ($line =~ /^site-code\s+(.*)$/i) {
      $siteCode = $1; next;
    }
    if ($line =~ /^site-userid\s+(.*)$/i) {
      $siteUserid = $1; next;
    }
    if ($line =~ /^site-password\s+(.*)$/i) {
      $sitePassword = $1; next;
    }
    if ($line =~ /^register-URL\s+(.*)$/i) {
      ($registerURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^top-URL\s+(.*)$/i) {
      ($topURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^index-URL\s+(.*)$/i) {
      ($indexURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^changeInfo-URL\s+(.*)$/i) {
      ($changeInfoURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^lostPasswd-URL\s+(.*)$/i) {
      ($lostPasswdURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^search-URL\s+(.*)$/i) {
      ($searchURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^help-URL\s+(.*)$/i) {
      ($helpURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^copyright-URL\s+(.*)$/i) {
      ($copyURL = $1) =~ s/\%\%code\%\%/$siteCode/i; next;
    }
    if ($line =~ /^journal\s+(\S*)\s+(\S*)\s+(.*)$/i) {
      $jDB{lc($1)}{'url'}=$2; $jDB{lc($1)}{'title'}=$3;
      $jDB{lc($1)}{'url'} =~ s/\%\%code\%\%/$siteCode/i;
      next;
    }
    warn "Unknown line in config file: $line\n";
  }
  close(CONFIGFILE);
}

sub denyAccess {
  print "HTTP/1.0 500 Site Not Authorized\n";
  print "Content-type: text/html\n\n";
  print pageHeader("Journal Access Denied");
  print "<P>Access to the IOP journals is restricted to CWRU hosts.</P>";
  print pageFooter($adminEmail,"mailto:$adminEmail");
  exit;
}

sub Die {
  my($reason)=@_;

  print "HTTP/1.0 500 $reason accessing $journal $action\n";
  print "Content-type: text/html\n\n";
  print pageHeader("Journal Access Problem");
  print "<P>Couldn't access the journal you requested.  Here is some info:</P>\n";
  print "<UL><LI>Journal: $journal\n";
  print "<LI>Journal Title: $jDB{$journal}{'title'}\n";
  print "<LI>Action: $action\n";
  print "<LI>Problem Short Name: $reason</UL>";
  print pageFooter($adminEmail,"mailto:$adminEmail");
  die("Accessing '$journal' by '$action' resulted in '$reason'");
  exit;
}

sub pageHeader {
  local($titleTag,$hOneTag) = @_;

  $hOneTag = $titleTag if ($hOneTag eq "");
  print "<HTML><HEAD><TITLE>$titleTag</TITLE></HEAD>\n";
  print "<BODY><H1>$hOneTag</H1>\n";
  return;
}

sub pageFooter {
  local($helpInfo,$helpTag) = @_;

  print "For further assistance, contact <A HREF=\"$helpTag\">$helpInfo</A>.\n";
  print "</BODY></HTML>\n";
  return;
}