LedgerSMB/RESTXML/Handler.pm



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;
    my $cgi = CGI->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";

    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;