trunk/Meteor/Koha.pm

package Meteor::Koha;

use strict;
use warnings;

my $use_disk_cache = 1;

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;

our $cache;

use HTML::Query qw/Query/;
use File::Slurp;
use Encode qw/decode/;
use Data::Dump qw/dump/;

sub item {
        my ( $class, $client, $sid ) = @_;

        my $item = unpack('h*', substr($sid,-8)) % 10000;

        my $html;
        my $status = 200;

        my $path = "cache/$item.html";

        if ( $html = $cache->{$item} ) {

                warn "# koha item $item from cache\n";

        } elsif ( $use_disk_cache && -e $path ) {
        
                $html = $cache->{$item} = read_file( $path );

        } else {

                my $url = 'http://koha.ffzg.hr/cgi-bin/koha/opac-detail.pl?biblionumber=' . $item;

                my $response = $ua->get( $url );

                if ($response->is_success) {

                        $html = $response->content;

                        write_file( "cache/$item.koha.html", $html );

                        warn "## size before: ", length( $html );

                        $html = decode( 'utf-8', $html );
                        my $q = Query( text => $html, 'div.container' )
                                || die;
                        $html = $q->as_HTML->[0];

                        warn "## size after: ", length( $html ), dump( $html );

                        $cache->{$item} = $html;
                        write_file( $path, $html );

                } else {

                        $html = qq{Can't load $item } . $response->status_line;
#                       $status = 404;

                }
        }

        my $len = length($html);

        warn "# koha item $item [$len]\n";

        $client->write(
                "HTTP/1.1 $status OK\r\n" .
                "Content-Type: text/html\r\n" .
                "Content-length: $len\r\n" .
                "Connection: close\r\n" .
                "\r\n\r\n$html\r\n"
        );

}

1;
1	dpavlin	70	package Meteor::Koha;
2
3			use strict;
4			use warnings;
5
6	dpavlin	80	my $use_disk_cache = 1;
7
8	dpavlin	70	use LWP::UserAgent;
9
10			my $ua = LWP::UserAgent->new;
11
12	dpavlin	71	our $cache;
13
14	dpavlin	79	use HTML::Query qw/Query/;
15			use File::Slurp;
16			use Encode qw/decode/;
17			use Data::Dump qw/dump/;
18
19	dpavlin	70	sub item {
20	dpavlin	80	my ( $class, $client, $sid ) = @_;
21	dpavlin	70
22	dpavlin	80	my $item = unpack('h*', substr($sid,-8)) % 10000;
23
24	dpavlin	71	my $html;
25	dpavlin	77	my $status = 200;
26	dpavlin	70
27	dpavlin	79	my $path = "cache/$item.html";
28
29	dpavlin	71	if ( $html = $cache->{$item} ) {
30	dpavlin	70
31	dpavlin	71	warn "# koha item $item from cache\n";
32	dpavlin	70
33	dpavlin	80	} elsif ( $use_disk_cache && -e $path ) {
34	dpavlin	79
35			$html = $cache->{$item} = read_file( $path );
36
37	dpavlin	71	} else {
38
39			my $url = 'http://koha.ffzg.hr/cgi-bin/koha/opac-detail.pl?biblionumber=' . $item;
40
41			my $response = $ua->get( $url );
42
43	dpavlin	77	if ($response->is_success) {
44	dpavlin	71
45	dpavlin	77	$html = $response->content;
46
47	dpavlin	79	write_file( "cache/$item.koha.html", $html );
48
49			warn "## size before: ", length( $html );
50
51			$html = decode( 'utf-8', $html );
52			my $q = Query( text => $html, 'div.container' )
53			\|\| die;
54			$html = $q->as_HTML->[0];
55
56			warn "## size after: ", length( $html ), dump( $html );
57
58	dpavlin	77	$cache->{$item} = $html;
59	dpavlin	79	write_file( $path, $html );
60	dpavlin	77
61			} else {
62
63			$html = qq{Can't load $item } . $response->status_line;
64			# $status = 404;
65
66			}
67	dpavlin	71	}
68
69	dpavlin	70	my $len = length($html);
70
71			warn "# koha item $item [$len]\n";
72
73			$client->write(
74	dpavlin	77	"HTTP/1.1 $status OK\r\n" .
75	dpavlin	70	"Content-Type: text/html\r\n" .
76			"Content-length: $len\r\n" .
77			"Connection: close\r\n" .
78			"\r\n\r\n$html\r\n"
79			);
80
81			}
82
83			1;