package Horizon::DLF;


#
#  GENERATE BASIC DLF ITEM AVAILABILITY
#
#  This is a mod_perl handler (not a standard CGI script), so you'll want something like this in your httpd.conf
#
#	PerlModule Horizon::DLF
#	<Location /dlf>
#	    SetHandler modperl
#	    PerlResponseHandler Horizon::DLF
#	</Location>
#
#  ...however, if shouldn't be too difficult to change the code back to a bog standard Perl script
#
#
#  Notes...
#
#  - you'll need a working ODBC connection to your Horizon server and the DBD::ODBC Perl module
#
#  - the handler can handle mutiple bib numbers
#
#  - you'll probably want to use Apache::DBI to provide a persistent connection to Horizon
#
#  - you'll need to create a "DLF.status.txt" file with 1 line per status code and three colums (separated by a TAB character):
#
#    column 1: Horizon item status code in lower case
#    column 2: the string "available" or "not available" (without quotes)
#    column 3: item status description
#
#    ...any undefined status codes will be ignored by the handler
#
#
#  This Perl script is released under a CC0 1.0 Universal licence
#  http://creativecommons.org/publicdomain/zero/1.0/
#



    use strict;
    use DBI;

    use Apache2::RequestRec ();  # for $r->content_type
    use Apache2::RequestIO ();   # for $r->puts
    use Apache2::Const -compile => ':common';



### CONFIGURE THE FOLLOWING VARIABLES!

    my $HorizonOdbcServer = 'HORIZON';
    my $HorizonUsername   = 'xxx';
    my $HorizonPassword   = 'xxx';
    my $statusFile        = '/Apache2/modperl/HIP/DLF.status.txt';



### HORIZON DATABASE HANDLE...

    my $dbh = '';



### SPECIFY ANY COLLECTIONS (IN UPPERCASE) TO IGNORE ITEMS FROM...

    my %ignoreCollections    = ( );
    $ignoreCollections{LAWP} = 1;
    $ignoreCollections{STLJ} = 1;



### HASH FOR STORING COLLECTION DESCRIPTIONS...

    my %collections = ( );



### READ IN STATUS CODE DATA...

    my %status = ( );

    if( open( IN, $statusFile ) )
    {
        while( <IN> )
        {
	    chomp;
	    my( $a, $b ) = split( /\t/, $_, 2 );
	    $status{$a} = "$b";
        }
        close( IN );
    }




    sub handler 
    {
        my $r = shift;


### INITIATE DB CONNECTION...

	unless( $dbh )
	{
	    $dbh = DBI->connect(	"dbi:ODBC:".$HorizonOdbcServer, 
					$HorizonUsername, 
					$HorizonPassword, 
					{ PrintError => 0, RaiseError => 0 }
				);
	}


### FETCH COLLECTION DESCRIPTIONS...

	unless( %collections )
  	{
	    my $sth = $dbh->prepare( 'select collection, pac_descr from collection' );
            $sth->execute( );  

	    while( my @row = $sth->fetchrow_array( ) )
	    {   
	  	$collections{lc($row[0])} = $row[1];
	    }
	}


### GET THE BIB NUMBERS...

        my $bib = $r->path_info() || '';
	$bib =~ s/\/id\=//g;
	$bib =~ s/^\///g;
        $bib =~ s/[^0-9 ]/ /g;

        my @bibs = split( /  */,$bib );


### DECLARE OTHER VARIABLES...

    	my $sth     = '';
	my @row     = ( );


### $output CONTAINS THE FINAL XML OUTPUT...

	my $output  = '';
        $output .= qq(<?xml version="1.0" encoding="iso-8859-1"?><dlf:collection xmlns:dlf="http://diglib.org/ilsdi/1.1" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://diglib.org/ilsdi/1.1 http://diglib.org/architectures/ilsdi/schemas/1.1/dlfexpanded.xsd">);


### GET AVAILABILITY INFO FOR EACH BIB...

        foreach my $bib ( @bibs )
        {
	    $output .= qq(<dlf:record><dlf:bibliographic id="$bib" />);
	    $output .= qq(<dlf:items>);


### IF THE BIB NO LONGER EXISTS IN HORIZON, LOG THE BIB# SO YOU CAN INVESTIGATE IT LATER...

            $sth = $dbh->prepare( 'select count(*) from bib_control where bib#='.$bib );
            $sth->execute( );  
	    @row = $sth->fetchrow_array( );
	    if( $row[0] < 1 )
	    {
	 	open( OUT, ">>/dlf_bad_books.txt" );
		print OUT "$bib\n";
		close( OUT );
	    }



### FETCH THE ITEM INFO FOR ALL ITEMS WITH THAT BIB#...

            $sth = $dbh->prepare( 'select item#,location,collection,item_status from item where bib#='.$bib );
            $sth->execute( );  

	    while( @row = $sth->fetchrow_array( ) )
	    {
	        my $itemNumber          = $row[0];
	        my $itemLocation        = lc($row[1]);
	        my $itemCollection      = lc($row[2]);
	        my $itemStatus          = lc($row[3]);

	        my $location            = '';
	        my $availabilityStatus  = '';
	        my $availabilityMessage = '';


### SKIP IF THE ITEM COLLECTION IS TO BE IGNORED...

	        if( $ignoreCollections{uc($itemCollection)} ) { next }


### SKIP IF THE ITEM STATUS ISN'T DEFINED...

		unless( $status{$itemStatus} ) { next }


### BUILD THE ITEM OUTPUT...

		my $collectionName = $collections{lc($itemCollection)} || '';

		if( $collectionName ) { $collectionName = " ($collectionName)" }

	        if( $itemLocation eq 'cl' ) { $location = 'Huddersfield' }
	        if( $itemLocation eq 'sl' ) { $location = 'Huddersfield' }
	        if( $itemLocation eq 'mu' ) { $location = 'Huddersfield' }
	        if( $itemLocation eq 'ol' ) { $location = 'Oldham' }
	        if( $itemLocation eq 'ba' ) { $location = 'Barnsley' }

	        ( $availabilityStatus, $availabilityMessage ) = split( /\t/, $status{$itemStatus} );

	        if( $location )
	        {
	            $output .= qq(<dlf:item id="$itemNumber"><dlf:simpleavailability><dlf:identifier>$itemNumber</dlf:identifier><dlf:availabilitystatus>$availabilityStatus</dlf:availabilitystatus><dlf:availabilitymsg>$availabilityMessage</dlf:availabilitymsg><dlf:location>$location$collectionName</dlf:location></dlf:simpleavailability></dlf:item>);
	        }
	    }


	    $output .= qq(</dlf:items>);
	    $output .= qq(</dlf:record>);
        }

        $output .= qq(</dlf:collection>);




        $r->content_type( 'text/xml' );
        $r->puts( $output );

        return Apache2::Const::OK;


    }

1;