package LedgerSMB::RESTXML::Handler;
use strict;
use warnings;
use Carp;
use LedgerSMB::User;
use LedgerSMB::Sysconfig;
use LedgerSMB::Log;
use Scalar::Util qw(blessed);
use DBI;
=head3 cgi_handle
CGI_handle is the gateway for the RESTful lsmb API.
=head3 NOTES
=cut
sub cgi_handle {
my $self = shift;
my $method = $ENV{REQUEST_METHOD};
my $pathinfo = $ENV{PATH_INFO};
#pull off the leading slash, we need it in the form document/arguments/foo
$pathinfo =~ s#^/##;
my $function = 'handle_' . lc($method);
my ( $user, $module, @args ) = split '/', $pathinfo;
$user = LedgerSMB::User->fetch_config($user);
my $dbh = $self->connect_db($user);
# non-word characters are forbidden, usually a sign of someone being sneaky.
$module =~ s#\W##;
my $document_module = $self->try_to_load($module);
if ($document_module) {
if ( $document_module->can($function) ) {
my $returnValue = $document_module->$function(
{
dbh => $dbh,
args => \@args,
handler => $self,
user => $user
}
);
#return $self->return_serialized_response($returnValue);
}
else {
return $self->unsupported("$module cannot handle method $method");
}
}
else {
return $self->not_found(
"Could not find a handler for document type $module: <pre>$@</pre>"
);
}
}
sub cgi_report_error {
my $self = shift;
my $message = shift;
my $code = shift || 500;
print "Status: $code\n";
print "Content-Type: text/html\n\n";
print "<html><body>\n";
print "<h1>REST API error</h1>";
print "<blockquote>$message</blockquote>";
print "</body></html>";
}
sub cgi_read_query {
my $self = shift;
use CGI::Simple;
my $cgi = CGI::Simple->new();
return $cgi;
}
# ------------------------------------------------------------------------------------------------------------------------
=head3 try_to_load
try_to_load will try to load a RESTXML document handler module. returns undef
if it cannot load the given module for any reason. passed the type of RESTXML
document to try to load. returns a blessed anonymous hashref if the module
*can*, and is successfully loaded.
=cut
sub try_to_load {
my $self = shift;
my $module = shift;
eval qq{
use LedgerSMB::RESTXML::Document::$module;
};
if ($@) {
warn "Cannot load $module: $@" unless $@ =~ /Can't locate LedgerSMB\//i;
return undef;
}
else {
return bless {}, "LedgerSMB::RESTXML::Document::$module";
}
}
=head3 connect_db
Given a user's config, returns a database connection handle.
=cut
sub connect_db {
my ( $self, $myconfig ) = @_;
my $dbh = DBI->connect( $myconfig->{dbconnect},
$myconfig->{dbuser}, $myconfig->{dbpasswd} )
or carp "Error connecting to the db :$DBI::errstr";
$dbh->{pg_enable_utf8} = 1;
return $dbh;
}
# lets see how far XML::Simple can take us.
use XML::Simple;
use Scalar::Util qw(blessed);
sub return_serialized_response {
my ( $self, $response ) = @_;
print "Content-type: text/xml\n\n";
if ( blessed $response && $response->isa('XML::Twig::Elt') ) {
print qq{<?xml version="1.0"?>\n};
print $response->sprint();
}
else {
my $xs = XML::Simple->new(
NoAttr => 1,
RootName => 'LedgerSMBResponse',
XMLDecl => 1
);
print $xs->XMLout($response);
}
return;
}
sub read_query {
my ($self) = @_;
# for now.
return $self->cgi_read_query();
}
# =------------------------- POSSIBLE WAYS FOR MODULES TO RESPOND.
sub respond {
my ( $self, $data ) = @_;
return $self->return_serialized_response($data);
}
sub not_found {
my ( $self, $message ) = @_;
$self->cgi_report_error( $message, 404 );
}
sub unsupported {
my ( $self, $message ) = @_;
$self->cgi_report_error( $message, 501 );
}
sub error {
my ( $self, $message ) = @_;
$self->cgi_report_error( $message, 500 );
}
1;