API Change on LedgerSMB->call_procedure to accommodate bytea's, and a…

… test case fix

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

LedgerSMB.pm

@@ -120,7 +120,13 @@ Retrieves a default value for the given key, it is just a wrapper on LedgerSMB::
 
 =item call_procedure( procname => $procname, args => $args )
 
-Function that allows you to call a stored procedure by name and map the appropriate argument to the function values
+Function that allows you to call a stored procedure by name and map the appropriate argument to the function values.
+
+Args is an arrayref.  The members of args can be scalars or arrayrefs in which 
+case they are just bound to the placeholders (arrayref to Pg array conversion
+occurs automatically in DBD::Pg 2.x), or they can be hashrefs of the following
+syntax: {value => $data, type=> $db_type}.  The type field is any SQL type 
+DBD::Pg supports (such as 'PG_BYTEA').
 
 =item dberror()
 
@@ -751,26 +757,30 @@ sub call_procedure {
     }
     $query =~ s/\(\)/($argstr)/;
     my $sth = $self->{dbh}->prepare($query);
-    if (scalar @call_args){
-        $query_rc = $sth->execute(@call_args);
-        if (!$query_rc){
-              if ($args{continue_on_error} and  #  only for plpgsql exceptions
-                              ($self->{dbh}->state =~ /^P/)){
-                    $@ = $self->{dbh}->errstr;
-              } else {
-                    $self->dberror($self->{dbh}->errstr . ": " . $query);
-              }
-        }
-    } else {
-        $query_rc = $sth->execute();
-        if (!$query_rc){
-              if ($args{continue_on_error} and  #  only for plpgsql exceptions
-                              ($self->{dbh}->state =~ /^P/)){
-                    $@ = $self->{dbh}->errstr;
-              } else {
-                    $self->dberror($self->{dbh}->errstr . ": " . $query);
-              }
+    my $place = 1;
+    # API Change here to support byteas:  
+    # If the argument is a hashref, allow it to define it's SQL type
+    # for example PG_BYTEA, and use that to bind.  The API supports the old
+    # syntax (array of scalars and arrayrefs) but extends this so that hashrefs
+    # now have special meaning. I expect this to be somewhat recursive in the
+    # future if hashrefs to complex types are added, but we will have to put 
+    # that off for another day. --CT
+    foreach my $carg (@call_args){
+        if (ref($carg) eq 'HASH'){
+            $sth->bind_param($place, $carg->{value}, $carg->{type}); 
+        } else {
+            $sth->bind_param($place, $carg);
         }
+        ++$place;
+    }
+    $query_rc = $sth->execute();
+    if (!$query_rc){
+          if ($args{continue_on_error} and  #  only for plpgsql exceptions
+                          ($self->{dbh}->state =~ /^P/)){
+                $@ = $self->{dbh}->errstr;
+          } else {
+                $self->dberror($self->{dbh}->errstr . ": " . $query);
+          }
     }
 
     my @types = @{$sth->{TYPE}};

LedgerSMB/File.pm

@@ -315,8 +315,8 @@ sub exec_method{
           $self->dbobject->{dbobject}       = $self->dbobject;
           $self->dbobject->{x_info}         = $self->x_info;
     }
-    $self->dbobject->exec_method($args);
-
+    my @results = $self->dbobject->exec_method($args);
+    return @results;
 }
 
 =item merge(hashref)

LedgerSMB/GL.pm

@@ -50,9 +50,9 @@ sub get_files {
      my ($self, $form, $locale) = @_;
      my $file = LedgerSMB::File->new();
      $file->new_dbobject({base => $form, locale => $locale});
-     @{$self->{files}} = $file->list({ref_key => $self->{id}, file_class => 1});
-     @{$self->{file_links}} = $file->list_links(
-                  {ref_key => $self->{id}, file_class => 1}
+     @{$form->{files}} = $file->list({ref_key => $self->{id}, file_class => 1});
+     @{$form->{file_links}} = $file->list_links(
+                  {ref_key => $form->{id}, file_class => 1}
      );
 
 }

sql/modules/Files.sql

@@ -108,15 +108,17 @@ CREATE TYPE file_list_item AS (
        uploaded_at timestamp,
        id int,
        ref_key int,
-       file_class int
+       file_class int,
+       content bytea
 );
 
 CREATE OR REPLACE FUNCTION file__list_by(in_ref_key int, in_file_class int)
 RETURNS SETOF file_list_item AS
 $$
 
 SELECT m.mime_type, f.file_name, f.description, f.uploaded_by, e.name, 
-       f.uploaded_at, f.id, f.ref_key, f.file_class
+       f.uploaded_at, f.id, f.ref_key, f.file_class, 
+       case when m.mime_type = 'text/x-uri' THEN f.content ELSE NULL END
   FROM mime_type m
   JOIN file_base f ON f.mime_type_id = m.id
   JOIN entity e ON f.uploaded_by = e.id
@@ -137,9 +139,9 @@ $$ language sql;
 COMMENT ON FUNCTION file__get(in_id int, in_file_class int) IS
 $$ Retrieves the file information specified including content.$$;
 
-DROP VIEW IF EXISTS file_links;
-DROP VIEW IF EXISTS file_tx_links;
 DROP VIEW IF EXISTS file_order_links;
+DROP VIEW IF EXISTS file_tx_links;
+DROP VIEW IF EXISTS file_links;
 DELETE FROM file_view_catalog WHERE file_class in (1, 2);
 
 CREATE OR REPLACE view file_tx_links AS

t/62-api.t

@@ -33,7 +33,7 @@ if (defined $ENV{LSMB_TEST_DB}){
 @test_request_data = do { 't/data/62-request-data' } ; # Import test case hashes
 
 for (qw(	drafts.pl     login.pl      payment.pl      
-		report.pl    employee.pl   menu.pl       vendor.pl
+		employee.pl   menu.pl       vendor.pl
 		customer.pl  inventory.pl  vouchers.pl recon.pl menu.pl)
     ){
 	ok(eval { require "scripts/$_" }, "Importing $_");