#!/usr/bin/perl -w # # objectlist.cgi # use strict; use warnings; use Data::Dumper; use Encode; use DBI; use YAML::Syck; use CGI; use Log::Log4perl qw(get_logger); use Cache::FastMmap; use Template; Log::Log4perl::init('/etc/phaidra_logging.conf'); my $cgi = new CGI; eval { if(!defined($cgi->param('page'))) { die("Missing parameter: page"); } print $cgi->header(-type => "text/xml", -charset => 'UTF-8'); print objectlist($cgi->param('page')); }; if($@) { print "Content-Type: text/plain\n\n"; print "Died: $@\n"; } exit(0); sub objectlist { my ($page)=@_; my $log = get_logger("Phaidra::Utils::Objectlist"); my $config = YAML::Syck::LoadFile('/etc/phaidra.yml'); my $connect_info=$config->{'Model::Fedora22'}->{'connect_info'}; my $dbh=DBI->connect($connect_info->[0], $connect_info->[1], $connect_info->[2]); unless($dbh) { die("Can't connect to fedora22 database: ".$DBI::errstr); } my $cache_os = getCache($config, "objectlist"); my $list = undef; unless($list = $cache_os->get($page)) { $log->debug("Cache miss for objectlist |$page|"); my ($ss,$sth); $ss=qq/ SELECT pid,dcTitle FROM doFields WHERE pid LIKE 'o:%' AND dcType NOT LIKE '\%page%' ORDER BY cDate ASC LIMIT ?,? /; $sth=$dbh->prepare($ss) or $log->logdie("prepare: ".$dbh->errstr); $sth->execute(($page-1)*$config->{objectlistlimit},$config->{objectlistlimit}) or $log->logdie("execute: ".$dbh->errstr); my ($objects,$pid,$dcTitle); $sth->bind_columns(undef, \$pid, \$dcTitle) or $log->logdie("bind_columns: ".$dbh->errstr); while($sth->fetch()) { push @$objects, { pid => $pid, title => $dcTitle }; } $ss=qq/SELECT COUNT(pid) FROM doFields WHERE pid LIKE 'o:%' AND dcType NOT LIKE '\%page%'/; $sth=$dbh->prepare($ss) or $log->logdie("prepare: ".$dbh->errstr); $sth->execute() or $log->logdie("execute: ".$dbh->errstr); my $count; $sth->bind_columns(undef, \$count) or $log->logdie("bind_columns: ".$dbh->errstr); $sth->fetch(); my %fields = ( objects => $objects, count => $count); my $tt = Template->new(); $tt->process('objectlist.tt', \%fields, \$list) or die("processing of objectlist.tt failed: ".$tt->error()); $cache_os->set($page, $list); $sth->finish; $dbh->disconnect; undef $dbh; } else { $log->debug("Cache hit for objectlist |$page|"); } return encode('utf-8',$list); } sub getCache { my ($c, $name) = @_; my $log = get_logger("Phaidra::Utils::Objectlist"); my $cache = Cache::FastMmap->new( cache_size => $c->{caches}->{$name}->{size}, share_file => $c->{caches}->{$name}->{file}, expire_time => $c->{caches}->{$name}->{expires}, unlink_on_exit => 0, ); $log->logdie("can't create open $name! ".Dumper($c->{caches})) unless($cache); return $cache; }