#!/usr/bin/perl -w

##################
#
#  856 logging script for HIP 3
#
#  see http://www.daveyp.com/blog/index.php/archives/111/
#
#############
#
#  Knocked together by Dave Pattern <d.c.pattern@hud.ac.uk>
#  If you spot any bugs, please let me know!
#
#############
#
#  version 1.00 - last updated 29/Sep/2006
#
#
#########
#
# (cc) 2006
#
# http://creativecommons.org/licenses/by-nc-sa/2.5/
#
#####



    use strict;
  
    my $bib = 0;
    my $ttl = '';



### GET THE 856 URL BEING PASSED TO THE SCRIPT...
    my $url = $ENV{QUERY_STRING} || '';


### TRY AND GET THE URL OF THE REFERING PAGE...
    my $ref = $ENV{HTTP_REFERER} || '';


### FQDN OF YOUR HIP SERVER...
    my $hip = 'webcat.hud.ac.uk';


### THE LOG FILE...
    my $log = './856log.txt';




### IF WE'VE NOT GOT AN 856 URL, THEN RETURN AN HTTP STATUS 204 (NO ACTION)...

    unless( $url )
    {
	print "status: 204\n\n";
	exit;
    }


### IF THE REFERING PAGE IS A HIP PAGE, THEN TRY AND GET THE BIB NUMBER AND TITLE...

    if( $ref && $ref =~ /$hip/ )
    {
	( $bib, $ttl ) = getBib( $ref )
    }



### REDIRECT THE USER'S WEB BROWSER TO THE 856 URL...

    print "Location: $url\n\n";



### "LOG IT!" (TO BE SHOUTED IN THE SAME WAY WITHNAIL SHOUTS "FORK IT!")

    open( OUT, ">>$log" );
    print OUT localtime(time)."\t$bib\t$ttl\t$url\n";
    close( OUT );




### TO GET THE BIB NUMBER AND TITLE, WE TAKE THE REFERING URL AND TWEAK IT TO FETCH THE XML VERSION OF THE HIP PAGE...

sub getBib
{
    my $url = shift;
    my $bib = 0;
    my $ttl = '';

    if( $url =~ /^http/ )
    {
        use LWP::Simple;

	$url =~ s/\#.*$//;
	$url .= '&GetXML=true';

        my $content = get( $url );

	if( $content =~ /\<key\>(\d\d*)\<\/key\>/i )
	{
	    $bib = $1;
	}

	if( $content =~ /\<TITLE\>\<data\>\<text\>(.+?)\<\/text\>/i )
	{
	    $ttl = $1;
	}
    }

    return( $bib, $ttl );
}