summaryrefslogtreecommitdiff
path: root/LedgerSMB/RESTXML/Document
diff options
context:
space:
mode:
Diffstat (limited to 'LedgerSMB/RESTXML/Document')
-rw-r--r--LedgerSMB/RESTXML/Document/Base.pm52
-rw-r--r--LedgerSMB/RESTXML/Document/Customer.pm27
-rw-r--r--LedgerSMB/RESTXML/Document/Customer_Search.pm91
-rw-r--r--LedgerSMB/RESTXML/Document/Part.pm27
-rw-r--r--LedgerSMB/RESTXML/Document/Part_Search.pm89
-rw-r--r--LedgerSMB/RESTXML/Document/SalesOrder.pm11
-rw-r--r--LedgerSMB/RESTXML/Document/Session.pm15
7 files changed, 173 insertions, 139 deletions
diff --git a/LedgerSMB/RESTXML/Document/Base.pm b/LedgerSMB/RESTXML/Document/Base.pm
index e8feaa96..986b4148 100644
--- a/LedgerSMB/RESTXML/Document/Base.pm
+++ b/LedgerSMB/RESTXML/Document/Base.pm
@@ -5,26 +5,27 @@ use XML::Twig;
use LedgerSMB::Log;
use Carp;
-sub handle_post {
- my ($self, $args) = @_;
+sub handle_post {
+ my ( $self, $args ) = @_;
- return $args->{handler}->unsupported('the POST method is not implemented.');
+ 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_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.');
+ my ( $self, $args ) = @_;
+ return $self->{handler}
+ ->unsupported('the DELETE method is not implemented.');
}
sub handle_get {
- my ($self, $args) = @_;
+ my ( $self, $args ) = @_;
- return $self->{handler}->unsupported('the GET method is not implemented.');
+ return $self->{handler}->unsupported('the GET method is not implemented.');
}
=head3 hash_to_twig
@@ -45,18 +46,25 @@ 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 );
+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
index 3a494965..b2e19753 100644
--- a/LedgerSMB/RESTXML/Document/Customer.pm
+++ b/LedgerSMB/RESTXML/Document/Customer.pm
@@ -3,21 +3,22 @@ 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};
-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] );
- 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}));
- }
+ 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
index 7456f9d3..9f2fb3d6 100644
--- a/LedgerSMB/RESTXML/Document/Customer_Search.pm
+++ b/LedgerSMB/RESTXML/Document/Customer_Search.pm
@@ -4,43 +4,58 @@ 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));
+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
index 072f9b80..97394494 100644
--- a/LedgerSMB/RESTXML/Document/Part.pm
+++ b/LedgerSMB/RESTXML/Document/Part.pm
@@ -3,21 +3,22 @@ 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};
-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] );
- 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}));
- }
+ 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
index 927c67c0..9339dcc2 100644
--- a/LedgerSMB/RESTXML/Document/Part_Search.pm
+++ b/LedgerSMB/RESTXML/Document/Part_Search.pm
@@ -4,42 +4,57 @@ 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));
+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
index acb4d5aa..b2f96256 100644
--- a/LedgerSMB/RESTXML/Document/SalesOrder.pm
+++ b/LedgerSMB/RESTXML/Document/SalesOrder.pm
@@ -3,15 +3,12 @@ use strict;
use warnings;
use base qw(LedgerSMB::RESTXML::Document::Base);
+sub handle_get {
+ my ( $self, $args ) = @_;
-
-sub handle_get {
- my ($self, $args) = @_;
-
- print "Content-type: text/html\n\n";
- print "It still works";
+ 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
index 1db36502..ed99b06b 100644
--- a/LedgerSMB/RESTXML/Document/Session.pm
+++ b/LedgerSMB/RESTXML/Document/Session.pm
@@ -16,18 +16,15 @@ use strict;
use warnings;
use base qw(LedgerSMB::RESTXML::Document::Base);
-
-sub handle_get {
- my ($self, $args) = @_;
-
+sub handle_get {
+ my ( $self, $args ) = @_;
}
-sub handle_post {
- my ($self, $args) = @_;
- print "Content-type: text/html\n\nhi";
-
-}
+sub handle_post {
+ my ( $self, $args ) = @_;
+ print "Content-type: text/html\n\nhi";
+}
1;
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-27 01:59:29 +0000