From a56fe253c96abdff7d9909a3cca3c1d0a6a8e3d2 Mon Sep 17 00:00:00 2001
From: jasonjayr <jasonjayr@4979c152-3d1c-0410-bac9-87ea11338e46>
Date: Thu, 4 Jan 2007 02:43:30 +0000
Subject: 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
---
LedgerSMB/RESTXML/Document/Base.pm | 63 +++++++++++++++++++++++++++
LedgerSMB/RESTXML/Document/Customer.pm | 23 ++++++++++
LedgerSMB/RESTXML/Document/Customer_Search.pm | 46 +++++++++++++++++++
LedgerSMB/RESTXML/Document/Part.pm | 23 ++++++++++
LedgerSMB/RESTXML/Document/Part_Search.pm | 45 +++++++++++++++++++
LedgerSMB/RESTXML/Document/SalesOrder.pm | 17 ++++++++
LedgerSMB/RESTXML/Document/Session.pm | 33 ++++++++++++++
7 files changed, 250 insertions(+)
create mode 100644 LedgerSMB/RESTXML/Document/Base.pm
create mode 100644 LedgerSMB/RESTXML/Document/Customer.pm
create mode 100644 LedgerSMB/RESTXML/Document/Customer_Search.pm
create mode 100644 LedgerSMB/RESTXML/Document/Part.pm
create mode 100644 LedgerSMB/RESTXML/Document/Part_Search.pm
create mode 100644 LedgerSMB/RESTXML/Document/SalesOrder.pm
create mode 100644 LedgerSMB/RESTXML/Document/Session.pm
(limited to 'LedgerSMB/RESTXML/Document')
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;
--
cgit v1.2.3