[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb: [750] trunk
- Subject: SF.net SVN: ledger-smb: [750] trunk
- From: ..hidden..
- Date: Wed, 03 Jan 2007 18:43:30 -0800
Revision: 750
http://svn.sourceforge.net/ledger-smb/?rev=750&view=rev
Author: jasonjayr
Date: 2007-01-03 18:43:30 -0800 (Wed, 03 Jan 2007)
Log Message:
-----------
The start of a new REST API, these modules only provide read-only access for now.
Added Paths:
-----------
trunk/LedgerSMB/RESTXML/
trunk/LedgerSMB/RESTXML/Document/
trunk/LedgerSMB/RESTXML/Document/Base.pm
trunk/LedgerSMB/RESTXML/Document/Customer.pm
trunk/LedgerSMB/RESTXML/Document/Customer_Search.pm
trunk/LedgerSMB/RESTXML/Document/Part.pm
trunk/LedgerSMB/RESTXML/Document/Part_Search.pm
trunk/LedgerSMB/RESTXML/Document/SalesOrder.pm
trunk/LedgerSMB/RESTXML/Document/Session.pm
trunk/LedgerSMB/RESTXML/Handler.pm
trunk/rest.pl
Added: trunk/LedgerSMB/RESTXML/Document/Base.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Document/Base.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Document/Base.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,63 @@
+package LedgerSMB::RESTXML::Document::Base;
+use strict;
+use warnings;
+use XML::Twig;
+use LedgerSMB::Log;
+use Carp;
+
+sub handle_post {
+ my ($self, $args) = @_;
+
+ return $args->{handler}->unsupported('the POST method is not implemented.');
+}
+
+sub handle_put {
+ my ($self, $args) = @_;
+ return $self->{handler}->unsupported('the PUT method is not implemented.');
+}
+
+sub handle_delete {
+ my ($self, $args) = @_;
+ return $self->{handler}->unsupported('the DELETE method is not implemented.');
+}
+
+sub handle_get {
+ my ($self, $args) = @_;
+
+ return $self->{handler}->unsupported('the GET method is not implemented.');
+}
+
+=head3 hash_to_twig
+
+Convinenve function to convert a hashref to a XML::Twig structure.
+
+passed a hashref, required arguments:
+
+hash - the hash to convert
+
+name - the name of the root element.
+
+optional arguments:
+
+sort - by default, on set to 0 to disable. toggles whether or not hash keys are sorted
+in the resulting xml node created. Disabling this may save some performance if converting a lot of
+nodes at once.
+
+=cut
+
+sub hash_to_twig {
+ my ($self, $args) = @_;
+
+ my $hash = $args->{hash} || croak "Need a hash to convert to use hash_to_twig";
+ my $name = $args->{name} || croak "Need a root element name to use hash_to_twig";
+ my @keyorder = keys %$hash;
+
+ @keyorder = sort @keyorder unless defined($args->{sort}) and $args->{sort} == 0;
+
+ return XML::Twig::Elt->new($name,$args->{root_attr}||{}, map {
+ XML::Twig::Elt->new($_, {'#CDATA'=>1}, $hash->{$_})
+ } @keyorder );
+}
+
+1;
+
Added: trunk/LedgerSMB/RESTXML/Document/Customer.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Document/Customer.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Document/Customer.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,23 @@
+package LedgerSMB::RESTXML::Document::Customer;
+use strict;
+use warnings;
+use base qw(LedgerSMB::RESTXML::Document::Base);
+
+
+sub handle_get {
+ my ($self, $args) = @_;
+ my $user = $args->{user};
+ my $dbh = $args->{dbh};
+ my $handler = $args->{handler};
+
+ my $res = $dbh->selectrow_hashref(q{SELECT * from customer where id = ?}, undef, $args->{args}[0]);
+
+ if(!$res) {
+ $handler->not_found("No customer with the id $args->{args}[0] found");
+ } else {
+ $handler->respond($self->hash_to_twig({name=>'Customer',hash=>$res}));
+ }
+}
+
+
+1;
Added: trunk/LedgerSMB/RESTXML/Document/Customer_Search.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Document/Customer_Search.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Document/Customer_Search.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,46 @@
+package LedgerSMB::RESTXML::Document::Customer_Search;
+use strict;
+use warnings;
+use base qw(LedgerSMB::RESTXML::Document::Base);
+use LedgerSMB::Log;
+
+sub handle_get {
+ my ($self, $args) = @_;
+ my $user = $args->{user};
+ my $dbh = $args->{dbh};
+ my $handler = $args->{handler};
+
+ my $query = $handler->read_query();
+
+ my %terms;
+
+ for my $field ($query->param()) {
+ # TODO: BIG GAPING HOLE HERE.
+ $terms{$field} = $query->param($field);
+ }
+
+ if($terms{_keyword}) {
+ %terms = (
+ name=>$terms{_keyword},
+ customernumber=>$terms{_keyword},
+ contact=>$terms{_keyword}
+ );
+ }
+ my $sql = 'SELECT id,name,phone,customernumber FROM customer WHERE '.join(' OR ',map { "$_ like ?" } sort keys %terms);
+
+
+ my $res = $dbh->prepare($sql);
+
+ $res->execute(map { "$terms{$_}\%" } sort keys %terms) or return $handler->error($dbh->errstr);
+
+ my @rows;
+ my $row;
+ push @rows, $row while $row = $res->fetchrow_hashref();
+
+ $res->finish();
+
+ $handler->respond(XML::Twig::Elt->new('Customer_Search_Response',{'xmlns:xlink'=>"http://www.w3.org/1999/xlink"},map {
+ $self->hash_to_twig({name=>'Customer',root_attr=>{'xlink:href'=>"Customer/$_->{id}"}, hash=>$_});
+ } @rows));
+}
+1;
Added: trunk/LedgerSMB/RESTXML/Document/Part.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Document/Part.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Document/Part.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,23 @@
+package LedgerSMB::RESTXML::Document::Part;
+use strict;
+use warnings;
+use base qw(LedgerSMB::RESTXML::Document::Base);
+
+
+sub handle_get {
+ my ($self, $args) = @_;
+ my $user = $args->{user};
+ my $dbh = $args->{dbh};
+ my $handler = $args->{handler};
+
+ my $res = $dbh->selectrow_hashref(q{SELECT * from part where id = ?}, undef, $args->{args}[0]);
+
+ if(!$res) {
+ $handler->not_found("No part with the id $args->{args}[0] found");
+ } else {
+ $handler->respond($self->hash_to_twig({name=>'Customer',hash=>$res}));
+ }
+}
+
+
+1;
Added: trunk/LedgerSMB/RESTXML/Document/Part_Search.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Document/Part_Search.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Document/Part_Search.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,45 @@
+package LedgerSMB::RESTXML::Document::Part_Search;
+use strict;
+use warnings;
+use base qw(LedgerSMB::RESTXML::Document::Base);
+use LedgerSMB::Log;
+
+sub handle_get {
+ my ($self, $args) = @_;
+ my $user = $args->{user};
+ my $dbh = $args->{dbh};
+ my $handler = $args->{handler};
+
+ my $query = $handler->read_query();
+
+ my %terms;
+
+ for my $field ($query->param()) {
+ # TODO: BIG GAPING HOLE HERE.
+ $terms{$field} = $query->param($field);
+ }
+
+ if($terms{_keyword}) {
+ %terms = (
+ description=>$terms{_keyword},
+ partnumber=>$terms{_keyword},
+ );
+ }
+ my $sql = 'SELECT id,description,partnumber FROM parts WHERE '.join(' OR ',map { "$_ like ?" } sort keys %terms);
+
+
+ my $res = $dbh->prepare($sql);
+
+ $res->execute(map { "$terms{$_}\%" } sort keys %terms) or return $handler->error($dbh->errstr);
+
+ my @rows;
+ my $row;
+ push @rows, $row while $row = $res->fetchrow_hashref();
+
+ $res->finish();
+
+ $handler->respond(XML::Twig::Elt->new('Part_Search_Response',{'xmlns:xlink'=>"http://www.w3.org/1999/xlink"},map {
+ $self->hash_to_twig({name=>'Part',root_attr=>{'xlink:href'=>"Part/$_->{id}"}, hash=>$_});
+ } @rows));
+}
+1;
Added: trunk/LedgerSMB/RESTXML/Document/SalesOrder.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Document/SalesOrder.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Document/SalesOrder.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,17 @@
+package LedgerSMB::RESTXML::Document::SalesOrder;
+use strict;
+use warnings;
+use base qw(LedgerSMB::RESTXML::Document::Base);
+
+
+
+sub handle_get {
+ my ($self, $args) = @_;
+
+ print "Content-type: text/html\n\n";
+ print "It still works";
+
+}
+
+
+1;
Added: trunk/LedgerSMB/RESTXML/Document/Session.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Document/Session.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Document/Session.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,33 @@
+
+=head1 NAME
+
+LedgerSMB::RESTXML::Document::Session
+
+=head1 SYNOPSIS
+
+This sets up an authentication session for iterativly accessing documents in LedgerSMB. A user should
+post a login document to /Session/userid, and upon success, they will recieve a cookie which they can use to further
+access other resources.
+
+=cut
+
+package LedgerSMB::RESTXML::Document::Session;
+use strict;
+use warnings;
+use base qw(LedgerSMB::RESTXML::Document::Base);
+
+
+sub handle_get {
+ my ($self, $args) = @_;
+
+
+}
+
+sub handle_post {
+ my ($self, $args) = @_;
+ print "Content-type: text/html\n\nhi";
+
+}
+
+
+1;
Added: trunk/LedgerSMB/RESTXML/Handler.pm
===================================================================
--- trunk/LedgerSMB/RESTXML/Handler.pm (rev 0)
+++ trunk/LedgerSMB/RESTXML/Handler.pm 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,171 @@
+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=>..hidden.., 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;
Added: trunk/rest.pl
===================================================================
--- trunk/rest.pl (rev 0)
+++ trunk/rest.pl 2007-01-04 02:43:30 UTC (rev 750)
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use LedgerSMB::RESTXML::Handler;
+
+# To Enable the REST API, Delete these 3 lines.
+
+print "Content-type: text/plain\n\n";
+print "REST API disabled by default until authentication is working correctly";
+exit;
+
+LedgerSMB::RESTXML::Handler->cgi_handle();
+
+=head1 NAME
+
+rest.pl - RESTful interface to LedgerSMB
+
+=head1 SUMMARY
+
+ status
+ [OK] GET rest.pl/Customer/12345
+ [ ] GET rest.pl/Customer/CUSTOMERNUMBER
+ [OK] GET rest.pl/Customer_Search?_keyword=FOO
+
+ [OK] GET rest.pl/Part/12345
+ [ ] GET rest.pl/Part/PARTNUMBER
+ [ ] GET rest.pl/Part_Search?_keyword=red
+
+ [ ] GET rest.pl/SalesOrder/12345
+
+
+=cut
+
Property changes on: trunk/rest.pl
___________________________________________________________________
Name: svn:executable
+ *
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.