The start of a new REST API, these modules only provide read-only access for now.

git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@750 4979c152-3d1c-0410-bac9-87ea11338e46

7 files changed, 250 insertions, 0 deletions

diff --git a/LedgerSMB/RESTXML/Document/Base.pm b/LedgerSMB/RESTXML/Document/Base.pm
new file mode 100644
index 00000000..e8feaa96
--- /dev/null
+++ b/LedgerSMB/RESTXML/Document/Base.pm
@@ -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;
+
diff --git a/LedgerSMB/RESTXML/Document/Customer.pm b/LedgerSMB/RESTXML/Document/Customer.pm
new file mode 100644
index 00000000..3a494965
--- /dev/null
+++ b/LedgerSMB/RESTXML/Document/Customer.pm
@@ -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;
diff --git a/LedgerSMB/RESTXML/Document/Customer_Search.pm b/LedgerSMB/RESTXML/Document/Customer_Search.pm
new file mode 100644
index 00000000..7456f9d3
--- /dev/null
+++ b/LedgerSMB/RESTXML/Document/Customer_Search.pm
@@ -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;
diff --git a/LedgerSMB/RESTXML/Document/Part.pm b/LedgerSMB/RESTXML/Document/Part.pm
new file mode 100644
index 00000000..072f9b80
--- /dev/null
+++ b/LedgerSMB/RESTXML/Document/Part.pm
@@ -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;
diff --git a/LedgerSMB/RESTXML/Document/Part_Search.pm b/LedgerSMB/RESTXML/Document/Part_Search.pm
new file mode 100644
index 00000000..927c67c0
--- /dev/null
+++ b/LedgerSMB/RESTXML/Document/Part_Search.pm
@@ -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;
diff --git a/LedgerSMB/RESTXML/Document/SalesOrder.pm b/LedgerSMB/RESTXML/Document/SalesOrder.pm
new file mode 100644
index 00000000..acb4d5aa
--- /dev/null
+++ b/LedgerSMB/RESTXML/Document/SalesOrder.pm
@@ -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;
diff --git a/LedgerSMB/RESTXML/Document/Session.pm b/LedgerSMB/RESTXML/Document/Session.pm
new file mode 100644
index 00000000..1db36502
--- /dev/null
+++ b/LedgerSMB/RESTXML/Document/Session.pm
@@ -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;