librefdb-sru-perl 0.7-2 / usr / share / perl5 / RefDB / SRUserver.pm

#!/usr/bin/perl

## SRUserver.pm: defines a class for a standalone SRU server for RefDB
## markus@mhoenicka.de 2007-08-10

##   This program is free software; you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation; either version 2 of the License, or
##   (at your option) any later version.
##   
##   This program is distributed in the hope that it will be useful,
##   but WITHOUT ANY WARRANTY; without even the implied warranty of
##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##   GNU General Public License for more details.
   
##   You should have received a copy of the GNU General Public License
##   along with this program; if not, write to the Free Software
##   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA



package RefDB::SRUserver;
use base qw(HTTP::Server::Simple::CGI);

## some RefDB modules
use RefDB::Prefs;
use RefDB::SRU;

use Sys::Syslog;

=head1 NAME

RefDB::SRUserver - Lightweight SRU server for RefDB


=head1 SYNOPSIS

use warnings;
use strict;
 
use RefDB::SRUserver;

# change into the directory that contains the sru stylesheets
 
chdir '<refdblib>/sru' or die "Can't cd to stylesheet directory: $!\n";

# create and start the web server

my $server = RefDB::SRUserver->new();

$server->run();

=head1 DESCRIPTION

This is a simple standalone SRU server for RefDB. By default, it
doesn't thread, fork, scale well, run fast, or do anything else you'd need
to serve out datasets to the world. It is intended to set up a no-frills
SRU server without having to configure a web server like Apache. If you need
performance, or want to allow remote access to your RefDB data, by all means
use the RefDB SRU CGI module with a decent web server instead. The CGI module
is available in the same package as this standalone server.

To add some level of security, an application using this module must run from
or change to the subdirectory which contains the stylesheets. All path info
is stripped, and the stylesheets are then served from the current working
directory. This should keep most users from sharing their /etc/passwd with
everyone else.

=head1 FEEDBACK

Send bug reports, questions, and comments to the refdb-users mailing list at:

refdb-users@lists.sourceforge.net

For list information and archives, please visit:

http://lists.sourceforge.net/lists/listinfo/refdb-users


=head1 AUTHOR

Markus Hoenicka, markus@mhoenicka.de

=head1 SEE ALSO

This module is part of the RefDB package, a reference manager and bibliography tool for markup languages. Please visit http://refdb.sourceforge.net for further information.

=head2  print_banner

This routine prints a banner before the server request-handling loop
starts.

=cut

sub print_banner {
    my $self = shift;

    print(    __PACKAGE__
	      . ": You can connect to your server at "
	      . "http://localhost:"
	      . $self->port
	      . "/\n"
	      . "To terminate the server, press Ctrl-c\n");

}

=head2 handle_request CGI

This routine is called whenever your server gets a request it can
handle.

It's called with a CGI object that's been pre-initialized.


=cut


sub handle_request {
    my ($self, $query) = @_;

    if ($query->path_info() =~ "styles") {
	# this is a stylesheet request. Strip the leading directory from the
	# path and load the file from the current directory. 
	$stylepath = $query->path_info();
	$stylepath =~ s/.*\/([^\/]+)/$1/;

	my $sh = eval { local *FH; open(FH, "< $stylepath") or die; *FH{IO}};
	while (<$sh>) {
	    print $_;
	}
	return;
    }
# else: run the SRU stuff

## read config file settings
    my $confdir = $self->{"confdir"};
    my $prefs = RefDB::Prefs::->new("$confdir/refdbsrurc", undef);

# this hash receives the parameter-value pairs
    my %params = $query->Vars;

# logging options
    $params{'logfile'} = (defined($prefs->{"logfile"})) ? $prefs->{"logfile"} : "/var/log/refdbsru.log";
    $params{'loglevel'} = (defined($prefs->{"loglevel"})) ? $prefs->{"loglevel"} : 6;
    $params{'logdest'} = (defined($prefs->{"logdest"})) ? $prefs->{"logdest"} : 2; ## 0 = stderr, 1 = syslog, 2 = file
    
# networking options
    $params{'server_ip'} = (defined($prefs->{"serverip"})) ? $prefs->{"serverip"} : "127.0.0.1";
    $params{'port'} = (defined($prefs->{"port"})) ? $prefs->{"port"} : "9734";
    $params{'timeout'} = (defined($prefs->{"timeout"})) ? $prefs->{"timeout"} : "180";

# user authentication
    $params{'username'} = (defined($prefs->{"username"})) ? $prefs->{"username"} : "anonymous";
    $params{'password'} = (defined($prefs->{"passwd"})) ? $prefs->{"passwd"} : "";
    

    $params{'pdfroot'} = (defined($prefs->{"pdfroot"})) ? $prefs->{"pdfroot"} : "/home/foo/literature";
    $params{'xsl_url'} = (defined($prefs->{"xsl_url"})) ? $prefs->{"xsl_url"} : "";
    $params{'db_engine'} = (defined($prefs->{"dbserver"})) ? $prefs->{"dbserver"} : undef;

# zeerex parameters
    $params{'zeerex_host'} = (defined($prefs->{"zeerex_host"})) ? $prefs->{"zeerex_host"} : "www.change.me";
    $params{'zeerex_port'} = (defined($prefs->{"zeerex_port"})) ? $prefs->{"zeerex_port"} : "80";
    $params{'zeerex_database'} = (defined($prefs->{"zeerex_database"})) ? $prefs->{"zeerex_database"} : "refs";
    $params{'zeerex_databaseInfo_title'} = (defined($prefs->{"zeerex_databaseInfo_title"})) ? $prefs->{"zeerex_databaseInfo_title"} : "Reference Database";
    $params{'zeerex_databaseInfo_description'} = (defined($prefs->{"zeerex_databaseInfo_description"})) ? $prefs->{"zeerex_databaseInfo_description"} : "Reference Database";
    $params{'zeerex_databaseInfo_author'} = (defined($prefs->{"zeerex_databaseInfo_author"})) ? $prefs->{"zeerex_databaseInfo_author"} : "John Doe";
    $params{'zeerex_databaseInfo_contact'} = (defined($prefs->{"zeerex_databaseInfo_contact"})) ? $prefs->{"zeerex_databaseInfo_contact"} : "John\@Doe.org";
    
# create a new RefDB query object and pass a reference to the
# parameter-value hash 
    my $refdbquery = new RefDB::SRU(\%params);

# try to figure out the database name. A default database should be
# provided in the config file. Remote users can override this setting
# by providing an additional path info in the URL. E.g.
# http://myserver.com/cgi-bin/refdbsru/?<query> will use the
# default database, whereas
# http://myserver.com/cgi-bin/refdbsru/foo?<query> will use the
# database "foo" instead
    if (defined($query->path_info()) && length($query->path_info()) > 1) {
	$params{'database'} = $query->path_info();
    
    # strip leading slash
	$params{'database'} =~ s/^\///;
    }
    else {
	$params{'database'} = (defined($prefs->{"defaultdb"})) ? $prefs->{"defaultdb"} : "references";
    }

    $refdbquery->run();

    my $result = $refdbquery->response();
    
    print "HTTP/1.0 200 OK\r\nContent-Type: text/xml\r\n\r\n";
    print "$result\n";

}

1;
__END__