SF.net SVN: ledger-smb:[3969] trunk/LedgerSMB/SODA.pm

[..hidden..]

Revision: 3969
          http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=3969&view=rev
Author:   einhverfr
Date:     2011-11-09 08:26:24 +0000 (Wed, 09 Nov 2011)
Log Message:
-----------
Added methods to stringify complex types.

Modified Paths:
--------------
    trunk/LedgerSMB/SODA.pm

Modified: trunk/LedgerSMB/SODA.pm
===================================================================
--- trunk/LedgerSMB/SODA.pm	2011-11-08 08:52:20 UTC (rev 3968)
+++ trunk/LedgerSMB/SODA.pm	2011-11-09 08:26:24 UTC (rev 3969)
@@ -199,8 +199,6 @@
 
 my $sql_type_cache = {};
 
-my $type_tree = {};
-
 my $registered_types = {};
 
 sub register_type {
@@ -212,21 +210,7 @@
                                        parse_input => $args{parse_input}, };
 }
 
-# Private method learn_all_types()
-# This is broken off for readability purposes from soda_method below as well.
-# This is only run once per Perl interpreter since it caches its results for
-# future use.
-# 
-# This method queries  the system catalogs for all defined types, and caches the
-# oid's and human readable names.  This is then used when parsing return values.
-#
-# This method sets $sql_type_cache and $type_tree entries.
 
-sub _learn_all_types {
-    my ($self) = @_;
-    #TODO
-}
-
 =item parse_input(class => $string, value => $string)
 This is a hook for parsing data via the database for registered types.
 
@@ -461,10 +445,7 @@
     my $method = $args{method};
 
     my $schema   = $args{schema} || $LedgerSMB::Sysconfig::db_namespace;
-    if (!keys %$sql_type_cache){
-        $self->_learn_all_types;
-    }
-    my @windows = @predef_windows;
+    my @windows  = @predef_windows;
     #Window specs
     my $col_list = "*";
 
@@ -646,6 +627,61 @@
     die "LedgerSMB::SODA $sqlstate";
 };
 
+=item stringify(string $typename, @hashrefs)
+
+Stringify returns an arrayref of strings representing the hashes in the SQL
+complex type identified.
+
+=cut
+
+sub stringify {
+    my ($self) = shift @_;
+    my $typename = shift @_;
+    my @hashes = @_;
+    my $dbh = $self->dbh;
+    my $arglist_str = '';
+    my @arglist;
+
+    if ($sql_type_cache->{$typename}){
+       my @arglist = $sql_type_cache->{$typename};
+       if (..hidden..){
+           delete $sql_type_cache->{$typename};
+           return $self->stringify($typename, @hashes);
+       }
+    } else {
+        my $attquery = "
+            SELECT attname, attnum FROM pg_attribute 
+             WHERE attrelid = (SELECT oid FROM  pg_class WHERE relname = ?)
+        ";
+        my $attsth = $dbh->prepare($attquery);
+        $attsth->execute($typename) || $self->dberror();
+        while (my $attref = $attsth->fetchrow_hashref('NAME_lc')){
+             push @arglist, $attref->{attname};
+        }
+    }
+
+    my $retval = [];
+
+    for my $hash (@hashes) {
+        my $string  = '(';
+        for my $arg (@arglist){
+           $arg =~ s/"/""/; # double up double quotes -- CT
+           if ($arg =~ /\\/){ # Backshash escaping not supported
+               die 'LedgerSMB::SODA Backslash escaping not yet supported'
+           } elsif ($arg =~ /[(),"]/){ # Double quote escaping
+               $arg = '"' . $arg . '"';  
+           } elsif ($arg eq '' and defined $arg){
+               $arg = '""';
+           }
+           $string .= "$arg,";
+        }
+        $string =~ s/,$/\)/;
+        push @$retval, $string;
+    }
+
+    return $retval;
+}
+
 =back
 
 =head1 ENVIRONMENT VARIABLES

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