[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

SF.net SVN: ledger-smb:[4501] trunk/LedgerSMB/DBObject_Moose.pm



Revision: 4501
          http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=4501&view=rev
Author:   einhverfr
Date:     2012-03-17 03:50:51 +0000 (Sat, 17 Mar 2012)
Log Message:
-----------
Consolidated code so as to support old DBObject API and new DBObject_Moose api.  The latter is better for more mature code, and the other better at present for less mature code.

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

Modified: trunk/LedgerSMB/DBObject_Moose.pm
===================================================================
--- trunk/LedgerSMB/DBObject_Moose.pm	2012-03-17 03:14:43 UTC (rev 4500)
+++ trunk/LedgerSMB/DBObject_Moose.pm	2012-03-17 03:50:51 UTC (rev 4501)
@@ -35,9 +35,6 @@
 the operation will not raise an exception in the event of a database error, and 
 it will be up to the application to handle any exceptions.
 
-=item __validate__ is called on every new() invocation.  It is blank in this 
-module but can be overridden in decendant modules.
-
 =item _db_array_scalars(@elements) creates a db array from scalars.
 
 =item _db_array_literal(@elements) creates a multiple dimension db array from 
@@ -46,10 +43,16 @@
 =cut
 
 package LedgerSMB::DBObject_Moose;
+use LedgerSMB::DBObject;
 use Moose;
 use Scalar::Util;
 use Log::Log4perl;
+use LedgerSMB::DBObject;
 
+my $logger = Log::Log4perl->get_logger('LedgerSMB::DBObject');
+
+sub __validate__ {}
+
 has 'dbh' => (is => 'ro', isa => 'DBI::db', required => '1');
 has '_roles' => (is => 'ro', isa => 'ArrayRef[Str]', required => '1');
 has '_user' => (is => 'ro', isa => 'LedgerSMB::User', required => '1');
@@ -66,112 +69,26 @@
     }
 }
 
+# _to_dbobject 
+#Private method used to convert to db object for purposes of 
+#
+sub _to_dbobject {
+     my $self   = shift @_;
+    return LedgerSMB::DBObject->new({base => $self});
+}
 
-my $logger = Log::Log4perl->get_logger('LedgerSMB::DBObject');
-
-sub __validate__ {}
-
 =item set_ordering
 
 Sets the ordering used by default for specific functions called by exec_method
 
 =cut
 
-sub set_ordering {
-    my ($self, $args) = @_;
-    $self->{_order_method}->{$args->{method}} = 
-		$self->{dbh}->quote_identifier($args->{column});
-}
-
 sub exec_method {
     my $self   = shift @_;
-    my %args  = (ref($_[0]) eq 'HASH')? %{$_[0]}: @_;
-    my $funcname = $args{funcname};
-    
-    my $schema   = $args{schema} || $LedgerSMB::Sysconfig::db_namespace;
-    
-    $logger->debug("exec_method: \$funcname = $funcname");
-    my @in_args;
-    @in_args = @{ $args{args} } if $args{args};
-    
-    my @call_args;
-     
-    my $query = "
-	SELECT proname, pronargs, proargnames FROM pg_proc 
-	 WHERE proname = ? 
-	       AND pronamespace = 
-	       coalesce((SELECT oid FROM pg_namespace WHERE nspname = ?), 
-	                pronamespace)
-    ";
-    my $sth   = $self->{dbh}->prepare(
-		$query
-    );
-    $sth->execute($funcname, $schema) 
-	|| $self->error($DBI::errstr . "in exec_method");
-    my $ref;
-
-    $ref = $sth->fetchrow_hashref('NAME_lc');
-    
-    my $pargs = $ref->{proargnames};
-    my @proc_args;
-
-    if ( !$ref->{proname} ) {    # no such function
-        # If the function doesn't exist, $funcname gets zeroed?
-        $self->error( "No such function:  $funcname");
-#        die;
-    }
-    $ref->{pronargs} = 0 unless defined $ref->{pronargs};
-    # If the user provided args..
-    if (!defined $args{args}) {
-        @proc_args = $self->_parse_array($pargs);
-        if (@proc_args) {
-            for my $arg (@proc_args) {
-                #print STDERR "User Provided Args: $arg\n";
-                if ( $arg =~ s/^in_// ) {
-                     if ( defined $self->{$arg} )
-                     {
-                        $logger->debug("exec_method pushing $arg = $self->{$arg}");
-                     }
-                     else
-                     {
-                        $logger->debug("exec_method pushing \$arg defined $arg | \$self->{\$arg} is undefined");
-                        #$self->{$arg} = undef; # Why was this being unset? --CT
-                     }
-                     push ( @call_args, $self->{$arg} );
-                }
-            }
-        }
-        for (@in_args) { push @call_args, $_ } ;
-        $self->{call_args} = ..hidden..;
-        $logger->debug("exec_method: \$self = " . Data::Dumper::Dumper($self));
-        for my $arg(@call_args){
-            if (defined $arg && eval {$arg->can('to_db')}){
-               $arg = $arg->to_db;
-            }
-        }
-           
-        return $self->call_procedure( procname => $funcname, 
-                                          args => ..hidden.., 
-                                      order_by => $self->{_order_method}->{"$funcname"}, 
-                                         schema=>$schema,
-                             continue_on_error => $args{continue_on_error});
-    }
-    else {
-        for my $arg(@in_args){
-            if (eval {$arg->can('to_db')}){
-               $arg = $arg->to_db;
-            }
-        }
-           
-        return $self->call_procedure( procname => $funcname, 
-                                          args => ..hidden.., 
-                                      order_by => $self->{_order_method}->{"$funcname"}, 
-                                         schema=>$schema,
-                             continue_on_error => $args{continue_on_error});
-    }
+    my $dbo = $self->_to_dbobject;
+    return $dbo->exec_method(@_);
 }
 
-
 =item run_custom_queries
 
 Backward-compatible with 1.2 custom query system for moving forward.
@@ -179,281 +96,24 @@
 =cut
 
 sub run_custom_queries {
-    my ( $self, $tablename, $query_type, $linenum ) = @_;
-    my $dbh = $self->{dbh};
-    if ( $query_type !~ /^(select|insert|update)$/i ) {
-
-        # Commenting out this next bit until we figure out how the locale object
-        # will operate.  Chris
-        #$self->error($locale->text(
-        #	"Passed incorrect query type to run_custom_queries."
-        #));
-    }
-    my @rc;
-    my %temphash;
-    my @templist;
-    my $did_insert;
-    my @elements;
-    my $query;
-    my $ins_values;
-
-    if ($linenum) {
-        $linenum = "_$linenum";
-    }
-
-    $query_type = uc($query_type);
-    for ( @{ $self->{custom_db_fields}{$tablename} } ) {
-        @elements = split( /:/, $_ );
-        push @{ $temphash{ $elements[0] } }, $elements[1];
-    }
-    for ( keys %temphash ) {
-        my @data;
-        $query = "$query_type ";
-        if ( $query_type eq 'UPDATE' ) {
-            $query = "DELETE FROM $_ WHERE row_id = ?";
-            my $sth = $dbh->prepare($query);
-            $sth->execute( $self->{ "id" . "$linenum" } )
-              || $self->dberror($query);
-        }
-        elsif ( $query_type eq 'INSERT' ) {
-            $query .= " INTO $_ (";
-        }
-        my $first = 1;
-        for ( @{ $temphash{$_} } ) {
-            $query .= "$_";
-            if ( $query_type eq 'UPDATE' ) {
-                $query .= '= ?';
-            }
-            $ins_values .= "?, ";
-            $query      .= ", ";
-            $first = 0;
-            if ( $query_type eq 'UPDATE' or $query_type eq 'INSERT' ) {
-                push @data, $self->{"$_$linenum"};
-            }
-        }
-        if ( $query_type ne 'INSERT' ) {
-            $query =~ s/, $//;
-        }
-        if ( $query_type eq 'SELECT' ) {
-            $query .= " FROM $_";
-        }
-        if ( $query_type eq 'SELECT' or $query_type eq 'UPDATE' ) {
-            $query .= " WHERE row_id = ?";
-        }
-        if ( $query_type eq 'INSERT' ) {
-            $query .= " row_id) VALUES ($ins_values ?)";
-        }
-        if ( $query_type eq 'SELECT' ) {
-            push @rc, [$query];
-        }
-        else {
-            unshift( @data, $query );
-            push @rc, ..hidden..;
-        }
-    }
-    if ( $query_type eq 'INSERT' ) {
-        for (@rc) {
-            $query = shift( @{$_} );
-            my $sth = $dbh->prepare($query)
-              || $self->db_error($query);
-            $sth->execute( @{$_}, $self->{id} )
-              || $self->dberror($query);
-            $sth->finish;
-            $did_insert = 1;
-        }
-    }
-    elsif ( $query_type eq 'UPDATE' ) {
-        @rc = $self->run_custom_queries( $tablename, 'INSERT', $linenum );
-    }
-    elsif ( $query_type eq 'SELECT' ) {
-        for (@rc) {
-            $query = shift @{$_};
-            my $sth = $self->{dbh}->prepare($query);
-            $sth->execute( $self->{id} );
-            my $ref = $sth->fetchrow_hashref('NAME_lc');
-            $self->merge( $ref, keys(%$ref) );
-        }
-    }
-    return @rc;
+    my $self   = shift @_;
+    my $dbo = $self->_to_dbobject;
+    return $dbo->run_custom_queries(@_);
 }
 
-sub _parse_array {
-    my ($self, $value) = @_;
-    return @$value if ref $value eq 'ARRAY';
-    return if !defined $value;
-    # No longer needed since we require DBD::Pg 2.x 
-}
-
-sub _db_array_scalars {
-    my $self = shift @_;
-    my @args = @_;
-    return ..hidden..; 
-    # No longer needed since we require DBD::Pg 2.x
-}
-
-sub _db_array_literal {
-    my $self = shift @_;
-    my @args = @_;
-    return ..hidden..;
-    # No longer needed since we require DBD::Pg 2.x
-}
-
 sub call_procedure {
-    my $self     = shift @_;
-    my %args     = @_;
-    my $procname = $args{procname};
-    my $schema   = $args{schema};
-    my @call_args;
-    @call_args = @{ $args{args} } if defined $args{args};
-    my $order_by = $args{order_by};
-    my $query_rc;
-    my $argstr   = "";
-    my @results;
-
-    if (!defined $procname){
-        $self->error('Undefined function in call_procedure.');
-    }
-    $procname = $self->{dbh}->quote_identifier($procname);
-    # Add the test for whether the schema is something useful.
-    $logger->trace("\$procname=$procname");
-    
-    $schema = $schema || $LedgerSMB::Sysconfig::db_namespace;
-    
-    $schema = $self->{dbh}->quote_identifier($schema);
-    
-    for ( 1 .. scalar @call_args ) {
-        $argstr .= "?, ";
-    }
-    $argstr =~ s/\, $//;
-    my $query = "SELECT * FROM $schema.$procname()";
-    if ($order_by){
-        $query .= " ORDER BY $order_by";
-    }
-    $query =~ s/\(\)/($argstr)/;
-    my $sth = $self->{dbh}->prepare($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}, 
-                       { pg_type => $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}};
-    my @names = @{$sth->{NAME_lc}};
-    while ( my $ref = $sth->fetchrow_hashref('NAME_lc') ) {
-	for (0 .. $#names){
-            #   numeric            float4/real
-            if ($types[$_] == 3 or $types[$_] == 2) {
-                $ref->{$names[$_]} = LedgerSMB::PGNumber->from_db($ref->{$names[$_]});
-            }
-            #    DATE 
-            elsif ($types[$_] == 91){
-                $ref->{$names[$_]} = LedgerSMB::PGDate->from_db($ref->{$names[$_]}, 'date');
-            }
-            # TIMESTAMP
-            elsif ($types[$_] == 11){
-                $ref->{$names[$_]} = LedgerSMB::PGDate->from_db($ref->{$names[$_]}, 'datetime');
-            }
-        }
-        push @results, $ref;
-    }
-    return @results;
+    my $self   = shift @_; 
+    my $dbo = $self->_to_dbobject;
+    return $dbo->call_procedure(@_);
 }
 
 # Keeping this here due to common requirements
 sub is_allowed_role {
-    my ($self, $args) = @_;
-    my @roles = @{$args->{allowed_roles}};
-    for my $role (@roles){
-        $self->{_role_prefix} = "lsmb_$self->{company}__" unless defined $self->{_role_prefix};
-        my @roleset = grep m/^$self->{_role_prefix}$role$/, @{$self->{_roles}};
-        if (scalar @roleset){
-            return 1;
-        }
-    }
-    return 0; 
+    my $self   = shift @_;
+    my $dbo = $self->_to_dbobject;
+    return $dbo->is_allowed_role(@_);
 }
 
-# To be replaced with a generic interface to an Error class
-sub error {
-
-    my ( $self, $msg ) = @_;
-
-    if ( $ENV{GATEWAY_INTERFACE} ) {
-
-        $self->{msg}    = $msg;
-        $self->{format} = "html";
-
-        delete $self->{pre};
-
-        
-        print qq|Content-Type: text/html; charset=utf-8\n\n|;
-        print "<head></head>";
-        $self->{msg} =~ s/\n/<br \/>\n/;
-        print
-          qq|<body><h2 class="error">Error!</h2> <p><b>$self->{msg}</b></body>|;
-
-        exit;
-
-    }
-    else {
-
-        if ( $ENV{error_function} ) {
-            &{ $ENV{error_function} }($msg);
-        }
-        die "Error: $msg\n";
-    }
-}
-# Database routines used throughout
-sub dberror{
-   my $self = shift @_;
-   my $state_error = {};
-   if ($self->{_locale}){
-       my $state_error = {
-            '42883' => $self->{_locale}->text('Internal Database Error'),
-            '42501' => $self->{_locale}->text('Access Denied'),
-            '42401' => $self->{_locale}->text('Access Denied'),
-            '22008' => $self->{_locale}->text('Invalid date/time entered'),
-            '22012' => $self->{_locale}->text('Division by 0 error'),
-            '22004' => $self->{_locale}->text('Required input not provided'),
-            '23502' => $self->{_locale}->text('Required input not provided'),
-            '23505' => $self->{_locale}->text('Conflict with Existing Data'),
-            'P0001' => $self->{_locale}->text('Error from Function:') . "\n" .
-                    $self->{dbh}->errstr,
-       };
-   }
-   $logger->error("Logging SQL State ".$self->{dbh}->state.", error ".
-           $self->{dbh}->err . ", string " .$self->{dbh}->errstr);
-   if (defined $state_error->{$self->{dbh}->state}){
-       $self->error($state_error->{$self->{dbh}->state}
-           . "\n" . 
-          $self->{_locale}->text('More information has been reported in the error logs'));
-       $self->{dbh}->rollback;
-       exit;
-   }
-   $self->error($self->{dbh}->state . ":" . $self->{dbh}->errstr);
-}
-
 __PACKAGE__->meta->make_immutable;
 
 1;

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