diff options
-rwxr-xr-x | LedgerSMB.pm | 8 | ||||
-rw-r--r-- | LedgerSMB/Batch.pm | 7 | ||||
-rw-r--r-- | LedgerSMB/DBObject.pm | 2 | ||||
-rw-r--r-- | LedgerSMB/GL.pm | 7 | ||||
-rwxr-xr-x | LedgerSMB/Session/DB.pm | 2 | ||||
-rw-r--r-- | UI/create_batch.html | 2 | ||||
-rw-r--r-- | common.pl | 2 | ||||
-rw-r--r-- | scripts/vouchers.pl | 37 | ||||
-rw-r--r-- | sql/modules/Voucher.sql | 29 |
9 files changed, 74 insertions, 22 deletions
diff --git a/LedgerSMB.pm b/LedgerSMB.pm index f0e11c11..9ca12b2f 100755 --- a/LedgerSMB.pm +++ b/LedgerSMB.pm @@ -688,7 +688,7 @@ sub _db_init { $sth->execute; my ($dbversion) = $sth->fetchrow_array; if ($dbversion ne $self->{dbversion}){ - $self->error("Database is not the expected version."); + $self->error("Database is not the expected version. Was $dbversion, expected $self->{dbversion}"); } @@ -710,6 +710,12 @@ sub _db_init { } } +# Deprecated, only here for old code +sub dberror{ + my $self = shift @_; + $self->error(@_); +} + sub redo_rows { my $self = shift @_; diff --git a/LedgerSMB/Batch.pm b/LedgerSMB/Batch.pm index 7c7bcc53..1e6b320e 100644 --- a/LedgerSMB/Batch.pm +++ b/LedgerSMB/Batch.pm @@ -3,4 +3,11 @@ package LedgerSMB::Batch; use base qw(LedgerSMB::DBObject); +sub create { + $self = shift @_; + my ($ref) = $self->exec_method(funcname => 'batch_create'); + $self->{id} = $ref->{id} + return $ref->{id}; +} + 1; diff --git a/LedgerSMB/DBObject.pm b/LedgerSMB/DBObject.pm index f52724c7..93fc4f6e 100644 --- a/LedgerSMB/DBObject.pm +++ b/LedgerSMB/DBObject.pm @@ -107,7 +107,7 @@ sub exec_method { my $query = "SELECT proname, pronargs, proargnames FROM pg_proc WHERE proname = ?"; my $sth = $self->{dbh}->prepare($query); - $sth->execute($funcname); + $sth->execute($funcname) || $self->error($DBI::errstr . "in exec_method"); my $ref; $ref = $sth->fetchrow_hashref('NAME_lc'); diff --git a/LedgerSMB/GL.pm b/LedgerSMB/GL.pm index 502bb0e9..834bf8f0 100644 --- a/LedgerSMB/GL.pm +++ b/LedgerSMB/GL.pm @@ -101,12 +101,11 @@ sub post_transaction { $uid .= "$$"; $query = qq| - INSERT INTO gl (reference, employee_id) - VALUES ('$uid', (SELECT id FROM employee - WHERE login = ?))|; + INSERT INTO gl (reference) + VALUES ('$uid')|; $sth = $dbh->prepare($query); - $sth->execute( $form->{login} ) || $form->dberror($query); + $sth->execute() || $form->dberror($query); $query = qq| SELECT id diff --git a/LedgerSMB/Session/DB.pm b/LedgerSMB/Session/DB.pm index bfc0b9fc..19896ae7 100755 --- a/LedgerSMB/Session/DB.pm +++ b/LedgerSMB/Session/DB.pm @@ -182,7 +182,7 @@ sub session_create { } $deleteExisting->execute( $login) || $lsmb->dberror( - __FILE__ . ':' . __LINE__ . ': Delete from session: ' ); + __FILE__ . ':' . __LINE__ . ': Delete from session: ' . $DBI::errstr); #doing the random stuff in the db so that LedgerSMB won't #require a good random generator - maybe this should be reviewed, diff --git a/UI/create_batch.html b/UI/create_batch.html index da71ca26..4b507f17 100644 --- a/UI/create_batch.html +++ b/UI/create_batch.html @@ -41,7 +41,7 @@ </div> </div> <div id="buttons"> -<button value="create_batch" type="submit" class="submit"> +<button value="create_vouchers" type="submit" class="submit" name="action"> <?lsmb text('Continue') ?></button> </div> <?lsmb FOREACH item = hidden ?> @@ -57,7 +57,7 @@ sub redirect { $form->{script} = $script; if ( !$myconfig ) { # needed for login - %myconfig = %{ LedgerSMB::User->fetch_config( $form->{login} ) }; + %myconfig = %{ LedgerSMB::User->fetch_config( $form ) }; } if ( !$form->{dbh} and ( $script ne 'admin.pl' ) ) { $form->db_init( \%myconfig ); diff --git a/scripts/vouchers.pl b/scripts/vouchers.pl index 34305139..7e131bc2 100644 --- a/scripts/vouchers.pl +++ b/scripts/vouchers.pl @@ -16,7 +16,7 @@ use strict; sub create_batch { my ($request) = @_; $request->{hidden} = [ - batch_type => $request->{batch_type}, + {name => "batch_type", value => $request->{batch_type}}, ]; my $template = LedgerSMB::Template->new( user =>$request->{_user}, @@ -33,15 +33,40 @@ sub create_vouchers { # This is because these scripts import all functions into the *current* # namespace. People using fastcgi and modperl should *not* cache this # module at the moment. -- CT - my %vouchers_dispatch = ( + my ($request) = shift @_; + use LedgerSMB::Form; + + my $batch = LedgerSMB::Batch->new({base => $request}); + $batch->create; + + my $vouchers_dispatch = + { payable => {script => 'bin/ap.pl', function => sub {add()}}, receivable => {script => 'bin/ar.pl', function => sub {add()}}, payments => {script => 'bin/cp.pl', function => sub {payments()}}, receipts => {script => 'bin/cp.pl', function => sub {receipts()}}, - gl => {script => 'bin/gl.pl'. function => sub {add()}}, - ) - require $vouchers_dispatch{$request->{batch_type}}{script} - $vouchers_dispatch{$request->{batch_type}}{function}(); + gl => {script => 'bin/gl.pl', function => sub {add()}}, + }; + + # Note that the line below is generally considered incredibly bad form. + # However, the code we are including is going to require it for now. + no strict; + our $form = new Form; + our $locale = $request->{_locale}; + for (keys %$request){ + $form->{$_} = $request->{$_}; + } + + $form->{approved} = 0; + $form->{transdate} = $request->{batch_date}; + print STDERR "$request->{batch_type}\n"; + require $vouchers_dispatch->{$request->{batch_type}}{script}; + + my $script = $vouchers_dispatch->{$request->{batch_type}}{script}; + $script =~ s|.*/||; + $form->{script} = $script; + +\ $vouchers_dispatch->{$request->{batch_type}}{function}(); } sub list_vouchers { diff --git a/sql/modules/Voucher.sql b/sql/modules/Voucher.sql index 6ed8fa7d..d626595f 100644 --- a/sql/modules/Voucher.sql +++ b/sql/modules/Voucher.sql @@ -193,7 +193,7 @@ RETURNS BOOL AS $$ DECLARE control_amount NUMERIC; - voucher vouchers%ROWTYPE; + voucher voucher%ROWTYPE; incriment NUMERIC; BEGIN -- CHECK CONTROL NUMBERS @@ -204,7 +204,7 @@ BEGIN SELECT id FROM gl WHERE coalesce(approved, false) != true) AND trans_id IN ( - SELECT transaction_id FROM vouchers + SELECT transaction_id FROM voucher WHERE batch_id = ANY (in_batch_id)) AND coalesce(approved, false) != true AND amount > 0 @@ -214,7 +214,7 @@ BEGIN SELECT sum(ac.amount) INTO control_amount FROM acc_trans ac - JOIN vouchers v ON (v.transaction_id = ac.trans_id) + JOIN voucher v ON (v.transaction_id = ac.trans_id) WHERE v.batch_id = ANY (in_batch_id) AND ac.vr_id = v.id AND coalesce(approved, false) = false @@ -224,7 +224,7 @@ BEGIN SELECT sum(amount) INTO control_amount FROM acc_trans WHERE trans_id IN - (SELECT transaction_id FROM vouchers + (SELECT transaction_id FROM voucher WHERE batch_id = ANY (in_batch_id)) AND trans_id IN (SELECT trans_id FROM ap @@ -245,20 +245,20 @@ BEGIN UPDATE acc_trans SET approved = true WHERE trans_id IN - (SELECT transaction_id FROM vouchers + (SELECT transaction_id FROM voucher WHERE batch_id = ANY (in_batch_id)); IF in_batch = 'gl' THEN UPDATE gl SET approved = true WHERE trans_id IN - (SELECT transaction_id FROM vouchers + (SELECT transaction_id FROM voucher WHERE batch_id = ANY (in_batch_id)); ELSE UPDATE ap SET approved = true WHERE trans_id IN - (SELECT transaction_id FROM vouchers + (SELECT transaction_id FROM voucher WHERE batch_id = ANY (in_batch_id)); END IF; END IF; @@ -266,3 +266,18 @@ BEGIN RETURN TRUE; END; $$ LANGUAGE PLPGSQL; + + +CREATE OR REPLACE FUNCTION batch_create( +in_batch_number text, in_description text, in_batch_class text) RETURNS int AS +$$ +BEGIN + INSERT INTO + batch (batch_class_id, description, control_code, created_by) + VALUES ((SELECT id FROM batch_class WHERE class = in_batch_class), + in_description, in_batch_number, + (select id FROM users WHERE username = session_user)); + + return currval('batch_id_seq'); +END; +$$ LANGUAGE PLPGSQL; |