# NHSE Repository in a Box (RIB)
#
# The authors of this software are Paul McMahan and Jeff Horner.
# Copyright (c) 1997 by the University of Tennessee.
# Permission to use, copy, modify, and distribute this software for any
# purpose without fee is hereby granted, provided that this entire notice
# is included in all copies of any software which is or includes a copy
# or modification of this software and in all copies of the supporting
# documentation for such software.
# THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTY.  IN PARTICULAR, NEITHER THE AUTHORS NOR UNIVERSITY OF TENNESSEE
# MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE
# MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
#

use strict;
use RIB::Util ();
use RIB::ConfigParser ();
use LWP::UserAgent ();
use HTTP::Request ();
use MD5;

my $CACHE_DIR = RIB::Util->GetRibDir . "/show_object.cache";  # where cache is at

my $MAX_CACHE_SIZE = 1000000;   # This is the max cache size in bytes.
                                # When the cache gets bigger than this size
                                # a FIFO routine will be followed.  1MB is
                                # probably a good size because it will be able
                                # to cache about 300 entries and not take too long
                                # for cache management.

my $TIME_OK = 60 * 60;     # number of seconds after which entries in the cache
                           # will be checked (via If-Modified-Since header)
                           # before they're assumed to be current.

################# Acquire Important Variables and Arguments
select(STDERR); $| = 1; # no output buffering
select(STDOUT); $| = 1;

my $util = RIB::Util->new();
my %in = RIB::Util->ReadParse();
my $RIBDIR = $util->GetRibDir();
my $RIBURL = $util->GetRibUrl();
my $repository = $in{r};
my $url = $in{u};
unless ($repository ne "") {
  &Croak("A repository was not specified in your input");
}
unless ($url =~ m/^http:\/\//) {
  &Croak("A properly formatted url was not specified in your input");
}
my $filepath = "$RIBDIR/repositories/$repository";

# use these to fetch web docs
my $ua = LWP::UserAgent->new("RIB/1.3");
my $req; my $res;


################# try to determine the type of the object
my $object_type = "Asset"; # use Asset for the default in case object
                        # type can't be derived from the url
if ($url =~ m,rib/repositories/[^/]+/objects/([^/]+)/[^/]+\.html$,i) {
  $object_type = $1;
}


################# see if the html for this object is cached
my $md5 = MD5->new; $md5->add($url); $md5->add($repository);
my $cache_file = $md5->hexdigest() . '.html';
if (open (INPUT, "$CACHE_DIR/$cache_file")) {
  my $mtime = (stat "$CACHE_DIR/$cache_file")[9];
  # if the header or footer for the object has changed then don't use cached copy
  if (((stat "$filepath/conf/$object_type.header")[9] > $mtime) 
                            or
      ((stat "$filepath/conf/$object_type.footer")[9] > $mtime)) {
    # do nothing...
  } else {
    my $was_checked = 0;
    if (time - $mtime > $TIME_OK) { # only check if older than $TIME_OK
      $req = HTTP::Request->new('HEAD',$url);
      $req->header('If-Modified-Since' => HTTP::Date::time2str($mtime));
      $res = $ua->request($req);
      $was_checked = 1;
      # touch the cached file because it's current
      utime time, time, "$CACHE_DIR/$cache_file";
    }
    if (!$was_checked || $res->code == 304) {
      print "Content-type: text/html\n\n";
      undef ($/); # undefine record separator
      while(<INPUT>) { print; }
      $/ = "\n";
      close INPUT;
      exit;
    }
  }
}


################# Parse the document and create its HTML.
my $buf = "";  # this is where the HTML for this object will be stored
$ua = LWP::UserAgent->new("RIB/1.2.1");
$req = HTTP::Request->new('GET',$url);
$res = $ua->request($req);
if ($res->is_success) {
  # Create the catalog entry
  my $bp = RIB::BIDMParser->new();
  my $ce;
  my $cp;
  if ($bp->parse($res->content)){
    # Initialize ConfigParser for self
    $cp = RIB::ConfigParser->new();
    unless($cp->load_config("$filepath/conf/BIDM.conf")){
        &Croak("Error loading configuration file for $repository");
    }
    $ce = $cp->InstanceOf($url,$object_type,$bp);
  }
  unless($ce->AsHtml(\$buf,$repository,$url,$cp)) {
    &Croak("Can't parse $url");
  }
} else {
  &Croak("Can't fetch $url");
}


################# get the header and footer for the class
my $header = "";
my $footer = "";
if (open (HEADER,"$filepath/conf/$object_type.header")) {
  undef($/);
  $header = <HEADER>; # this overrides the default (empty) header
  $/ = "\n";
  close HEADER;
}
if (open (FOOTER,"$filepath/conf/$object_type.footer")) {
  undef($/);
  $footer = <FOOTER>; # this overrides the default (empty) footer
  $/ = "\n";
  close FOOTER;
}

################# Print the html representation of this object
print "Content-type: text/html\n\n";
print $header;
print $buf;
print $footer;

################# Save this file to the cache
chdir $CACHE_DIR || exit;
opendir (DIR, ".") || exit;
my $tmp;
my $totalsize = 0;
my $oldest_file = "";
my $oldest_file_date = time;
foreach $tmp (readdir DIR) {
  next if -d $tmp;
  my $size=0; my $mtime=0;
  (undef,undef,undef,undef,undef,undef,undef,$size,
       undef,$mtime,undef,undef,undef) = stat($tmp);
  next unless $size; # in case stat fails;
  $totalsize += $size;
  if ($mtime < $oldest_file_date) {
    $oldest_file = $tmp;
    $oldest_file_date = $mtime;
  }
}
if ($totalsize >= $MAX_CACHE_SIZE) {
  unlink ($oldest_file) || exit;
}
closedir DIR;
open (OUTPUT,">$cache_file") || exit;
print OUTPUT $header;
print OUTPUT $buf;
print OUTPUT $footer;
close OUTPUT;

sub Croak {
  my $message = shift;
print << "EOF";
Content-type: text/html

<HTML>
<HEAD><TITLE>ERROR</TITLE></HEAD>
<BODY>
<H1>ERROR</H1>
<P><HR><P>
$message
</BODY>
</HTML>
EOF
  exit(1);
}