SF.net SVN: ledger-smb:[4974] trunk

[..hidden..]

Revision: 4974
          http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=4974&view=rev
Author:   einhverfr
Date:     2012-07-13 07:09:40 +0000 (Fri, 13 Jul 2012)
Log Message:
-----------
Initial changes for web services for retrieving specified entity.

Modified Paths:
--------------
    trunk/LedgerSMB/DBObject/Entity.pm
    trunk/LedgerSMB/DBObject/User.pm
    trunk/LedgerSMB/REST_Class/Contact.pm
    trunk/LedgerSMB/REST_Format/json.pm
    trunk/LedgerSMB/REST_Format/xml.pm
    trunk/rest-handler.pl
    trunk/sql/modules/Entity.sql

Modified: trunk/LedgerSMB/DBObject/Entity.pm
===================================================================
--- trunk/LedgerSMB/DBObject/Entity.pm	2012-07-13 06:53:21 UTC (rev 4973)
+++ trunk/LedgerSMB/DBObject/Entity.pm	2012-07-13 07:09:40 UTC (rev 4974)
@@ -85,6 +85,25 @@
 
 has 'entity_class' => (is => 'rw', isa => 'Int');
 
+=head1 METHODS
+
+=over
+
+=item get($id)
+
+Returns an entity by id
+
+=cut
+
+sub get{
+    my ($id) = @_;
+    my @results =  __PACKAGE__->call_procedure(procname => 'entity__get', 
+                                                   args => [$id]);
+    return shift @results;
+}
+
+=back
+
 =head1 COPYRIGHT
 
 Copyright (C) 2012 The LedgerSMB Core Team.  This file may be reused under the

Modified: trunk/LedgerSMB/DBObject/User.pm
===================================================================
--- trunk/LedgerSMB/DBObject/User.pm	2012-07-13 06:53:21 UTC (rev 4973)
+++ trunk/LedgerSMB/DBObject/User.pm	2012-07-13 07:09:40 UTC (rev 4974)
@@ -187,7 +187,7 @@
         );
     $self->{employee} = $emp;
     my ($ent) = $self->exec_method( 
-        funcname=>'entity__get_entity',
+        funcname=>'entity__get',
         args=>[ $self->{user}->{entity_id} ] 
         );
     $self->{entity} = $ent;

Modified: trunk/LedgerSMB/REST_Class/Contact.pm
===================================================================
--- trunk/LedgerSMB/REST_Class/Contact.pm	2012-07-13 06:53:21 UTC (rev 4973)
+++ trunk/LedgerSMB/REST_Class/Contact.pm	2012-07-13 07:09:40 UTC (rev 4974)
@@ -2,6 +2,17 @@
 
 LedgerSMB::REST_Class::Contact - Customer/vendor web servicesA
 
+=cut
+
+package LedgerSMB::REST_Class::Contact;
+use LedgerSMB::DBObject::Entity;
+use LedgerSMB::DBObject::Entity::Credit_Acount;
+use LedgerSMB::DBObject::Entity::Location;
+use LedgerSMB::DBObject::Entity::Contact;
+use LedgerSMB::DBObject::Entity::Company;
+use LedgerSMB::DBObject::Entity::Person;
+use LedgerSMB::DBObject::Entity::Bank;
+
 =head1 SYNOPSIS
 
  my $obj = LedgerSMB::REST_Class::Contact->new(%$payload);
@@ -17,19 +28,55 @@
 
 =over
 
-=item GET
+=item get
 
 Searches or retrieves one or more records.
 
-=item POST
+=cut 
 
+my $cname = 'LedgerSMB::REST_Class::contact';
+
+sub get {
+    my ($request) = @_;
+    my $id = $request->{$cname};
+    my $data;
+    if ($id){
+       my $company = LedgerSMB::DBObject::Entity::Company->get($id);
+       if ($company){
+          $data= $company;
+          $data->{entity_type} = 'Company';
+       } else {
+          my $person = LedgerSMB::DBObject::Entity::Person->get($id);
+          if ($person){
+             $data= $person;
+             $data->{entity_type} = 'Person';
+          } else {
+             die '404  Not Found';
+          }
+       }
+       @{$data->{credit_accounts}} = 
+          LedgerSMB::DBObject::Entity::Credit_Account->list_for_entity($id);
+       @{$data->{locations}} = 
+         LedgerSMB::DBObject::Entity::Location->get_active({entity_id => $id});
+       @{$data->{contact}} =
+         LedgerSMB::DBObject::Entity::Contact->list({{entity_id => $id}});
+       @{$data->{bank_accounts}} = 
+         LedgerSMB::DBObject::Entity::Bank-> list($id);
+       return $data;
+    } else {
+       ...
+    }
+}
+
+=item post
+
 Determines of record exists and if not creates it.  If so, throws a 400 error
 
-=item PUT
+=item put
 
 Saves record, overwriting any record that was there before.
 
-=item DELETE not implemented.
+=item delete not implemented.
 
 =back
 

Modified: trunk/LedgerSMB/REST_Format/json.pm
===================================================================
--- trunk/LedgerSMB/REST_Format/json.pm	2012-07-13 06:53:21 UTC (rev 4973)
+++ trunk/LedgerSMB/REST_Format/json.pm	2012-07-13 07:09:40 UTC (rev 4974)
@@ -31,7 +31,8 @@
 
 sub to_output{
     my $request = shift @_; 
-    return encode_json($request->{payload}, { pretty => 1, indent => 2 };
+    my $output = shift @_;
+    return encode_json($output, { pretty => 1, indent => 2 };
 }
 
 1;

Modified: trunk/LedgerSMB/REST_Format/xml.pm
===================================================================
--- trunk/LedgerSMB/REST_Format/xml.pm	2012-07-13 06:53:21 UTC (rev 4973)
+++ trunk/LedgerSMB/REST_Format/xml.pm	2012-07-13 07:09:40 UTC (rev 4974)
@@ -30,7 +30,8 @@
 
 sub to_output{
     my $request = shift @_; 
-    return XMLout($request->{payload}, RootName => $request->{class_name},
+    my $output = shift @_;
+    return XMLout($output, RootName => $request->{class_name},
            ContentKey => 'text');
 }
 

Modified: trunk/rest-handler.pl
===================================================================
--- trunk/rest-handler.pl	2012-07-13 06:53:21 UTC (rev 4973)
+++ trunk/rest-handler.pl	2012-07-13 07:09:40 UTC (rev 4974)
@@ -154,6 +154,8 @@
     my $request = get_request_properties();
 
     my $format = lc($request->{format});
+    my $return_info;
+
     if (! eval "require LedgerSMB::REST_Format::" . $format) {
        eval "require LedgerSMB::REST_Format::" . $format;
     }
@@ -191,7 +193,7 @@
     } else {
 
         if ($classpkg->can(lc($request->{method}))){
-            $classpkg->can(lc($request->{method}))->($request);
+            $return_info = $classpkg->can(lc($request->{method}))->($request);
         } else {
             die '405 Method Not Allowed';
         }
@@ -200,9 +202,9 @@
 
     my $content;
     my $ctype;
-    if ($request->{payload}){
+    if ($return_info){
         if ($fmtpackage->can('to_output')){
-            $content = $fmtpackage->can('to_output')->($request);
+            $content = $fmtpackage->can('to_output')->($request, $return_info);
         } else {
             return error_handler('415 Unsupported Media Type');
         }
@@ -271,15 +273,14 @@
     }
 
     $request->{classes} = {};
-    $request->{class_name} = '';
-    while (1) {
-        my $class = shift $components;
-        my $id = shift $components;
+    $request->{class_name} = 'LedgerSMB::REST_Class';
+    while (@$components) {
+        my $class = shift @$components;
+        my $id = shift @$components;
         $id = undef if $id = 'all';
         $request->{class_name} .= "::$class";
-        $request->{classes}->{$class} = $id;
+        $request->{classes}->{$request->{class_name}} = $id;
     }
-    $request->{class_name} =~ s/^:://;
     
     return $request;
 }

Modified: trunk/sql/modules/Entity.sql
===================================================================
--- trunk/sql/modules/Entity.sql	2012-07-13 06:53:21 UTC (rev 4973)
+++ trunk/sql/modules/Entity.sql	2012-07-13 07:09:40 UTC (rev 4974)
@@ -72,7 +72,7 @@
 COMMENT ON FUNCTION entity__list_classes () IS
 $$ Returns a list of entity classes, ordered by assigned ids$$;
 
-CREATE OR REPLACE FUNCTION entity__get_entity (
+CREATE OR REPLACE FUNCTION entity__get (
     in_entity_id int
 ) RETURNS setof entity AS $$
 
@@ -90,7 +90,7 @@
 
 $$ language plpgsql;
 
-COMMENT ON FUNCTION entity__get_entity (
+COMMENT ON FUNCTION entity__get (
     in_entity_id int
 ) IS
 $$ Returns a set of (only one) entity record with the entity id.$$;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.