Correcting problem in DBObject.pm constructor

Correcting method->procedure mappings for DBD::Pg 2.0 and above.

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

4 files changed, 16 insertions, 18 deletions

diff --git a/LedgerSMB.pm b/LedgerSMB.pm
index 7c9e9644..ce279466 100755
--- a/LedgerSMB.pm
+++ b/LedgerSMB.pm
@@ -197,11 +197,12 @@ sub new {
     if (!$self->{script}) {
         $self->{script} = 'login.pl';
     }
-    if ($self->{action} eq 'migrate_user'){
-        return $self;
-    }
+#    if ($self->{action} eq 'migrate_user'){
+#        return $self;
+#    }
     if ($self->{script} eq 'login.pl' &&
-        ($self->{action} eq 'authenticate' || !$self->{action})){
+        ($self->{action} eq 'authenticate'  || $self->{action} eq '__default' 
+		|| !$self->{action})){
         return $self;
     }
     if (!$self->{company} && $self->is_run_mode('cgi', 'mod_perl')){
diff --git a/LedgerSMB/DBObject.pm b/LedgerSMB/DBObject.pm
index 94a26bb3..07b2b0a6 100644
--- a/LedgerSMB/DBObject.pm
+++ b/LedgerSMB/DBObject.pm
@@ -65,7 +65,7 @@ sub new {
         $self->error('Mergelist not set');
     }
     else {
-        @mergelist = [];
+        @mergelist = ();
     }
     if ( !$base->isa('LedgerSMB') ) {
         $self->error("Constructor called without LedgerSMB object arg");
@@ -122,19 +122,16 @@ sub exec_method {
     
     my $args = $ref->{proargnames};
     my @proc_args;
-    $ref->{pronargs} = 0 unless defined $ref->{pronargs};
-    if ($ref->{pronargs}){
-        $args =~ s/\{(.*)\}/$1/;
-        @proc_args = split /,/, $args if $args;
-    }
-    
+
     if ( !$ref->{proname} ) {    # no such function
      
         $self->error( "No such function:  $funcname");
 #        die;
     }
-    
-    if ($args) {
+    $ref->{pronargs} = 0 unless defined $ref->{pronargs};
+
+    @proc_args = $self->_parse_array($args);    
+    if (@proc_args) {
         for my $arg (@proc_args) {
             if ( $arg =~ s/^in_// ) {
                  push @call_args, $self->{$arg};
@@ -249,14 +246,14 @@ sub run_custom_queries {
 sub _parse_array {
     my ($self, $value) = @_;
     return @$value if ref $value eq 'ARRAY';
-
+    return if !defined $value;
     my $next;
     my $separator;
     my @return_array;
 
     while ($value ne '{}') {
-        my $next = "";
-        my $separator = "";
+        $next = "";
+        $separator = "";
         if ($value =~ /^\{"/){
             while ($next eq "" or ($next =~ /\\".$/)){
                 $value =~ s/^\{("[^"]*".)/\{/;
diff --git a/LedgerSMB/Template.pm b/LedgerSMB/Template.pm
index 35602cb4..3a92e1c2 100755
--- a/LedgerSMB/Template.pm
+++ b/LedgerSMB/Template.pm
@@ -235,6 +235,7 @@ sub render {
 		throw Error::Simple "Invalid format";
 	}
 	my $format = "LedgerSMB::Template::$self->{format}";
+
 #	if ($self->{myconfig}){
 #	        $self->_preprocess($vars);
 #	}
diff --git a/lsmb-request.pl b/lsmb-request.pl
index a0de6115..851d66b8 100644
--- a/lsmb-request.pl
+++ b/lsmb-request.pl
@@ -49,10 +49,9 @@ if (!$script){
 &call_script( $script, $request );
 
 sub call_script {
-    
+        
     my $script = shift @_;
     my $request = shift @_;
-
     eval { require "scripts/$script" } 
       || $request->error($locale->text('Unable to open script') . ": scripts/$script : $!");
     $script =~ s/\.pl$//;