summaryrefslogtreecommitdiff
path: root/LedgerSMB/RESTXML/Handler.pm
blob: ab63ad2aadd5faabce59d6c0a7472d21579085aa (plain)
  1. package LedgerSMB::RESTXML::Handler;
  2. use strict;
  3. use warnings;
  4. use Carp;
  5. use LedgerSMB::User;
  6. use LedgerSMB::Sysconfig;
  7. use LedgerSMB::Log;
  8. use Scalar::Util qw(blessed);
  9. use DBI;
  10. =head3 cgi_handle
  11. CGI_handle is the gateway for the RESTful lsmb API.
  12. =head3 NOTES
  13. =cut
  14. sub cgi_handle {
  15. my $self = shift;
  16. my $method = $ENV{REQUEST_METHOD};
  17. my $pathinfo = $ENV{PATH_INFO};
  18. #pull off the leading slash, we need it in the form document/arguments/foo
  19. $pathinfo =~ s#^/##;
  20. my $function = 'handle_' . lc($method);
  21. my ( $user, $module, @args ) = split '/', $pathinfo;
  22. $user = LedgerSMB::User->fetch_config($user);
  23. my $dbh = $self->connect_db($user);
  24. # non-word characters are forbidden, usually a sign of someone being sneaky.
  25. $module =~ s#\W##;
  26. my $document_module = $self->try_to_load($module);
  27. if ($document_module) {
  28. if ( $document_module->can($function) ) {
  29. my $returnValue = $document_module->$function(
  30. {
  31. dbh => $dbh,
  32. args => \@args,
  33. handler => $self,
  34. user => $user
  35. }
  36. );
  37. #return $self->return_serialized_response($returnValue);
  38. }
  39. else {
  40. return $self->unsupported("$module cannot handle method $method");
  41. }
  42. }
  43. else {
  44. return $self->not_found(
  45. "Could not find a handler for document type $module: <pre>$@</pre>"
  46. );
  47. }
  48. }
  49. sub cgi_report_error {
  50. my $self = shift;
  51. my $message = shift;
  52. my $code = shift || 500;
  53. print "Status: $code\n";
  54. print "Content-Type: text/html\n\n";
  55. print "<html><body>\n";
  56. print "<h1>REST API error</h1>";
  57. print "<blockquote>$message</blockquote>";
  58. print "</body></html>";
  59. }
  60. sub cgi_read_query {
  61. my $self = shift;
  62. use CGI;
  63. my $cgi = CGI->new();
  64. return $cgi;
  65. }
  66. # ------------------------------------------------------------------------------------------------------------------------
  67. =head3 try_to_load
  68. try_to_load will try to load a RESTXML document handler module. returns undef
  69. if it cannot load the given module for any reason. passed the type of RESTXML
  70. document to try to load. returns a blessed anonymous hashref if the module
  71. *can*, and is successfully loaded.
  72. =cut
  73. sub try_to_load {
  74. my $self = shift;
  75. my $module = shift;
  76. eval qq{
  77. use LedgerSMB::RESTXML::Document::$module;
  78. };
  79. if ($@) {
  80. warn "Cannot load $module: $@" unless $@ =~ /Can't locate LedgerSMB\//i;
  81. return undef;
  82. }
  83. else {
  84. return bless {}, "LedgerSMB::RESTXML::Document::$module";
  85. }
  86. }
  87. =head3 connect_db
  88. Given a user's config, returns a database connection handle.
  89. =cut
  90. sub connect_db {
  91. my ( $self, $myconfig ) = @_;
  92. my $dbh = DBI->connect( $myconfig->{dbconnect},
  93. $myconfig->{dbuser}, $myconfig->{dbpasswd} )
  94. or carp "Error connecting to the db :$DBI::errstr";
  95. $dbh->{pg_enable_utf8} = 1;
  96. return $dbh;
  97. }
  98. # lets see how far XML::Simple can take us.
  99. use XML::Simple;
  100. use Scalar::Util qw(blessed);
  101. sub return_serialized_response {
  102. my ( $self, $response ) = @_;
  103. print "Content-type: text/xml\n\n";
  104. if ( blessed $response && $response->isa('XML::Twig::Elt') ) {
  105. print qq{<?xml version="1.0"?>\n};
  106. print $response->sprint();
  107. }
  108. else {
  109. my $xs = XML::Simple->new(
  110. NoAttr => 1,
  111. RootName => 'LedgerSMBResponse',
  112. XMLDecl => 1
  113. );
  114. print $xs->XMLout($response);
  115. }
  116. return;
  117. }
  118. sub read_query {
  119. my ($self) = @_;
  120. # for now.
  121. return $self->cgi_read_query();
  122. }
  123. # =------------------------- POSSIBLE WAYS FOR MODULES TO RESPOND.
  124. sub respond {
  125. my ( $self, $data ) = @_;
  126. return $self->return_serialized_response($data);
  127. }
  128. sub not_found {
  129. my ( $self, $message ) = @_;
  130. $self->cgi_report_error( $message, 404 );
  131. }
  132. sub unsupported {
  133. my ( $self, $message ) = @_;
  134. $self->cgi_report_error( $message, 501 );
  135. }
  136. sub error {
  137. my ( $self, $message ) = @_;
  138. $self->cgi_report_error( $message, 500 );
  139. }
  140. 1;