diff options
Diffstat (limited to 'LedgerSMB')
52 files changed, 19168 insertions, 18782 deletions
diff --git a/LedgerSMB/AA.pm b/LedgerSMB/AA.pm index 77c97b0a..e6d7b573 100644 --- a/LedgerSMB/AA.pm +++ b/LedgerSMB/AA.pm @@ -1,5 +1,5 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ # Copyright (C) 2006 @@ -20,7 +20,7 @@ # # Contributors: # -# +# # See COPYRIGHT file for copyright information #====================================================================== # @@ -38,237 +38,258 @@ use LedgerSMB::Sysconfig; sub post_transaction { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query; - my $sth; - - my $null; - ($null, $form->{department_id}) = split(/--/, $form->{department}); - $form->{department_id} *= 1; - - my $ml = 1; - my $table = 'ar'; - my $buysell = 'buy'; - my $ARAP = 'AR'; - my $invnumber = "sinumber"; - my $keepcleared; - - if ($form->{vc} eq 'vendor') { - $table = 'ap'; - $buysell = 'sell'; - $ARAP = 'AP'; - $ml = -1; - $invnumber = "vinumber"; - } - - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{exchangerate} = 1; - } else { - $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, $buysell); - - $form->{exchangerate} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{exchangerate}); - } - - my @taxaccounts = split / /, $form->{taxaccounts}; - my $tax = 0; - my $fxtax = 0; - my $amount; - my $diff; - - my %tax = (); - my $accno; - - # add taxes - foreach $accno (@taxaccounts) { - $fxtax += $tax{fxamount}{$accno} = $form->parse_amount($myconfig, $form->{"tax_$accno"}); - $tax += $tax{fxamount}{$accno}; - - push @{ $form->{acc_trans}{taxes} }, { - accno => $accno, - amount => $tax{fxamount}{$accno}, - project_id => undef, - fx_transaction => 0 }; - - $amount = $tax{fxamount}{$accno} * $form->{exchangerate}; - $tax{amount}{$accno} = $form->round_amount($amount - $diff, 2); - $diff = $tax{amount}{$accno} - ($amount - $diff); - $amount = $tax{amount}{$accno} - $tax{fxamount}{$accno}; - $tax += $amount; - - if ($form->{currency} ne $form->{defaultcurrency}) { - push @{ $form->{acc_trans}{taxes} }, { - accno => $accno, - amount => $amount, - project_id => undef, - fx_transaction => 1 }; - } - - } - - my %amount = (); - my $fxinvamount = 0; - for (1 .. $form->{rowcount}) { - $fxinvamount += $amount{fxamount}{$_} = $form->parse_amount($myconfig, $form->{"amount_$_"}) - } - - $form->{taxincluded} *= 1; - - my $i; - my $project_id; - my $cleared = 0; - - $diff = 0; - # deduct tax from amounts if tax included - for $i (1 .. $form->{rowcount}) { - - if ($amount{fxamount}{$i}) { - - if ($form->{taxincluded}) { - $amount = ($fxinvamount) ? $fxtax * $amount{fxamount}{$i} / $fxinvamount : 0; - $amount{fxamount}{$i} -= $amount; - } - - # multiply by exchangerate - $amount = $amount{fxamount}{$i} * $form->{exchangerate}; - $amount{amount}{$i} = $form->round_amount($amount - $diff, 2); - $diff = $amount{amount}{$i} - ($amount - $diff); - - ($null, $project_id) = split /--/, $form->{"projectnumber_$i"}; - $project_id ||= undef; - ($accno) = split /--/, $form->{"${ARAP}_amount_$i"}; - - if ($keepcleared) { - $cleared = ($form->{"cleared_$i"}) ? 1 : 0; - } - - push @{ $form->{acc_trans}{lineitems} }, { - accno => $accno, - amount => $amount{fxamount}{$i}, - project_id => $project_id, - description => $form->{"description_$i"}, - cleared => $cleared, - fx_transaction => 0 }; - - if ($form->{currency} ne $form->{defaultcurrency}) { - $amount = $amount{amount}{$i} - $amount{fxamount}{$i}; - push @{ $form->{acc_trans}{lineitems} }, { - accno => $accno, - amount => $amount, - project_id => $project_id, - description => $form->{"description_$i"}, - cleared => $cleared, - fx_transaction => 1 }; - } - } - } - - - my $invnetamount = 0; - for (@{ $form->{acc_trans}{lineitems} }) { $invnetamount += $_->{amount} } - my $invamount = $invnetamount + $tax; - - # adjust paidaccounts if there is no date in the last row - $form->{paidaccounts}-- - unless ($form->{"datepaid_$form->{paidaccounts}"}); - - if ($form->{vc} ne "customer"){ - $form->{vc} = "vendor"; - } - - my $paid = 0; - my $fxamount; - - $diff = 0; - # add payments - for $i (1 .. $form->{paidaccounts}) { - $fxamount = $form->parse_amount($myconfig, $form->{"paid_$i"}); - - if ($fxamount) { - $paid += $fxamount; - - $paidamount = $fxamount * $form->{exchangerate}; - - $amount = $form->round_amount($paidamount - $diff, 2); - $diff = $amount - ($paidamount - $diff); - - $form->{datepaid} = $form->{"datepaid_$i"}; - - $paid{fxamount}{$i} = $fxamount; - $paid{amount}{$i} = $amount; - } - } - - $fxinvamount += $fxtax unless $form->{taxincluded}; - $fxinvamount = $form->round_amount($fxinvamount, 2); - $invamount = $form->round_amount($invamount, 2); - $paid = $form->round_amount($paid, 2); - - $paid = ($fxinvamount == $paid) - ? $invamount - : $form->round_amount($paid * $form->{exchangerate}, 2); - - - $query = q| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $query; + my $sth; + + my $null; + ( $null, $form->{department_id} ) = split( /--/, $form->{department} ); + $form->{department_id} *= 1; + + my $ml = 1; + my $table = 'ar'; + my $buysell = 'buy'; + my $ARAP = 'AR'; + my $invnumber = "sinumber"; + my $keepcleared; + + if ( $form->{vc} eq 'vendor' ) { + $table = 'ap'; + $buysell = 'sell'; + $ARAP = 'AP'; + $ml = -1; + $invnumber = "vinumber"; + } + + if ( $form->{currency} eq $form->{defaultcurrency} ) { + $form->{exchangerate} = 1; + } + else { + $exchangerate = + $form->check_exchangerate( $myconfig, $form->{currency}, + $form->{transdate}, $buysell ); + + $form->{exchangerate} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount( $myconfig, $form->{exchangerate} ); + } + + my @taxaccounts = split / /, $form->{taxaccounts}; + my $tax = 0; + my $fxtax = 0; + my $amount; + my $diff; + + my %tax = (); + my $accno; + + # add taxes + foreach $accno (@taxaccounts) { + $fxtax += $tax{fxamount}{$accno} = + $form->parse_amount( $myconfig, $form->{"tax_$accno"} ); + $tax += $tax{fxamount}{$accno}; + + push @{ $form->{acc_trans}{taxes} }, + { + accno => $accno, + amount => $tax{fxamount}{$accno}, + project_id => undef, + fx_transaction => 0 + }; + + $amount = $tax{fxamount}{$accno} * $form->{exchangerate}; + $tax{amount}{$accno} = $form->round_amount( $amount - $diff, 2 ); + $diff = $tax{amount}{$accno} - ( $amount - $diff ); + $amount = $tax{amount}{$accno} - $tax{fxamount}{$accno}; + $tax += $amount; + + if ( $form->{currency} ne $form->{defaultcurrency} ) { + push @{ $form->{acc_trans}{taxes} }, + { + accno => $accno, + amount => $amount, + project_id => undef, + fx_transaction => 1 + }; + } + + } + + my %amount = (); + my $fxinvamount = 0; + for ( 1 .. $form->{rowcount} ) { + $fxinvamount += $amount{fxamount}{$_} = + $form->parse_amount( $myconfig, $form->{"amount_$_"} ); + } + + $form->{taxincluded} *= 1; + + my $i; + my $project_id; + my $cleared = 0; + + $diff = 0; + + # deduct tax from amounts if tax included + for $i ( 1 .. $form->{rowcount} ) { + + if ( $amount{fxamount}{$i} ) { + + if ( $form->{taxincluded} ) { + $amount = + ($fxinvamount) + ? $fxtax * $amount{fxamount}{$i} / $fxinvamount + : 0; + $amount{fxamount}{$i} -= $amount; + } + + # multiply by exchangerate + $amount = $amount{fxamount}{$i} * $form->{exchangerate}; + $amount{amount}{$i} = $form->round_amount( $amount - $diff, 2 ); + $diff = $amount{amount}{$i} - ( $amount - $diff ); + + ( $null, $project_id ) = split /--/, $form->{"projectnumber_$i"}; + $project_id ||= undef; + ($accno) = split /--/, $form->{"${ARAP}_amount_$i"}; + + if ($keepcleared) { + $cleared = ( $form->{"cleared_$i"} ) ? 1 : 0; + } + + push @{ $form->{acc_trans}{lineitems} }, + { + accno => $accno, + amount => $amount{fxamount}{$i}, + project_id => $project_id, + description => $form->{"description_$i"}, + cleared => $cleared, + fx_transaction => 0 + }; + + if ( $form->{currency} ne $form->{defaultcurrency} ) { + $amount = $amount{amount}{$i} - $amount{fxamount}{$i}; + push @{ $form->{acc_trans}{lineitems} }, + { + accno => $accno, + amount => $amount, + project_id => $project_id, + description => $form->{"description_$i"}, + cleared => $cleared, + fx_transaction => 1 + }; + } + } + } + + my $invnetamount = 0; + for ( @{ $form->{acc_trans}{lineitems} } ) { $invnetamount += $_->{amount} } + my $invamount = $invnetamount + $tax; + + # adjust paidaccounts if there is no date in the last row + $form->{paidaccounts}-- + unless ( $form->{"datepaid_$form->{paidaccounts}"} ); + + if ( $form->{vc} ne "customer" ) { + $form->{vc} = "vendor"; + } + + my $paid = 0; + my $fxamount; + + $diff = 0; + + # add payments + for $i ( 1 .. $form->{paidaccounts} ) { + $fxamount = $form->parse_amount( $myconfig, $form->{"paid_$i"} ); + + if ($fxamount) { + $paid += $fxamount; + + $paidamount = $fxamount * $form->{exchangerate}; + + $amount = $form->round_amount( $paidamount - $diff, 2 ); + $diff = $amount - ( $paidamount - $diff ); + + $form->{datepaid} = $form->{"datepaid_$i"}; + + $paid{fxamount}{$i} = $fxamount; + $paid{amount}{$i} = $amount; + } + } + + $fxinvamount += $fxtax unless $form->{taxincluded}; + $fxinvamount = $form->round_amount( $fxinvamount, 2 ); + $invamount = $form->round_amount( $invamount, 2 ); + $paid = $form->round_amount( $paid, 2 ); + + $paid = + ( $fxinvamount == $paid ) + ? $invamount + : $form->round_amount( $paid * $form->{exchangerate}, 2 ); + + $query = q| SELECT (SELECT value FROM defaults WHERE setting_key = 'fxgain_accno_id'), (SELECT value FROM defaults WHERE setting_key = 'fxloss_accno_id')|; - my ($fxgain_accno_id, $fxloss_accno_id) = $dbh->selectrow_array($query); + my ( $fxgain_accno_id, $fxloss_accno_id ) = $dbh->selectrow_array($query); - ($null, $form->{employee_id}) = split /--/, $form->{employee}; - unless ($form->{employee_id}) { - ($form->{employee}, $form->{employee_id}) = - $form->get_employee($dbh); - } + ( $null, $form->{employee_id} ) = split /--/, $form->{employee}; + unless ( $form->{employee_id} ) { + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + } - # check if id really exists - if ($form->{id}) { - my $id = $dbh->quote($form->{id}); - $keepcleared = 1; - $query = qq| + # check if id really exists + if ( $form->{id} ) { + my $id = $dbh->quote( $form->{id} ); + $keepcleared = 1; + $query = qq| SELECT id FROM $table WHERE id = $id|; - if ($dbh->selectrow_array($query)) { - # delete detail records - $query = qq| + if ( $dbh->selectrow_array($query) ) { + + # delete detail records + $query = qq| DELETE FROM acc_trans WHERE trans_id = $id|; - $dbh->do($query) || $form->dberror($query); - } - } else { + $dbh->do($query) || $form->dberror($query); + } + } + else { - my $uid = localtime; - $uid .= "$$"; + my $uid = localtime; + $uid .= "$$"; - $query = qq| + $query = qq| INSERT INTO $table (invnumber) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM $table WHERE invnumber = '$uid'|; - ($form->{id}) = $dbh->selectrow_array($query); - } - + ( $form->{id} ) = $dbh->selectrow_array($query); + } - # record last payment date in ar/ap table - $form->{datepaid} = $form->{transdate} unless $form->{datepaid}; - my $datepaid = ($paid) ? qq|'$form->{datepaid}'| : 'NOW'; + # record last payment date in ar/ap table + $form->{datepaid} = $form->{transdate} unless $form->{datepaid}; + my $datepaid = ($paid) ? qq|'$form->{datepaid}'| : 'NOW'; - $form->{invnumber} = $form->update_defaults($myconfig, $invnumber) unless $form->{invnumber}; + $form->{invnumber} = $form->update_defaults( $myconfig, $invnumber ) + unless $form->{invnumber}; - $query = qq| + $query = qq| UPDATE $table SET invnumber = ?, ordnumber = ?, @@ -288,38 +309,42 @@ sub post_transaction { WHERE id = ? |; - my @queryargs = ($form->{invnumber}, $form->{ordnumber}, - $form->{transdate}, $form->{"$form->{vc}_id"}, - $form->{taxincluded}, $invamount, $form->{duedate}, $paid, - $datepaid, $invnetamout, $form->{currency}, $form->{notes}, - $form->{department_id}, $form->{employee_id}, - $form->{ponumber}, $form->{id}); - - $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); - - @queries = $form->run_custom_queries($table, 'INSERT'); - # update exchangerate - my $buy = $form->{exchangerate}; - my $sell = 0; - if ($form->{vc} eq 'vendor') { - $buy = 0; - $sell = $form->{exchangerate}; - } - - if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { - $form->update_exchangerate( - $dbh, $form->{currency}, $form->{transdate}, - $buy, $sell); - } - - my $ref; - - # add individual transactions - foreach $ref (@{ $form->{acc_trans}{lineitems} }) { - - # insert detail records in acc_trans - if ($ref->{amount}) { - $query = qq| + my @queryargs = ( + $form->{invnumber}, $form->{ordnumber}, + $form->{transdate}, $form->{"$form->{vc}_id"}, + $form->{taxincluded}, $invamount, + $form->{duedate}, $paid, + $datepaid, $invnetamout, + $form->{currency}, $form->{notes}, + $form->{department_id}, $form->{employee_id}, + $form->{ponumber}, $form->{id} + ); + + $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); + + @queries = $form->run_custom_queries( $table, 'INSERT' ); + + # update exchangerate + my $buy = $form->{exchangerate}; + my $sell = 0; + if ( $form->{vc} eq 'vendor' ) { + $buy = 0; + $sell = $form->{exchangerate}; + } + + if ( ( $form->{currency} ne $form->{defaultcurrency} ) && !$exchangerate ) { + $form->update_exchangerate( $dbh, $form->{currency}, $form->{transdate}, + $buy, $sell ); + } + + my $ref; + + # add individual transactions + foreach $ref ( @{ $form->{acc_trans}{lineitems} } ) { + + # insert detail records in acc_trans + if ( $ref->{amount} ) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, project_id, memo, @@ -328,19 +353,21 @@ sub post_transaction { WHERE accno = ?), ?, ?, ?, ?, ?, ?)|; - @queryargs = ($form->{id}, $ref->{accno}, - $ref->{amount} * $ml, $form->{transdate}, - $ref->{project_id}, $ref->{description}, - $ref->{fx_transaction}, $ref->{cleared}); - $dbh->prepare($query)->execute(@queryargs) - || $form->dberror($query); - } - } - - # save taxes - foreach $ref (@{ $form->{acc_trans}{taxes} }) { - if ($ref->{amount}) { - $query = qq| + @queryargs = ( + $form->{id}, $ref->{accno}, + $ref->{amount} * $ml, $form->{transdate}, + $ref->{project_id}, $ref->{description}, + $ref->{fx_transaction}, $ref->{cleared} + ); + $dbh->prepare($query)->execute(@queryargs) + || $form->dberror($query); + } + } + + # save taxes + foreach $ref ( @{ $form->{acc_trans}{taxes} } ) { + if ( $ref->{amount} ) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, fx_transaction) @@ -348,78 +375,78 @@ sub post_transaction { WHERE accno = ?), ?, ?, ?)|; - @queryargs = ($form->{id}, $ref->{accno}, - $ref->{amount} * $ml, $form->{transdate}, - $ref->{fx_transaction}); - $dbh->prepare($query)->execute(@queryargs) - || $form->dberror($query); - } - } - + @queryargs = ( + $form->{id}, $ref->{accno}, $ref->{amount} * $ml, + $form->{transdate}, $ref->{fx_transaction} + ); + $dbh->prepare($query)->execute(@queryargs) + || $form->dberror($query); + } + } - my $arap; + my $arap; - # record ar/ap - if (($arap = $invamount)) { - ($accno) = split /--/, $form->{$ARAP}; + # record ar/ap + if ( ( $arap = $invamount ) ) { + ($accno) = split /--/, $form->{$ARAP}; - $query = qq| + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate) VALUES (?, (SELECT id FROM chart WHERE accno = '?'), ?, ?)|; - @queryargs = ($form->{id}, $accno, $invamount * -1 * $ml, - $form->{transdate}); + @queryargs = + ( $form->{id}, $accno, $invamount * -1 * $ml, $form->{transdate} ); - $dbh->prepare($query)->execute(@queryargs) - || $form->dberror($query); - } + $dbh->prepare($query)->execute(@queryargs) + || $form->dberror($query); + } - # if there is no amount force ar/ap - if ($fxinvamount == 0) { - $arap = 1; - } + # if there is no amount force ar/ap + if ( $fxinvamount == 0 ) { + $arap = 1; + } + my $exchangerate; - my $exchangerate; + # add paid transactions + for $i ( 1 .. $form->{paidaccounts} ) { - # add paid transactions - for $i (1 .. $form->{paidaccounts}) { + if ( $paid{fxamount}{$i} ) { - if ($paid{fxamount}{$i}) { + ($accno) = split( /--/, $form->{"${ARAP}_paid_$i"} ); + $form->{"datepaid_$i"} = $form->{transdate} + unless ( $form->{"datepaid_$i"} ); - ($accno) = split(/--/, $form->{"${ARAP}_paid_$i"}); - $form->{"datepaid_$i"} = $form->{transdate} unless ($form->{"datepaid_$i"}); + $exchangerate = 0; - $exchangerate = 0; + if ( $form->{currency} eq $form->{defaultcurrency} ) { + $form->{"exchangerate_$i"} = 1; + } + else { + $exchangerate = + $form->check_exchangerate( $myconfig, $form->{currency}, + $form->{"datepaid_$i"}, $buysell ); - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{"exchangerate_$i"} = 1; - } else { - $exchangerate = $form->check_exchangerate( - $myconfig, $form->{currency}, - $form->{"datepaid_$i"}, $buysell); + $form->{"exchangerate_$i"} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount( $myconfig, + $form->{"exchangerate_$i"} ); + } - $form->{"exchangerate_$i"} = ($exchangerate) - ? $exchangerate - : $form->parse_amount( - $myconfig, - $form->{"exchangerate_$i"}); - } + # if there is no amount + if ( $fxinvamount == 0 ) { + $form->{exchangerate} = $form->{"exchangerate_$i"}; + } - # if there is no amount - if ($fxinvamount == 0) { - $form->{exchangerate} = - $form->{"exchangerate_$i"}; - } + # ar/ap amount + if ($arap) { + ($accno) = split /--/, $form->{$ARAP}; - # ar/ap amount - if ($arap) { - ($accno) = split /--/, $form->{$ARAP}; - - # add ar/ap - $query = qq| + # add ar/ap + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount,transdate) @@ -427,25 +454,26 @@ sub post_transaction { WHERE accno = ?), ?, ?)|; - @queryargs = ($form->{id}, - $paid{amount}{$i} * $ml, - $form->{"datepaid_$i"}); - $dbh->prepare($query)->execute(@queryargs) - || $form->dberror($query); - } - - $arap = $paid{amount}{$i}; + @queryargs = ( + $form->{id}, + $paid{amount}{$i} * $ml, + $form->{"datepaid_$i"} + ); + $dbh->prepare($query)->execute(@queryargs) + || $form->dberror($query); + } + $arap = $paid{amount}{$i}; - # add payment - if ($paid{fxamount}{$i}) { + # add payment + if ( $paid{fxamount}{$i} ) { - ($accno) = split /--/, $form->{"${ARAP}_paid_$i"}; + ($accno) = split /--/, $form->{"${ARAP}_paid_$i"}; - my $cleared = ($form->{"cleared_$i"}) ? 1 : 0; + my $cleared = ( $form->{"cleared_$i"} ) ? 1 : 0; - $amount = $paid{fxamount}{$i}; - $query = qq| + $amount = $paid{fxamount}{$i}; + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, source, memo, @@ -454,32 +482,34 @@ sub post_transaction { WHERE accno = ?), ? * -1 * $ml, ?, ?, ?, ?)|; - @queryargs = ($form->{id}, $accno, - $amount * -1 * $ml, - $form->{"datepaid_$i"}, - $form->{"source_$i"}, - $form->{"memo_$i"}, - $cleared); - $dbh->prepare($query)->execute(@queryargs) - || $form->dberror($query); - - if ($form->{currency} - ne $form->{defaultcurrency}) { - - # exchangerate gain/loss - $amount = ($form->round_amount( - $paid{fxamount}{$i} - * $form->{exchangerate},2) - - $form->round_amount( - $paid{fxamount}{$i} - * $form->{"exchangerate_$i"}, - 2)) * -1; - - if ($amount) { - - my $accno_id = (($amount * $ml) > 0) ? $fxgain_accno_id : $fxloss_accno_id; - - $query = qq| + @queryargs = ( + $form->{id}, $accno, + $amount * -1 * $ml, $form->{"datepaid_$i"}, + $form->{"source_$i"}, $form->{"memo_$i"}, + $cleared + ); + $dbh->prepare($query)->execute(@queryargs) + || $form->dberror($query); + + if ( $form->{currency} ne $form->{defaultcurrency} ) { + + # exchangerate gain/loss + $amount = ( + $form->round_amount( + $paid{fxamount}{$i} * $form->{exchangerate}, 2 ) - + $form->round_amount( + $paid{fxamount}{$i} * $form->{"exchangerate_$i"}, 2 + ) + ) * -1; + + if ($amount) { + + my $accno_id = + ( ( $amount * $ml ) > 0 ) + ? $fxgain_accno_id + : $fxloss_accno_id; + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, @@ -491,21 +521,20 @@ sub post_transaction { ?, ?, '1', ?)|; - @queryargs = ($form->{id}, - $accno_id, - $amount * $ml, - $form->{"datepaid_$i"}, - $cleared); - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) - || - $form->dberror($query); - } - - # exchangerate difference - $amount = $paid{amount}{$i} - $paid{fxamount}{$i} + $amount; - - $query = qq| + @queryargs = ( + $form->{id}, $accno_id, + $amount * $ml, + $form->{"datepaid_$i"}, $cleared + ); + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) + || $form->dberror($query); + } + + # exchangerate difference + $amount = $paid{amount}{$i} - $paid{fxamount}{$i} + $amount; + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, @@ -518,171 +547,175 @@ sub post_transaction { = ?), ?, ?, '1', ?, ?)|; - @queryargs = ($form->{id}, $accno, - $amount * -1 * $ml, - $form->{"datepaid_$i"}, - $cleared, $form->{"source_$i"}); - $sth = $dbh->prepare($query) ; - $sth->execute(@queryargs) - || $form->dberror($query); + @queryargs = ( + $form->{id}, $accno, + $amount * -1 * $ml, + $form->{"datepaid_$i"}, + $cleared, $form->{"source_$i"} + ); + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) + || $form->dberror($query); - } + } - # update exchangerate record - $buy = $form->{"exchangerate_$i"}; - $sell = 0; + # update exchangerate record + $buy = $form->{"exchangerate_$i"}; + $sell = 0; - if ($form->{vc} eq 'vendor') { - $buy = 0; - $sell = $form->{"exchangerate_$i"}; - } + if ( $form->{vc} eq 'vendor' ) { + $buy = 0; + $sell = $form->{"exchangerate_$i"}; + } - if (($form->{currency} ne - $form->{defaultcurrency}) && !$exchangerate) { + if ( ( $form->{currency} ne $form->{defaultcurrency} ) + && !$exchangerate ) + { - $form->update_exchangerate( - $dbh, $form->{currency}, - $form->{"datepaid_$i"}, $buy, - $sell); - } - } - } - } + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{"datepaid_$i"}, + $buy, $sell ); + } + } + } + } - # save printed and queued - $form->save_status($dbh); + # save printed and queued + $form->save_status($dbh); - my %audittrail = ( tablename => $table, - reference => $form->{invnumber}, - formname => 'transaction', - action => 'posted', - id => $form->{id} ); + my %audittrail = ( + tablename => $table, + reference => $form->{invnumber}, + formname => 'transaction', + action => 'posted', + id => $form->{id} + ); - $form->audittrail($dbh, "", \%audittrail); + $form->audittrail( $dbh, "", \%audittrail ); - $form->save_recurring($dbh, $myconfig); + $form->save_recurring( $dbh, $myconfig ); - my $rc = $dbh->commit; + my $rc = $dbh->commit; - $rc; + $rc; } - sub delete_transaction { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database, turn AutoCommit off - my $dbh = $form->{dbh}; + # connect to database, turn AutoCommit off + my $dbh = $form->{dbh}; - my $table = ($form->{vc} eq 'customer') ? 'ar' : 'ap'; + my $table = ( $form->{vc} eq 'customer' ) ? 'ar' : 'ap'; - my %audittrail = ( tablename => $table, - reference => $form->{invnumber}, - formname => 'transaction', - action => 'deleted', - id => $form->{id} ); + my %audittrail = ( + tablename => $table, + reference => $form->{invnumber}, + formname => 'transaction', + action => 'deleted', + id => $form->{id} + ); - $form->audittrail($dbh, "", \%audittrail); + $form->audittrail( $dbh, "", \%audittrail ); - my $query = qq|DELETE FROM $table WHERE id = $form->{id}|; - $dbh->do($query) || $form->dberror($query); + my $query = qq|DELETE FROM $table WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); - $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; - $dbh->prepare($query)->execute($form->{id}) || $form->dberror($query); + $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; + $dbh->prepare($query)->execute( $form->{id} ) || $form->dberror($query); - # get spool files - $query = qq|SELECT spoolfile + # get spool files + $query = qq|SELECT spoolfile FROM status WHERE trans_id = ? AND spoolfile IS NOT NULL|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $spoolfile; - my @spoolfiles = (); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - while (($spoolfile) = $sth->fetchrow_array) { - push @spoolfiles, $spoolfile; - } - - $sth->finish; + my $spoolfile; + my @spoolfiles = (); - $query = qq|DELETE FROM status WHERE trans_id = ?|; - $dbh->prepare($query)->execute($form->{id}) || $form->dberror($query); + while ( ($spoolfile) = $sth->fetchrow_array ) { + push @spoolfiles, $spoolfile; + } - # commit - my $rc = $dbh->commit; + $sth->finish; - if ($rc) { - foreach $spoolfile (@spoolfiles) { - unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" if $spoolfile; - } - } + $query = qq|DELETE FROM status WHERE trans_id = ?|; + $dbh->prepare($query)->execute( $form->{id} ) || $form->dberror($query); - $rc; -} + # commit + my $rc = $dbh->commit; + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" if $spoolfile; + } + } + $rc; +} sub transactions { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - my $null; - my $var; - my $paid = "a.paid"; - my $ml = 1; - my $ARAP = 'AR'; - my $table = 'ar'; - my $buysell = 'buy'; - my $acc_trans_join; - my $acc_trans_flds; - - if ($form->{vc} eq 'vendor') { - $ml = -1; - $ARAP = 'AP'; - $table = 'ap'; - $buysell = 'sell'; - } - - ($form->{transdatefrom}, $form->{transdateto}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; - - my @paidargs = (); - if ($form->{outstanding}) { - $paid = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + my $null; + my $var; + my $paid = "a.paid"; + my $ml = 1; + my $ARAP = 'AR'; + my $table = 'ar'; + my $buysell = 'buy'; + my $acc_trans_join; + my $acc_trans_flds; + + if ( $form->{vc} eq 'vendor' ) { + $ml = -1; + $ARAP = 'AP'; + $table = 'ap'; + $buysell = 'sell'; + } + + ( $form->{transdatefrom}, $form->{transdateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + my @paidargs = (); + if ( $form->{outstanding} ) { + $paid = qq| SELECT SUM(ac.amount) * -1 * $ml FROM acc_trans ac JOIN chart c ON (c.id = ac.chart_id) WHERE ac.trans_id = a.id AND (c.link LIKE '%${ARAP}_paid%' OR c.link = '')|; - if ($form->{transdateto}){ - $paid .= qq| + if ( $form->{transdateto} ) { + $paid .= qq| AND ac.transdate <= ?|; - push @paidargs, $form->{transdateto}; - } - $form->{summary} = 1; - } - + push @paidargs, $form->{transdateto}; + } + $form->{summary} = 1; + } - if (!$form->{summary}) { - $acc_trans_flds = qq| + if ( !$form->{summary} ) { + $acc_trans_flds = qq| , c.accno, ac.source, pr.projectnumber, ac.memo AS description, ac.amount AS linetotal, i.description AS linedescription|; - $acc_trans_join = qq| + $acc_trans_join = qq| JOIN acc_trans ac ON (a.id = ac.trans_id) JOIN chart c ON (c.id = ac.chart_id) LEFT JOIN project pr ON (pr.id = ac.project_id) LEFT JOIN invoice i ON (i.id = ac.invoice_id)|; - } + } - my $query = qq| + my $query = qq| SELECT a.id, a.invnumber, a.ordnumber, a.transdate, a.duedate, a.netamount, a.amount, ($paid) AS paid, a.invoice, a.datepaid, a.terms, a.notes, @@ -701,129 +734,130 @@ sub transactions { LEFT JOIN department d ON (a.department_id = d.id) $acc_trans_join|; - my %ordinal = ( id => 1, - invnumber => 2, - ordnumber => 3, - transdate => 4, - duedate => 5, - datepaid => 10, - shipvia => 13, - shippingpoint => 14, - employee => 15, - name => 16, - manager => 19, - curr => 20, - department => 22, - ponumber => 23, - accno => 24, - source => 25, - project => 26, - description => 27); - - - my @a = (transdate, invnumber, name); - push @a, "employee" if $form->{l_employee}; - push @a, "manager" if $form->{l_manager}; - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $where = "1 = 1"; - if ($form->{"$form->{vc}_id"}) { - $where .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; - } else { - if ($form->{$form->{vc}}) { - $var = $dbh->quote( - $form->like(lc $form->{$form->{vc}})); - $where .= " AND lower(vc.name) LIKE $var"; - } - } - - for (qw(department employee)) { - if ($form->{$_}) { - ($null, $var) = split /--/, $form->{$_}; - $var = $dbh->quote($var); - $where .= " AND a.${_}_id = $var"; - } - } - - for (qw(invnumber ordnumber)) { - if ($form->{$_}) { - $var = $dbh->quote($form->like(lc $form->{$_})); - $where .= " AND lower(a.$_) LIKE $var"; - $form->{open} = $form->{closed} = 0; - } - } - if ($form->{partsid}){ - my $partsid = $dbh->quote($form->{partsid}); - $where .= " AND a.id IN (select trans_id FROM invoice + my %ordinal = ( + id => 1, + invnumber => 2, + ordnumber => 3, + transdate => 4, + duedate => 5, + datepaid => 10, + shipvia => 13, + shippingpoint => 14, + employee => 15, + name => 16, + manager => 19, + curr => 20, + department => 22, + ponumber => 23, + accno => 24, + source => 25, + project => 26, + description => 27 + ); + + my @a = ( transdate, invnumber, name ); + push @a, "employee" if $form->{l_employee}; + push @a, "manager" if $form->{l_manager}; + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $where = "1 = 1"; + if ( $form->{"$form->{vc}_id"} ) { + $where .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } + else { + if ( $form->{ $form->{vc} } ) { + $var = $dbh->quote( $form->like( lc $form->{ $form->{vc} } ) ); + $where .= " AND lower(vc.name) LIKE $var"; + } + } + + for (qw(department employee)) { + if ( $form->{$_} ) { + ( $null, $var ) = split /--/, $form->{$_}; + $var = $dbh->quote($var); + $where .= " AND a.${_}_id = $var"; + } + } + + for (qw(invnumber ordnumber)) { + if ( $form->{$_} ) { + $var = $dbh->quote( $form->like( lc $form->{$_} ) ); + $where .= " AND lower(a.$_) LIKE $var"; + $form->{open} = $form->{closed} = 0; + } + } + if ( $form->{partsid} ) { + my $partsid = $dbh->quote( $form->{partsid} ); + $where .= " AND a.id IN (select trans_id FROM invoice WHERE parts_id = $partsid)"; - } - - for (qw(ponumber shipvia notes)) { - if ($form->{$_}) { - $var = $dbh->quote($form->like(lc $form->{$_})); - $where .= " AND lower(a.$_) LIKE $var"; - } - } - - if ($form->{description}) { - if ($acc_trans_flds) { - $var = $dbh->quote( - $form->like(lc $form->{description}) - ); - $where .= " AND lower(ac.memo) LIKE $var + } + + for (qw(ponumber shipvia notes)) { + if ( $form->{$_} ) { + $var = $dbh->quote( $form->like( lc $form->{$_} ) ); + $where .= " AND lower(a.$_) LIKE $var"; + } + } + + if ( $form->{description} ) { + if ($acc_trans_flds) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= " AND lower(ac.memo) LIKE $var OR lower(i.description) LIKE $var"; - } else { - $where .= " AND a.id = 0"; - } - } - - if ($form->{source}) { - if ($acc_trans_flds) { - $var = $dbh->quote($form->like(lc $form->{source})); - $where .= " AND lower(ac.source) LIKE $var"; - } else { - $where .= " AND a.id = 0"; - } - } - - my $transdatefrom = $dbh->quote($form->{transdatefrom}); - $where .= " AND a.transdate >= $transdatefrom" - if $form->{transdatefrom}; - - my $transdateto = $dbh->quote($form->{transdateto}); - $where .= " AND a.transdate <= $transdateto" if $form->{transdateto}; - - if ($form->{open} || $form->{closed}) { - unless ($form->{open} && $form->{closed}) { - $where .= " AND a.amount != a.paid" if ($form->{open}); - $where .= " AND a.amount = a.paid" if ($form->{closed}); - } - } - - if ($form->{till} ne "") { - $where .= " AND a.invoice = '1' + } + else { + $where .= " AND a.id = 0"; + } + } + + if ( $form->{source} ) { + if ($acc_trans_flds) { + $var = $dbh->quote( $form->like( lc $form->{source} ) ); + $where .= " AND lower(ac.source) LIKE $var"; + } + else { + $where .= " AND a.id = 0"; + } + } + + my $transdatefrom = $dbh->quote( $form->{transdatefrom} ); + $where .= " AND a.transdate >= $transdatefrom" + if $form->{transdatefrom}; + + my $transdateto = $dbh->quote( $form->{transdateto} ); + $where .= " AND a.transdate <= $transdateto" if $form->{transdateto}; + + if ( $form->{open} || $form->{closed} ) { + unless ( $form->{open} && $form->{closed} ) { + $where .= " AND a.amount != a.paid" if ( $form->{open} ); + $where .= " AND a.amount = a.paid" if ( $form->{closed} ); + } + } + + if ( $form->{till} ne "" ) { + $where .= " AND a.invoice = '1' AND a.till = $form->{till}"; - if ($myconfig->{role} eq 'user') { - my $login = $dbh->quote($form->{login}); - $where .= " AND e.login = $login"; - } - } + if ( $myconfig->{role} eq 'user' ) { + my $login = $dbh->quote( $form->{login} ); + $where .= " AND e.login = $login"; + } + } - if ($form->{$ARAP}) { - my ($accno) = split /--/, $form->{$ARAP}; - $accno = $dbh->quote($accno); - $where .= qq| + if ( $form->{$ARAP} ) { + my ($accno) = split /--/, $form->{$ARAP}; + $accno = $dbh->quote($accno); + $where .= qq| AND a.id IN (SELECT ac.trans_id FROM acc_trans ac JOIN chart c ON (c.id = ac.chart_id) WHERE a.id = ac.trans_id AND c.accno = $accno)|; - } + } - if ($form->{description}) { - $var = $dbh->quote($form->like(lc $form->{description})); - $where .= qq| + if ( $form->{description} ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= qq| AND (a.id IN (SELECT DISTINCT trans_id FROM acc_trans WHERE lower(memo) LIKE '$var') @@ -832,79 +866,83 @@ sub transactions { FROM invoice WHERE lower(description) LIKE '$var'))|; - } + } - $query .= "WHERE $where + $query .= "WHERE $where ORDER BY $sortorder"; - my $sth = $dbh->prepare($query); - $sth->execute(@paidargs) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute(@paidargs) || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{exchangerate} = 1 unless $ref->{exchangerate}; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{exchangerate} = 1 unless $ref->{exchangerate}; - if ($ref->{linetotal} <= 0) { - $ref->{debit} = $ref->{linetotal} * -1; - $ref->{credit} = 0; - } else { - $ref->{debit} = 0; - $ref->{credit} = $ref->{linetotal}; - } + if ( $ref->{linetotal} <= 0 ) { + $ref->{debit} = $ref->{linetotal} * -1; + $ref->{credit} = 0; + } + else { + $ref->{debit} = 0; + $ref->{credit} = $ref->{linetotal}; + } - if ($ref->{invoice}) { - $ref->{description} ||= $ref->{linedescription}; - } + if ( $ref->{invoice} ) { + $ref->{description} ||= $ref->{linedescription}; + } - if ($form->{outstanding}) { - next if $form->round_amount($ref->{amount}, 2) - == $form->round_amount($ref->{paid}, 2); - } + if ( $form->{outstanding} ) { + next + if $form->round_amount( $ref->{amount}, 2 ) == + $form->round_amount( $ref->{paid}, 2 ); + } - push @{ $form->{transactions} }, $ref; - } + push @{ $form->{transactions} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - # this is used in IS, IR to retrieve the name sub get_name { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # sanitize $form->{vc} - if ($form->{vc} ne 'customer'){ - $form->{vc} = 'vendor'; - } else { - $form->{vc} = 'customer'; - } - # connect to database - my $dbh = $form->{dbh}; + # sanitize $form->{vc} + if ( $form->{vc} ne 'customer' ) { + $form->{vc} = 'vendor'; + } + else { + $form->{vc} = 'customer'; + } - my $dateformat = $myconfig->{dateformat}; + # connect to database + my $dbh = $form->{dbh}; - if ($myconfig->{dateformat} !~ /^y/) { - my @a = split /\W/, $form->{transdate}; - $dateformat .= "yy" if (length $a[2] > 2); - } + my $dateformat = $myconfig->{dateformat}; - if ($form->{transdate} !~ /\W/) { - $dateformat = 'yyyymmdd'; - } + if ( $myconfig->{dateformat} !~ /^y/ ) { + my @a = split /\W/, $form->{transdate}; + $dateformat .= "yy" if ( length $a[2] > 2 ); + } - my $duedate; + if ( $form->{transdate} !~ /\W/ ) { + $dateformat = 'yyyymmdd'; + } - $dateformat = $dbh->quote($dateformat); - my $tdate = $dbh->quote($form->{transdate}); - $duedate = ($form->{transdate}) - ? "to_date($tdate, $dateformat) - + c.terms" - : "current_date + c.terms"; + my $duedate; - $form->{"$form->{vc}_id"} *= 1; - # get customer/vendor - my $query = qq| + $dateformat = $dbh->quote($dateformat); + my $tdate = $dbh->quote( $form->{transdate} ); + $duedate = ( $form->{transdate} ) + ? "to_date($tdate, $dateformat) + + c.terms" + : "current_date + c.terms"; + + $form->{"$form->{vc}_id"} *= 1; + + # get customer/vendor + my $query = qq| SELECT c.name AS $form->{vc}, c.discount, c.creditlimit, c.terms, c.email, c.cc, c.bcc, c.taxincluded, c.address1, c.address2, c.city, c.state, @@ -919,65 +957,67 @@ sub get_name { LEFT JOIN employees e ON (e.id = c.employee_id) WHERE c.id = ?|; - @queryargs = ($form->{"$form->{vc}_id"}); - my $sth = $dbh->prepare($query); + @queryargs = ( $form->{"$form->{vc}_id"} ); + my $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); + $sth->execute(@queryargs) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); + $ref = $sth->fetchrow_hashref(NAME_lc); - if ($form->{id}) { - for (qw(currency employee employee_id intnotes)) { - delete $ref->{$_}; - } - } + if ( $form->{id} ) { + for (qw(currency employee employee_id intnotes)) { + delete $ref->{$_}; + } + } - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - my $buysell = ($form->{vc} eq 'customer') ? "buy" : "sell"; + my $buysell = ( $form->{vc} eq 'customer' ) ? "buy" : "sell"; - # if no currency use defaultcurrency - $form->{currency} = - ($form->{currency}) - ? $form->{currency} - : $form->{defaultcurrency}; - $form->{exchangerate} = 0 - if $form->{currency} eq $form->{defaultcurrency}; + # if no currency use defaultcurrency + $form->{currency} = + ( $form->{currency} ) + ? $form->{currency} + : $form->{defaultcurrency}; + $form->{exchangerate} = 0 + if $form->{currency} eq $form->{defaultcurrency}; - if ($form->{transdate} && ($form->{currency} - ne $form->{defaultcurrency})) { - $form->{exchangerate} = $form->get_exchangerate( - $dbh, $form->{currency}, $form->{transdate}, $buysell); - } + if ( $form->{transdate} + && ( $form->{currency} ne $form->{defaultcurrency} ) ) + { + $form->{exchangerate} = + $form->get_exchangerate( $dbh, $form->{currency}, $form->{transdate}, + $buysell ); + } - $form->{forex} = $form->{exchangerate}; + $form->{forex} = $form->{exchangerate}; - # if no employee, default to login - ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh) - unless $form->{employee_id}; + # if no employee, default to login + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh) + unless $form->{employee_id}; - my $arap = ($form->{vc} eq 'customer') ? 'ar' : 'ap'; - my $ARAP = uc $arap; + my $arap = ( $form->{vc} eq 'customer' ) ? 'ar' : 'ap'; + my $ARAP = uc $arap; - $form->{creditremaining} = $form->{creditlimit}; - $query = qq| + $form->{creditremaining} = $form->{creditlimit}; + $query = qq| SELECT SUM(amount - paid) FROM $arap WHERE $form->{vc}_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{"$form->{vc}_id"}) - || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{"$form->{vc}_id"} ) + || $form->dberror($query); - ($form->{creditremaining}) -= $sth->fetchrow_array; + ( $form->{creditremaining} ) -= $sth->fetchrow_array; - $sth->finish; - if ($form->{vc} ne "customer"){ - $form->{vc} = 'vendor'; - } + $sth->finish; + if ( $form->{vc} ne "customer" ) { + $form->{vc} = 'vendor'; + } - $query = qq| + $query = qq| SELECT o.amount, (SELECT e.$buysell FROM exchangerate e WHERE e.curr = o.curr AND e.transdate = o.transdate) @@ -985,66 +1025,66 @@ sub get_name { WHERE o.$form->{vc}_id = ? AND o.quotation = '0' AND o.closed = '0'|; - $sth = $dbh->prepare($query); - $sth->execute ($form->{"$form->{vc}_id"}) || $form->dberror($query); - - while (my ($amount, $exch) = $sth->fetchrow_array) { - $exch = 1 unless $exch; - $form->{creditremaining} -= $amount * $exch; - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{"$form->{vc}_id"} ) || $form->dberror($query); - $sth->finish; + while ( my ( $amount, $exch ) = $sth->fetchrow_array ) { + $exch = 1 unless $exch; + $form->{creditremaining} -= $amount * $exch; + } + $sth->finish; - # get shipto if we did not converted an order or invoice - if (!$form->{shipto}) { + # get shipto if we did not converted an order or invoice + if ( !$form->{shipto} ) { - for ( - qw(shiptoname shiptoaddress1 shiptoaddress2 - shiptocity shiptostate shiptozipcode - shiptocountry shiptocontact shiptophone - shiptofax shiptoemail) - ) { - delete $form->{$_} - } + for ( + qw(shiptoname shiptoaddress1 shiptoaddress2 + shiptocity shiptostate shiptozipcode + shiptocountry shiptocontact shiptophone + shiptofax shiptoemail) + ) + { + delete $form->{$_}; + } - ## needs fixing (SELECT *) - $query = qq| + ## needs fixing (SELECT *) + $query = qq| SELECT * FROM shipto WHERE trans_id = $form->{"$form->{vc}_id"}|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; - } + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; + } - # get taxes - $query = qq| + # get taxes + $query = qq| SELECT c.accno FROM chart c JOIN $form->{vc}tax ct ON (ct.chart_id = c.id) WHERE ct.$form->{vc}_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( $form->{"$form->{vc}_id"}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{"$form->{vc}_id"} ) || $form->dberror($query); - my %tax; + my %tax; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $tax{$ref->{accno}} = 1; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $tax{ $ref->{accno} } = 1; + } - $sth->finish; - $transdate = $dbh->quote($form->{transdate}); - my $where = qq|AND (t.validto >= $transdate OR t.validto IS NULL)| - if $form->{transdate}; + $sth->finish; + $transdate = $dbh->quote( $form->{transdate} ); + my $where = qq|AND (t.validto >= $transdate OR t.validto IS NULL)| + if $form->{transdate}; - # get tax rates and description - $query = qq| + # get tax rates and description + $query = qq| SELECT c.accno, c.description, t.rate, t.taxnumber FROM chart c JOIN tax t ON (c.id = t.chart_id) @@ -1052,33 +1092,32 @@ sub get_name { $where ORDER BY accno, validto|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - $form->{taxaccounts} = ""; - my %a = (); + $form->{taxaccounts} = ""; + my %a = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { - if ($tax{$ref->{accno}}) { - if (not exists $a{$ref->{accno}}) { - for (qw(rate description taxnumber)) { - $form->{"$ref->{accno}_$_"} = - $ref->{$_}; - } - $form->{taxaccounts} .= "$ref->{accno} "; - $a{$ref->{accno}} = 1; - } - } - } + if ( $tax{ $ref->{accno} } ) { + if ( not exists $a{ $ref->{accno} } ) { + for (qw(rate description taxnumber)) { + $form->{"$ref->{accno}_$_"} = $ref->{$_}; + } + $form->{taxaccounts} .= "$ref->{accno} "; + $a{ $ref->{accno} } = 1; + } + } + } - $sth->finish; - chop $form->{taxaccounts}; + $sth->finish; + chop $form->{taxaccounts}; - # setup last accounts used for this customer/vendor - if (!$form->{id} && $form->{type} !~ /_(order|quotation)/) { + # setup last accounts used for this customer/vendor + if ( !$form->{id} && $form->{type} !~ /_(order|quotation)/ ) { - $query = qq| + $query = qq| SELECT c.accno, c.description, c.link, c.category, ac.project_id, p.projectnumber, a.department_id, d.description AS department @@ -1094,41 +1133,38 @@ sub get_name { ?) |; - $sth = $dbh->prepare($query); - $sth->execute($form->{"$form->{vc}_id"}, - $form->{"$form->{vc}_id"}) || $form->dberror($query); - - my $i = 0; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{department} = $ref->{department}; - $form->{department_id} = $ref->{department_id}; - - if ($ref->{link} =~ /_amount/) { - $i++; - $form->{"$form->{ARAP}_amount_$i"} = - "$ref->{accno}--$ref->{description}" - if $ref->{accno}; - $form->{"projectnumber_$i"} = - "$ref->{projectnumber}--" . - "$ref->{project_id}" - if $ref->{project_id}; - } - - if ($ref->{link} eq $form->{ARAP}) { - $form->{$form->{ARAP}} = - $form->{"$form->{ARAP}_1"} = - "$ref->{accno}--". - "$ref->{description}" - if $ref->{accno}; - } - } - - $sth->finish; - $form->{rowcount} = $i if ($i && !$form->{type}); - } - - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{"$form->{vc}_id"}, $form->{"$form->{vc}_id"} ) + || $form->dberror($query); + + my $i = 0; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{department} = $ref->{department}; + $form->{department_id} = $ref->{department_id}; + + if ( $ref->{link} =~ /_amount/ ) { + $i++; + $form->{"$form->{ARAP}_amount_$i"} = + "$ref->{accno}--$ref->{description}" + if $ref->{accno}; + $form->{"projectnumber_$i"} = + "$ref->{projectnumber}--" . "$ref->{project_id}" + if $ref->{project_id}; + } + + if ( $ref->{link} eq $form->{ARAP} ) { + $form->{ $form->{ARAP} } = $form->{"$form->{ARAP}_1"} = + "$ref->{accno}--" . "$ref->{description}" + if $ref->{accno}; + } + } + + $sth->finish; + $form->{rowcount} = $i if ( $i && !$form->{type} ); + } + + $dbh->commit; } 1; diff --git a/LedgerSMB/AM.pm b/LedgerSMB/AM.pm index 66795305..1219c50c 100644 --- a/LedgerSMB/AM.pm +++ b/LedgerSMB/AM.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -40,25 +40,25 @@ use LedgerSMB::Sysconfig; sub get_account { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT accno, description, charttype, gifi_accno, category, link, contra FROM chart WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + my $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - # get default accounts - $query = qq| + # get default accounts + $query = qq| SELECT (SELECT value FROM defaults WHERE setting_key = 'inventory_accno_id') AS inventory_accno_id, @@ -75,77 +75,71 @@ sub get_account { WHERE setting_key = 'fxloss_accno_id') AS fxloss_accno_id|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - # check if we have any transactions - $query = qq| + # check if we have any transactions + $query = qq| SELECT trans_id FROM acc_trans WHERE chart_id = ? LIMIT 1|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - ($form->{orphaned}) = $sth->fetchrow_array(); - $form->{orphaned} = !$form->{orphaned}; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + ( $form->{orphaned} ) = $sth->fetchrow_array(); + $form->{orphaned} = !$form->{orphaned}; - $dbh->commit; + $dbh->commit; } - sub save_account { - my ($self, $myconfig, $form) = @_; - - # connect to database, turn off AutoCommit - my $dbh = $form->{dbh}; - - $form->{link} = ""; - foreach my $item ($form->{AR}, - $form->{AR_amount}, - $form->{AR_tax}, - $form->{AR_paid}, - $form->{AP}, - $form->{AP_amount}, - $form->{AP_tax}, - $form->{AP_paid}, - $form->{IC}, - $form->{IC_income}, - $form->{IC_sale}, - $form->{IC_expense}, - $form->{IC_cogs}, - $form->{IC_taxpart}, - $form->{IC_taxservice}) { - $form->{link} .= "${item}:" if ($item); - } - - chop $form->{link}; - - # strip blanks from accno - for (qw(accno gifi_accno)) { $form->{$_} =~ s/( |')//g } - - foreach my $item (qw(accno gifi_accno description)) { - $form->{$item} =~ s/-(-+)/-/g; - $form->{$item} =~ s/ ( )+/ /g; - } - - my $query; - my $sth; - - $form->{contra} *= 1; - - my @queryargs; - @queryargs = ($form->{accno}, $form->{description}, - $form->{charttype}, $form->{gifi_accno}, - $form->{category}, $form->{"link"}, - $form->{contra}); - # if we have an id then replace the old record - if ($form->{id}) { - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database, turn off AutoCommit + my $dbh = $form->{dbh}; + + $form->{link} = ""; + foreach my $item ( + $form->{AR}, $form->{AR_amount}, $form->{AR_tax}, + $form->{AR_paid}, $form->{AP}, $form->{AP_amount}, + $form->{AP_tax}, $form->{AP_paid}, $form->{IC}, + $form->{IC_income}, $form->{IC_sale}, $form->{IC_expense}, + $form->{IC_cogs}, $form->{IC_taxpart}, $form->{IC_taxservice} + ) + { + $form->{link} .= "${item}:" if ($item); + } + + chop $form->{link}; + + # strip blanks from accno + for (qw(accno gifi_accno)) { $form->{$_} =~ s/( |')//g } + + foreach my $item (qw(accno gifi_accno description)) { + $form->{$item} =~ s/-(-+)/-/g; + $form->{$item} =~ s/ ( )+/ /g; + } + + my $query; + my $sth; + + $form->{contra} *= 1; + + my @queryargs; + @queryargs = ( + $form->{accno}, $form->{description}, $form->{charttype}, + $form->{gifi_accno}, $form->{category}, $form->{"link"}, + $form->{contra} + ); + + # if we have an id then replace the old record + if ( $form->{id} ) { + $query = qq| UPDATE chart SET accno = ?, description = ?, charttype = ?, @@ -154,102 +148,104 @@ sub save_account { link = ?, contra = ? WHERE id = ?|; - push @queryargs, $form->{id}; - } else { - $query = qq| + push @queryargs, $form->{id}; + } + else { + $query = qq| INSERT INTO chart (accno, description, charttype, gifi_accno, category, link, contra) VALUES (?, ?, ?, ?, ?, ?, ?)|; - } + } + + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + $sth->finish; - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - $sth->finish; + $chart_id = $dbh->quote( $form->{id} ); - $chart_id = $dbh->quote($form->{id}); + if ( !$form->{id} ) { - if (! $form->{id}) { - # get id from chart - $query = qq| + # get id from chart + $query = qq| SELECT id FROM chart WHERE accno = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}); - ($chart_id) = $sth->fetchrow_array(); - $sth->finish; - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ); + ($chart_id) = $sth->fetchrow_array(); + $sth->finish; + } - if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{AR_tax} || $form->{AP_tax}) { + if ( $form->{IC_taxpart} + || $form->{IC_taxservice} + || $form->{AR_tax} + || $form->{AP_tax} ) + { - # add account if it doesn't exist in tax - $query = qq|SELECT chart_id + # add account if it doesn't exist in tax + $query = qq|SELECT chart_id FROM tax WHERE chart_id = $chart_id|; - my ($tax_id) = $dbh->selectrow_array($query); + my ($tax_id) = $dbh->selectrow_array($query); - # add tax if it doesn't exist - unless ($tax_id) { - $query = qq|INSERT INTO tax (chart_id, rate) + # add tax if it doesn't exist + unless ($tax_id) { + $query = qq|INSERT INTO tax (chart_id, rate) VALUES ($chart_id, 0)|; - $dbh->do($query) || $form->dberror($query); - } + $dbh->do($query) || $form->dberror($query); + } - } else { + } + else { - # remove tax - if ($form->{id}) { - $query = qq|DELETE FROM tax + # remove tax + if ( $form->{id} ) { + $query = qq|DELETE FROM tax WHERE chart_id = $form->{id}|; - $dbh->do($query) || $form->dberror($query); - } - } + $dbh->do($query) || $form->dberror($query); + } + } - # commit - my $rc = $dbh->commit; + # commit + my $rc = $dbh->commit; - $rc; + $rc; } - - sub delete_account { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database, turn off AutoCommit - my $dbh = $form->{dbh}; - my $sth; - my $query = qq| + # connect to database, turn off AutoCommit + my $dbh = $form->{dbh}; + my $sth; + my $query = qq| SELECT count(*) FROM acc_trans WHERE chart_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - my ($rowcount) = $sth->fetchrow_array(); - - if ($rowcount) { - $form->error( - "Cannot delete accounts with associated transactions!" - ); - } - - - # delete chart of account record - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + my ($rowcount) = $sth->fetchrow_array(); + + if ($rowcount) { + $form->error( "Cannot delete accounts with associated transactions!" ); + } + + # delete chart of account record + $query = qq| DELETE FROM chart WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - # set inventory_accno_id, income_accno_id, expense_accno_id to defaults - $query = qq| + # set inventory_accno_id, income_accno_id, expense_accno_id to defaults + $query = qq| UPDATE parts SET inventory_accno_id = (SELECT value FROM defaults @@ -257,724 +253,711 @@ sub delete_account { 'inventory_accno_id') WHERE inventory_accno_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - for (qw(income_accno_id expense_accno_id)){ - $query = qq| + for (qw(income_accno_id expense_accno_id)) { + $query = qq| UPDATE parts SET $_ = (SELECT value FROM defaults WHERE setting_key = '$_') WHERE $_ = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - $sth->finish; - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + $sth->finish; + } - foreach my $table (qw(partstax customertax vendortax tax)) { - $query = qq| + foreach my $table (qw(partstax customertax vendortax tax)) { + $query = qq| DELETE FROM $table WHERE chart_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - $sth->finish; - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + $sth->finish; + } - # commit and redirect - my $rc = $dbh->commit; + # commit and redirect + my $rc = $dbh->commit; - $rc; + $rc; } - sub gifi_accounts { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT accno, description FROM gifi ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{ALL} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{ALL} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - - sub get_gifi { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; - my $sth; + # connect to database + my $dbh = $form->{dbh}; + my $sth; - my $query = qq| + my $query = qq| SELECT accno, description FROM gifi WHERE accno = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}) || $form->dberror($query); - ($form->{accno}, $form->{description}) = $sth->fetchrow_array(); + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ) || $form->dberror($query); + ( $form->{accno}, $form->{description} ) = $sth->fetchrow_array(); - $sth->finish; + $sth->finish; - # check for transactions - $query = qq| + # check for transactions + $query = qq| SELECT count(*) FROM acc_trans a JOIN chart c ON (a.chart_id = c.id) JOIN gifi g ON (c.gifi_accno = g.accno) WHERE g.accno = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}) || $form->dberror($query); - ($numrows) = $sth->fetchrow_array; - if (($numrows * 1) == 0){ - $form->{orphaned} = 1; - } else { - $form->{orphaned} = 0; - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ) || $form->dberror($query); + ($numrows) = $sth->fetchrow_array; + if ( ( $numrows * 1 ) == 0 ) { + $form->{orphaned} = 1; + } + else { + $form->{orphaned} = 0; + } - $dbh->commit; + $dbh->commit; } - sub save_gifi { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; - my $dbh = $form->{dbh}; + $form->{accno} =~ s/( |')//g; - $form->{accno} =~ s/( |')//g; + foreach my $item (qw(accno description)) { + $form->{$item} =~ s/-(-+)/-/g; + $form->{$item} =~ s/ ( )+/ /g; + } - foreach my $item (qw(accno description)) { - $form->{$item} =~ s/-(-+)/-/g; - $form->{$item} =~ s/ ( )+/ /g; - } + my @queryargs = ( $form->{accno}, $form->{description} ); - my @queryargs = ($form->{accno}, $form->{description}); - # id is the old account number! - if ($form->{id}) { - $query = qq| + # id is the old account number! + if ( $form->{id} ) { + $query = qq| UPDATE gifi SET accno = ?, description = ? WHERE accno = ?|; - push @queryargs, $form->{id}; + push @queryargs, $form->{id}; - } else { - $query = qq| + } + else { + $query = qq| INSERT INTO gifi (accno, description) VALUES (?, ?)|; - } + } - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror; - $sth->finish; - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror; + $sth->finish; + $dbh->commit; } - sub delete_gifi { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - # id is the old account number! - $query = qq| + # id is the old account number! + $query = qq| DELETE FROM gifi WHERE accno = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - $sth->finish; - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + $sth->finish; + $dbh->commit; } - sub warehouses { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $form->sort_order(); - my $query = qq| + $form->sort_order(); + my $query = qq| SELECT id, description FROM warehouse ORDER BY description $form->{direction}|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{ALL} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{ALL} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub get_warehouse { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; - my $sth; + # connect to database + my $dbh = $form->{dbh}; + my $sth; - my $query = qq| + my $query = qq| SELECT description FROM warehouse WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - ($form->{description}) = $sth->fetchrow_array; - $sth->finish; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + ( $form->{description} ) = $sth->fetchrow_array; + $sth->finish; - # see if it is in use - $query = qq| + # see if it is in use + $query = qq| SELECT count(*) FROM inventory WHERE warehouse_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); - ($form->{orphaned}) = $sth->fetchrow_array; - if (($form->{orphaned} * 1) == 0){ - $form->{orphaned} = 1; - } else { - $form->{orphaned} = 0; - } + ( $form->{orphaned} ) = $sth->fetchrow_array; + if ( ( $form->{orphaned} * 1 ) == 0 ) { + $form->{orphaned} = 1; + } + else { + $form->{orphaned} = 0; + } - $dbh->commit; + $dbh->commit; } - sub save_warehouse { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; - my $sth; - my @queryargs = ($form->{description}); + # connect to database + my $dbh = $form->{dbh}; - $form->{description} =~ s/-(-)+/-/g; - $form->{description} =~ s/ ( )+/ /g; + my $sth; + my @queryargs = ( $form->{description} ); + $form->{description} =~ s/-(-)+/-/g; + $form->{description} =~ s/ ( )+/ /g; - if ($form->{id}) { - $query = qq| + if ( $form->{id} ) { + $query = qq| UPDATE warehouse SET description = ? WHERE id = ?|; - push @queryargs, $form->{id}; - } else { - $query = qq| + push @queryargs, $form->{id}; + } + else { + $query = qq| INSERT INTO warehouse (description) VALUES (?)|; - } + } - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - $sth->finish; - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + $sth->finish; + $dbh->commit; } - sub delete_warehouse { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $query = qq| + $query = qq| DELETE FROM warehouse WHERE id = ?|; - $dbh->prepare($query)->execute($form->{id}) || $form->dberror($query); - $dbh->commit; + $dbh->prepare($query)->execute( $form->{id} ) || $form->dberror($query); + $dbh->commit; } - - sub departments { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $form->sort_order(); - my $query = qq|SELECT id, description, role + $form->sort_order(); + my $query = qq|SELECT id, description, role FROM department ORDER BY description $form->{direction}|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{ALL} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{ALL} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - - sub get_department { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; - my $sth; + # connect to database + my $dbh = $form->{dbh}; + my $sth; - my $query = qq| + my $query = qq| SELECT description, role FROM department WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - ($form->{description}, $form->{role}) = $sth->fetchrow_array; - $sth->finish; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + ( $form->{description}, $form->{role} ) = $sth->fetchrow_array; + $sth->finish; - for (keys %$ref) { $form->{$_} = $ref->{$_} } + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - # see if it is in use - $query = qq| + # see if it is in use + $query = qq| SELECT count(*) FROM dpt_trans WHERE department_id = ? |; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - ($form->{orphaned}) = $sth->fetchrow_array; - if (($form->{orphaned} * 1) == 0){ - $form->{orphaned} = 1; - } else { - $form->{orphaned} = 0; - } - - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + ( $form->{orphaned} ) = $sth->fetchrow_array; + if ( ( $form->{orphaned} * 1 ) == 0 ) { + $form->{orphaned} = 1; + } + else { + $form->{orphaned} = 0; + } + + $dbh->commit; } - sub save_department { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $form->{description} =~ s/-(-)+/-/g; - $form->{description} =~ s/ ( )+/ /g; - my $sth; - my @queryargs = ($form->{description}, $form->{role}); - if ($form->{id}) { - $query = qq| + $form->{description} =~ s/-(-)+/-/g; + $form->{description} =~ s/ ( )+/ /g; + my $sth; + my @queryargs = ( $form->{description}, $form->{role} ); + if ( $form->{id} ) { + $query = qq| UPDATE department SET description = ?, role = ? WHERE id = ?|; - push @queryargs, $form->{id}; + push @queryargs, $form->{id}; - } else { - $query = qq| + } + else { + $query = qq| INSERT INTO department (description, role) VALUES (?, ?)|; - } + } - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + $dbh->commit; } - sub delete_department { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $query = qq| + $query = qq| DELETE FROM department WHERE id = ?|; - $dbh->prepare($query)->execute($form->{id}); - $dbh->commit; + $dbh->prepare($query)->execute( $form->{id} ); + $dbh->commit; } - sub business { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $form->sort_order(); - my $query = qq| + $form->sort_order(); + my $query = qq| SELECT id, description, discount FROM business ORDER BY description $form->{direction}|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{ALL} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{ALL} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub get_business { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT description, discount FROM business WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - ($form->{description}, $form->{discount}) = $sth->fetchrow_array(); - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + ( $form->{description}, $form->{discount} ) = $sth->fetchrow_array(); + $dbh->commit; } - sub save_business { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $form->{description} =~ s/-(-)+/-/g; - $form->{description} =~ s/ ( )+/ /g; - $form->{discount} /= 100; + $form->{description} =~ s/-(-)+/-/g; + $form->{description} =~ s/ ( )+/ /g; + $form->{discount} /= 100; - my $sth; - my @queryargs = ($form->{description}, $form->{discount}); + my $sth; + my @queryargs = ( $form->{description}, $form->{discount} ); - if ($form->{id}) { - $query = qq| + if ( $form->{id} ) { + $query = qq| UPDATE business SET description = ?, discount = ? WHERE id = ?|; - push @queryargs, $form->{id}; + push @queryargs, $form->{id}; - } else { - $query = qq|INSERT INTO business (description, discount) + } + else { + $query = qq|INSERT INTO business (description, discount) VALUES (?, ?)|; - } + } - $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); - $dbh->commit; + $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); + $dbh->commit; } - sub delete_business { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $query = qq| + $query = qq| DELETE FROM business WHERE id = ?|; - $dbh->prepare($query)->execute($form->{id}) || $form->dberror($query); - $dbh->commit; + $dbh->prepare($query)->execute( $form->{id} ) || $form->dberror($query); + $dbh->commit; } - sub sic { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $form->{sort} = "code" unless $form->{sort}; - my @a = qw(code description); + $form->{sort} = "code" unless $form->{sort}; + my @a = qw(code description); - my %ordinal = ( code => 1, - description => 3 ); + my %ordinal = ( + code => 1, + description => 3 + ); - my $sortorder = $form->sort_order(\@a, \%ordinal); + my $sortorder = $form->sort_order( \@a, \%ordinal ); - my $query = qq|SELECT code, sictype, description + my $query = qq|SELECT code, sictype, description FROM sic ORDER BY $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{ALL} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{ALL} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub get_sic { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT code, sictype, description FROM sic - WHERE code = |.$dbh->quote($form->{code}); + WHERE code = | . $dbh->quote( $form->{code} ); - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } + my $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub save_sic { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; - # connect to database - my $dbh = $form->{dbh}; + foreach my $item (qw(code description)) { + $form->{$item} =~ s/-(-)+/-/g; + } + my $sth; + @queryargs = ( $form->{code}, $form->{sictype}, $form->{description} ); - foreach my $item (qw(code description)) { - $form->{$item} =~ s/-(-)+/-/g; - } - my $sth; - @queryargs = ($form->{code}, $form->{sictype}, $form->{description}); - # if there is an id - if ($form->{id}) { - $query = qq| + # if there is an id + if ( $form->{id} ) { + $query = qq| UPDATE sic SET code = ?, sictype = ?, description = ? WHERE code = ?)|; - push @queryargs, $form->{id}; + push @queryargs, $form->{id}; - } else { - $query = qq| + } + else { + $query = qq| INSERT INTO sic (code, sictype, description) VALUES (?, ?, ?)|; - } + } - $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); - $dbh->commit; + $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); + $dbh->commit; } - sub delete_sic { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $query = qq| + $query = qq| DELETE FROM sic WHERE code = ?|; - $dbh->prepare($query)->execute($form->{code}); - $dbh->commit; + $dbh->prepare($query)->execute( $form->{code} ); + $dbh->commit; } - sub language { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $form->{sort} = "code" unless $form->{sort}; - my @a = qw(code description); + $form->{sort} = "code" unless $form->{sort}; + my @a = qw(code description); - my %ordinal = ( code => 1, - description => 2 ); + my %ordinal = ( + code => 1, + description => 2 + ); - my $sortorder = $form->sort_order(\@a, \%ordinal); + my $sortorder = $form->sort_order( \@a, \%ordinal ); - my $query = qq| + my $query = qq| SELECT code, description FROM language ORDER BY $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{ALL} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{ALL} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub get_language { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - ## needs fixing (SELECT *...) - my $query = qq| + ## needs fixing (SELECT *...) + my $query = qq| SELECT * FROM language WHERE code = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{code}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{code} ) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); + my $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub save_language { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; - # connect to database - my $dbh = $form->{dbh}; + $form->{code} =~ s/ //g; - $form->{code} =~ s/ //g; + foreach my $item (qw(code description)) { + $form->{$item} =~ s/-(-)+/-/g; + $form->{$item} =~ s/ ( )+/-/g; + } + my $sth; + my @queryargs = ( $form->{code}, $form->{description} ); - foreach my $item (qw(code description)) { - $form->{$item} =~ s/-(-)+/-/g; - $form->{$item} =~ s/ ( )+/-/g; - } - my $sth; - my @queryargs = ($form->{code}, $form->{description}); - # if there is an id - if ($form->{id}) { - $query = qq| + # if there is an id + if ( $form->{id} ) { + $query = qq| UPDATE language SET code = ?, description = ? WHERE code = ?|; - push @queryargs, $form->{id}; + push @queryargs, $form->{id}; - } else { - $query = qq| + } + else { + $query = qq| INSERT INTO language (code, description) VALUES (?, ?)|; - } + } - $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); - $dbh->commit; + $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); + $dbh->commit; } - sub delete_language { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $query = qq| + $query = qq| DELETE FROM language - WHERE code = |.$dbh->quote($form->{code}); + WHERE code = | . $dbh->quote( $form->{code} ); - $dbh->do($query) || $form->dberror($query); - $dbh->{dbh}; + $dbh->do($query) || $form->dberror($query); + $dbh->{dbh}; } - sub recurring_transactions { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq|SELECT value FROM defaults where setting_key = 'curr'|; + my $query = qq|SELECT value FROM defaults where setting_key = 'curr'|; - my ($defaultcurrency) = $dbh->selectrow_array($query); - $defaultcurrency = $dbh->quote($defaultcurrency =~ s/:.*//g); + my ($defaultcurrency) = $dbh->selectrow_array($query); + $defaultcurrency = $dbh->quote( $defaultcurrency =~ s/:.*//g ); - $form->{sort} ||= "nextdate"; - my @a = ($form->{sort}); - my $sortorder = $form->sort_order(\@a); + $form->{sort} ||= "nextdate"; + my @a = ( $form->{sort} ); + my $sortorder = $form->sort_order( \@a ); - $query = qq| + $query = qq| SELECT 'ar' AS module, 'ar' AS transaction, a.invoice, n.name AS description, a.amount, s.*, se.formname AS recurringemail, @@ -1069,77 +1052,90 @@ sub recurring_transactions { ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - my $id; - my $transaction; - my %e = (); - my %p = (); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + my $id; + my $transaction; + my %e = (); + my %p = (); - $ref->{exchangerate} ||= 1; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { - if ($ref->{id} != $id) { + $ref->{exchangerate} ||= 1; - if (%e) { - $form->{transactions}{$transaction}->[$i]->{recurringemail} = ""; - for (keys %e) { - $form->{transactions}{$transaction}->[$i]->{recurringemail} .= "${_}:"; - } - chop $form->{transactions}{$transaction}->[$i]->{recurringemail}; - } + if ( $ref->{id} != $id ) { - if (%p) { - $form->{transactions}{$transaction}->[$i]->{recurringprint} = ""; - for (keys %p) { $form->{transactions}{$transaction}->[$i]->{recurringprint} .= "${_}:" } - chop $form->{transactions}{$transaction}->[$i]->{recurringprint}; - } + if (%e) { + $form->{transactions}{$transaction}->[$i]->{recurringemail} = + ""; + for ( keys %e ) { + $form->{transactions}{$transaction}->[$i] + ->{recurringemail} .= "${_}:"; + } + chop $form->{transactions}{$transaction}->[$i] + ->{recurringemail}; + } - %e = (); - %p = (); + if (%p) { + $form->{transactions}{$transaction}->[$i]->{recurringprint} = + ""; + for ( keys %p ) { + $form->{transactions}{$transaction}->[$i] + ->{recurringprint} .= "${_}:"; + } + chop $form->{transactions}{$transaction}->[$i] + ->{recurringprint}; + } - push @{ $form->{transactions}{$ref->{transaction}} }, $ref; + %e = (); + %p = (); - $id = $ref->{id}; - $i = $#{ $form->{transactions}{$ref->{transaction}} }; + push @{ $form->{transactions}{ $ref->{transaction} } }, $ref; - } + $id = $ref->{id}; + $i = $#{ $form->{transactions}{ $ref->{transaction} } }; - $transaction = $ref->{transaction}; + } - $e{$ref->{recurringemail}} = 1 if $ref->{recurringemail}; - $p{$ref->{recurringprint}} = 1 if $ref->{recurringprint}; + $transaction = $ref->{transaction}; - } + $e{ $ref->{recurringemail} } = 1 if $ref->{recurringemail}; + $p{ $ref->{recurringprint} } = 1 if $ref->{recurringprint}; - $sth->finish; + } - # this is for the last row - if (%e) { - $form->{transactions}{$transaction}->[$i]->{recurringemail} = ""; - for (keys %e) { $form->{transactions}{$transaction}->[$i]->{recurringemail} .= "${_}:" } - chop $form->{transactions}{$transaction}->[$i]->{recurringemail}; - } + $sth->finish; - if (%p) { - $form->{transactions}{$transaction}->[$i]->{recurringprint} = ""; - for (keys %p) { $form->{transactions}{$transaction}->[$i]->{recurringprint} .= "${_}:" } - chop $form->{transactions}{$transaction}->[$i]->{recurringprint}; - } + # this is for the last row + if (%e) { + $form->{transactions}{$transaction}->[$i]->{recurringemail} = ""; + for ( keys %e ) { + $form->{transactions}{$transaction}->[$i]->{recurringemail} .= + "${_}:"; + } + chop $form->{transactions}{$transaction}->[$i]->{recurringemail}; + } + if (%p) { + $form->{transactions}{$transaction}->[$i]->{recurringprint} = ""; + for ( keys %p ) { + $form->{transactions}{$transaction}->[$i]->{recurringprint} .= + "${_}:"; + } + chop $form->{transactions}{$transaction}->[$i]->{recurringprint}; + } - $dbh->commit; + $dbh->commit; } sub recurring_details { - my ($self, $myconfig, $form, $id) = @_; + my ( $self, $myconfig, $form, $id ) = @_; - my $dbh = $form->{dbh}; - my $query = qq| + my $dbh = $form->{dbh}; + my $query = qq| SELECT s.*, ar.id AS arid, ar.invoice AS arinvoice, ap.id AS apid, ap.invoice AS apinvoice, ar.duedate - ar.transdate AS overdue, @@ -1152,374 +1148,386 @@ sub recurring_details { LEFT JOIN oe ON (oe.id = s.id) WHERE s.id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - $form->{vc} = "customer" if $ref->{customer_id}; - $form->{vc} = "vendor" if $ref->{vendor_id}; - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + my $ref = $sth->fetchrow_hashref(NAME_lc); + $form->{vc} = "customer" if $ref->{customer_id}; + $form->{vc} = "vendor" if $ref->{vendor_id}; + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - $form->{invoice} = ($form->{arid} && $form->{arinvoice}); - $form->{invoice} = ($form->{apid} && $form->{apinvoice}) unless $form->{invoice}; + $form->{invoice} = ( $form->{arid} && $form->{arinvoice} ); + $form->{invoice} = ( $form->{apid} && $form->{apinvoice} ) + unless $form->{invoice}; - $query = qq| + $query = qq| SELECT * FROM recurringemail WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); - $form->{recurringemail} = ""; + $form->{recurringemail} = ""; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{recurringemail} .= "$ref->{formname}:$ref->{format}:"; - $form->{message} = $ref->{message}; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{recurringemail} .= "$ref->{formname}:$ref->{format}:"; + $form->{message} = $ref->{message}; + } - $sth->finish; + $sth->finish; - $query = qq| + $query = qq| SELECT * FROM recurringprint WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); - $form->{recurringprint} = ""; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{recurringprint} .= - "$ref->{formname}:$ref->{format}:$ref->{printer}:"; - } + $form->{recurringprint} = ""; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{recurringprint} .= + "$ref->{formname}:$ref->{format}:$ref->{printer}:"; + } - $sth->finish; + $sth->finish; - chop $form->{recurringemail}; - chop $form->{recurringprint}; + chop $form->{recurringemail}; + chop $form->{recurringprint}; - for (qw(arinvoice apinvoice)) { delete $form->{$_} } + for (qw(arinvoice apinvoice)) { delete $form->{$_} } - $dbh->commit; + $dbh->commit; } - sub update_recurring { - my ($self, $myconfig, $form, $id) = @_; + my ( $self, $myconfig, $form, $id ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - $id = $dbh->quote($id); - my $query = qq| + $id = $dbh->quote($id); + my $query = qq| SELECT nextdate, repeat, unit FROM recurring WHERE id = $id|; - my ($nextdate, $repeat, $unit) = $dbh->selectrow_array($query); + my ( $nextdate, $repeat, $unit ) = $dbh->selectrow_array($query); + + $nextdate = $dbh->quote($nextdate); + my $interval = $dbh->quote("$repeat $unit"); - $nextdate = $dbh->quote($nextdate); - my $interval = $dbh->quote("$repeat $unit"); - # check if it is the last date - $query = qq| + # check if it is the last date + $query = qq| SELECT (date $nextdate + interval $interval) > enddate FROM recurring WHERE id = $id|; - my ($last_repeat) = $dbh->selectrow_array($query); - if ($last_repeat) { - $advance{$myconfig->{dbdriver}} = "NULL"; - } + my ($last_repeat) = $dbh->selectrow_array($query); + if ($last_repeat) { + $advance{ $myconfig->{dbdriver} } = "NULL"; + } - $query = qq| + $query = qq| UPDATE recurring SET nextdate = (date $nextdate + interval $interval) WHERE id = $id|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $dbh->commit; + $dbh->commit; } - sub check_template_name { - my ($self, $myconfig, $form) = @_; - - my @allowedsuff = qw(css tex txt html xml); - if ($form->{file} =~ /^(.:)*?\/|\.\.\/|^\//){ - $form->error("Directory transversal not allowed."); - } - if ($form->{file} =~ /^${LedgerSMB::Sysconfig::userspath}\//){ - $form->error("Not allowed to access ${LedgerSMB::Sysconfig::userspath}/ with this method"); - } - my $whitelisted = 0; - for (@allowedsuff){ - if ($form->{file} =~ /$_$/){ - $whitelisted = 1; - } - } - if (!$whitelisted){ - $form->error("Error: File is of type that is not allowed."); - } - - if ($form->{file} !~ /^$myconfig->{templates}\//){ - $form->error("Not in a whitelisted directory: $form->{file}") unless $form->{file} =~ /^css\//; - } + my ( $self, $myconfig, $form ) = @_; + + my @allowedsuff = qw(css tex txt html xml); + if ( $form->{file} =~ /^(.:)*?\/|\.\.\/|^\// ) { + $form->error("Directory transversal not allowed."); + } + if ( $form->{file} =~ /^${LedgerSMB::Sysconfig::userspath}\// ) { + $form->error( +"Not allowed to access ${LedgerSMB::Sysconfig::userspath}/ with this method" + ); + } + my $whitelisted = 0; + for (@allowedsuff) { + if ( $form->{file} =~ /$_$/ ) { + $whitelisted = 1; + } + } + if ( !$whitelisted ) { + $form->error("Error: File is of type that is not allowed."); + } + + if ( $form->{file} !~ /^$myconfig->{templates}\// ) { + $form->error("Not in a whitelisted directory: $form->{file}") + unless $form->{file} =~ /^css\//; + } } - sub load_template { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - $self->check_template_name(\%$myconfig, \%$form); - open(TEMPLATE, '<', "$form->{file}") or $form->error("$form->{file} : $!"); + $self->check_template_name( \%$myconfig, \%$form ); + open( TEMPLATE, '<', "$form->{file}" ) + or $form->error("$form->{file} : $!"); - while (<TEMPLATE>) { - $form->{body} .= $_; - } + while (<TEMPLATE>) { + $form->{body} .= $_; + } - close(TEMPLATE); + close(TEMPLATE); } - sub save_template { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - $self->check_template_name(\%$myconfig, \%$form); - open(TEMPLATE, '>', "$form->{file}") or $form->error("$form->{file} : $!"); + $self->check_template_name( \%$myconfig, \%$form ); + open( TEMPLATE, '>', "$form->{file}" ) + or $form->error("$form->{file} : $!"); - # strip
- $form->{body} =~ s/\r//g; - print TEMPLATE $form->{body}; + # strip + $form->{body} =~ s/\r//g; + print TEMPLATE $form->{body}; - close(TEMPLATE); + close(TEMPLATE); } - sub save_preferences { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - # get username, is same as requested? - my @queryargs; - my $query = qq| + # get username, is same as requested? + my @queryargs; + my $query = qq| SELECT login FROM employees WHERE login = ?|; - @queryargs = ($form->{login}); - my $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - my ($dbusername) = $sth->fetchrow_array; - $sth->finish; + @queryargs = ( $form->{login} ); + my $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + my ($dbusername) = $sth->fetchrow_array; + $sth->finish; - return 0 if ($dbusername ne $form->{login}); + return 0 if ( $dbusername ne $form->{login} ); - # update name - $query = qq| + # update name + $query = qq| UPDATE employees SET name = ? WHERE login = ?|; - @queryargs = ($form->{name}, $form->{login}); - $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); + @queryargs = ( $form->{name}, $form->{login} ); + $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); - # get default currency - $query = qq| + # get default currency + $query = qq| SELECT value, (SELECT value FROM defaults WHERE setting_key = 'businessnumber') FROM defaults WHERE setting_key = 'curr'|; - ($form->{currency}, $form->{businessnumber}) = - $dbh->selectrow_array($query); - $form->{currency} =~ s/:.*//; + ( $form->{currency}, $form->{businessnumber} ) = + $dbh->selectrow_array($query); + $form->{currency} =~ s/:.*//; - $dbh->commit; + $dbh->commit; - my $myconfig = LedgerSMB::User->new($form->{login}); + my $myconfig = LedgerSMB::User->new( $form->{login} ); - map {$myconfig->{$_} = $form->{$_} if exists $form->{$_}} - qw(name email dateformat signature numberformat vclimit tel fax - company menuwidth countrycode address timeout stylesheet - printer password); - - foreach my $item (keys %$form) { - $myconfig->{$item} = $form->{$item}; - } + map { $myconfig->{$_} = $form->{$_} if exists $form->{$_} } + qw(name email dateformat signature numberformat vclimit tel fax + company menuwidth countrycode address timeout stylesheet + printer password); - $myconfig->{password} = $form->{new_password} if ($form->{old_password} ne $form->{new_password}); + foreach my $item ( keys %$form ) { + $myconfig->{$item} = $form->{$item}; + } - $myconfig->save_member(); + $myconfig->{password} = $form->{new_password} + if ( $form->{old_password} ne $form->{new_password} ); - 1; + $myconfig->save_member(); -} + 1; +} sub save_defaults { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + for (qw(IC IC_income IC_expense FX_gain FX_loss)) { + ( $form->{$_} ) = split /--/, $form->{$_}; + } - for (qw(IC IC_income IC_expense FX_gain FX_loss)) { ($form->{$_}) = split /--/, $form->{$_} } + my @a; + $form->{curr} =~ s/ //g; + for ( split /:/, $form->{curr} ) { push( @a, uc pack "A3", $_ ) if $_ } + $form->{curr} = join ':', @a; - my @a; - $form->{curr} =~ s/ //g; - for (split /:/, $form->{curr}) { push(@a, uc pack "A3", $_) if $_ } - $form->{curr} = join ':', @a; + # connect to database + my $dbh = $form->{dbh}; - # connect to database - my $dbh = $form->{dbh}; - # save defaults - $sth_plain = $dbh->prepare(" - UPDATE defaults SET value = ? WHERE setting_key = ?"); - $sth_accno = $dbh->prepare(qq| + # save defaults + $sth_plain = $dbh->prepare( " + UPDATE defaults SET value = ? WHERE setting_key = ?" ); + $sth_accno = $dbh->prepare( + qq| UPDATE defaults SET value = (SELECT id FROM chart WHERE accno = ?) - WHERE setting_key = ?|); - my %translation = ( - inventory_accno_id => 'IC', - income_accno_id => 'IC_income', - expense_accno_id => 'IC_expense', - fxgain_accno_id => 'FX_gain', - fxloss_accno_id => 'FX_loss' - ); - for ( - qw(inventory_accno_id income_accno_id expense_accno_id - fxgain_accno_id fxloss_accno_id glnumber sinumber vinumber - sonumber ponumber sqnumber rfqnumber partnumber employeenumber - customernumber vendornumber projectnumber yearend curr - weightunit businessnumber) - ){ - my $val = $form->{$_}; - - if ($translation{$_}){ - $val = $form->{$translation{$_}}; - } - if ($_ =~ /accno/){ - $sth_accno->execute($val, $_) - || $form->dberror("Saving $_"); - } else { - $sth_plain->execute($val, $_) - || $form->dberror("Saving $_"); - } - - } - my $rc = $dbh->commit; - - $rc; + WHERE setting_key = ?| + ); + my %translation = ( + inventory_accno_id => 'IC', + income_accno_id => 'IC_income', + expense_accno_id => 'IC_expense', + fxgain_accno_id => 'FX_gain', + fxloss_accno_id => 'FX_loss' + ); + for ( + qw(inventory_accno_id income_accno_id expense_accno_id + fxgain_accno_id fxloss_accno_id glnumber sinumber vinumber + sonumber ponumber sqnumber rfqnumber partnumber employeenumber + customernumber vendornumber projectnumber yearend curr + weightunit businessnumber) + ) + { + my $val = $form->{$_}; + + if ( $translation{$_} ) { + $val = $form->{ $translation{$_} }; + } + if ( $_ =~ /accno/ ) { + $sth_accno->execute( $val, $_ ) + || $form->dberror("Saving $_"); + } + else { + $sth_plain->execute( $val, $_ ) + || $form->dberror("Saving $_"); + } + + } + my $rc = $dbh->commit; + + $rc; } - sub defaultaccounts { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - # get defaults from defaults table - my $query = qq| + # get defaults from defaults table + my $query = qq| SELECT setting_key, value FROM defaults WHERE setting_key LIKE ?|; - my $sth = $dbh->prepare($query); - $sth->execute('%accno_id') || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute('%accno_id') || $form->dberror($query); - my $ref; - while ($ref = $sth->fetchrow_hashref(NAME_lc)){ - $form->{$ref->{setting_key}} = $ref->{value}; - } + my $ref; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{ $ref->{setting_key} } = $ref->{value}; + } - $form->{defaults}{IC} = $form->{inventory_accno_id}; - $form->{defaults}{IC_income} = $form->{income_accno_id}; - $form->{defaults}{IC_sale} = $form->{income_accno_id}; - $form->{defaults}{IC_expense} = $form->{expense_accno_id}; - $form->{defaults}{IC_cogs} = $form->{expense_accno_id}; - $form->{defaults}{FX_gain} = $form->{fxgain_accno_id}; - $form->{defaults}{FX_loss} = $form->{fxloss_accno_id}; + $form->{defaults}{IC} = $form->{inventory_accno_id}; + $form->{defaults}{IC_income} = $form->{income_accno_id}; + $form->{defaults}{IC_sale} = $form->{income_accno_id}; + $form->{defaults}{IC_expense} = $form->{expense_accno_id}; + $form->{defaults}{IC_cogs} = $form->{expense_accno_id}; + $form->{defaults}{FX_gain} = $form->{fxgain_accno_id}; + $form->{defaults}{FX_loss} = $form->{fxloss_accno_id}; - $sth->finish; + $sth->finish; - $query = qq| + $query = qq| SELECT id, accno, description, link FROM chart WHERE link LIKE '%IC%' ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - my $nkey; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /IC/) { - $nkey = $key; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - if ($key =~ /cogs/) { - $nkey = "IC_expense"; - } + my $nkey; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + foreach my $key ( split( /:/, $ref->{link} ) ) { + if ( $key =~ /IC/ ) { + $nkey = $key; - if ($key =~ /sale/) { - $nkey = "IC_income"; - } + if ( $key =~ /cogs/ ) { + $nkey = "IC_expense"; + } - %{ $form->{accno}{$nkey}{$ref->{accno}} } = ( id => $ref->{id}, - description => $ref->{description} ); - } - } - } + if ( $key =~ /sale/ ) { + $nkey = "IC_income"; + } - $sth->finish; + %{ $form->{accno}{$nkey}{ $ref->{accno} } } = ( + id => $ref->{id}, + description => $ref->{description} + ); + } + } + } + $sth->finish; - $query = qq| + $query = qq| SELECT id, accno, description FROM chart WHERE (category = 'I' OR category = 'E') AND charttype = 'A' ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - %{ $form->{accno}{FX_gain}{$ref->{accno}} } = ( id => $ref->{id}, - description => $ref->{description} ); + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + %{ $form->{accno}{FX_gain}{ $ref->{accno} } } = ( + id => $ref->{id}, + description => $ref->{description} + ); - %{ $form->{accno}{FX_loss}{$ref->{accno}} } = ( id => $ref->{id}, - description => $ref->{description} ); - } + %{ $form->{accno}{FX_loss}{ $ref->{accno} } } = ( + id => $ref->{id}, + description => $ref->{description} + ); + } - $sth->finish; + $sth->finish; - $dbh->commit; + $dbh->commit; } - sub taxes { - my ($self, $myconfig, $form) = @_; - my $taxaccounts = ''; + my ( $self, $myconfig, $form ) = @_; + my $taxaccounts = ''; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT c.id, c.accno, c.description, t.rate * 100 AS rate, t.taxnumber, t.validto, t.pass, m.taxmodulename @@ -1528,155 +1536,160 @@ sub taxes { JOIN taxmodule m ON (t.taxmodule_id = m.taxmodule_id) ORDER BY 3, 6|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{taxrates} }, $ref; + $taxaccounts .= " " . $ref{accno}; + } - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{taxrates} }, $ref; - $taxaccounts .= " " . $ref{accno}; - } + $sth->finish; - $sth->finish; - - $query = qq| + $query = qq| SELECT taxmodule_id, taxmodulename FROM taxmodule ORDER BY 2|; - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{"taxmodule_".$ref->{taxmodule_id}} = - $ref->{taxmodulename}; - } + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - $sth->finish; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{ "taxmodule_" . $ref->{taxmodule_id} } = $ref->{taxmodulename}; + } - $dbh->commit; + $sth->finish; -} + $dbh->commit; +} sub save_taxes { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query = qq|DELETE FROM tax|; - $dbh->do($query) || $form->dberror($query); + my $query = qq|DELETE FROM tax|; + $dbh->do($query) || $form->dberror($query); - - $query = qq| + $query = qq| INSERT INTO tax (chart_id, rate, taxnumber, validto, pass, taxmodule_id) VALUES (?, ?, ?, ?, ?, ?)|; - my $sth = $dbh->prepare($query); - foreach my $item (split / /, $form->{taxaccounts}) { - my ($chart_id, $i) = split /_/, $item; - my $rate = $form->parse_amount( - $myconfig, $form->{"taxrate_$i"}) / 100; - my $validto = $form->{"validto_$i"}; - $validto = undef if not $validto; - my @queryargs = ($chart_id, $rate, $form->{"taxnumber_$i"}, - $validto, $form->{"pass_$i"}, - $form->{"taxmodule_id_$i"}); + my $sth = $dbh->prepare($query); + foreach my $item ( split / /, $form->{taxaccounts} ) { + my ( $chart_id, $i ) = split /_/, $item; + my $rate = + $form->parse_amount( $myconfig, $form->{"taxrate_$i"} ) / 100; + my $validto = $form->{"validto_$i"}; + $validto = undef if not $validto; + my @queryargs = ( + $chart_id, $rate, $form->{"taxnumber_$i"}, + $validto, $form->{"pass_$i"}, $form->{"taxmodule_id_$i"} + ); - $sth->execute(@queryargs) || $form->dberror($query); - } + $sth->execute(@queryargs) || $form->dberror($query); + } - my $rc = $dbh->commit; + my $rc = $dbh->commit; - $rc; + $rc; } - sub backup { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $mail; - my $err; + my $mail; + my $err; - my @t = localtime(time); - $t[4]++; - $t[5] += 1900; - $t[3] = substr("0$t[3]", -2); - $t[4] = substr("0$t[4]", -2); + my @t = localtime(time); + $t[4]++; + $t[5] += 1900; + $t[3] = substr( "0$t[3]", -2 ); + $t[4] = substr( "0$t[4]", -2 ); - my $boundary = time; - my $tmpfile = "${LedgerSMB::Sysconfig::userspath}/$boundary.$myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql"; - $tmpfile .= ".gz" if ${LedgerSMB::Sysconfig::gzip}; - $form->{OUT} = "$tmpfile"; + my $boundary = time; + my $tmpfile = +"${LedgerSMB::Sysconfig::userspath}/$boundary.$myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql"; + $tmpfile .= ".gz" if ${LedgerSMB::Sysconfig::gzip}; + $form->{OUT} = "$tmpfile"; - open(OUT, '>', "$form->{OUT}") or $form->error("$form->{OUT} : $!"); + open( OUT, '>', "$form->{OUT}" ) or $form->error("$form->{OUT} : $!"); - # get sequences, functions and triggers + # get sequences, functions and triggers - my $today = scalar localtime; + my $today = scalar localtime; - $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost}; + $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost}; - $ENV{PGPASSWD} = $myconfig->{dbpasswd}; - # drop tables and sequences + $ENV{PGPASSWD} = $myconfig->{dbpasswd}; - # compress backup if gzip defined - my $suffix = ""; + # drop tables and sequences - if ($form->{media} eq 'email') { - if (${LedgerSMB::Sysconfig::gzip}){ - print OUT `pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname} | ${LedgerSMB::Sysconfig::gzip}`; - } else { - print OUT `pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname}`; - } - close OUT; - use LedgerSMB::Mailer; - $mail = new Mailer; + # compress backup if gzip defined + my $suffix = ""; - $mail->{to} = qq|"$myconfig->{name}" <$myconfig->{email}>|; - $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; - $mail->{subject} = "LedgerSMB Backup / $myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix"; - @{ $mail->{attachments} } = ($tmpfile); - $mail->{version} = $form->{version}; - $mail->{fileid} = "$boundary."; - $mail->{format} = "plain"; - $mail->{format} = "octet-stream" if ${LedgerSMB::Sysconfig::gzip}; + if ( $form->{media} eq 'email' ) { + if ( ${LedgerSMB::Sysconfig::gzip} ) { + print OUT +`pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname} | ${LedgerSMB::Sysconfig::gzip}`; + } + else { + print OUT +`pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname}`; + } + close OUT; + use LedgerSMB::Mailer; + $mail = new Mailer; - $myconfig->{signature} =~ s/\\n/\n/g; - $mail->{message} = "-- \n$myconfig->{signature}"; + $mail->{to} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + $mail->{subject} = +"LedgerSMB Backup / $myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix"; + @{ $mail->{attachments} } = ($tmpfile); + $mail->{version} = $form->{version}; + $mail->{fileid} = "$boundary."; + $mail->{format} = "plain"; + $mail->{format} = "octet-stream" if ${LedgerSMB::Sysconfig::gzip}; - $err = $mail->send; - } + $myconfig->{signature} =~ s/\\n/\n/g; + $mail->{message} = "-- \n$myconfig->{signature}"; - if ($form->{media} eq 'file') { + $err = $mail->send; + } - open(IN, '<', "$tmpfile") or $form->error("$tmpfile : $!"); - open(OUT, ">-") or $form->error("STDOUT : $!"); + if ( $form->{media} eq 'file' ) { - print OUT qq|Content-Type: application/file;\n| . - qq|Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix"\n\n|; - if (${LedgerSMB::Sysconfig::gzip}){ - print OUT `pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname} | ${LedgerSMB::Sysconfig::gzip}`; - } else { - print OUT `pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname}`; - } + open( IN, '<', "$tmpfile" ) or $form->error("$tmpfile : $!"); + open( OUT, ">-" ) or $form->error("STDOUT : $!"); - } + print OUT qq|Content-Type: application/file;\n| + . qq|Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix"\n\n|; + if ( ${LedgerSMB::Sysconfig::gzip} ) { + print OUT +`pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname} | ${LedgerSMB::Sysconfig::gzip}`; + } + else { + print OUT +`pg_dump -U $myconfig->{dbuser} -h $myconfig->{dbhost} $myconfig->{dbname}`; + } - unlink "$tmpfile"; + } -} + unlink "$tmpfile"; +} sub closedto { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT (SELECT value FROM defaults WHERE setting_key = 'closedto'), (SELECT value FROM defaults @@ -1684,108 +1697,104 @@ sub closedto { (SELECT value FROM defaults WHERE setting_key = 'audittrail')|; - ($form->{closedto}, $form->{revtrans}, $form->{audittrail}) - = $dbh->selectrow_array($query); + ( $form->{closedto}, $form->{revtrans}, $form->{audittrail} ) = + $dbh->selectrow_array($query); - $dbh->commit; + $dbh->commit; } - sub closebooks { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; - my $query = qq| + my $dbh = $form->{dbh}; + my $query = qq| UPDATE defaults SET value = ? WHERE setting_key = ?|; - my $sth = $dbh->prepare($query); - for (qw(revtrans closedto audittrail)){ - - if ($form->{$_}){ - $val = 1; - } else { - $val = 0; - } - $sth->execute($val, $_); - } - - - if ($form->{removeaudittrail}) { - $query = qq| + my $sth = $dbh->prepare($query); + for (qw(revtrans closedto audittrail)) { + + if ( $form->{$_} ) { + $val = 1; + } + else { + $val = 0; + } + $sth->execute( $val, $_ ); + } + + if ( $form->{removeaudittrail} ) { + $query = qq| DELETE FROM audittrail - WHERE transdate < | . - $dbh->quote($form->{removeaudittrail}); + WHERE transdate < | . $dbh->quote( $form->{removeaudittrail} ); - $dbh->do($query) || $form->dberror($query); - } + $dbh->do($query) || $form->dberror($query); + } - $dbh->commit; + $dbh->commit; } - sub earningsaccounts { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my ($query, $sth, $ref); + my ( $query, $sth, $ref ); - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - # get chart of accounts - $query = qq| + # get chart of accounts + $query = qq| SELECT accno,description FROM chart WHERE charttype = 'A' AND category = 'Q' ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - $form->{chart} = ""; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + $form->{chart} = ""; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{chart} }, $ref; - } - - $sth->finish; - $dbh->commit; -} + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{chart} }, $ref; + } + $sth->finish; + $dbh->commit; +} sub post_yearend { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database, turn off AutoCommit - my $dbh = $form->{dbh}; + # connect to database, turn off AutoCommit + my $dbh = $form->{dbh}; - my $query; - my @queryargs; - my $uid = localtime; - $uid .= "$$"; + my $query; + my @queryargs; + my $uid = localtime; + $uid .= "$$"; - $query = qq| + $query = qq| INSERT INTO gl (reference, employee_id) VALUES (?, (SELECT id FROM employees WHERE login = ?))|; - $dbh->prepare($query)->execute($uid, $form->{login}) - || $form->dberror($query); + $dbh->prepare($query)->execute( $uid, $form->{login} ) + || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM gl WHERE reference = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($uid); - ($form->{id}) = $sth->fetchrow_array; + my $sth = $dbh->prepare($query); + $sth->execute($uid); + ( $form->{id} ) = $sth->fetchrow_array; - $query = qq| + $query = qq| UPDATE gl SET reference = ?, description = ?, @@ -1794,13 +1803,15 @@ sub post_yearend { department_id = 0 WHERE id = ?|; - @queryargs = ($form->{reference}, $form->{description}, $form->{notes}, - $form->{transdate}, $form->{id}); - $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); + @queryargs = ( + $form->{reference}, $form->{description}, $form->{notes}, + $form->{transdate}, $form->{id} + ); + $dbh->prepare($query)->execute(@queryargs) || $form->dberror($query); - my $amount; - my $accno; - $query = qq| + my $amount; + my $accno; + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, source) VALUES (?, (SELECT id @@ -1808,67 +1819,69 @@ sub post_yearend { WHERE accno = ?), ?, ?, ?)|; + # insert acc_trans transactions + for my $i ( 1 .. $form->{rowcount} ) { - # insert acc_trans transactions - for my $i (1 .. $form->{rowcount}) { - # extract accno - ($accno) = split(/--/, $form->{"accno_$i"}); - $amount = 0; - - if ($form->{"credit_$i"}) { - $amount = $form->{"credit_$i"}; - } + # extract accno + ($accno) = split( /--/, $form->{"accno_$i"} ); + $amount = 0; - if ($form->{"debit_$i"}) { - $amount = $form->{"debit_$i"} * -1; - } + if ( $form->{"credit_$i"} ) { + $amount = $form->{"credit_$i"}; + } + if ( $form->{"debit_$i"} ) { + $amount = $form->{"debit_$i"} * -1; + } - # if there is an amount, add the record - if ($amount) { - my @args = ($form->{id}, $accno, $amount, - $form->{transdate}, $form->{reference}); + # if there is an amount, add the record + if ($amount) { + my @args = ( + $form->{id}, $accno, $amount, $form->{transdate}, + $form->{reference} + ); - $dbh->prepare($query)->execute(@args) - || $form->dberror($query); - } - } + $dbh->prepare($query)->execute(@args) + || $form->dberror($query); + } + } - $query = qq| + $query = qq| INSERT INTO yearend (trans_id, transdate) VALUES (?, ?)|; - $dbh->prepare($query)->execute($form->{id}, $form->{transdate}) - || $form->dberror($query); + $dbh->prepare($query)->execute( $form->{id}, $form->{transdate} ) + || $form->dberror($query); - my %audittrail = ( - tablename => 'gl', - reference => $form->{reference}, - formname => 'yearend', - action => 'posted', - id => $form->{id} ); + my %audittrail = ( + tablename => 'gl', + reference => $form->{reference}, + formname => 'yearend', + action => 'posted', + id => $form->{id} + ); - $form->audittrail($dbh, "", \%audittrail); + $form->audittrail( $dbh, "", \%audittrail ); - # commit and redirect - my $rc = $dbh->commit; + # commit and redirect + my $rc = $dbh->commit; - $rc; + $rc; } -sub get_all_defaults{ - my ($self, $form) = @_; - my $dbh = $form->{dbh}; - my $query = "select setting_key, value FROM defaults"; - $sth = $dbh->prepare($query); - $sth->execute; - while (($skey, $value) = $sth->fetchrow_array()){ - $form->{$skey} = $value; - } - - $self->defaultaccounts(undef, $form); - $dbh->commit; +sub get_all_defaults { + my ( $self, $form ) = @_; + my $dbh = $form->{dbh}; + my $query = "select setting_key, value FROM defaults"; + $sth = $dbh->prepare($query); + $sth->execute; + while ( ( $skey, $value ) = $sth->fetchrow_array() ) { + $form->{$skey} = $value; + } + + $self->defaultaccounts( undef, $form ); + $dbh->commit; } 1; diff --git a/LedgerSMB/BP.pm b/LedgerSMB/BP.pm index 6b9bf73d..f745f62d 100644 --- a/LedgerSMB/BP.pm +++ b/LedgerSMB/BP.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used @@ -20,7 +20,7 @@ # Author: DWS Systems Inc. # Web: http://www.sql-ledger.org # -# Contributors: +# Contributors: # This file has undergone whitespace cleanup. # @@ -33,38 +33,37 @@ package BP; use LedgerSMB::Sysconfig; - - sub get_vc { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my %arap = ( invoice => ['ar'], - packing_list => ['oe', 'ar'], - sales_order => ['oe'], - work_order => ['oe'], - pick_list => ['oe', 'ar'], - purchase_order => ['oe'], - bin_list => ['oe'], - sales_quotation => ['oe'], - request_quotation => ['oe'], - timecard => ['jcitems'], - check => ['ap'], - ); - - my $query = ""; - my $sth; - my $n; - my $count; - my $item; - my $sth; - - $item = $form->{dbh}->quote($item); - foreach $item (@{ $arap{$form->{type}} }) { - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my %arap = ( + invoice => ['ar'], + packing_list => [ 'oe', 'ar' ], + sales_order => ['oe'], + work_order => ['oe'], + pick_list => [ 'oe', 'ar' ], + purchase_order => ['oe'], + bin_list => ['oe'], + sales_quotation => ['oe'], + request_quotation => ['oe'], + timecard => ['jcitems'], + check => ['ap'], + ); + + my $query = ""; + my $sth; + my $n; + my $count; + my $item; + my $sth; + + $item = $form->{dbh}->quote($item); + foreach $item ( @{ $arap{ $form->{type} } } ) { + $query = qq| SELECT count(*) FROM (SELECT DISTINCT vc.id FROM $form->{vc} vc, $item a, status s @@ -73,21 +72,21 @@ sub get_vc { AND s.formname = ? AND s.spoolfile IS NOT NULL) AS total|; - $sth = $dbh->prepare($query); - $sth->execute($form->{type}); - ($n) = $sth->fetchrow_array; - $count += $n; - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{type} ); + ($n) = $sth->fetchrow_array; + $count += $n; + } - # build selection list - my $union = ""; - $query = ""; - my @queryargs = (); + # build selection list + my $union = ""; + $query = ""; + my @queryargs = (); - if ($count < $myconfig->{vclimit}) { + if ( $count < $myconfig->{vclimit} ) { - foreach $item (@{ $arap{$form->{type}} }) { - $query .= qq| + foreach $item ( @{ $arap{ $form->{type} } } ) { + $query .= qq| $union SELECT DISTINCT vc.id, vc.name FROM $item a @@ -96,61 +95,63 @@ sub get_vc { JOIN status s ON (s.trans_id = a.id) WHERE s.formname = ? AND s.spoolfile IS NOT NULL|; - $union = "UNION"; - push @queryargs, $form->{type}; - } + $union = "UNION"; + push @queryargs, $form->{type}; + } - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{"all_$form->{vc}"} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{"all_$form->{vc}"} }, $ref; + } - $sth->finish; - } - $dbh->{commit}; + $sth->finish; + } + $dbh->{commit}; - $form->all_years($myconfig, $dbh); + $form->all_years( $myconfig, $dbh ); } - sub get_spoolfiles { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query; - my $invnumber = "invnumber"; - my $item; - - my %arap = ( invoice => ['ar'], - packing_list => ['oe', 'ar'], - sales_order => ['oe'], - work_order => ['oe'], - pick_list => ['oe', 'ar'], - purchase_order => ['oe'], - bin_list => ['oe'], - sales_quotation => ['oe'], - request_quotation => ['oe'], - timecard => ['jc'], - check => ['ap'], - ); - - ($form->{transdatefrom}, $form->{transdateto}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; - - my @queryargs; - if ($form->{type} eq 'timecard') { - my $dateformat = $myconfig->{dateformat}; - $dateformat =~ s/yy/yyyy/; - $dateformat =~ s/yyyyyy/yyyy/; - - $invnumber = 'id'; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $query; + my $invnumber = "invnumber"; + my $item; + + my %arap = ( + invoice => ['ar'], + packing_list => [ 'oe', 'ar' ], + sales_order => ['oe'], + work_order => ['oe'], + pick_list => [ 'oe', 'ar' ], + purchase_order => ['oe'], + bin_list => ['oe'], + sales_quotation => ['oe'], + request_quotation => ['oe'], + timecard => ['jc'], + check => ['ap'], + ); + + ( $form->{transdatefrom}, $form->{transdateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + my @queryargs; + if ( $form->{type} eq 'timecard' ) { + my $dateformat = $myconfig->{dateformat}; + $dateformat =~ s/yy/yyyy/; + $dateformat =~ s/yyyyyy/yyyy/; + + $invnumber = 'id'; + + $query = qq| SELECT j.id, e.name, j.id AS invnumber, to_char(j.checkedin, ?) AS transdate, '' AS ordnumber, '' AS quonumber, '0' AS invoice, @@ -160,42 +161,44 @@ sub get_spoolfiles { JOIN status s ON (s.trans_id = j.id) WHERE s.formname = ? AND s.spoolfile IS NOT NULL|; - @queryargs = ($dateformat, $form->{type}); - - if ($form->{"$form->{vc}_id"}) { - $query .= qq| AND j.$form->{vc}_id = ?|; - push(@queryargs, $form->{"$form->{vc}_id"}); - } else { - - if ($form->{$form->{vc}}) { - $item = $form->like(lc $form->{$form->{vc}}); - $query .= " AND lower(e.name) LIKE ?"; - push(@queryargs, $item); - } - } - - if ($form->{transdatefrom}){ - $query .= " AND j.checkedin >= ?"; - push (@queryargs, $form->{transdatefrom}); - } - if ($form->{transdateto}){ - $query .= " AND j.checkedin <= ?"; - push (@queryargs, $form->{transdateto}); - } - } else { - @queryargs = (); - - foreach $item (@{ $arap{$form->{type}} }) { - - $invoice = "a.invoice"; - $invnumber = "invnumber"; - - if ($item eq 'oe') { - $invnumber = "ordnumber"; - $invoice = "'0'"; - } - - $query .= qq| + @queryargs = ( $dateformat, $form->{type} ); + + if ( $form->{"$form->{vc}_id"} ) { + $query .= qq| AND j.$form->{vc}_id = ?|; + push( @queryargs, $form->{"$form->{vc}_id"} ); + } + else { + + if ( $form->{ $form->{vc} } ) { + $item = $form->like( lc $form->{ $form->{vc} } ); + $query .= " AND lower(e.name) LIKE ?"; + push( @queryargs, $item ); + } + } + + if ( $form->{transdatefrom} ) { + $query .= " AND j.checkedin >= ?"; + push( @queryargs, $form->{transdatefrom} ); + } + if ( $form->{transdateto} ) { + $query .= " AND j.checkedin <= ?"; + push( @queryargs, $form->{transdateto} ); + } + } + else { + @queryargs = (); + + foreach $item ( @{ $arap{ $form->{type} } } ) { + + $invoice = "a.invoice"; + $invnumber = "invnumber"; + + if ( $item eq 'oe' ) { + $invnumber = "ordnumber"; + $invoice = "'0'"; + } + + $query .= qq| $union SELECT a.id, vc.name, a.$invnumber AS invnumber, a.transdate, a.ordnumber, a.quonumber, $invoice AS invoice, @@ -206,174 +209,175 @@ sub get_spoolfiles { AND s.formname = ? AND a.$form->{vc}_id = vc.id|; - push (@queryargs, $form->{type}); - if ($form->{"$form->{vc}_id"}) { - $query .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; - } else { - - if ($form->{$form->{vc}} ne "") { - $item = $form->like( - lc $form->{$form->{vc}}); - $query .= " AND lower(vc.name) LIKE ?"; - push @queryargs, $item; - } - } - - if ($form->{invnumber} ne "") { - $item = $form->like(lc $form->{invnumber}); - $query .= " AND lower(a.invnumber) LIKE ?"; - push @queryargs, $item; - } - - if ($form->{ordnumber} ne "") { - $item = $form->like(lc $form->{ordnumber}); - $query .= " AND lower(a.ordnumber) LIKE ?"; - push @queryargs, $item; - } - - if ($form->{quonumber} ne "") { - $item = $form->like(lc $form->{quonumber}); - $query .= " AND lower(a.quonumber) LIKE ?"; - push @queryargs, $item; - } - - if ($form->{transdatefrom}){ - $query .= " AND a.transdate >= ?"; - push @queryargs, $form->{transdatefrom}; - } - if ($form->{transdateto}){ - $query .= " AND a.transdate <= ?"; - push @queryargs, $form->{transdateto}; - } - $union = "UNION"; - - } - } - - my %ordinal = ( 'name' => 2, - 'invnumber' => 3, - 'transdate' => 4, - 'ordnumber' => 5, - 'quonumber' => 6,); - - my @a = (); - push @a, ("transdate", "$invnumber", "name"); - my $sortorder = $form->sort_order(\@a, \%ordinal); - $query .= " ORDER by $sortorder"; - - my $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{SPOOL} }, $ref; - } - - $sth->finish; - $dbh->commit; + push( @queryargs, $form->{type} ); + if ( $form->{"$form->{vc}_id"} ) { + $query .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } + else { + + if ( $form->{ $form->{vc} } ne "" ) { + $item = $form->like( lc $form->{ $form->{vc} } ); + $query .= " AND lower(vc.name) LIKE ?"; + push @queryargs, $item; + } + } + + if ( $form->{invnumber} ne "" ) { + $item = $form->like( lc $form->{invnumber} ); + $query .= " AND lower(a.invnumber) LIKE ?"; + push @queryargs, $item; + } + + if ( $form->{ordnumber} ne "" ) { + $item = $form->like( lc $form->{ordnumber} ); + $query .= " AND lower(a.ordnumber) LIKE ?"; + push @queryargs, $item; + } + + if ( $form->{quonumber} ne "" ) { + $item = $form->like( lc $form->{quonumber} ); + $query .= " AND lower(a.quonumber) LIKE ?"; + push @queryargs, $item; + } + + if ( $form->{transdatefrom} ) { + $query .= " AND a.transdate >= ?"; + push @queryargs, $form->{transdatefrom}; + } + if ( $form->{transdateto} ) { + $query .= " AND a.transdate <= ?"; + push @queryargs, $form->{transdateto}; + } + $union = "UNION"; + + } + } + + my %ordinal = ( + 'name' => 2, + 'invnumber' => 3, + 'transdate' => 4, + 'ordnumber' => 5, + 'quonumber' => 6, + ); + + my @a = (); + push @a, ( "transdate", "$invnumber", "name" ); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + $query .= " ORDER by $sortorder"; + + my $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{SPOOL} }, $ref; + } + + $sth->finish; + $dbh->commit; } - sub delete_spool { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database, turn AutoCommit off - my $dbh = $form->{dbh}; + # connect to database, turn AutoCommit off + my $dbh = $form->{dbh}; - my $query; - my %audittrail; + my $query; + my %audittrail; - $query = qq| + $query = qq| UPDATE status SET spoolfile = NULL WHERE spoolfile = ?|; - my $sth = $dbh->prepare($query) || $form->dberror($query); + my $sth = $dbh->prepare($query) || $form->dberror($query); - foreach my $i (1 .. $form->{rowcount}) { + foreach my $i ( 1 .. $form->{rowcount} ) { - if ($form->{"checked_$i"}) { - $sth->execute($form->{"spoolfile_$i"}) || $form->dberror($query); - $sth->finish; + if ( $form->{"checked_$i"} ) { + $sth->execute( $form->{"spoolfile_$i"} ) || $form->dberror($query); + $sth->finish; - %audittrail = ( - tablename => $form->{module}, - reference => $form->{"reference_$i"}, - formname => $form->{type}, - action => 'dequeued', - id => $form->{"id_$i"} ); + %audittrail = ( + tablename => $form->{module}, + reference => $form->{"reference_$i"}, + formname => $form->{type}, + action => 'dequeued', + id => $form->{"id_$i"} + ); - $form->audittrail($dbh, "", \%audittrail); - } - } + $form->audittrail( $dbh, "", \%audittrail ); + } + } - # commit - my $rc = $dbh->commit; + # commit + my $rc = $dbh->commit; - if ($rc) { - foreach my $i (1 .. $form->{rowcount}) { - $_ = qq|${LedgerSMB::Sysconfig::spool}/$form->{"spoolfile_$i"}|; - if ($form->{"checked_$i"}) { - unlink; - } - } - } + if ($rc) { + foreach my $i ( 1 .. $form->{rowcount} ) { + $_ = qq|${LedgerSMB::Sysconfig::spool}/$form->{"spoolfile_$i"}|; + if ( $form->{"checked_$i"} ) { + unlink; + } + } + } - $rc; + $rc; } - sub print_spool { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my %audittrail; + my %audittrail; - my $query = qq|UPDATE status + my $query = qq|UPDATE status SET printed = '1' WHERE spoolfile = ?|; - my $sth = $dbh->prepare($query) || $form->dberror($query); - - foreach my $i (1 .. $form->{rowcount}) { + my $sth = $dbh->prepare($query) || $form->dberror($query); - if ($form->{"checked_$i"}) { - open(OUT, '>', $form->{OUT}) or $form->error("$form->{OUT} : $!"); - binmode(OUT); + foreach my $i ( 1 .. $form->{rowcount} ) { - $spoolfile = qq|$spool/$form->{"spoolfile_$i"}|; + if ( $form->{"checked_$i"} ) { + open( OUT, '>', $form->{OUT} ) or $form->error("$form->{OUT} : $!"); + binmode(OUT); - # send file to printer - open(IN, '<', $spoolfile) or $form->error("$spoolfile : $!"); - binmode(IN); + $spoolfile = qq|$spool/$form->{"spoolfile_$i"}|; - while (<IN>) { - print OUT $_; - } + # send file to printer + open( IN, '<', $spoolfile ) or $form->error("$spoolfile : $!"); + binmode(IN); - close(IN); - close(OUT); + while (<IN>) { + print OUT $_; + } - $sth->execute($form->{"spoolfile_$i"}) || $form->dberror($query); - $sth->finish; + close(IN); + close(OUT); - %audittrail = ( - tablename => $form->{module}, - reference => $form->{"reference_$i"}, - formname => $form->{type}, - action => 'printed', - id => $form->{"id_$i"} ); + $sth->execute( $form->{"spoolfile_$i"} ) || $form->dberror($query); + $sth->finish; - $form->audittrail($dbh, "", \%audittrail); + %audittrail = ( + tablename => $form->{module}, + reference => $form->{"reference_$i"}, + formname => $form->{type}, + action => 'printed', + id => $form->{"id_$i"} + ); - $dbh->commit; - } - } + $form->audittrail( $dbh, "", \%audittrail ); + $dbh->commit; + } + } } diff --git a/LedgerSMB/CA.pm b/LedgerSMB/CA.pm index 2c4ff105..b182e6d0 100644 --- a/LedgerSMB/CA.pm +++ b/LedgerSMB/CA.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used @@ -32,199 +32,202 @@ # #====================================================================== - package CA; - sub all_accounts { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $amount = (); - # connect to database - my $dbh = $form->{dbh}; + my $amount = (); - my $query = qq| + # connect to database + my $dbh = $form->{dbh}; + + my $query = qq| SELECT accno, SUM(acc_trans.amount) AS amount FROM chart, acc_trans WHERE chart.id = acc_trans.chart_id GROUP BY accno|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $amount{ $ref->{accno} } = $ref->{amount}; + } - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $amount{$ref->{accno}} = $ref->{amount} - } - - $sth->finish; + $sth->finish; - $query = qq| + $query = qq| SELECT accno, description FROM gifi|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $gifi = (); + my $gifi = (); - while (my ($accno, $description) = $sth->fetchrow_array) { - $gifi{$accno} = $description; - } + while ( my ( $accno, $description ) = $sth->fetchrow_array ) { + $gifi{$accno} = $description; + } - $sth->finish; + $sth->finish; - $query = qq| + $query = qq| SELECT c.id, c.accno, c.description, c.charttype, c.gifi_accno, c.category, c.link FROM chart c ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ca = $sth->fetchrow_hashref(NAME_lc)) { - $ca->{amount} = $amount{$ca->{accno}}; - $ca->{gifi_description} = $gifi{$ca->{gifi_accno}}; + while ( my $ca = $sth->fetchrow_hashref(NAME_lc) ) { + $ca->{amount} = $amount{ $ca->{accno} }; + $ca->{gifi_description} = $gifi{ $ca->{gifi_accno} }; - if ($ca->{amount} < 0) { - $ca->{debit} = $ca->{amount} * -1; - } else { - $ca->{credit} = $ca->{amount}; - } + if ( $ca->{amount} < 0 ) { + $ca->{debit} = $ca->{amount} * -1; + } + else { + $ca->{credit} = $ca->{amount}; + } - push @{ $form->{CA} }, $ca; - } + push @{ $form->{CA} }, $ca; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub all_transactions { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - # get chart_id - my $query = qq| + # get chart_id + my $query = qq| SELECT id FROM chart WHERE accno = ?|; - my $accno = $form->{accno}; + my $accno = $form->{accno}; - if ($form->{accounttype} eq 'gifi') { - $query = qq| + if ( $form->{accounttype} eq 'gifi' ) { + $query = qq| SELECT id FROM chart WHERE gifi_accno = ?|; - $accno = $form->{gifi_accno}; - } - - my $sth = $dbh->prepare($query); - $sth->execute($accno) || $form->dberror($query); - - my @id = (); - - while (my ($id) = $sth->fetchrow_array) { - push @id, $id; - } - - $sth->finish; - - my $fromdate_where; - my $todate_where; - - ($form->{fromdate}, $form->{todate}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; - - my $fdate; - if ($form->{fromdate}) { - $fromdate_where = qq| AND ac.transdate >= ? |; - $fdate = $form->{fromdate}; - } - my $tdate; - if ($form->{todate}) { - $todate_where .= qq| AND ac.transdate <= ? |; - $tdate = $form->{todate}; - } - - - my $false = 'FALSE'; - - # Oracle workaround, use ordinal positions - my %ordinal = ( transdate => 4, - reference => 2, - description => 3 ); - - my @a = qw(transdate reference description); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $null; - my $department_id; - my $dpt_where; - my $dpt_join; - my $union; - - ($null, $department_id) = split /--/, $form->{department}; - - my $d_id; - if ($department_id) { - $dpt_join = qq| JOIN department t ON (t.id = a.department_id) |; - $dpt_where = qq| AND t.id = ? |; - $d_id = $department_id; - } - - - my $project; - my $project_id; - my $p_id; - if ($form->{projectnumber}) { - ($null, $project_id) = split /--/, $form->{projectnumber}; - $project = qq| AND ac.project_id = ? |; - $p_id = $project_id; - } - - @queryargs = (); - - if ($form->{accno} || $form->{gifi_accno}) { - # get category for account - $query = qq| + $accno = $form->{gifi_accno}; + } + + my $sth = $dbh->prepare($query); + $sth->execute($accno) || $form->dberror($query); + + my @id = (); + + while ( my ($id) = $sth->fetchrow_array ) { + push @id, $id; + } + + $sth->finish; + + my $fromdate_where; + my $todate_where; + + ( $form->{fromdate}, $form->{todate} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + my $fdate; + if ( $form->{fromdate} ) { + $fromdate_where = qq| AND ac.transdate >= ? |; + $fdate = $form->{fromdate}; + } + my $tdate; + if ( $form->{todate} ) { + $todate_where .= qq| AND ac.transdate <= ? |; + $tdate = $form->{todate}; + } + + my $false = 'FALSE'; + + # Oracle workaround, use ordinal positions + my %ordinal = ( + transdate => 4, + reference => 2, + description => 3 + ); + + my @a = qw(transdate reference description); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $null; + my $department_id; + my $dpt_where; + my $dpt_join; + my $union; + + ( $null, $department_id ) = split /--/, $form->{department}; + + my $d_id; + if ($department_id) { + $dpt_join = qq| JOIN department t ON (t.id = a.department_id) |; + $dpt_where = qq| AND t.id = ? |; + $d_id = $department_id; + } + + my $project; + my $project_id; + my $p_id; + if ( $form->{projectnumber} ) { + ( $null, $project_id ) = split /--/, $form->{projectnumber}; + $project = qq| AND ac.project_id = ? |; + $p_id = $project_id; + } + + @queryargs = (); + + if ( $form->{accno} || $form->{gifi_accno} ) { + + # get category for account + $query = qq| SELECT description, category, link, contra FROM chart WHERE accno = ?|; - $accno = $form->{accno}; - if ($form->{accounttype} eq 'gifi') { - $query = qq| + $accno = $form->{accno}; + if ( $form->{accounttype} eq 'gifi' ) { + $query = qq| SELECT description, category, link, contra FROM chart WHERE gifi_accno = ? AND charttype = 'A'|; - $accno = $form->{gifi_accno}; - } + $accno = $form->{gifi_accno}; + } - $sth = $dbh->prepare($query); - $sth->execute($accno); - ($form->{description}, $form->{category}, $form->{link}, - $form->{contra}) - = $sth->fetchrow_array; + $sth = $dbh->prepare($query); + $sth->execute($accno); + ( + $form->{description}, $form->{category}, + $form->{link}, $form->{contra} + ) = $sth->fetchrow_array; - if ($form->{fromdate}) { + if ( $form->{fromdate} ) { - if ($department_id) { + if ($department_id) { - # get beginning balance - $query = ""; - $union = ""; + # get beginning balance + $query = ""; + $union = ""; - for (qw(ar ap gl)) { + for (qw(ar ap gl)) { - if ($form->{accounttype} eq 'gifi') { - $query = qq| + if ( $form->{accounttype} eq 'gifi' ) { + $query = qq| $union SELECT SUM(ac.amount) FROM acc_trans ac @@ -244,16 +247,15 @@ sub all_transactions { = ? $project |; - push @queryargs, - $form->{gifi_accno}, - $form->{fromdate}, - $form->{department_id}; - if ($p_id){ - push @queryargs, $p_id; - } - } else { + push @queryargs, $form->{gifi_accno}, $form->{fromdate}, + $form->{department_id}; + if ($p_id) { + push @queryargs, $p_id; + } + } + else { - $query .= qq| + $query .= qq| $union SELECT SUM(ac.amount) FROM acc_trans ac @@ -270,21 +272,21 @@ sub all_transactions { a.department_id = ? $project |; - push @queryargs, $form->{accno}, - $form->{fromdate}, - $department_id; - if ($p_id){ - push @queryargs, $p_id; - } - } + push @queryargs, $form->{accno}, $form->{fromdate}, + $department_id; + if ($p_id) { + push @queryargs, $p_id; + } + } - $union = qq| UNION ALL |; - } + $union = qq| UNION ALL |; + } - } else { + } + else { - if ($form->{accounttype} eq 'gifi') { - $query = qq| + if ( $form->{accounttype} eq 'gifi' ) { + $query = qq| SELECT SUM(ac.amount) FROM acc_trans ac JOIN chart c ON @@ -292,13 +294,13 @@ sub all_transactions { WHERE c.gifi_accno = ? AND ac.transdate < ? $project |; - @queryargs = ($form->{gifi_accno}, - $form->{fromdate}); - if ($p_id){ - push @query_ags, $p_id; - } - } else { - $query = qq| + @queryargs = ( $form->{gifi_accno}, $form->{fromdate} ); + if ($p_id) { + push @query_ags, $p_id; + } + } + else { + $query = qq| SELECT SUM(ac.amount) FROM acc_trans ac JOIN chart c @@ -306,29 +308,28 @@ sub all_transactions { WHERE c.accno = ? AND ac.transdate < ? $project |; - @queryargs = ($form->{accno}, - $form->{fromdate}); - if ($p_id){ - push @queryargs, $p_id; - } - } - } - - $sth = $dbh->prepare($query); - $sth->execute(@queryargs); - ($form->{balance}) = $sth->fetchrow_array; - $sth->finish; - @queryargs = (); - } - } - - $query = ""; - $union = ""; - - foreach my $id (@id) { - - # get all transactions - $query .= qq| + @queryargs = ( $form->{accno}, $form->{fromdate} ); + if ($p_id) { + push @queryargs, $p_id; + } + } + } + + $sth = $dbh->prepare($query); + $sth->execute(@queryargs); + ( $form->{balance} ) = $sth->fetchrow_array; + $sth->finish; + @queryargs = (); + } + } + + $query = ""; + $union = ""; + + foreach my $id (@id) { + + # get all transactions + $query .= qq| $union SELECT a.id, a.reference, a.description, ac.transdate, $false AS invoice, ac.amount, 'gl' as module, @@ -341,23 +342,23 @@ sub all_transactions { $todate_where $dpt_where $project|; - if ($d_id){ - push @queryargs, $d_id; - } - push @queryargs, $id; - if ($fdate){ - push @queryargs, $fdate; - } - if ($tdate){ - push @queryargs, $tdate; - } - if ($d_id){ - push @queryargs, $d_id; - } - if ($p_id){ - push @queryargs, $p_id; - } - $query .= qq| + if ($d_id) { + push @queryargs, $d_id; + } + push @queryargs, $id; + if ($fdate) { + push @queryargs, $fdate; + } + if ($tdate) { + push @queryargs, $tdate; + } + if ($d_id) { + push @queryargs, $d_id; + } + if ($p_id) { + push @queryargs, $p_id; + } + $query .= qq| UNION ALL @@ -374,24 +375,24 @@ sub all_transactions { $dpt_where $project|; - if ($d_id){ - push @queryargs, $d_id; - } - push @queryargs, $id; - if ($fdate){ - push @queryargs, $fdate; - } - if ($tdate){ - push @queryargs, $tdate; - } - if ($d_id){ - push @queryargs, $d_id; - } - if ($p_id){ - push @queryargs, $p_id; - } - - $query .= qq| + if ($d_id) { + push @queryargs, $d_id; + } + push @queryargs, $id; + if ($fdate) { + push @queryargs, $fdate; + } + if ($tdate) { + push @queryargs, $tdate; + } + if ($d_id) { + push @queryargs, $d_id; + } + if ($p_id) { + push @queryargs, $p_id; + } + + $query .= qq| UNION ALL SELECT a.id, a.invnumber, v.name, ac.transdate, @@ -407,112 +408,113 @@ sub all_transactions { $dpt_where $project |; - if ($d_id){ - push @queryargs, $d_id; - } - push @queryargs, $id; - if ($fdate){ - push @queryargs, $fdate; - } - if ($tdate){ - push @queryargs, $tdate; - } - if ($d_id){ - push @queryargs, $d_id; - } - if ($p_id){ - push @queryargs, $p_id; - } - $union = qq| UNION ALL |; - } - - $query .= qq| ORDER BY $sortorder |; - - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - - $query = qq|SELECT c.id, c.accno + if ($d_id) { + push @queryargs, $d_id; + } + push @queryargs, $id; + if ($fdate) { + push @queryargs, $fdate; + } + if ($tdate) { + push @queryargs, $tdate; + } + if ($d_id) { + push @queryargs, $d_id; + } + if ($p_id) { + push @queryargs, $p_id; + } + $union = qq| UNION ALL |; + } + + $query .= qq| ORDER BY $sortorder |; + + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + + $query = qq|SELECT c.id, c.accno FROM chart c JOIN acc_trans ac ON (ac.chart_id = c.id) WHERE ac.amount >= 0 AND (c.link = 'AR' OR c.link = 'AP') AND ac.trans_id = ?|; - my $dr = $dbh->prepare($query) || $form->dberror($query); + my $dr = $dbh->prepare($query) || $form->dberror($query); - $query = qq|SELECT c.id, c.accno + $query = qq|SELECT c.id, c.accno FROM chart c JOIN acc_trans ac ON (ac.chart_id = c.id) WHERE ac.amount < 0 AND (c.link = 'AR' OR c.link = 'AP') AND ac.trans_id = ?|; - my $cr = $dbh->prepare($query) || $form->dberror($query); + my $cr = $dbh->prepare($query) || $form->dberror($query); - my $accno; - my $chart_id; - my %accno; + my $accno; + my $chart_id; + my %accno; - while (my $ca = $sth->fetchrow_hashref(NAME_lc)) { + while ( my $ca = $sth->fetchrow_hashref(NAME_lc) ) { - # gl - if ($ca->{module} eq "gl") { - $ca->{module} = "gl"; - } + # gl + if ( $ca->{module} eq "gl" ) { + $ca->{module} = "gl"; + } - # ap - if ($ca->{module} eq "ap") { - $ca->{module} = ($ca->{invoice}) ? 'ir' : 'ap'; - $ca->{module} = 'ps' if $ca->{till}; - } + # ap + if ( $ca->{module} eq "ap" ) { + $ca->{module} = ( $ca->{invoice} ) ? 'ir' : 'ap'; + $ca->{module} = 'ps' if $ca->{till}; + } - # ar - if ($ca->{module} eq "ar") { - $ca->{module} = ($ca->{invoice}) ? 'is' : 'ar'; - $ca->{module} = 'ps' if $ca->{till}; - } + # ar + if ( $ca->{module} eq "ar" ) { + $ca->{module} = ( $ca->{invoice} ) ? 'is' : 'ar'; + $ca->{module} = 'ps' if $ca->{till}; + } - if ($ca->{amount}) { - %accno = (); + if ( $ca->{amount} ) { + %accno = (); - if ($ca->{amount} < 0) { - $ca->{debit} = $ca->{amount} * -1; - $ca->{credit} = 0; - $dr->execute($ca->{id}); - $ca->{accno} = (); + if ( $ca->{amount} < 0 ) { + $ca->{debit} = $ca->{amount} * -1; + $ca->{credit} = 0; + $dr->execute( $ca->{id} ); + $ca->{accno} = (); - while (($chart_id, $accno) = $dr->fetchrow_array) { - $accno{$accno} = 1 if $chart_id ne $ca->{chart_id}; - } + while ( ( $chart_id, $accno ) = $dr->fetchrow_array ) { + $accno{$accno} = 1 if $chart_id ne $ca->{chart_id}; + } - $dr->finish; + $dr->finish; - for (sort keys %accno) { push @{ $ca->{accno} }, "$_ " } + for ( sort keys %accno ) { push @{ $ca->{accno} }, "$_ " } - } else { + } + else { - $ca->{credit} = $ca->{amount}; - $ca->{debit} = 0; + $ca->{credit} = $ca->{amount}; + $ca->{debit} = 0; - $cr->execute($ca->{id}); - $ca->{accno} = (); + $cr->execute( $ca->{id} ); + $ca->{accno} = (); - while (($chart_id, $accno) = $cr->fetchrow_array) { - $accno{$accno} = 1 if $chart_id ne $ca->{chart_id}; - } + while ( ( $chart_id, $accno ) = $cr->fetchrow_array ) { + $accno{$accno} = 1 if $chart_id ne $ca->{chart_id}; + } - $cr->finish; + $cr->finish; - for (keys %accno) { push @{ $ca->{accno} }, "$_ " } + for ( keys %accno ) { push @{ $ca->{accno} }, "$_ " } - } + } - push @{ $form->{CA} }, $ca; - } - } + push @{ $form->{CA} }, $ca; + } + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } diff --git a/LedgerSMB/CP.pm b/LedgerSMB/CP.pm index bfd18585..7c2d3b45 100644 --- a/LedgerSMB/CP.pm +++ b/LedgerSMB/CP.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -37,353 +37,354 @@ package CP; use LedgerSMB::Sysconfig; - - sub new { - my ($type, $countrycode) = @_; + my ( $type, $countrycode ) = @_; - $self = {}; + $self = {}; - use LedgerSMB::Num2text; - use LedgerSMB::Locale; - $self->{'locale'} = LedgerSMB::Locale->get_handle($countrycode); + use LedgerSMB::Num2text; + use LedgerSMB::Locale; + $self->{'locale'} = LedgerSMB::Locale->get_handle($countrycode); - bless $self, $type; + bless $self, $type; } - sub paymentaccounts { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq|SELECT accno, description, link + my $query = qq|SELECT accno, description, link FROM chart WHERE link LIKE ? ORDER BY accno|; - my $sth = $dbh->prepare($query); - $sth->execute("%$form->{ARAP}%") || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute("%$form->{ARAP}%") || $form->dberror($query); - $form->{PR}{$form->{ARAP}} = (); - $form->{PR}{"$form->{ARAP}_paid"} = (); + $form->{PR}{ $form->{ARAP} } = (); + $form->{PR}{"$form->{ARAP}_paid"} = (); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { - foreach my $item (split /:/, $ref->{link}) { + foreach my $item ( split /:/, $ref->{link} ) { - if ($item eq $form->{ARAP}) { - push @{ $form->{PR}{$form->{ARAP}} }, $ref; - } + if ( $item eq $form->{ARAP} ) { + push @{ $form->{PR}{ $form->{ARAP} } }, $ref; + } - if ($item eq "$form->{ARAP}_paid") { - push @{ $form->{PR}{"$form->{ARAP}_paid"} }, $ref; - } - } - } + if ( $item eq "$form->{ARAP}_paid" ) { + push @{ $form->{PR}{"$form->{ARAP}_paid"} }, $ref; + } + } + } - $sth->finish; + $sth->finish; - # get currencies and closedto - $query = qq| + # get currencies and closedto + $query = qq| SELECT value, (SELECT value FROM defaults WHERE setting_key = 'closedto'), current_date FROM defaults WHERE setting_key = 'curr'|; - ($form->{currencies}, $form->{closedto}, $form->{datepaid}) = $dbh->selectrow_array($query); + ( $form->{currencies}, $form->{closedto}, $form->{datepaid} ) = + $dbh->selectrow_array($query); - if ($form->{payment} eq 'payments') { - # get language codes - $query = qq|SELECT * + if ( $form->{payment} eq 'payments' ) { + + # get language codes + $query = qq|SELECT * FROM language ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); - $form->{all_language} = (); + $form->{all_language} = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_language} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_language} }, $ref; + } - $sth->finish; + $sth->finish; - $form->all_departments($myconfig, $dbh, $form->{vc}); - } + $form->all_departments( $myconfig, $dbh, $form->{vc} ); + } - $dbh->commit; + $dbh->commit; } - sub get_openvc { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $arap = ($form->{vc} eq 'customer') ? 'ar' : 'ap'; - my $query = qq|SELECT count(*) + my $arap = ( $form->{vc} eq 'customer' ) ? 'ar' : 'ap'; + my $query = qq|SELECT count(*) FROM $form->{vc} ct, $arap a WHERE a.$form->{vc}_id = ct.id AND a.amount != a.paid|; - my ($count) = $dbh->selectrow_array($query); + my ($count) = $dbh->selectrow_array($query); - my $sth; - my $ref; - my $i = 0; + my $sth; + my $ref; + my $i = 0; - my $where = qq|WHERE a.$form->{vc}_id = ct.id + my $where = qq|WHERE a.$form->{vc}_id = ct.id AND a.amount != a.paid|; - if ($form->{$form->{vc}}) { - my $var = $dbh->quote($form->like(lc $form->{$form->{vc}})); - $where .= " AND lower(name) LIKE $var"; - } + if ( $form->{ $form->{vc} } ) { + my $var = $dbh->quote( $form->like( lc $form->{ $form->{vc} } ) ); + $where .= " AND lower(name) LIKE $var"; + } - # build selection list - $query = qq|SELECT DISTINCT ct.* + # build selection list + $query = qq|SELECT DISTINCT ct.* FROM $form->{vc} ct, $arap a $where ORDER BY name|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $i++; - push @{ $form->{name_list} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $i++; + push @{ $form->{name_list} }, $ref; + } - $sth->finish; + $sth->finish; - $form->all_departments($myconfig, $dbh, $form->{vc}); + $form->all_departments( $myconfig, $dbh, $form->{vc} ); - # get language codes - $query = qq|SELECT * + # get language codes + $query = qq|SELECT * FROM language ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); - $form->{all_language} = (); + $form->{all_language} = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_language} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_language} }, $ref; + } - $sth->finish; + $sth->finish; - # get currency for first name - if (@{ $form->{name_list} }) { + # get currency for first name + if ( @{ $form->{name_list} } ) { - # Chris T: I don't like this but it seems safe injection-wise - # Leaving it so we can change it when we go to a new system - $query = qq|SELECT curr + # Chris T: I don't like this but it seems safe injection-wise + # Leaving it so we can change it when we go to a new system + $query = qq|SELECT curr FROM $form->{vc} WHERE id = $form->{name_list}->[0]->{id}|; - ($form->{currency}) = $dbh->selectrow_array($query); - $form->{currency} ||= $form->{defaultcurrency}; - } + ( $form->{currency} ) = $dbh->selectrow_array($query); + $form->{currency} ||= $form->{defaultcurrency}; + } - $dbh->commit; + $dbh->commit; - $i; + $i; } - sub get_openinvoices { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $null; - my $department_id; + my $null; + my $department_id; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - $vc_id = $dbh->quote($form->{"$form->{vc}_id"}); - my $where = qq|WHERE a.$form->{vc}_id = $vc_id + $vc_id = $dbh->quote( $form->{"$form->{vc}_id"} ); + my $where = qq|WHERE a.$form->{vc}_id = $vc_id AND a.amount != a.paid|; - $curr = $dbh->quote($form->{currency}); - $where .= qq| AND a.curr = $curr| if $form->{currency}; + $curr = $dbh->quote( $form->{currency} ); + $where .= qq| AND a.curr = $curr| if $form->{currency}; - my $sortorder = "transdate, invnumber"; + my $sortorder = "transdate, invnumber"; - my ($buysell); + my ($buysell); - if ($form->{vc} eq 'customer') { - $buysell = "buy"; - } else { - $buysell = "sell"; - } + if ( $form->{vc} eq 'customer' ) { + $buysell = "buy"; + } + else { + $buysell = "sell"; + } - if ($form->{payment} eq 'payments') { + if ( $form->{payment} eq 'payments' ) { - $where = qq|WHERE a.amount != a.paid|; - $where .= qq| AND a.curr = $curr| if $form->{currency}; + $where = qq|WHERE a.amount != a.paid|; + $where .= qq| AND a.curr = $curr| if $form->{currency}; - if ($form->{duedatefrom}) { - $where .= qq| AND a.duedate >= - |.$dbh->quote($form->{duedatefrom}); - } + if ( $form->{duedatefrom} ) { + $where .= qq| AND a.duedate >= + | . $dbh->quote( $form->{duedatefrom} ); + } - if ($form->{duedateto}) { - $where .= qq| AND a.duedate <= |. - $dbh->quote($form->{duedateto}); - } + if ( $form->{duedateto} ) { + $where .= + qq| AND a.duedate <= | . $dbh->quote( $form->{duedateto} ); + } - $sortorder = "name, transdate"; - } + $sortorder = "name, transdate"; + } + ( $null, $department_id ) = split /--/, $form->{department}; - ($null, $department_id) = split /--/, $form->{department}; + if ($department_id) { + $where .= qq| AND a.department_id = $department_id|; + } - if ($department_id) { - $where .= qq| AND a.department_id = $department_id|; - } - - my $query = qq|SELECT a.id, a.invnumber, a.transdate, a.amount, a.paid, + my $query = qq|SELECT a.id, a.invnumber, a.transdate, a.amount, a.paid, a.curr, c.name, a.$form->{vc}_id, c.language_code FROM $form->{arap} a JOIN $form->{vc} c ON (c.id = a.$form->{vc}_id) $where ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - $query = qq|SELECT s.spoolfile + $query = qq|SELECT s.spoolfile FROM status s WHERE s.formname = '$form->{formname}' AND s.trans_id = ?|; - my $vth = $dbh->prepare($query); - - my $spoolfile; + my $vth = $dbh->prepare($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + my $spoolfile; - # if this is a foreign currency transaction get exchangerate - $ref->{exchangerate} = - $form->get_exchangerate($dbh, - $ref->{curr}, - $ref->{transdate}, - $buysell) - if ($form->{currency} - ne $form->{defaultcurrency}); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { - $vth->execute($ref->{id}); - $ref->{queue} = ""; - - while (($spoolfile) = $vth->fetchrow_array) { - $ref->{queued} .= "$form->{formname} $spoolfile "; - } + # if this is a foreign currency transaction get exchangerate + $ref->{exchangerate} = + $form->get_exchangerate( $dbh, $ref->{curr}, $ref->{transdate}, + $buysell ) + if ( $form->{currency} ne $form->{defaultcurrency} ); - $vth->finish; - $ref->{queued} =~ s/ +$//g; + $vth->execute( $ref->{id} ); + $ref->{queue} = ""; - push @{ $form->{PR} }, $ref; - } + while ( ($spoolfile) = $vth->fetchrow_array ) { + $ref->{queued} .= "$form->{formname} $spoolfile "; + } - $sth->finish; - $dbh->commit; + $vth->finish; + $ref->{queued} =~ s/ +$//g; -} + push @{ $form->{PR} }, $ref; + } + $sth->finish; + $dbh->commit; +} sub post_payment { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database, turn AutoCommit off - my $dbh = $form->{dbh}; + # connect to database, turn AutoCommit off + my $dbh = $form->{dbh}; - my $sth; + my $sth; - my ($paymentaccno) = split /--/, $form->{account}; + my ($paymentaccno) = split /--/, $form->{account}; - # if currency ne defaultcurrency update exchangerate - if ($form->{currency} ne $form->{defaultcurrency}) { + # if currency ne defaultcurrency update exchangerate + if ( $form->{currency} ne $form->{defaultcurrency} ) { - $form->{exchangerate} = $form->parse_amount($myconfig, $form->{exchangerate}); + $form->{exchangerate} = + $form->parse_amount( $myconfig, $form->{exchangerate} ); - if ($form->{vc} eq 'customer') { - $form->update_exchangerate($dbh, $form->{currency}, $form->{datepaid}, $form->{exchangerate}, 0); - } else { - $form->update_exchangerate($dbh, $form->{currency}, $form->{datepaid}, 0, $form->{exchangerate}); - } + if ( $form->{vc} eq 'customer' ) { + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{datepaid}, $form->{exchangerate}, 0 ); + } + else { + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{datepaid}, 0, $form->{exchangerate} ); + } - } else { - $form->{exchangerate} = 1; - } + } + else { + $form->{exchangerate} = 1; + } - my $query = qq| + my $query = qq| SELECT (SELECT value FROM defaults WHERE setting_key='fxgain_accno_id'), (SELECT value FROM defaults WHERE setting_key='fxloss_accno_id')|; - my ($fxgain_accno_id, $fxloss_accno_id) = $dbh->selectrow_array($query); + my ( $fxgain_accno_id, $fxloss_accno_id ) = $dbh->selectrow_array($query); - my ($buysell); + my ($buysell); - if ($form->{vc} eq 'customer') { - $buysell = "buy"; - } else { - $buysell = "sell"; - } + if ( $form->{vc} eq 'customer' ) { + $buysell = "buy"; + } + else { + $buysell = "sell"; + } - my $ml; - my $where; + my $ml; + my $where; - if ($form->{ARAP} eq 'AR') { + if ( $form->{ARAP} eq 'AR' ) { - $ml = 1; - $where = qq| (c.link = 'AR' OR c.link LIKE 'AR:%') |; + $ml = 1; + $where = qq| (c.link = 'AR' OR c.link LIKE 'AR:%') |; - } else { + } + else { - $ml = -1; - $where = qq| (c.link = 'AP' OR c.link LIKE '%:AP' OR c.link LIKE '%:AP:%') |; + $ml = -1; + $where = + qq| (c.link = 'AP' OR c.link LIKE '%:AP' OR c.link LIKE '%:AP:%') |; - } + } - my $paymentamount = $form->parse_amount($myconfig, $form->{amount}); + my $paymentamount = $form->parse_amount( $myconfig, $form->{amount} ); - # query to retrieve paid amount - $query = qq|SELECT paid + # query to retrieve paid amount + $query = qq|SELECT paid FROM $form->{arap} WHERE id = ? FOR UPDATE|; - my $pth = $dbh->prepare($query) || $form->dberror($query); + my $pth = $dbh->prepare($query) || $form->dberror($query); - my %audittrail; + my %audittrail; - # go through line by line - for my $i (1 .. $form->{rowcount}) { + # go through line by line + for my $i ( 1 .. $form->{rowcount} ) { - $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); - $form->{"due_$i"} = $form->parse_amount($myconfig, $form->{"due_$i"}); + $form->{"paid_$i"} = + $form->parse_amount( $myconfig, $form->{"paid_$i"} ); + $form->{"due_$i"} = $form->parse_amount( $myconfig, $form->{"due_$i"} ); - if ($form->{"checked_$i"} && $form->{"paid_$i"}) { + if ( $form->{"checked_$i"} && $form->{"paid_$i"} ) { - $paymentamount -= $form->{"paid_$i"}; + $paymentamount -= $form->{"paid_$i"}; - # get exchangerate for original - $query = qq| + # get exchangerate for original + $query = qq| SELECT $buysell FROM exchangerate e JOIN $form->{arap} a @@ -391,42 +392,41 @@ sub post_payment { WHERE e.curr = ? AND a.id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{currency}, $form->{"id_$i"}); - my ($exchangerate) = $sth->fetchrow_array(); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{currency}, $form->{"id_$i"} ); + my ($exchangerate) = $sth->fetchrow_array(); - $exchangerate = 1 unless $exchangerate; + $exchangerate = 1 unless $exchangerate; - $query = qq| + $query = qq| SELECT c.id FROM chart c JOIN acc_trans a ON (a.chart_id = c.id) WHERE $where AND a.trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{"id_$i"}); - my ($id) = $sth->fetchrow_array; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{"id_$i"} ); + my ($id) = $sth->fetchrow_array; - $amount = - $form->round_amount( - $form->{"paid_$i"} * $exchangerate, 2); + $amount = + $form->round_amount( $form->{"paid_$i"} * $exchangerate, 2 ); - # add AR/AP - $query = qq| + # add AR/AP + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount) VALUES (?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute($form->{"id_$i"}, $id, - $form->{date_paid}, $amount * $ml) - || $form->dberror($query, __file__, __line__); + $sth = $dbh->prepare($query); + $sth->execute( $form->{"id_$i"}, $id, $form->{date_paid}, + $amount * $ml ) + || $form->dberror( $query, __file__, __line__ ); - # add payment - $query = qq| + # add payment + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount, source, memo) @@ -434,24 +434,21 @@ sub post_payment { FROM chart WHERE accno = ?), ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"id_$i"}, $paymentaccno, - $form->{datepaid}, - $form->{"paid_$i"} * $ml * -1, - $form->{source}, $form->{memo}) - || $form->dberror( - $query, 'CP.pm', 444); - - # add exchangerate difference if currency ne defaultcurrency - $amount = $form->round_amount( - $form->{"paid_$i"} * - ($form->{exchangerate} - 1), - 2); - - if ($amount) { - # exchangerate difference - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{"id_$i"}, $paymentaccno, $form->{datepaid}, + $form->{"paid_$i"} * $ml * -1, + $form->{source}, $form->{memo} ) + || $form->dberror( $query, 'CP.pm', 444 ); + + # add exchangerate difference if currency ne defaultcurrency + $amount = + $form->round_amount( + $form->{"paid_$i"} * ( $form->{exchangerate} - 1 ), 2 ); + + if ($amount) { + + # exchangerate difference + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount, cleared, @@ -461,34 +458,29 @@ sub post_payment { WHERE accno = ?), ?, ?, '0', '1', ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"id_$i"}, $paymentaccno, - $form->{datepaid}, $amount * $ml * -1, - $form->{source}) - || $form->dberror( - $query, 'CP.pm', 470); - - # gain/loss - $amount = - ($form->round_amount( - $form->{"paid_$i"} * - $exchangerate, - 2) - - $form->round_amount( - $form->{"paid_$i"} * - $form->{exchangerate}, - 2)) - * $ml * -1; - - if ($amount) { - - my $accno_id = - ($amount > 0) - ? $fxgain_accno_id - : $fxloss_accno_id; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{"id_$i"}, $paymentaccno, $form->{datepaid}, + $amount * $ml * -1, $form->{source} + ) || $form->dberror( $query, 'CP.pm', 470 ); + + # gain/loss + $amount = ( + $form->round_amount( + $form->{"paid_$i"} * $exchangerate, 2 + ) - $form->round_amount( + $form->{"paid_$i"} * $form->{exchangerate}, 2 + ) + ) * $ml * -1; + + if ($amount) { + + my $accno_id = + ( $amount > 0 ) + ? $fxgain_accno_id + : $fxloss_accno_id; + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, @@ -496,172 +488,176 @@ sub post_payment { amount, cleared, fx_transaction) VALUES (?, ?, ?, ?, '0', '1')|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"id_$i"}, $accno_id, - $form->{datepaid}, $amount) - || $form->dberror( - $query, - 'CP.pm', - 506); - } - } - - $form->{"paid_$i"} = - $form->round_amount( - $form->{"paid_$i"} * $exchangerate, 2); - - $pth->execute($form->{"id_$i"}) || $form->dberror; - ($amount) = $pth->fetchrow_array; - $pth->finish; - - $amount += $form->{"paid_$i"}; - - # update AR/AP transaction - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{"id_$i"}, $accno_id, + $form->{datepaid}, $amount + ) || $form->dberror( $query, 'CP.pm', 506 ); + } + } + + $form->{"paid_$i"} = + $form->round_amount( $form->{"paid_$i"} * $exchangerate, 2 ); + + $pth->execute( $form->{"id_$i"} ) || $form->dberror; + ($amount) = $pth->fetchrow_array; + $pth->finish; + + $amount += $form->{"paid_$i"}; + + # update AR/AP transaction + $query = qq| UPDATE $form->{arap} SET paid = ?, datepaid = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $amount, $form->{datepaid}, $form->{"id_$i"}) - || $form->dberror($query, 'CP.pm', - 530); - - %audittrail = ( - tablename => $form->{arap}, - reference => $form->{source}, - formname => $form->{formname}, - action => 'posted', - id => $form->{"id_$i"} ); + $sth = $dbh->prepare($query); + $sth->execute( $amount, $form->{datepaid}, $form->{"id_$i"} ) + || $form->dberror( $query, 'CP.pm', 530 ); - $form->audittrail($dbh, "", \%audittrail); + %audittrail = ( + tablename => $form->{arap}, + reference => $form->{source}, + formname => $form->{formname}, + action => 'posted', + id => $form->{"id_$i"} + ); - } - } + $form->audittrail( $dbh, "", \%audittrail ); + } + } - # record a AR/AP with a payment - if ($form->round_amount($paymentamount, 2)) { - $form->{invnumber} = ""; - OP::overpayment("", $myconfig, $form, $dbh, $paymentamount, $ml, 1); - } + # record a AR/AP with a payment + if ( $form->round_amount( $paymentamount, 2 ) ) { + $form->{invnumber} = ""; + OP::overpayment( "", $myconfig, $form, $dbh, $paymentamount, $ml, 1 ); + } - my $rc = $dbh->commit; + my $rc = $dbh->commit; - $rc; + $rc; } - sub post_payments { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database, turn AutoCommit off - my $dbh = $form->{dbh}; + # connect to database, turn AutoCommit off + my $dbh = $form->{dbh}; - my $sth; + my $sth; - my ($paymentaccno) = split /--/, $form->{account}; + my ($paymentaccno) = split /--/, $form->{account}; - # if currency ne defaultcurrency update exchangerate - if ($form->{currency} ne $form->{defaultcurrency}) { - $form->{exchangerate} = $form->parse_amount($myconfig, $form->{exchangerate}); + # if currency ne defaultcurrency update exchangerate + if ( $form->{currency} ne $form->{defaultcurrency} ) { + $form->{exchangerate} = + $form->parse_amount( $myconfig, $form->{exchangerate} ); - if ($form->{vc} eq 'customer') { - $form->update_exchangerate($dbh, $form->{currency}, $form->{datepaid}, $form->{exchangerate}, 0); - } else { - $form->update_exchangerate($dbh, $form->{currency}, $form->{datepaid}, 0, $form->{exchangerate}); - } + if ( $form->{vc} eq 'customer' ) { + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{datepaid}, $form->{exchangerate}, 0 ); + } + else { + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{datepaid}, 0, $form->{exchangerate} ); + } - } else { - $form->{exchangerate} = 1; - } + } + else { + $form->{exchangerate} = 1; + } - my $query = qq| + my $query = qq| SELECT (SELECT value FROM defaults WHERE setting_key='fxgain_accno_id'), (SELECT value FROM defaults WHERE setting_key='fxloss_accno_id')|; - my ($fxgain_accno_id, $fxloss_accno_id) = $dbh->selectrow_array($query); + my ( $fxgain_accno_id, $fxloss_accno_id ) = $dbh->selectrow_array($query); - my ($buysell); + my ($buysell); - if ($form->{vc} eq 'customer') { - $buysell = "buy"; - } else { - $buysell = "sell"; - } + if ( $form->{vc} eq 'customer' ) { + $buysell = "buy"; + } + else { + $buysell = "sell"; + } - my $ml; - my $where; + my $ml; + my $where; - if ($form->{ARAP} eq 'AR') { + if ( $form->{ARAP} eq 'AR' ) { - $ml = 1; - $where = qq| (c.link = 'AR' OR c.link LIKE 'AR:%') |; + $ml = 1; + $where = qq| (c.link = 'AR' OR c.link LIKE 'AR:%') |; - } else { + } + else { - $ml = -1; - $where = qq| (c.link = 'AP' OR c.link LIKE '%:AP' OR c.link LIKE '%:AP:%') |; + $ml = -1; + $where = + qq| (c.link = 'AP' OR c.link LIKE '%:AP' OR c.link LIKE '%:AP:%') |; - } + } - # get AR/AP account - $query = qq|SELECT c.accno + # get AR/AP account + $query = qq|SELECT c.accno FROM chart c JOIN acc_trans ac ON (ac.chart_id = c.id) WHERE trans_id = ? AND $where|; - my $ath = $dbh->prepare($query) || $form->dberror($query); + my $ath = $dbh->prepare($query) || $form->dberror($query); - # query to retrieve paid amount - $query = qq|SELECT paid + # query to retrieve paid amount + $query = qq|SELECT paid FROM $form->{arap} WHERE id = ? FOR UPDATE|; - my $pth = $dbh->prepare($query) || $form->dberror($query); + my $pth = $dbh->prepare($query) || $form->dberror($query); + + my %audittrail; - my %audittrail; + my $overpayment = 0; + my $accno_id; - my $overpayment = 0; - my $accno_id; + # go through line by line + for my $i ( 1 .. $form->{rowcount} ) { - # go through line by line - for my $i (1 .. $form->{rowcount}) { + $ath->execute( $form->{"id_$i"} ); + ( $form->{ $form->{ARAP} } ) = $ath->fetchrow_array; + $ath->finish; - $ath->execute($form->{"id_$i"}); - ($form->{$form->{ARAP}}) = $ath->fetchrow_array; - $ath->finish; + $form->{"paid_$i"} = + $form->parse_amount( $myconfig, $form->{"paid_$i"} ); + $form->{"due_$i"} = $form->parse_amount( $myconfig, $form->{"due_$i"} ); - $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); - $form->{"due_$i"} = $form->parse_amount($myconfig, $form->{"due_$i"}); + if ( $form->{"$form->{vc}_id_$i"} ne $sameid ) { - if ($form->{"$form->{vc}_id_$i"} ne $sameid) { - # record a AR/AP with a payment - if ($overpayment > 0 && $form->{$form->{ARAP}}) { - $form->{invnumber} = ""; - OP::overpayment("", $myconfig, $form, $dbh, $overpayment, $ml, 1); - } + # record a AR/AP with a payment + if ( $overpayment > 0 && $form->{ $form->{ARAP} } ) { + $form->{invnumber} = ""; + OP::overpayment( "", $myconfig, $form, $dbh, $overpayment, $ml, + 1 ); + } - $overpayment = 0; - $form->{"$form->{vc}_id"} = $form->{"$form->{vc}_id_$i"}; - for (qw(source memo)) { $form->{$_} = $form->{"${_}_$i"} } - } + $overpayment = 0; + $form->{"$form->{vc}_id"} = $form->{"$form->{vc}_id_$i"}; + for (qw(source memo)) { $form->{$_} = $form->{"${_}_$i"} } + } - if ($form->{"checked_$i"} && $form->{"paid_$i"}) { + if ( $form->{"checked_$i"} && $form->{"paid_$i"} ) { - $overpayment += ($form->{"paid_$i"} - $form->{"due_$i"}); + $overpayment += ( $form->{"paid_$i"} - $form->{"due_$i"} ); - # get exchangerate for original - $query = qq| + # get exchangerate for original + $query = qq| SELECT $buysell FROM exchangerate e JOIN $form->{arap} a @@ -669,99 +665,97 @@ sub post_payments { WHERE e.curr = ? AND a.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{currency}, $form->{"id_$i"}) - || $form->dberror($query, 'CP.pm', 671); - my ($exchangerate) = $sth->fetchrow_array; + $sth = $dbh->prepare($query); + $sth->execute( $form->{currency}, $form->{"id_$i"} ) + || $form->dberror( $query, 'CP.pm', 671 ); + my ($exchangerate) = $sth->fetchrow_array; - $exchangerate ||= 1; + $exchangerate ||= 1; - $query = qq| + $query = qq| SELECT c.id FROM chart c JOIN acc_trans a ON (a.chart_id = c.id) WHERE $where AND a.trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{"id_$i"}); - ($id) = $sth->fetchrow_array(); + $sth = $dbh->prepare($query); + $sth->execute( $form->{"id_$i"} ); + ($id) = $sth->fetchrow_array(); - $paid = ($form->{"paid_$i"} > $form->{"due_$i"}) ? $form->{"due_$i"} : $form->{"paid_$i"}; - $amount = $form->round_amount($paid * $exchangerate, 2); + $paid = + ( $form->{"paid_$i"} > $form->{"due_$i"} ) + ? $form->{"due_$i"} + : $form->{"paid_$i"}; + $amount = $form->round_amount( $paid * $exchangerate, 2 ); - # add AR/AP - $query = qq| + # add AR/AP + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount) VALUES (?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"id_$i"}, $id, $form->{datepaid}, - $amount * $ml) - || $form->dberror($query, 'CP.pm', - 701); + $sth = $dbh->prepare($query); + $sth->execute( $form->{"id_$i"}, $id, $form->{datepaid}, + $amount * $ml ) + || $form->dberror( $query, 'CP.pm', 701 ); - $query = qq|SELECT id + $query = qq|SELECT id FROM chart WHERE accno = ?|; - $sth = $dbh->prepare($query); - $sth->execute($paymentaccno); - ($accno_id) = $sth->fetchrow_array; + $sth = $dbh->prepare($query); + $sth->execute($paymentaccno); + ($accno_id) = $sth->fetchrow_array; - # add payment - $query = qq| + # add payment + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount, source, memo) VALUES (?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"id_$i"}, $accno_id, $form->{datepaid}, - $paid * $ml * -1, $form->{source}, - $form->{memo}) - || $form->dberror($query, 'CP.pm', - 723); - - # add exchangerate difference if currency ne defaultcurrency - $amount = - $form->round_amount( - $paid * ($form->{exchangerate} - 1) - * $ml * -1, - 2); - - if ($amount) { - # exchangerate difference - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{"id_$i"}, $accno_id, $form->{datepaid}, + $paid * $ml * -1, $form->{source}, $form->{memo} + ) || $form->dberror( $query, 'CP.pm', 723 ); + + # add exchangerate difference if currency ne defaultcurrency + $amount = + $form->round_amount( + $paid * ( $form->{exchangerate} - 1 ) * $ml * -1, 2 ); + + if ($amount) { + + # exchangerate difference + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount, source) VALUES (?, ?, ?, ?, ?)|; - - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"id_$i"}, $accno_id, - $form->{datepaid}, $amount, - $form->{source}) - || $form->dberror( - $query, 'CP.pm', 748); - - # gain/loss - $amount = ($form->round_amount($paid * $exchangerate,2) - $form->round_amount($paid * $form->{exchangerate},2)) * $ml * -1; - - if ($amount) { - $accno_id = - ($amount > 0) - ? $fxgain_accno_id - : $fxloss_accno_id; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{"id_$i"}, $accno_id, $form->{datepaid}, + $amount, $form->{source} + ) || $form->dberror( $query, 'CP.pm', 748 ); + + # gain/loss + $amount = + ( $form->round_amount( $paid * $exchangerate, 2 ) - + $form->round_amount( $paid * $form->{exchangerate}, 2 ) ) + * $ml * -1; + + if ($amount) { + $accno_id = + ( $amount > 0 ) + ? $fxgain_accno_id + : $fxloss_accno_id; + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, @@ -770,63 +764,60 @@ sub post_payments { fx_transaction) VALUES (?, ?, ?, ?, '1')|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"id_$i"}, $accno_id, - $form->{datepaid}, $amount) - || $form->dberror( - $query, - 'CP.pm', 775); - } - } + $sth = $dbh->prepare($query); + $sth->execute( + $form->{"id_$i"}, $accno_id, + $form->{datepaid}, $amount + ) || $form->dberror( $query, 'CP.pm', 775 ); + } + } - $paid = $form->round_amount($paid * $exchangerate, 2); + $paid = $form->round_amount( $paid * $exchangerate, 2 ); - $pth->execute($form->{"id_$i"}) || $form->dberror; - ($amount) = $pth->fetchrow_array; - $pth->finish; + $pth->execute( $form->{"id_$i"} ) || $form->dberror; + ($amount) = $pth->fetchrow_array; + $pth->finish; - $amount += $paid; + $amount += $paid; - # update AR/AP transaction - $query = qq| + # update AR/AP transaction + $query = qq| UPDATE $form->{arap} SET paid = ?, datepaid = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $amount, $form->{datepaid}, $form->{"id_$i"}) - || $form->dberror($query, 'CP.pm', - 796); + $sth = $dbh->prepare($query); + $sth->execute( $amount, $form->{datepaid}, $form->{"id_$i"} ) + || $form->dberror( $query, 'CP.pm', 796 ); - %audittrail = ( tablename => $form->{arap}, - reference => $form->{source}, - formname => $form->{formname}, - action => 'posted', - id => $form->{"id_$i"} ); + %audittrail = ( + tablename => $form->{arap}, + reference => $form->{source}, + formname => $form->{formname}, + action => 'posted', + id => $form->{"id_$i"} + ); - $form->audittrail($dbh, "", \%audittrail); + $form->audittrail( $dbh, "", \%audittrail ); - } + } - $sameid = $form->{"$form->{vc}_id_$i"}; + $sameid = $form->{"$form->{vc}_id_$i"}; - } + } - # record a AR/AP with a payment - if ($overpayment > 0 && $form->{$form->{ARAP}}) { - $form->{invnumber} = ""; - OP::overpayment("", $myconfig, $form, $dbh, $overpayment, $ml, 1); - } + # record a AR/AP with a payment + if ( $overpayment > 0 && $form->{ $form->{ARAP} } ) { + $form->{invnumber} = ""; + OP::overpayment( "", $myconfig, $form, $dbh, $overpayment, $ml, 1 ); + } - my $rc = $dbh->commit; + my $rc = $dbh->commit; - $rc; + $rc; } - 1; diff --git a/LedgerSMB/CT.pm b/LedgerSMB/CT.pm index 5e70e302..7c1c3bf3 100644 --- a/LedgerSMB/CT.pm +++ b/LedgerSMB/CT.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -34,20 +34,19 @@ package CT; - sub create_links { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; - my $query; - my $sth; - my $ref; - my $arap = ($form->{db} eq 'customer') ? "ar" : "ap"; - my $ARAP = uc $arap; + my $dbh = $form->{dbh}; + my $query; + my $sth; + my $ref; + my $arap = ( $form->{db} eq 'customer' ) ? "ar" : "ap"; + my $ARAP = uc $arap; - if ($form->{id}) { - $query = qq| + if ( $form->{id} ) { + $query = qq| SELECT ct.*, b.description AS business, s.*, e.name AS employee, g.pricegroup AS pricegroup, @@ -60,15 +59,15 @@ sub create_links { LEFT JOIN language l ON (l.code = ct.language_code) WHERE ct.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - # check if it is orphaned - $query = qq| + # check if it is orphaned + $query = qq| SELECT a.id FROM $arap a JOIN $form->{db} ct ON (a.$form->{db}_id = ct.id) @@ -81,230 +80,232 @@ sub create_links { JOIN $form->{db} ct ON (a.$form->{db}_id = ct.id) WHERE ct.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}, $form->{id}) - || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $form->{id} ) + || $form->dberror($query); - unless ($sth->fetchrow_array) { - $form->{status} = "orphaned"; - } + unless ( $sth->fetchrow_array ) { + $form->{status} = "orphaned"; + } - $sth->finish; + $sth->finish; - # get taxes for customer/vendor - $query = qq| + # get taxes for customer/vendor + $query = qq| SELECT c.accno FROM chart c JOIN $form->{db}tax t ON (t.chart_id = c.id) WHERE t.$form->{db}_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{tax}{$ref->{accno}}{taxable} = 1; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{tax}{ $ref->{accno} }{taxable} = 1; + } - $sth->finish; + $sth->finish; - } else { + } + else { - ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); - $query = qq|SELECT current_date|; - ($form->{startdate}) = $dbh->selectrow_array($query); + $query = qq|SELECT current_date|; + ( $form->{startdate} ) = $dbh->selectrow_array($query); - } + } - # get tax labels - $query = qq| + # get tax labels + $query = qq| SELECT DISTINCT c.accno, c.description FROM chart c JOIN tax t ON (t.chart_id = c.id) WHERE c.link LIKE ? ORDER BY c.accno|; - $sth = $dbh->prepare($query); - $sth->execute("%${ARAP}_tax%") || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{taxaccounts} .= "$ref->{accno} "; - $form->{tax}{$ref->{accno}}{description} = $ref->{description}; - } + $sth = $dbh->prepare($query); + $sth->execute("%${ARAP}_tax%") || $form->dberror($query); - $sth->finish; - chop $form->{taxaccounts}; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{taxaccounts} .= "$ref->{accno} "; + $form->{tax}{ $ref->{accno} }{description} = $ref->{description}; + } + $sth->finish; + chop $form->{taxaccounts}; - # get business types ## needs fixing, this is bad (SELECT * ...) with order by 2. Yuck - $query = qq| +# get business types ## needs fixing, this is bad (SELECT * ...) with order by 2. Yuck + $query = qq| SELECT * FROM business ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_business} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_business} }, $ref; + } - $sth->finish; + $sth->finish; - # employees/salespersons - $form->all_employees($myconfig, $dbh, undef, - ($form->{vc} eq 'customer') - ? 1 - : 0); + # employees/salespersons + $form->all_employees( $myconfig, $dbh, undef, + ( $form->{vc} eq 'customer' ) + ? 1 + : 0 ); - # get language ## needs fixing, this is bad (SELECT * ...) with order by 2. Yuck - $query = qq| +# get language ## needs fixing, this is bad (SELECT * ...) with order by 2. Yuck + $query = qq| SELECT * FROM language ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_language} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_language} }, $ref; + } - $sth->finish; + $sth->finish; - # get pricegroups ## needs fixing, this is bad (SELECT * ...) with order by 2. Yuck - $query = qq| +# get pricegroups ## needs fixing, this is bad (SELECT * ...) with order by 2. Yuck + $query = qq| SELECT * FROM pricegroup ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_pricegroup} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_pricegroup} }, $ref; + } - $sth->finish; + $sth->finish; - # get currencies - $query = qq| + # get currencies + $query = qq| SELECT value AS currencies FROM defaults WHERE setting_key = 'curr'|; - ($form->{currencies}) = $dbh->selectrow_array($query); + ( $form->{currencies} ) = $dbh->selectrow_array($query); - $dbh->commit; + $dbh->commit; } - sub save_customer { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - my $query; - my $sth; - my $null; - - # remove double spaces - $form->{name} =~ s/ / /g; - # remove double minus and minus at the end - $form->{name} =~ s/--+/-/g; - $form->{name} =~ s/-+$//; - - # assign value discount, terms, creditlimit - $form->{discount} = $form->parse_amount($myconfig, $form->{discount}); - $form->{discount} /= 100; - $form->{terms} *= 1; - $form->{taxincluded} *= 1; - $form->{creditlimit} = $form->parse_amount($myconfig, $form->{creditlimit}); - if (!$form->{creditlimit}){ - $form->{creditlimit} = 0; - } - - - if ($form->{id}) { - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + my $query; + my $sth; + my $null; + + # remove double spaces + $form->{name} =~ s/ / /g; + + # remove double minus and minus at the end + $form->{name} =~ s/--+/-/g; + $form->{name} =~ s/-+$//; + + # assign value discount, terms, creditlimit + $form->{discount} = $form->parse_amount( $myconfig, $form->{discount} ); + $form->{discount} /= 100; + $form->{terms} *= 1; + $form->{taxincluded} *= 1; + $form->{creditlimit} = + $form->parse_amount( $myconfig, $form->{creditlimit} ); + if ( !$form->{creditlimit} ) { + $form->{creditlimit} = 0; + } + + if ( $form->{id} ) { + $query = qq| DELETE FROM customertax WHERE customer_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $query = qq| + $query = qq| DELETE FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM customer WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - if (! $sth->fetchrow_array) { - $query = qq| + if ( !$sth->fetchrow_array ) { + $query = qq| INSERT INTO customer (id) VALUES (?)|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } - # retrieve enddate - if ($form->{type} && $form->{enddate}) { - my $now; - $query = qq| + # retrieve enddate + if ( $form->{type} && $form->{enddate} ) { + my $now; + $query = qq| SELECT enddate, current_date AS now FROM customer|; - ($form->{enddate}, $now) = - $dbh->selectrow_array($query); - $form->{enddate} = $now if $form->{enddate} lt $now; - } + ( $form->{enddate}, $now ) = $dbh->selectrow_array($query); + $form->{enddate} = $now if $form->{enddate} lt $now; + } - } else { - my $uid = localtime; - $uid .= "$$"; + } + else { + my $uid = localtime; + $uid .= "$$"; - $query = qq|INSERT INTO customer (name) + $query = qq|INSERT INTO customer (name) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq|SELECT id + $query = qq|SELECT id FROM customer WHERE name = '$uid'|; - ($form->{id}) = $dbh->selectrow_array($query); + ( $form->{id} ) = $dbh->selectrow_array($query); - } + } - my $employee_id; - ($null, $employee_id) = split /--/, $form->{employee}; - $employee_id *= 1; + my $employee_id; + ( $null, $employee_id ) = split /--/, $form->{employee}; + $employee_id *= 1; - my $pricegroup_id; - ($null, $pricegroup_id) = split /--/, $form->{pricegroup}; - $pricegroup_id *= 1; + my $pricegroup_id; + ( $null, $pricegroup_id ) = split /--/, $form->{pricegroup}; + $pricegroup_id *= 1; - my $business_id; - ($null, $business_id) = split /--/, $form->{business}; - $business_id *= 1; + my $business_id; + ( $null, $business_id ) = split /--/, $form->{business}; + $business_id *= 1; - my $language_code; - ($null, $language_code) = split /--/, $form->{language}; + my $language_code; + ( $null, $language_code ) = split /--/, $form->{language}; - $form->{customernumber} = $form->update_defaults($myconfig, "customernumber", $dbh) if ! $form->{customernumber}; + $form->{customernumber} = + $form->update_defaults( $myconfig, "customernumber", $dbh ) + if !$form->{customernumber}; - $query = qq| + $query = qq| UPDATE customer SET customernumber = ?, name = ?, @@ -338,149 +339,151 @@ sub save_customer { enddate = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - if (!$form->{startdate}){ - undef $form->{startdate}; - } - if (!$form->{enddate}){ - undef $form->{enddate}; - } - $sth->execute( - $form->{customernumber}, $form->{name}, $form->{address1}, - $form->{address2}, $form->{city}, $form->{state}, - $form->{zipcode}, $form->{country}, $form->{contact}, - $form->{phone}, $form->{fax}, $form->{email}, $form->{cc}, - $form->{bcc}, $form->{notes}, $form->{discount}, - $form->{creditlimit}, $form->{terms}, $form->{taxincluded}, - $business_id, $form->{taxnumber}, $form->{sic_code}, - $form->{iban}, $form->{bic}, $employee_id, $pricegroup_id, - $language_code, - $form->{curr}, $form->{startdate}, $form->{enddate}, - $form->{id}) - || $form->dberror($query); - - # save taxes - foreach $item (split / /, $form->{taxaccounts}) { - - if ($form->{"tax_$item"}) { - $query = qq| + $sth = $dbh->prepare($query); + if ( !$form->{startdate} ) { + undef $form->{startdate}; + } + if ( !$form->{enddate} ) { + undef $form->{enddate}; + } + $sth->execute( + $form->{customernumber}, $form->{name}, $form->{address1}, + $form->{address2}, $form->{city}, $form->{state}, + $form->{zipcode}, $form->{country}, $form->{contact}, + $form->{phone}, $form->{fax}, $form->{email}, + $form->{cc}, $form->{bcc}, $form->{notes}, + $form->{discount}, $form->{creditlimit}, $form->{terms}, + $form->{taxincluded}, $business_id, $form->{taxnumber}, + $form->{sic_code}, $form->{iban}, $form->{bic}, + $employee_id, $pricegroup_id, $language_code, + $form->{curr}, $form->{startdate}, $form->{enddate}, + $form->{id} + ) || $form->dberror($query); + + # save taxes + foreach $item ( split / /, $form->{taxaccounts} ) { + + if ( $form->{"tax_$item"} ) { + $query = qq| INSERT INTO customertax (customer_id, chart_id) VALUES (?, (SELECT id FROM chart WHERE accno = ?))|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}, $item) - || $form->dberror($query); - } - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $item ) + || $form->dberror($query); + } + } - # add shipto - $form->add_shipto($dbh, $form->{id}); + # add shipto + $form->add_shipto( $dbh, $form->{id} ); - $dbh->commit; + $dbh->commit; } - sub save_vendor { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query; - my $sth; - my $null; + my $query; + my $sth; + my $null; - # remove double spaces - $form->{name} =~ s/ / /g; - # remove double minus and minus at the end - $form->{name} =~ s/--+/-/g; - $form->{name} =~ s/-+$//; + # remove double spaces + $form->{name} =~ s/ / /g; - $form->{discount} = $form->parse_amount($myconfig, $form->{discount}); - $form->{discount} /= 100; - $form->{terms} *= 1; - $form->{taxincluded} *= 1; - $form->{creditlimit} = - $form->parse_amount($myconfig, $form->{creditlimit}); + # remove double minus and minus at the end + $form->{name} =~ s/--+/-/g; + $form->{name} =~ s/-+$//; + $form->{discount} = $form->parse_amount( $myconfig, $form->{discount} ); + $form->{discount} /= 100; + $form->{terms} *= 1; + $form->{taxincluded} *= 1; + $form->{creditlimit} = + $form->parse_amount( $myconfig, $form->{creditlimit} ); - if ($form->{id}) { - $query = qq|DELETE FROM vendortax + if ( $form->{id} ) { + $query = qq|DELETE FROM vendortax WHERE vendor_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $query = qq|DELETE FROM shipto + $query = qq|DELETE FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $query = qq|SELECT id + $query = qq|SELECT id FROM vendor WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - if (! $sth->fetchrow_array) { - $query = qq|INSERT INTO vendor (id) + if ( !$sth->fetchrow_array ) { + $query = qq|INSERT INTO vendor (id) VALUES (?)|; - $sth = $dbh->prepare($query) ; - $sth->execute($form->{id}) || $form->dberror($query); - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } - # retrieve enddate - if ($form->{type} && $form->{enddate}) { - my $now; - $query = qq|SELECT enddate, current_date AS now FROM vendor|; - ($form->{enddate}, $now) = $dbh->selectrow_array($query); - $form->{enddate} = $now if $form->{enddate} lt $now; - } + # retrieve enddate + if ( $form->{type} && $form->{enddate} ) { + my $now; + $query = qq|SELECT enddate, current_date AS now FROM vendor|; + ( $form->{enddate}, $now ) = $dbh->selectrow_array($query); + $form->{enddate} = $now if $form->{enddate} lt $now; + } - } else { - my $uid = localtime; - $uid .= "$$"; + } + else { + my $uid = localtime; + $uid .= "$$"; - $query = qq|INSERT INTO vendor (name) + $query = qq|INSERT INTO vendor (name) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq|SELECT id + $query = qq|SELECT id FROM vendor WHERE name = '$uid'|; - ($form->{id}) = $dbh->selectrow_array($query); + ( $form->{id} ) = $dbh->selectrow_array($query); - } + } - my $employee_id; - ($null, $employee_id) = split /--/, $form->{employee}; - $employee_id *= 1; + my $employee_id; + ( $null, $employee_id ) = split /--/, $form->{employee}; + $employee_id *= 1; - my $pricegroup_id; - ($null, $pricegroup_id) = split /--/, $form->{pricegroup}; - $pricegroup_id *= 1; + my $pricegroup_id; + ( $null, $pricegroup_id ) = split /--/, $form->{pricegroup}; + $pricegroup_id *= 1; - my $business_id; - ($null, $business_id) = split /--/, $form->{business}; - $business_id *= 1; + my $business_id; + ( $null, $business_id ) = split /--/, $form->{business}; + $business_id *= 1; - my $language_code; - ($null, $language_code) = split /--/, $form->{language}; + my $language_code; + ( $null, $language_code ) = split /--/, $form->{language}; - $form->{vendornumber} = $form->update_defaults($myconfig, "vendornumber", $dbh) if ! $form->{vendornumber}; - - $form->{startdate} = undef unless $form->{startdate}; - $form->{enddate} = undef unless $form->{enddate}; + $form->{vendornumber} = + $form->update_defaults( $myconfig, "vendornumber", $dbh ) + if !$form->{vendornumber}; - $query = qq| + $form->{startdate} = undef unless $form->{startdate}; + $form->{enddate} = undef unless $form->{enddate}; + + $query = qq| UPDATE vendor SET vendornumber = ?, name = ?, @@ -515,141 +518,138 @@ sub save_vendor { enddate = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - - $sth->execute( - $form->{vendornumber}, $form->{name}, $form->{address1}, - $form->{address2}, $form->{city}, $form->{state}, - $form->{zipcode}, $form->{country}, $form->{contact}, - $form->{phone}, $form->{fax}, $form->{email}, $form->{cc}, - $form->{bcc}, $form->{notes}, $form->{discount}, - $form->{creditlimit}, $form->{terms}, $form->{taxincluded}, - $form->{gifi_accno}, $business_id, $form->{taxnumber}, - $form->{sic_code}, $form->{iban}, $form->{bic}, $employee_id, - $language_code, $pricegroup_id, - $form->{curr}, $form->{startdate}, $form->{enddate}, - $form->{id}) - || $form->dberror($query); - # save taxes - foreach $item (split / /, $form->{taxaccounts}) { - if ($form->{"tax_$item"}) { - $query = qq| + $sth = $dbh->prepare($query); + + $sth->execute( + $form->{vendornumber}, $form->{name}, $form->{address1}, + $form->{address2}, $form->{city}, $form->{state}, + $form->{zipcode}, $form->{country}, $form->{contact}, + $form->{phone}, $form->{fax}, $form->{email}, + $form->{cc}, $form->{bcc}, $form->{notes}, + $form->{discount}, $form->{creditlimit}, $form->{terms}, + $form->{taxincluded}, $form->{gifi_accno}, $business_id, + $form->{taxnumber}, $form->{sic_code}, $form->{iban}, + $form->{bic}, $employee_id, $language_code, + $pricegroup_id, $form->{curr}, $form->{startdate}, + $form->{enddate}, $form->{id} + ) || $form->dberror($query); + + # save taxes + foreach $item ( split / /, $form->{taxaccounts} ) { + if ( $form->{"tax_$item"} ) { + $query = qq| INSERT INTO vendortax (vendor_id, chart_id) VALUES (?, (SELECT id FROM chart WHERE accno = ?))|; - - $sth = $dbh->prepare($query); - $sth->execute($form->{id}, $item) - || $form->dberror($query); - } - } - - # add shipto - $form->add_shipto($dbh, $form->{id}); - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $item ) + || $form->dberror($query); + } + } -} + # add shipto + $form->add_shipto( $dbh, $form->{id} ); + $dbh->commit; +} sub delete { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - # delete customer/vendor - my $query = qq|DELETE FROM $form->{db} + # delete customer/vendor + my $query = qq|DELETE FROM $form->{db} WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $dbh->commit; + $dbh->commit; } - sub search { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $where = "1 = 1"; - $form->{sort} = ($form->{sort}) ? $form->{sort} : "name"; - my @a = qw(name); - my $sortorder = $form->sort_order(\@a); + my $where = "1 = 1"; + $form->{sort} = ( $form->{sort} ) ? $form->{sort} : "name"; + my @a = qw(name); + my $sortorder = $form->sort_order( \@a ); - my $var; - my $item; + my $var; + my $item; - @a = ("$form->{db}number"); - push @a, qw(name contact city state zipcode country notes phone email); + @a = ("$form->{db}number"); + push @a, qw(name contact city state zipcode country notes phone email); - if ($form->{employee}) { - $var = $form->like(lc $form->{employee}); - $where .= " AND lower(e.name) LIKE '$var'"; - } + if ( $form->{employee} ) { + $var = $form->like( lc $form->{employee} ); + $where .= " AND lower(e.name) LIKE '$var'"; + } - foreach $item (@a) { + foreach $item (@a) { - if ($form->{$item} ne "") { - $var = $form->like(lc $form->{$item}); - $where .= " AND lower(ct.$item) LIKE '$var'"; - } - } + if ( $form->{$item} ne "" ) { + $var = $form->like( lc $form->{$item} ); + $where .= " AND lower(ct.$item) LIKE '$var'"; + } + } - if ($form->{address} ne "") { - $var = $dbh->quote($form->like(lc $form->{address})); - $where .= " AND (lower(ct.address1) LIKE $var OR lower(ct.address2) LIKE '$var')"; - } + if ( $form->{address} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{address} ) ); + $where .= +" AND (lower(ct.address1) LIKE $var OR lower(ct.address2) LIKE '$var')"; + } - if ($form->{startdatefrom}) { - $where .= " AND ct.startdate >= ". - $dbh->quote($form->{startdatefrom}); - } + if ( $form->{startdatefrom} ) { + $where .= + " AND ct.startdate >= " . $dbh->quote( $form->{startdatefrom} ); + } - if ($form->{startdateto}) { - $where .= " AND ct.startdate <= ". - $dbh->quote($form->{startdateto}); - } + if ( $form->{startdateto} ) { + $where .= " AND ct.startdate <= " . $dbh->quote( $form->{startdateto} ); + } - if ($form->{status} eq 'active') { - $where .= " AND ct.enddate IS NULL"; - } + if ( $form->{status} eq 'active' ) { + $where .= " AND ct.enddate IS NULL"; + } - if ($form->{status} eq 'inactive') { - $where .= " AND ct.enddate <= current_date"; - } + if ( $form->{status} eq 'inactive' ) { + $where .= " AND ct.enddate <= current_date"; + } - if ($form->{status} eq 'orphaned') { - $where .= qq| + if ( $form->{status} eq 'orphaned' ) { + $where .= qq| AND ct.id NOT IN (SELECT o.$form->{db}_id FROM oe o, $form->{db} vc WHERE vc.id = o.$form->{db}_id)|; - if ($form->{db} eq 'customer') { - $where .= qq| AND ct.id NOT IN (SELECT a.customer_id + if ( $form->{db} eq 'customer' ) { + $where .= qq| AND ct.id NOT IN (SELECT a.customer_id FROM ar a, customer vc WHERE vc.id = a.customer_id)|; - } - - if ($form->{db} eq 'vendor') { - $where .= qq| AND ct.id NOT IN (SELECT a.vendor_id + } + + if ( $form->{db} eq 'vendor' ) { + $where .= qq| AND ct.id NOT IN (SELECT a.vendor_id FROM ap a, vendor vc WHERE vc.id = a.vendor_id)|; - } - - $form->{l_invnumber} = $form->{l_ordnumber} = $form->{l_quonumber} = ""; - } + } + $form->{l_invnumber} = $form->{l_ordnumber} = $form->{l_quonumber} = ""; + } - my $query = qq| + my $query = qq| SELECT ct.*, b.description AS business, e.name AS employee, g.pricegroup, l.description AS language, m.name AS manager @@ -661,46 +661,46 @@ sub search { LEFT JOIN language l ON (l.code = ct.language_code) WHERE $where|; - # redo for invoices, orders and quotations - if ($form->{l_transnumber} - || $form->{l_invnumber} - || $form->{l_ordnumber} - || $form->{l_quonumber}) { - - my ($ar, $union, $module); - $query = ""; - my $transwhere; - my $openarap = ""; - my $openoe = ""; - - if ($form->{open} || $form->{closed}) { - unless ($form->{open} && $form->{closed}) { - $openarap = " AND a.amount != a.paid" - if $form->{open}; - $openarap = " AND a.amount = a.paid" - if $form->{closed}; - $openoe = " AND o.closed = '0'" - if $form->{open}; - $openoe = " AND o.closed = '1'" - if $form->{closed}; - } - } - - if ($form->{l_transnumber}) { - - $ar = ($form->{db} eq 'customer') ? 'ar' : 'ap'; - $module = $ar; - - $transwhere = ""; - $transwhere .= " AND a.transdate >= " - .$dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $transwhere .= " AND a.transdate <= ". - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; - - - $query = qq| + # redo for invoices, orders and quotations + if ( $form->{l_transnumber} + || $form->{l_invnumber} + || $form->{l_ordnumber} + || $form->{l_quonumber} ) + { + + my ( $ar, $union, $module ); + $query = ""; + my $transwhere; + my $openarap = ""; + my $openoe = ""; + + if ( $form->{open} || $form->{closed} ) { + unless ( $form->{open} && $form->{closed} ) { + $openarap = " AND a.amount != a.paid" + if $form->{open}; + $openarap = " AND a.amount = a.paid" + if $form->{closed}; + $openoe = " AND o.closed = '0'" + if $form->{open}; + $openoe = " AND o.closed = '1'" + if $form->{closed}; + } + } + + if ( $form->{l_transnumber} ) { + + $ar = ( $form->{db} eq 'customer' ) ? 'ar' : 'ap'; + $module = $ar; + + $transwhere = ""; + $transwhere .= + " AND a.transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $transwhere .= + " AND a.transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; + + $query = qq| SELECT ct.*, b.description AS business, a.invnumber, a.ordnumber, a.quonumber, @@ -720,23 +720,23 @@ sub search { $transwhere $openarap |; - $union = qq| UNION |; + $union = qq| UNION |; - } + } - if ($form->{l_invnumber}) { - $ar = ($form->{db} eq 'customer') ? 'ar' : 'ap'; - $module = ($ar eq 'ar') ? 'is' : 'ir'; + if ( $form->{l_invnumber} ) { + $ar = ( $form->{db} eq 'customer' ) ? 'ar' : 'ap'; + $module = ( $ar eq 'ar' ) ? 'is' : 'ir'; - $transwhere = ""; - $transwhere .= " AND a.transdate >= ". - $dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $transwhere .= " AND a.transdate <= ". - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; + $transwhere = ""; + $transwhere .= + " AND a.transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $transwhere .= + " AND a.transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; - $query .= qq| + $query .= qq| $union SELECT ct.*, b.description AS business, a.invnumber, a.ordnumber, a.quonumber, @@ -756,21 +756,21 @@ sub search { $transwhere $openarap |; - $union = qq| UNION|; + $union = qq| UNION|; - } + } - if ($form->{l_ordnumber}) { + if ( $form->{l_ordnumber} ) { - $transwhere = ""; - $transwhere .= " AND o.transdate >= ". - $dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $transwhere .= " AND o.transdate <= ". - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; + $transwhere = ""; + $transwhere .= + " AND o.transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $transwhere .= + " AND o.transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; - $query .= qq| + $query .= qq| $union SELECT ct.*, b.description AS business, ' ' AS invnumber, o.ordnumber, @@ -788,22 +788,21 @@ sub search { $transwhere $openoe |; - $union = qq| UNION|; - - } + $union = qq| UNION|; - if ($form->{l_quonumber}) { + } - $transwhere = ""; - $transwhere .= " AND o.transdate >= ". - $dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $transwhere .= " AND o.transdate <= ". - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; + if ( $form->{l_quonumber} ) { + $transwhere = ""; + $transwhere .= + " AND o.transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $transwhere .= + " AND o.transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; - $query .= qq| + $query .= qq| $union SELECT ct.*, b.description AS business, ' ' AS invnumber, o.ordnumber, @@ -822,190 +821,195 @@ sub search { $transwhere $openoe |; - } + } - $sortorder .= ", invid"; - } + $sortorder .= ", invid"; + } - $query .= qq| ORDER BY $sortorder|; + $query .= qq| ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - # accounts - $query = qq| + # accounts + $query = qq| SELECT c.accno FROM chart c JOIN $form->{db}tax t ON (t.chart_id = c.id) WHERE t.$form->{db}_id = ?|; - my $tth = $dbh->prepare($query); + my $tth = $dbh->prepare($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $tth->execute($ref->{id}); + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $tth->execute( $ref->{id} ); - while (($item) = $tth->fetchrow_array) { - $ref->{taxaccount} .= "$item "; - } + while ( ($item) = $tth->fetchrow_array ) { + $ref->{taxaccount} .= "$item "; + } - $tth->finish; - chop $ref->{taxaccount}; + $tth->finish; + chop $ref->{taxaccount}; - $ref->{address} = ""; + $ref->{address} = ""; - for (qw(address1 address2 city state zipcode country)) { - $ref->{address} .= "$ref->{$_} "; - } - push @{ $form->{CT} }, $ref; - } + for (qw(address1 address2 city state zipcode country)) { + $ref->{address} .= "$ref->{$_} "; + } + push @{ $form->{CT} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub get_history { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query; - my $where = "1 = 1"; - $form->{sort} = "partnumber" unless $form->{sort}; - my $sortorder = $form->{sort}; - my %ordinal = (); - my $var; - my $table; - - # setup ASC or DESC - $form->sort_order(); - - if ($form->{"$form->{db}number"} ne "") { - $var = $dbh->($form->like(lc $form->{"$form->{db}number"})); - $where .= " AND lower(ct.$form->{db}number) LIKE $var"; - } - - if ($form->{address} ne "") { - $var = $dbh->quote($form->like(lc $form->{address})); - $where .= " AND lower(ct.address1) LIKE $var"; - } - - for (qw(name contact email phone notes city state zipcode country)) { - - if ($form->{$_} ne "") { - $var = $dbh->quote($form->like(lc $form->{$_})); - $where .= " AND lower(ct.$_) LIKE $var"; - } - } - - if ($form->{employee} ne "") { - $var = $form->like(lc $form->{employee}); - $where .= " AND lower(e.name) LIKE '$var'"; - } - - $transwhere .= " AND a.transdate >= ". - $dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $transwhere .= " AND a.transdate <= ". - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; - - if ($form->{open} || $form->{closed}) { - - unless ($form->{open} && $form->{closed}) { - - if ($form->{type} eq 'invoice') { - $where .= " AND a.amount != a.paid" - if $form->{open}; - $where .= " AND a.amount = a.paid" - if $form->{closed}; - } else { - $where .= " AND a.closed = '0'" - if $form->{open}; - $where .= " AND a.closed = '1'" - if $form->{closed}; - } - } - } - - my $invnumber = 'invnumber'; - my $deldate = 'deliverydate'; - my $buysell; - my $sellprice = "sellprice"; - - if ($form->{db} eq 'customer') { - $buysell = "buy"; - - if ($form->{type} eq 'invoice') { - $where .= qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $query; + my $where = "1 = 1"; + $form->{sort} = "partnumber" unless $form->{sort}; + my $sortorder = $form->{sort}; + my %ordinal = (); + my $var; + my $table; + + # setup ASC or DESC + $form->sort_order(); + + if ( $form->{"$form->{db}number"} ne "" ) { + $var = $dbh->( $form->like( lc $form->{"$form->{db}number"} ) ); + $where .= " AND lower(ct.$form->{db}number) LIKE $var"; + } + + if ( $form->{address} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{address} ) ); + $where .= " AND lower(ct.address1) LIKE $var"; + } + + for (qw(name contact email phone notes city state zipcode country)) { + + if ( $form->{$_} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{$_} ) ); + $where .= " AND lower(ct.$_) LIKE $var"; + } + } + + if ( $form->{employee} ne "" ) { + $var = $form->like( lc $form->{employee} ); + $where .= " AND lower(e.name) LIKE '$var'"; + } + + $transwhere .= + " AND a.transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $transwhere .= " AND a.transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; + + if ( $form->{open} || $form->{closed} ) { + + unless ( $form->{open} && $form->{closed} ) { + + if ( $form->{type} eq 'invoice' ) { + $where .= " AND a.amount != a.paid" + if $form->{open}; + $where .= " AND a.amount = a.paid" + if $form->{closed}; + } + else { + $where .= " AND a.closed = '0'" + if $form->{open}; + $where .= " AND a.closed = '1'" + if $form->{closed}; + } + } + } + + my $invnumber = 'invnumber'; + my $deldate = 'deliverydate'; + my $buysell; + my $sellprice = "sellprice"; + + if ( $form->{db} eq 'customer' ) { + $buysell = "buy"; + + if ( $form->{type} eq 'invoice' ) { + $where .= qq| AND a.invoice = '1' AND i.assemblyitem = '0'|; - $table = 'ar'; - $sellprice = "fxsellprice"; - } else { - $table = 'oe'; - - if ($form->{type} eq 'order') { - $invnumber = 'ordnumber'; - $where .= qq| AND a.quotation = '0'|; - } else { - $invnumber = 'quonumber'; - $where .= qq| AND a.quotation = '1'|; - } - - $deldate = 'reqdate'; - } - } - - if ($form->{db} eq 'vendor') { - - $buysell = "sell"; - - if ($form->{type} eq 'invoice') { - - $where .= qq| AND a.invoice = '1' AND i.assemblyitem = '0'|; - $table = 'ap'; - $sellprice = "fxsellprice"; - - } else { - - $table = 'oe'; - - if ($form->{type} eq 'order') { - $invnumber = 'ordnumber'; - $where .= qq| AND a.quotation = '0'|; - } else { - $invnumber = 'quonumber'; - $where .= qq| AND a.quotation = '1'|; - } - - $deldate = 'reqdate'; - } - } - - my $invjoin = qq| JOIN invoice i ON (i.trans_id = a.id)|; - - if ($form->{type} eq 'order') { - $invjoin = qq| JOIN orderitems i ON (i.trans_id = a.id)|; - } - - if ($form->{type} eq 'quotation') { - $invjoin = qq| JOIN orderitems i ON (i.trans_id = a.id)|; - $where .= qq| AND a.quotation = '1'|; - } - - - %ordinal = ( partnumber => 9, - description => 12, - "$deldate" => 16, - serialnumber => 17, - projectnumber => 18 ); - - $sortorder = "2 $form->{direction}, 1, 11, $ordinal{$sortorder} $form->{direction}"; - - $query = qq| + $table = 'ar'; + $sellprice = "fxsellprice"; + } + else { + $table = 'oe'; + + if ( $form->{type} eq 'order' ) { + $invnumber = 'ordnumber'; + $where .= qq| AND a.quotation = '0'|; + } + else { + $invnumber = 'quonumber'; + $where .= qq| AND a.quotation = '1'|; + } + + $deldate = 'reqdate'; + } + } + + if ( $form->{db} eq 'vendor' ) { + + $buysell = "sell"; + + if ( $form->{type} eq 'invoice' ) { + + $where .= qq| AND a.invoice = '1' AND i.assemblyitem = '0'|; + $table = 'ap'; + $sellprice = "fxsellprice"; + + } + else { + + $table = 'oe'; + + if ( $form->{type} eq 'order' ) { + $invnumber = 'ordnumber'; + $where .= qq| AND a.quotation = '0'|; + } + else { + $invnumber = 'quonumber'; + $where .= qq| AND a.quotation = '1'|; + } + + $deldate = 'reqdate'; + } + } + + my $invjoin = qq| JOIN invoice i ON (i.trans_id = a.id)|; + + if ( $form->{type} eq 'order' ) { + $invjoin = qq| JOIN orderitems i ON (i.trans_id = a.id)|; + } + + if ( $form->{type} eq 'quotation' ) { + $invjoin = qq| JOIN orderitems i ON (i.trans_id = a.id)|; + $where .= qq| AND a.quotation = '1'|; + } + + %ordinal = ( + partnumber => 9, + description => 12, + "$deldate" => 16, + serialnumber => 17, + projectnumber => 18 + ); + + $sortorder = + "2 $form->{direction}, 1, 11, $ordinal{$sortorder} $form->{direction}"; + + $query = qq| SELECT ct.id AS ctid, ct.name, ct.address1, ct.address2, ct.city, ct.state, p.id AS pid, p.partnumber, a.id AS invid, @@ -1026,34 +1030,35 @@ sub get_history { WHERE $where ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{address} = ""; - $ref->{exchangerate} ||= 1; - for (qw(address1 address2 city state zipcode country)) { $ref->{address} .= "$ref->{$_} " } - $ref->{id} = $ref->{ctid}; - push @{ $form->{CT} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{address} = ""; + $ref->{exchangerate} ||= 1; + for (qw(address1 address2 city state zipcode country)) { + $ref->{address} .= "$ref->{$_} "; + } + $ref->{id} = $ref->{ctid}; + push @{ $form->{CT} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub pricelist { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query; + my $query; - if ($form->{db} eq 'customer') { - $query = qq|SELECT p.id, p.partnumber, p.description, + if ( $form->{db} eq 'customer' ) { + $query = qq|SELECT p.id, p.partnumber, p.description, p.sellprice, pg.partsgroup, p.partsgroup_id, m.pricebreak, m.sellprice, m.validfrom, m.validto, m.curr @@ -1062,10 +1067,10 @@ sub pricelist { LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) WHERE m.customer_id = ? ORDER BY partnumber|; - } + } - if ($form->{db} eq 'vendor') { - $query = qq|SELECT p.id, p.partnumber AS sku, p.description, + if ( $form->{db} eq 'vendor' ) { + $query = qq|SELECT p.id, p.partnumber AS sku, p.description, pg.partsgroup, p.partsgroup_id, m.partnumber, m.leadtime, m.lastcost, m.curr FROM partsvendor m @@ -1073,159 +1078,154 @@ sub pricelist { LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) WHERE m.vendor_id = ? ORDER BY p.partnumber|; - } + } - my $sth; - my $ref; + my $sth; + my $ref; - if ($form->{id}) { + if ( $form->{id} ) { - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_partspricelist} }, $ref; - } - - $sth->finish; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_partspricelist} }, $ref; + } - $query = qq|SELECT value FROM defaults where setting_key = 'curr'|; - ($form->{currencies}) = $dbh->selectrow_array($query); + $sth->finish; + } - $query = qq|SELECT id, partsgroup + $query = qq|SELECT value FROM defaults where setting_key = 'curr'|; + ( $form->{currencies} ) = $dbh->selectrow_array($query); + + $query = qq|SELECT id, partsgroup FROM partsgroup ORDER BY partsgroup|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); - $form->{all_partsgroup} = (); + $form->{all_partsgroup} = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_partsgroup} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_partsgroup} }, $ref; + } - $sth->finish; + $sth->finish; - $dbh->commit; + $dbh->commit; } - sub save_pricelist { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| DELETE FROM parts$form->{db} WHERE $form->{db}_id = ?}|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - foreach $i (1 .. $form->{rowcount}) { + foreach $i ( 1 .. $form->{rowcount} ) { - if ($form->{"id_$i"}) { + if ( $form->{"id_$i"} ) { - if ($form->{db} eq 'customer') { + if ( $form->{db} eq 'customer' ) { - for (qw(pricebreak sellprice)) { - $form->{"${_}_$i"} = - $form->parse_amount( - $myconfig, - $form->{"${_}_$i"}); - } + for (qw(pricebreak sellprice)) { + $form->{"${_}_$i"} = + $form->parse_amount( $myconfig, $form->{"${_}_$i"} ); + } - $query = qq| + $query = qq| INSERT INTO parts$form->{db} (parts_id, customer_id, pricebreak, sellprice, validfrom, validto, curr) VALUES (?, ?, ?, ?, ?, ?, ?)|; - @queryargs = ($form->{"id_$i"}, $form->{id}, - $form->{"pricebreak_$i"}, - $form->{"sellprice_$i"}, - $form->{"validfrom_$i"}, - $form->{"validto_$i"}, - $form->{"curr_$i"}); - } else { - - for (qw(leadtime lastcost)) { - $form->{"${_}_$i"} = - $form->parse_amount( - $myconfig, - $form->{"${_}_$i"}) - } - - $query = qq| + @queryargs = ( + $form->{"id_$i"}, $form->{id}, + $form->{"pricebreak_$i"}, $form->{"sellprice_$i"}, + $form->{"validfrom_$i"}, $form->{"validto_$i"}, + $form->{"curr_$i"} + ); + } + else { + + for (qw(leadtime lastcost)) { + $form->{"${_}_$i"} = + $form->parse_amount( $myconfig, $form->{"${_}_$i"} ); + } + + $query = qq| INSERT INTO parts$form->{db} (parts_id, vendor_id, partnumber, lastcost, leadtime, curr) VALUES (?, ?, ?, ?, ?, ?)|; - @queryargs = ($form->{"id_$i"}, $form->{id}, - $form->{"partnumber_$i"}, - $form->{"lastcost_$i"}, - $form->{"leadtime_$i"}, - $form->{"curr_$i"}); + @queryargs = ( + $form->{"id_$i"}, $form->{id}, + $form->{"partnumber_$i"}, $form->{"lastcost_$i"}, + $form->{"leadtime_$i"}, $form->{"curr_$i"} + ); - } - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - } + } + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + } - } + } - $_ = $dbh->commit; + $_ = $dbh->commit; } - - sub retrieve_item { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $i = $form->{rowcount}; - my $var; - my $null; + my $i = $form->{rowcount}; + my $var; + my $null; - my $where = "WHERE p.obsolete = '0'"; + my $where = "WHERE p.obsolete = '0'"; - if ($form->{db} eq 'vendor') { - # parts, services, labor - $where .= " AND p.assembly = '0'"; - } + if ( $form->{db} eq 'vendor' ) { - if ($form->{db} eq 'customer') { - # parts, assemblies, services - $where .= " AND p.income_accno_id > 0"; - } + # parts, services, labor + $where .= " AND p.assembly = '0'"; + } - if ($form->{"partnumber_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"partnumber_$i"})); - $where .= " AND lower(p.partnumber) LIKE $var"; - } + if ( $form->{db} eq 'customer' ) { - if ($form->{"description_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"description_$i"})); - $where .= " AND lower(p.description) LIKE $var"; - } + # parts, assemblies, services + $where .= " AND p.income_accno_id > 0"; + } - if ($form->{"partsgroup_$i"} ne "") { - ($null, $var) = split /--/, $form->{"partsgroup_$i"}; - $var = $dbh->quote($var); - $where .= qq| AND p.partsgroup_id = $var|; - } + if ( $form->{"partnumber_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"partnumber_$i"} ) ); + $where .= " AND lower(p.partnumber) LIKE $var"; + } + if ( $form->{"description_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"description_$i"} ) ); + $where .= " AND lower(p.description) LIKE $var"; + } - my $query = qq| + if ( $form->{"partsgroup_$i"} ne "" ) { + ( $null, $var ) = split /--/, $form->{"partsgroup_$i"}; + $var = $dbh->quote($var); + $where .= qq| AND p.partsgroup_id = $var|; + } + + my $query = qq| SELECT p.id, p.partnumber, p.description, p.sellprice, p.lastcost, p.unit, pg.partsgroup, p.partsgroup_id FROM parts p @@ -1233,19 +1233,18 @@ sub retrieve_item { $where ORDER BY partnumber|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - my $ref; - $form->{item_list} = (); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + my $ref; + $form->{item_list} = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{item_list} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{item_list} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - 1; diff --git a/LedgerSMB/Contact.pm b/LedgerSMB/Contact.pm index d28cbc64..14f3ee6e 100644 --- a/LedgerSMB/Contact.pm +++ b/LedgerSMB/Contact.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::Contact - LedgerSMB class for managing Contacts diff --git a/LedgerSMB/CreditCard.pm b/LedgerSMB/CreditCard.pm index 8e2a4e1a..dd124163 100644 --- a/LedgerSMB/CreditCard.pm +++ b/LedgerSMB/CreditCard.pm @@ -1,5 +1,5 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ # Copyright (C) 2006 @@ -19,6 +19,7 @@ use LedgerSMB; use LedgerSMB::DBObject; our @ISA qw(LedgerSMB::DBObject); + # use LedgerSMB::CreditCard::Config; # moving elsewhere ## TODO: Add code for credit card number validation and the like diff --git a/LedgerSMB/CreditCard/Config.pm b/LedgerSMB/CreditCard/Config.pm index 199431c0..c8b30758 100644 --- a/LedgerSMB/CreditCard/Config.pm +++ b/LedgerSMB/CreditCard/Config.pm @@ -1,6 +1,6 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ # Copyright (C) 2006 @@ -18,6 +18,6 @@ package Config; $gateway_module = "TrustCommerce"; -$debug = 0; # Debugging off by default +$debug = 0; # Debugging off by default 1; diff --git a/LedgerSMB/CreditCard/TrustCommerce.pm b/LedgerSMB/CreditCard/TrustCommerce.pm index e0adb395..634af8f2 100644 --- a/LedgerSMB/CreditCard/TrustCommerce.pm +++ b/LedgerSMB/CreditCard/TrustCommerce.pm @@ -1,6 +1,6 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ # Copyright (C) 2006 @@ -23,63 +23,63 @@ use Net::TCLink; $debug = $1; sub sale { - $form = shift @_; - $params{action} = 'sale'; - $params{amount} = $form->{amount} * 100; - $params{track1} = $form->{track1}; - $params{track2} = $form->{track2}; - &process; + $form = shift @_; + $params{action} = 'sale'; + $params{amount} = $form->{amount} * 100; + $params{track1} = $form->{track1}; + $params{track2} = $form->{track2}; + &process; } sub process { - for (keys %params){ - print "$_= ".$params{$_}."\n"; - } - my %result = Net::TCLink::send(\%params); - $form->{status} = $result{status}; - if ($result{status} eq 'decline'){ - $form->{declinetype} = $result{declinetype}; - $form->{declinemsg} = $declinemsg{$result{declinetype}}; - } - $form->{ccauth} = $result{transID}; - # log transID and status - print STDERR "Info: TCLink CC AUTH transID $result{transid} returned ". - "status $result{status}:$result{declinetype}:$result{baddata}:". - "$result{errortype}\n"; - if ($debug){ - print STDERR "Full Result:\n"; + for ( keys %params ) { + print "$_= " . $params{$_} . "\n"; + } + my %result = Net::TCLink::send( \%params ); + $form->{status} = $result{status}; + if ( $result{status} eq 'decline' ) { + $form->{declinetype} = $result{declinetype}; + $form->{declinemsg} = $declinemsg{ $result{declinetype} }; + } + $form->{ccauth} = $result{transID}; - for (keys %result){ - print STDERR "$_= ".$result{$_}."\n"; - } - } - - %result; + # log transID and status + print STDERR "Info: TCLink CC AUTH transID $result{transid} returned " + . "status $result{status}:$result{declinetype}:$result{baddata}:" + . "$result{errortype}\n"; + if ($debug) { + print STDERR "Full Result:\n"; + + for ( keys %result ) { + print STDERR "$_= " . $result{$_} . "\n"; + } + } + + %result; } sub credit { - $form = shift @_; - my %params = %baseparams; - $params{transid} = $form->{transid}; - $params{amount} = $form->{amount}; - &process; + $form = shift @_; + my %params = %baseparams; + $params{transid} = $form->{transid}; + $params{amount} = $form->{amount}; + &process; } - %declinemsg = ( - decline => 'Transaction declined by bank', - avs => 'AVS failed: Address and/or Zip mismatch', - cvv => 'CVV2 Failure: Check the CVV2 number and try again', - call => 'Call customer service number on card to get authcode', - expiredcard => 'This card has expired', - carderror => 'This card number is invalid.', - authexpired => 'The authorization expired. Can not postauth.', - fraud => 'CrediGuard Fraud Score exceeded desired threshold', - blacklist => 'CrediGuard Declined: blacklisted this transaction.', - velocity => 'Crediguard declined: Too many transactions', - dailylimit => 'Too many transactions in a day.', - weeklylimit => 'Too many transactions in a week', - monthlylimit => 'Too many transactions in a month' + decline => 'Transaction declined by bank', + avs => 'AVS failed: Address and/or Zip mismatch', + cvv => 'CVV2 Failure: Check the CVV2 number and try again', + call => 'Call customer service number on card to get authcode', + expiredcard => 'This card has expired', + carderror => 'This card number is invalid.', + authexpired => 'The authorization expired. Can not postauth.', + fraud => 'CrediGuard Fraud Score exceeded desired threshold', + blacklist => 'CrediGuard Declined: blacklisted this transaction.', + velocity => 'Crediguard declined: Too many transactions', + dailylimit => 'Too many transactions in a day.', + weeklylimit => 'Too many transactions in a week', + monthlylimit => 'Too many transactions in a month' ); 1; diff --git a/LedgerSMB/CreditCard/TrustCommerce/Config.pm b/LedgerSMB/CreditCard/TrustCommerce/Config.pm index bbe707be..86d026d8 100644 --- a/LedgerSMB/CreditCard/TrustCommerce/Config.pm +++ b/LedgerSMB/CreditCard/TrustCommerce/Config.pm @@ -1,5 +1,5 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ # Copyright (C) 2006 @@ -14,12 +14,11 @@ # # TrustCommerce configuration Information goes Here - package TrustCommerce; - -%baseparams = ( custid => '000000', - password => 'password', +%baseparams = ( + custid => '000000', + password => 'password', ); $debug = 0; diff --git a/LedgerSMB/DBObject.pm b/LedgerSMB/DBObject.pm index 38e96adb..2b4b35da 100644 --- a/LedgerSMB/DBObject.pm +++ b/LedgerSMB/DBObject.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::DBObject - LedgerSMB class for building objects from db relations @@ -41,161 +42,162 @@ use warnings; our $AUTOLOAD; sub AUTOLOAD { - my ($self) = shift; - my $type = Scalar::Util::blessed $self; - $type =~ m/::(.*?)$/; - $type = lc $1; - print "Type: $type\n"; - $self->exec_method(procname => "$type" . "_" . $AUTOLOAD, args => \@_); + my ($self) = shift; + my $type = Scalar::Util::blessed $self; + $type =~ m/::(.*?)$/; + $type = lc $1; + print "Type: $type\n"; + $self->exec_method( procname => "$type" . "_" . $AUTOLOAD, args => \@_ ); } sub new { - my $class = shift @_; - my %args = @_; - my $base = $args{base}; - my $self = bless {}, $class; - if (! $base->isa('LedgerSMB')){ - $self->error("Constructor called without LedgerSMB object arg"); - } - - my $attr; - $self->merge($base); - $self; + my $class = shift @_; + my %args = @_; + my $base = $args{base}; + my $self = bless {}, $class; + if ( !$base->isa('LedgerSMB') ) { + $self->error("Constructor called without LedgerSMB object arg"); + } + + my $attr; + $self->merge($base); + $self; } - sub exec_method { - my ($self) = shift @_; - my %args = @_; - my $funcname = $args{funcname}; - my @in_args = @{$args{args}}; - my @call_args; - - my $query = - "SELECT proname, proargnames FROM pg_proc WHERE proname = ?"; - my $sth = $self->{dbh}->prepare($query); - $sth->execute($funcname); - my $ref; - - $ref = $sth->fetchrow_hashref('NAME_lc'); - my $args = $ref->{proargnames}; - $args =~ s/\{(.*)\}/$1/; - my @proc_args = split /,/, $args; - - if (!$ref){ # no such function - $self->error("No such function: ", $funcname); - die; - } - my $m_name = $ref->{proname}; - - - if ($args){ - for my $arg (@proc_args){ - if ($arg =~ s/^in_//){ - push @call_args, $self->{$arg}; - } - } - } - else { - @call_args = @_; - } - $self->call_procedure(procname => $funcname, args => \@call_args); + my ($self) = shift @_; + my %args = @_; + my $funcname = $args{funcname}; + my @in_args = @{ $args{args} }; + my @call_args; + + my $query = "SELECT proname, proargnames FROM pg_proc WHERE proname = ?"; + my $sth = $self->{dbh}->prepare($query); + $sth->execute($funcname); + my $ref; + + $ref = $sth->fetchrow_hashref('NAME_lc'); + my $args = $ref->{proargnames}; + $args =~ s/\{(.*)\}/$1/; + my @proc_args = split /,/, $args; + + if ( !$ref ) { # no such function + $self->error( "No such function: ", $funcname ); + die; + } + my $m_name = $ref->{proname}; + + if ($args) { + for my $arg (@proc_args) { + if ( $arg =~ s/^in_// ) { + push @call_args, $self->{$arg}; + } + } + } + else { + @call_args = @_; + } + $self->call_procedure( procname => $funcname, args => \@call_args ); } 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; - my $ins_values; - $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, [ @data ]; - } - } - 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)); - } - } - @rc; + 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; + my $ins_values; + $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, [@data]; + } + } + 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) ); + } + } + @rc; } - 1; diff --git a/LedgerSMB/Employee.pm b/LedgerSMB/Employee.pm index 0512cf64..dd74be75 100644 --- a/LedgerSMB/Employee.pm +++ b/LedgerSMB/Employee.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::Employee - LedgerSMB class for managing Employees @@ -34,25 +35,27 @@ use strict; our $VERSION = '1.0.0'; sub save { - my $self = shift; - my $hashref = shift @{$self->exec_method(procname => "employee_save")}; - $self->merge($hashref, 'id'); + my $self = shift; + my $hashref = shift @{ $self->exec_method( procname => "employee_save" ) }; + $self->merge( $hashref, 'id' ); } sub get { - my $self = shift; - my $hashref = shift @{$self->exec_method(procname => "employee_get")}; - $self->merge($hashref, keys %{$hashref}); + my $self = shift; + my $hashref = shift @{ $self->exec_method( procname => "employee_get" ) }; + $self->merge( $hashref, keys %{$hashref} ); } sub list_managers { - my $self = shift; - $self->{manager_list} = $self->exec_method(procname => "employee_list_managers"); + my $self = shift; + $self->{manager_list} = + $self->exec_method( procname => "employee_list_managers" ); } sub search { - my $self = shift; - $self->{search_results} = $self->exec_method(procname => "employee_search"); + my $self = shift; + $self->{search_results} = + $self->exec_method( procname => "employee_search" ); } 1; diff --git a/LedgerSMB/Form.pm b/LedgerSMB/Form.pm index 9e6a403b..76f4877f 100644 --- a/LedgerSMB/Form.pm +++ b/LedgerSMB/Form.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -33,284 +33,293 @@ # #====================================================================== -use Math::BigFloat lib=>'GMP'; +use Math::BigFloat lib => 'GMP'; use LedgerSMB::Sysconfig; package Form; - sub new { - my $type = shift; + my $type = shift; - my $argstr = shift; + my $argstr = shift; - read(STDIN, $_, $ENV{CONTENT_LENGTH}); + read( STDIN, $_, $ENV{CONTENT_LENGTH} ); - if ($argstr){ - $_ = $argstr; - } - elsif ($ENV{QUERY_STRING}) { - $_ = $ENV{QUERY_STRING}; - } + if ($argstr) { + $_ = $argstr; + } + elsif ( $ENV{QUERY_STRING} ) { + $_ = $ENV{QUERY_STRING}; + } - elsif ($ARGV[0]) { - $_ = $ARGV[0]; - } - - my $self = {}; - %$self = split /[&=]/; - for (keys %$self) { $self->{$_} = unescape("", $self->{$_}) } + elsif ( $ARGV[0] ) { + $_ = $ARGV[0]; + } - if (substr($self->{action}, 0, 1) !~ /( |\.)/) { - $self->{action} = lc $self->{action}; - $self->{action} =~ s/( |-|,|\#|\/|\.$)/_/g; - $self->{nextsub} = lc $self->{nextsub}; - $self->{nextsub} =~ s/( |-|,|\#|\/|\.$)/_/g; - } + my $self = {}; + %$self = split /[&=]/; + for ( keys %$self ) { $self->{$_} = unescape( "", $self->{$_} ) } - $self->{menubar} = 1 if $self->{path} =~ /lynx/i; - #menubar will be deprecated, replaced with below - $self->{lynx} = 1 if $self->{path} =~ /lynx/i; + if ( substr( $self->{action}, 0, 1 ) !~ /( |\.)/ ) { + $self->{action} = lc $self->{action}; + $self->{action} =~ s/( |-|,|\#|\/|\.$)/_/g; + $self->{nextsub} = lc $self->{nextsub}; + $self->{nextsub} =~ s/( |-|,|\#|\/|\.$)/_/g; + } - $self->{version} = "1.3.0 Alpha 0 Pre"; - $self->{dbversion} = "1.2.0"; + $self->{menubar} = 1 if $self->{path} =~ /lynx/i; - bless $self, $type; + #menubar will be deprecated, replaced with below + $self->{lynx} = 1 if $self->{path} =~ /lynx/i; - if ($self->{path} eq "bin/lynx"){ - $self->{menubar} = 1; - #menubar will be deprecated, replaced with below - $self->{lynx} = 1; - $self->{path} = "bin/lynx"; - } else { - $self->{path} = "bin/mozilla"; + $self->{version} = "1.3.0 Alpha 0 Pre"; + $self->{dbversion} = "1.2.0"; - } + bless $self, $type; - if (($self->{script} =~ m#(\.\.|\\|/)#)){ - $self->error("Access Denied"); - } - + if ( $self->{path} eq "bin/lynx" ) { + $self->{menubar} = 1; - if (($self->{action} =~ /:/) || ($self->{nextsub} =~ /:/)){ - $self->error("Access Denied"); - } - $self; -} + #menubar will be deprecated, replaced with below + $self->{lynx} = 1; + $self->{path} = "bin/lynx"; + } + else { + $self->{path} = "bin/mozilla"; + } -sub debug { + if ( ( $self->{script} =~ m#(\.\.|\\|/)# ) ) { + $self->error("Access Denied"); + } - my ($self, $file) = @_; + if ( ( $self->{action} =~ /:/ ) || ( $self->{nextsub} =~ /:/ ) ) { + $self->error("Access Denied"); + } + $self; +} - if ($file) { - open(FH, '>', "$file") or die $!; - for (sort keys %$self) { print FH "$_ = $self->{$_}\n" } - close(FH); - } else { - print "\n"; - for (sort keys %$self) { print "$_ = $self->{$_}\n" } - } +sub debug { -} + my ( $self, $file ) = @_; + if ($file) { + open( FH, '>', "$file" ) or die $!; + for ( sort keys %$self ) { print FH "$_ = $self->{$_}\n" } + close(FH); + } + else { + print "\n"; + for ( sort keys %$self ) { print "$_ = $self->{$_}\n" } + } + +} sub escape { - my ($self, $str, $beenthere) = @_; + my ( $self, $str, $beenthere ) = @_; - # for Apache 2 we escape strings twice - if (($ENV{SERVER_SIGNATURE} =~ /Apache\/2\.(\d+)\.(\d+)/) && !$beenthere) { - $str = $self->escape($str, 1) if $1 == 0 && $2 < 44; - } + # for Apache 2 we escape strings twice + if ( ( $ENV{SERVER_SIGNATURE} =~ /Apache\/2\.(\d+)\.(\d+)/ ) + && !$beenthere ) + { + $str = $self->escape( $str, 1 ) if $1 == 0 && $2 < 44; + } - $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge; - $str; + $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge; + $str; } - sub unescape { - my ($self, $str) = @_; + my ( $self, $str ) = @_; - $str =~ tr/+/ /; - $str =~ s/\\$//; + $str =~ tr/+/ /; + $str =~ s/\\$//; - $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; - $str =~ s/\r?\n/\n/g; + $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; + $str =~ s/\r?\n/\n/g; - $str; + $str; } - sub quote { - my ($self, $str) = @_; + my ( $self, $str ) = @_; - if ($str && ! ref($str)) { - $str =~ s/"/"/g; - } + if ( $str && !ref($str) ) { + $str =~ s/"/"/g; + } - $str; + $str; } sub format_date { - # takes an iso date in, and converts it to the date for printing - my ($self, $date) = @_; - my $datestring; - if ($date =~ /^\d{4}\D/){ # is an ISO date - $datestring = $self->{db_dateformat}; - my ($yyyy, $mm, $dd) = split(/\W/, $date); - $datestring =~ s/y+/$yyyy/; - $datestring =~ s/mm/$mm/; - $datestring =~ s/dd/$dd/; - } else { # return date - $datestring = $date; - } - $datestring; -} + # takes an iso date in, and converts it to the date for printing + my ( $self, $date ) = @_; + my $datestring; + if ( $date =~ /^\d{4}\D/ ) { # is an ISO date + $datestring = $self->{db_dateformat}; + my ( $yyyy, $mm, $dd ) = split( /\W/, $date ); + $datestring =~ s/y+/$yyyy/; + $datestring =~ s/mm/$mm/; + $datestring =~ s/dd/$dd/; + } + else { # return date + $datestring = $date; + } + $datestring; +} sub unquote { - my ($self, $str) = @_; + my ( $self, $str ) = @_; - if ($str && ! ref($str)) { - $str =~ s/"/"/g; - } + if ( $str && !ref($str) ) { + $str =~ s/"/"/g; + } - $str; + $str; } - sub hide_form { - my $self = shift; - - if (@_) { - - for (@_) { - print qq|<input type="hidden" name="$_" value="|.$self->quote($self->{$_}).qq|" />\n| - } - - } else { - delete $self->{header}; - - for (sort keys %$self) { - print qq|<input type="hidden" name="$_" value="|.$self->quote($self->{$_}).qq|" />\n| - } - } + my $self = shift; + + if (@_) { + + for (@_) { + print qq|<input type="hidden" name="$_" value="| + . $self->quote( $self->{$_} ) + . qq|" />\n|; + } + + } + else { + delete $self->{header}; + + for ( sort keys %$self ) { + print qq|<input type="hidden" name="$_" value="| + . $self->quote( $self->{$_} ) + . qq|" />\n|; + } + } } - sub error { - my ($self, $msg) = @_; + my ( $self, $msg ) = @_; - if ($ENV{GATEWAY_INTERFACE}) { + if ( $ENV{GATEWAY_INTERFACE} ) { - $self->{msg} = $msg; - $self->{format} = "html"; - $self->format_string('msg'); + $self->{msg} = $msg; + $self->{format} = "html"; + $self->format_string('msg'); - delete $self->{pre}; + delete $self->{pre}; - if (!$self->{header}) { - $self->header; - } + if ( !$self->{header} ) { + $self->header; + } - print qq|<body><h2 class="error">Error!</h2> <p><b>$self->{msg}</b></body>|; + print + qq|<body><h2 class="error">Error!</h2> <p><b>$self->{msg}</b></body>|; - exit; + exit; - } else { + } + else { - if ($ENV{error_function}) { - &{$ENV{error_function}}($msg); - } else { - die "Error: $msg\n"; - } - } + if ( $ENV{error_function} ) { + &{ $ENV{error_function} }($msg); + } + else { + die "Error: $msg\n"; + } + } } - sub info { - my ($self, $msg) = @_; + my ( $self, $msg ) = @_; - if ($ENV{GATEWAY_INTERFACE}) { - $msg =~ s/\n/<br>/g; + if ( $ENV{GATEWAY_INTERFACE} ) { + $msg =~ s/\n/<br>/g; - delete $self->{pre}; + delete $self->{pre}; - if (!$self->{header}) { - $self->header; - print qq| <body>|; - $self->{header} = 1; - } + if ( !$self->{header} ) { + $self->header; + print qq| <body>|; + $self->{header} = 1; + } - print "<b>$msg</b>"; + print "<b>$msg</b>"; - } else { + } + else { - if ($ENV{info_function}) { - &{ $ENV{info_function} }($msg); - } else { - print "$msg\n"; - } - } + if ( $ENV{info_function} ) { + &{ $ENV{info_function} }($msg); + } + else { + print "$msg\n"; + } + } } - sub numtextrows { - my ($self, $str, $cols, $maxrows) = @_; + my ( $self, $str, $cols, $maxrows ) = @_; - my $rows = 0; + my $rows = 0; - for (split /\n/, $str) { - $rows += int (((length) - 2)/$cols) + 1 - } + for ( split /\n/, $str ) { + $rows += int( ( (length) - 2 ) / $cols ) + 1; + } - $maxrows = $rows unless defined $maxrows; + $maxrows = $rows unless defined $maxrows; - return ($rows > $maxrows) ? $maxrows : $rows; + return ( $rows > $maxrows ) ? $maxrows : $rows; } - sub dberror { - my ($self, $msg) = @_; - $self->error("$msg\n".$DBI::errstr); + my ( $self, $msg ) = @_; + $self->error( "$msg\n" . $DBI::errstr ); } - sub isblank { - my ($self, $name, $msg) = @_; - $self->error($msg) if $self->{$name} =~ /^\s*$/; + my ( $self, $name, $msg ) = @_; + $self->error($msg) if $self->{$name} =~ /^\s*$/; } - sub header { - my ($self, $init, $headeradd) = @_; + my ( $self, $init, $headeradd ) = @_; - return if $self->{header}; + return if $self->{header}; - my ($stylesheet, $favicon, $charset); + my ( $stylesheet, $favicon, $charset ); - if ($ENV{GATEWAY_INTERFACE}) { + if ( $ENV{GATEWAY_INTERFACE} ) { - if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { - $stylesheet = qq|<link rel="stylesheet" href="css/$self->{stylesheet}" type="text/css" title="LedgerSMB stylesheet" />\n|; - } + if ( $self->{stylesheet} && ( -f "css/$self->{stylesheet}" ) ) { + $stylesheet = +qq|<link rel="stylesheet" href="css/$self->{stylesheet}" type="text/css" title="LedgerSMB stylesheet" />\n|; + } - if ($self->{charset}) { - $charset = qq|<meta http-equiv="content-type" content="text/html; charset=$self->{charset}" />\n|; - } + if ( $self->{charset} ) { + $charset = +qq|<meta http-equiv="content-type" content="text/html; charset=$self->{charset}" />\n|; + } - $self->{titlebar} = ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; + $self->{titlebar} = + ( $self->{title} ) + ? "$self->{title} - $self->{titlebar}" + : $self->{titlebar}; - print qq|Content-Type: text/html; charset=utf-8\n\n + print qq|Content-Type: text/html; charset=utf-8\n\n <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> @@ -326,1350 +335,1420 @@ sub header { </head> $self->{pre} \n|; - } + } - $self->{header} = 1; + $self->{header} = 1; } sub redirect { - my ($self, $msg) = @_; - use List::Util qw(first); + my ( $self, $msg ) = @_; + use List::Util qw(first); - if ($self->{callback} || !$msg) { + if ( $self->{callback} || !$msg ) { - main::redirect(); - } else { + main::redirect(); + } + else { - $self->info($msg); - } + $self->info($msg); + } } - sub sort_columns { - my ($self, @columns) = @_; + my ( $self, @columns ) = @_; - if ($self->{sort}) { - if (@columns) { - @columns = grep !/^$self->{sort}$/, @columns; - splice @columns, 0, 0, $self->{sort}; - } - } + if ( $self->{sort} ) { + if (@columns) { + @columns = grep !/^$self->{sort}$/, @columns; + splice @columns, 0, 0, $self->{sort}; + } + } - @columns; + @columns; } - sub sort_order { - my ($self, $columns, $ordinal) = @_; + my ( $self, $columns, $ordinal ) = @_; - # setup direction - if ($self->{direction}) { + # setup direction + if ( $self->{direction} ) { - if ($self->{sort} eq $self->{oldsort}) { + if ( $self->{sort} eq $self->{oldsort} ) { - if ($self->{direction} eq 'ASC') { - $self->{direction} = "DESC"; - } else { - $self->{direction} = "ASC"; - } - } + if ( $self->{direction} eq 'ASC' ) { + $self->{direction} = "DESC"; + } + else { + $self->{direction} = "ASC"; + } + } - } else { + } + else { - $self->{direction} = "ASC"; - } + $self->{direction} = "ASC"; + } - $self->{oldsort} = $self->{sort}; + $self->{oldsort} = $self->{sort}; - my @a = $self->sort_columns(@{$columns}); + my @a = $self->sort_columns( @{$columns} ); - if (%$ordinal) { - $a[0] = ($ordinal->{$a[$_]}) ? "$ordinal->{$a[0]} $self->{direction}" : "$a[0] $self->{direction}"; + if (%$ordinal) { + $a[0] = + ( $ordinal->{ $a[$_] } ) + ? "$ordinal->{$a[0]} $self->{direction}" + : "$a[0] $self->{direction}"; - for (1 .. $#a) { - $a[$_] = $ordinal->{$a[$_]} if $ordinal->{$a[$_]} - } + for ( 1 .. $#a ) { + $a[$_] = $ordinal->{ $a[$_] } if $ordinal->{ $a[$_] }; + } - } else { - $a[0] .= " $self->{direction}"; - } + } + else { + $a[0] .= " $self->{direction}"; + } - $sortorder = join ',', @a; - $sortorder; + $sortorder = join ',', @a; + $sortorder; } - sub format_amount { - my ($self, $myconfig, $amount, $places, $dash) = @_; - - my $negative ; - if ($amount){ - $amount = $self->parse_amount($myconfig, $amount); - $negative = ($amount < 0); - $amount =~ s/-//; - } - - if ($places =~ /\d+/) { - #$places = 4 if $places == 2; - $amount = $self->round_amount($amount, $places); - } - - # is the amount negative - - # Parse $myconfig->{numberformat} - - - - my ($ts, $ds) = ($1, $2); - - if ($amount) { - - if ($myconfig->{numberformat}) { - - my ($whole, $dec) = split /\./, "$amount"; - $amount = join '', reverse split //, $whole; - - if ($places) { - $dec .= "0" x $places; - $dec = substr($dec, 0, $places); - } - - if ($myconfig->{numberformat} eq '1,000.00') { - $amount =~ s/\d{3,}?/$&,/g; - $amount =~ s/,$//; - $amount = join '', reverse split //, $amount; - $amount .= "\.$dec" if ($dec ne ""); - } - - if ($myconfig->{numberformat} eq '1 000.00') { - $amount =~ s/\d{3,}?/$& /g; - $amount =~ s/\s$//; - $amount = join '', reverse split //, $amount; - $amount .= "\.$dec" if ($dec ne ""); - } - - if ($myconfig->{numberformat} eq "1'000.00") { - $amount =~ s/\d{3,}?/$&'/g; - $amount =~ s/'$//; - $amount = join '', reverse split //, $amount; - $amount .= "\.$dec" if ($dec ne ""); - } - - if ($myconfig->{numberformat} eq '1.000,00') { - $amount =~ s/\d{3,}?/$&./g; - $amount =~ s/\.$//; - $amount = join '', reverse split //, $amount; - $amount .= ",$dec" if ($dec ne ""); - } - - if ($myconfig->{numberformat} eq '1000,00') { - $amount = "$whole"; - $amount .= ",$dec" if ($dec ne ""); - } - - if ($myconfig->{numberformat} eq '1000.00') { - $amount = "$whole"; - $amount .= ".$dec" if ($dec ne ""); - } - - if ($dash =~ /-/) { - $amount = ($negative) ? "($amount)" : "$amount"; - } elsif ($dash =~ /DRCR/) { - $amount = ($negative) ? "$amount DR" : "$amount CR"; - } else { - $amount = ($negative) ? "-$amount" : "$amount"; - } - } - - } else { - - if ($dash eq "0" && $places) { - - if ($myconfig->{numberformat} eq '1.000,00') { - $amount = "0".","."0" x $places; - } else { - $amount = "0"."."."0" x $places; - } - - } else { - $amount = ($dash ne "") ? "$dash" : ""; - } - } - - $amount; + my ( $self, $myconfig, $amount, $places, $dash ) = @_; + + my $negative; + if ($amount) { + $amount = $self->parse_amount( $myconfig, $amount ); + $negative = ( $amount < 0 ); + $amount =~ s/-//; + } + + if ( $places =~ /\d+/ ) { + + #$places = 4 if $places == 2; + $amount = $self->round_amount( $amount, $places ); + } + + # is the amount negative + + # Parse $myconfig->{numberformat} + + my ( $ts, $ds ) = ( $1, $2 ); + + if ($amount) { + + if ( $myconfig->{numberformat} ) { + + my ( $whole, $dec ) = split /\./, "$amount"; + $amount = join '', reverse split //, $whole; + + if ($places) { + $dec .= "0" x $places; + $dec = substr( $dec, 0, $places ); + } + + if ( $myconfig->{numberformat} eq '1,000.00' ) { + $amount =~ s/\d{3,}?/$&,/g; + $amount =~ s/,$//; + $amount = join '', reverse split //, $amount; + $amount .= "\.$dec" if ( $dec ne "" ); + } + + if ( $myconfig->{numberformat} eq '1 000.00' ) { + $amount =~ s/\d{3,}?/$& /g; + $amount =~ s/\s$//; + $amount = join '', reverse split //, $amount; + $amount .= "\.$dec" if ( $dec ne "" ); + } + + if ( $myconfig->{numberformat} eq "1'000.00" ) { + $amount =~ s/\d{3,}?/$&'/g; + $amount =~ s/'$//; + $amount = join '', reverse split //, $amount; + $amount .= "\.$dec" if ( $dec ne "" ); + } + + if ( $myconfig->{numberformat} eq '1.000,00' ) { + $amount =~ s/\d{3,}?/$&./g; + $amount =~ s/\.$//; + $amount = join '', reverse split //, $amount; + $amount .= ",$dec" if ( $dec ne "" ); + } + + if ( $myconfig->{numberformat} eq '1000,00' ) { + $amount = "$whole"; + $amount .= ",$dec" if ( $dec ne "" ); + } + + if ( $myconfig->{numberformat} eq '1000.00' ) { + $amount = "$whole"; + $amount .= ".$dec" if ( $dec ne "" ); + } + + if ( $dash =~ /-/ ) { + $amount = ($negative) ? "($amount)" : "$amount"; + } + elsif ( $dash =~ /DRCR/ ) { + $amount = ($negative) ? "$amount DR" : "$amount CR"; + } + else { + $amount = ($negative) ? "-$amount" : "$amount"; + } + } + + } + else { + + if ( $dash eq "0" && $places ) { + + if ( $myconfig->{numberformat} eq '1.000,00' ) { + $amount = "0" . "," . "0" x $places; + } + else { + $amount = "0" . "." . "0" x $places; + } + + } + else { + $amount = ( $dash ne "" ) ? "$dash" : ""; + } + } + + $amount; } - sub parse_amount { - my ($self, $myconfig, $amount) = @_; - - if ($amount eq '' or $amount == undef){ - return 0; - } - - if (UNIVERSAL::isa($amount, 'Math::BigFloat')){ # Amount may not be an object - return $amount; - } - my $numberformat = $myconfig->{numberformat}; - - - if (($numberformat eq '1.000,00') || - ($numberformat eq '1000,00')) { - - $amount =~ s/\.//g; - $amount =~ s/,/./; - } - if ($numberformat eq '1 000.00'){ - $amount =~ s/\s//g; - } - - if ($numberformat eq "1'000.00") { - $amount =~ s/'//g; - } - - - $amount =~ s/,//g; - if ($amount =~ s/\((\d*\.?\d*)\)/$1/){ - $amount = $1 * -1; - } - if ($amount =~ s/(\d*\.?\d*)\s?DR/$1/){ - $amount = $1 * -1; - } - $amount =~ s/\s?CR//; - $amount = new Math::BigFloat($amount); - return ($amount * 1); + my ( $self, $myconfig, $amount ) = @_; + + if ( $amount eq '' or $amount == undef ) { + return 0; + } + + if ( UNIVERSAL::isa( $amount, 'Math::BigFloat' ) ) + { # Amount may not be an object + return $amount; + } + my $numberformat = $myconfig->{numberformat}; + + if ( ( $numberformat eq '1.000,00' ) + || ( $numberformat eq '1000,00' ) ) + { + + $amount =~ s/\.//g; + $amount =~ s/,/./; + } + if ( $numberformat eq '1 000.00' ) { + $amount =~ s/\s//g; + } + + if ( $numberformat eq "1'000.00" ) { + $amount =~ s/'//g; + } + + $amount =~ s/,//g; + if ( $amount =~ s/\((\d*\.?\d*)\)/$1/ ) { + $amount = $1 * -1; + } + if ( $amount =~ s/(\d*\.?\d*)\s?DR/$1/ ) { + $amount = $1 * -1; + } + $amount =~ s/\s?CR//; + $amount = new Math::BigFloat($amount); + return ( $amount * 1 ); } - sub round_amount { - my ($self, $amount, $places) = @_; + my ( $self, $amount, $places ) = @_; - # These rounding rules follow from the previous implementation. - # They should be changed to allow different rules for different accounts. - Math::BigFloat->round_mode('+inf') if $amount >= 0; - Math::BigFloat->round_mode('-inf') if $amount < 0; + # These rounding rules follow from the previous implementation. + # They should be changed to allow different rules for different accounts. + Math::BigFloat->round_mode('+inf') if $amount >= 0; + Math::BigFloat->round_mode('-inf') if $amount < 0; - $amount = Math::BigFloat->new($amount)->ffround(-$places) if $places >= 0; - $amount = Math::BigFloat->new($amount)->ffround(-($places-1)) if $places < 0; + $amount = Math::BigFloat->new($amount)->ffround( -$places ) if $places >= 0; + $amount = Math::BigFloat->new($amount)->ffround( -( $places - 1 ) ) + if $places < 0; - return $amount; + return $amount; } sub callproc { - my $procname = shift @_; - my $argstr = ""; - my @results; - for (1 .. $#_){ - $argstr .= "?, "; - } - $argstr =~ s/\, $//; - $query = "SELECT * FROM $procname"; - $query =~ s/\(\)/$argstr/; - my $sth = $self->{dbh}->prepare($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)){ - push @results, $ref; - } - @results; + my $procname = shift @_; + my $argstr = ""; + my @results; + for ( 1 .. $#_ ) { + $argstr .= "?, "; + } + $argstr =~ s/\, $//; + $query = "SELECT * FROM $procname"; + $query =~ s/\(\)/$argstr/; + my $sth = $self->{dbh}->prepare($query); + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @results, $ref; + } + @results; } sub get_my_emp_num { - my ($self, $myconfig, $form) = @_; - %myconfig = %{$myconfig}; - my $dbh = $form->{dbh}; - # we got a connection, check the version - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + %myconfig = %{$myconfig}; + my $dbh = $form->{dbh}; + + # we got a connection, check the version + my $query = qq| SELECT employeenumber FROM employees WHERE login = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{login}) || $form->dberror($query); - $sth->execute; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{login} ) || $form->dberror($query); + $sth->execute; - my ($id) = $sth->fetchrow_array; - $sth->finish; - $form->{'emp_num'} = $id; + my ($id) = $sth->fetchrow_array; + $sth->finish; + $form->{'emp_num'} = $id; } sub parse_template { - my ($self, $myconfig) = @_; - - my ($chars_per_line, $lines_on_first_page, $lines_on_second_page) = (0, 0, 0); - my ($current_page, $current_line) = (1, 1); - print STDERR "Using deprecated Form::parse_template function\n"; - my $pagebreak = ""; - my $sum = 0; - - my $subdir = ""; - my $err = ""; - - my %include = (); - my $ok; - $self->{images} = "${LedgerSMB::Sysconfig::images}/$self->{templates}"; - - if ($self->{language_code}) { - if ($self->{language_code} =~ /(\.\.|\/|\*)/){ - $self->error("Invalid Language Code"); - } - - if (-f "$self->{templates}/$self->{language_code}/$self->{IN}") { - open(IN, '<', "$self->{templates}/$self->{language_code}/$self->{IN}") or $self->error("$self->{IN} : $!"); - } else { - open(IN, '<', "$self->{templates}/$self->{IN}") or $self->error("$self->{IN} : $!"); - } - - } else { - open(IN, '<', "$self->{templates}/$self->{IN}") or $self->error("$self->{IN} : $!"); - } - - @_ = <IN>; - close(IN); - - $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); - - # OUT is used for the media, screen, printer, email - # for postscript we store a copy in a temporary file - my $fileid = time; - my $tmpfile = $self->{IN}; - $tmpfile =~ s/\./_$self->{fileid}./ if $self->{fileid}; - $self->{tmpfile} = "${LedgerSMB::Sysconfig::userspath}/${fileid}_${tmpfile}"; + my ( $self, $myconfig ) = @_; + + my ( $chars_per_line, $lines_on_first_page, $lines_on_second_page ) = + ( 0, 0, 0 ); + my ( $current_page, $current_line ) = ( 1, 1 ); + print STDERR "Using deprecated Form::parse_template function\n"; + my $pagebreak = ""; + my $sum = 0; + + my $subdir = ""; + my $err = ""; + + my %include = (); + my $ok; + $self->{images} = "${LedgerSMB::Sysconfig::images}/$self->{templates}"; + + if ( $self->{language_code} ) { + if ( $self->{language_code} =~ /(\.\.|\/|\*)/ ) { + $self->error("Invalid Language Code"); + } + + if ( -f "$self->{templates}/$self->{language_code}/$self->{IN}" ) { + open( IN, '<', + "$self->{templates}/$self->{language_code}/$self->{IN}" ) + or $self->error("$self->{IN} : $!"); + } + else { + open( IN, '<', "$self->{templates}/$self->{IN}" ) + or $self->error("$self->{IN} : $!"); + } + + } + else { + open( IN, '<', "$self->{templates}/$self->{IN}" ) + or $self->error("$self->{IN} : $!"); + } + + @_ = <IN>; + close(IN); + + $self->{copies} = 1 if ( ( $self->{copies} *= 1 ) <= 0 ); + + # OUT is used for the media, screen, printer, email + # for postscript we store a copy in a temporary file + my $fileid = time; + my $tmpfile = $self->{IN}; + $tmpfile =~ s/\./_$self->{fileid}./ if $self->{fileid}; + $self->{tmpfile} = + "${LedgerSMB::Sysconfig::userspath}/${fileid}_${tmpfile}"; my %temphash; - if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { - $temphash{out} = $self->{OUT}; - $self->{OUT} = "$self->{tmpfile}"; + if ( $self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email' ) { + $temphash{out} = $self->{OUT}; + $self->{OUT} = "$self->{tmpfile}"; $temphash{printmode} = $self->{printmode}; - $self->{printmode} = '>'; - } - - if ($self->{OUT}) { - open(OUT, $self->{printmode}, "$self->{OUT}") or $self->error("$self->{OUT} : $!"); - - } else { - open(OUT, ">-") or $self->error("STDOUT : $!"); - $self->header; - } - - # first we generate a tmpfile - # read file and replace <?lsmb variable ?> - while ($_ = shift) { - - $par = ""; - $var = $_; - - # detect pagebreak block and its parameters - if (/<\?lsmb pagebreak ([0-9]+) ([0-9]+) ([0-9]+) \?>/) { - $chars_per_line = $1; - $lines_on_first_page = $2; - $lines_on_second_page = $3; - - while ($_ = shift) { - last if (/<\?lsmb end pagebreak \?>/); - $pagebreak .= $_; - } - } - - if (/<\?lsmb foreach /) { - - # this one we need for the count - chomp $var; - $var =~ s/.*?<\?lsmb foreach (.+?) \?>/$1/; - while ($_ = shift) { - last if (/<\?lsmb end $var \?>/); - - # store line in $par - $par .= $_; - } - - # display contents of $self->{number}[] array - for $i (0 .. $#{ $self->{$var} }) { - - if ($var =~ /^(part|service)$/) { - next if $self->{$var}[$i] eq 'NULL'; - } - - # Try to detect whether a manual page break is necessary - # but only if there was a <?lsmb pagebreak ... ?> block before - - if ($var eq 'number' || $var eq 'part' || $var eq 'service') { - - if ($chars_per_line && defined $self->{$var}) { - - my $line; - my $lines = 0; - my @d = qw(description); - push @d, "itemnotes" if $self->{countitemnotes}; + $self->{printmode} = '>'; + } + + if ( $self->{OUT} ) { + open( OUT, $self->{printmode}, "$self->{OUT}" ) + or $self->error("$self->{OUT} : $!"); + + } + else { + open( OUT, ">-" ) or $self->error("STDOUT : $!"); + $self->header; + } + + # first we generate a tmpfile + # read file and replace <?lsmb variable ?> + while ( $_ = shift ) { + + $par = ""; + $var = $_; + + # detect pagebreak block and its parameters + if (/<\?lsmb pagebreak ([0-9]+) ([0-9]+) ([0-9]+) \?>/) { + $chars_per_line = $1; + $lines_on_first_page = $2; + $lines_on_second_page = $3; + + while ( $_ = shift ) { + last if (/<\?lsmb end pagebreak \?>/); + $pagebreak .= $_; + } + } + + if (/<\?lsmb foreach /) { + + # this one we need for the count + chomp $var; + $var =~ s/.*?<\?lsmb foreach (.+?) \?>/$1/; + while ( $_ = shift ) { + last if (/<\?lsmb end $var \?>/); + + # store line in $par + $par .= $_; + } + + # display contents of $self->{number}[] array + for $i ( 0 .. $#{ $self->{$var} } ) { - foreach my $item (@d) { + if ( $var =~ /^(part|service)$/ ) { + next if $self->{$var}[$i] eq 'NULL'; + } - if ($self->{$item}[$i]) { + # Try to detect whether a manual page break is necessary + # but only if there was a <?lsmb pagebreak ... ?> block before - foreach $line (split /\r?\n/, $self->{$item}[$i]) { - $lines++; - $lines += int(length($line) / $chars_per_line); - } - } - } + if ( $var eq 'number' || $var eq 'part' || $var eq 'service' ) { - my $lpp; + if ( $chars_per_line && defined $self->{$var} ) { - if ($current_page == 1) { - $lpp = $lines_on_first_page; - } else { - $lpp = $lines_on_second_page; - } + my $line; + my $lines = 0; + my @d = qw(description); + push @d, "itemnotes" if $self->{countitemnotes}; + + foreach my $item (@d) { + + if ( $self->{$item}[$i] ) { + + foreach $line ( split /\r?\n/, + $self->{$item}[$i] ) + { + $lines++; + $lines += + int( length($line) / $chars_per_line ); + } + } + } - # Yes we need a manual page break - if (($current_line + $lines) > $lpp) { - my $pb = $pagebreak; + my $lpp; - # replace the special variables <?lsmb sumcarriedforward ?> - # and <?lsmb lastpage ?> - my $psum = $self->format_amount($myconfig, $sum, 2); - $pb =~ s/<\?lsmb sumcarriedforward \?>/$psum/g; - $pb =~ s/<\?lsmb lastpage \?>/$current_page/g; + if ( $current_page == 1 ) { + $lpp = $lines_on_first_page; + } + else { + $lpp = $lines_on_second_page; + } - # only "normal" variables are supported here - # (no <?lsmb if, no <?lsmb foreach, no <?lsmb include) - $pb =~ s/<\?lsmb (.+?) \?>/$self->{$1}/g; + # Yes we need a manual page break + if ( ( $current_line + $lines ) > $lpp ) { + my $pb = $pagebreak; - # page break block is ready to rock - print(OUT $pb); - $current_page++; - $current_line = 1; - $lines = 0; - } + # replace the special variables <?lsmb sumcarriedforward ?> + # and <?lsmb lastpage ?> + my $psum = + $self->format_amount( $myconfig, $sum, 2 ); + $pb =~ s/<\?lsmb sumcarriedforward \?>/$psum/g; + $pb =~ s/<\?lsmb lastpage \?>/$current_page/g; - $current_line += $lines; - } + # only "normal" variables are supported here + # (no <?lsmb if, no <?lsmb foreach, no <?lsmb include) + $pb =~ s/<\?lsmb (.+?) \?>/$self->{$1}/g; - $sum += $self->parse_amount($myconfig, $self->{linetotal}[$i]); - } + # page break block is ready to rock + print( OUT $pb ); + $current_page++; + $current_line = 1; + $lines = 0; + } + + $current_line += $lines; + } + + $sum += + $self->parse_amount( $myconfig, $self->{linetotal}[$i] ); + } - # don't parse par, we need it for each line - print OUT $self->format_line($par, $i); - } - next; - } + # don't parse par, we need it for each line + print OUT $self->format_line( $par, $i ); + } + next; + } - # if not comes before if! - if (/<\?lsmb if not /) { + # if not comes before if! + if (/<\?lsmb if not /) { - # check if it is not set and display - chop; - s/.*?<\?lsmb if not (.+?) \?>/$1/; + # check if it is not set and display + chop; + s/.*?<\?lsmb if not (.+?) \?>/$1/; - if (! $self->{$_}) { + if ( !$self->{$_} ) { - while ($_ = shift) { - last if (/<\?lsmb end /); + while ( $_ = shift ) { + last if (/<\?lsmb end /); - # store line in $par - $par .= $_; - } + # store line in $par + $par .= $_; + } - $_ = $par; + $_ = $par; - } else { + } + else { - while ($_ = shift) { - last if (/<\?lsmb end /); - } + while ( $_ = shift ) { + last if (/<\?lsmb end /); + } - next; - } - } + next; + } + } - if (/<\?lsmb if /) { + if (/<\?lsmb if /) { - # check if it is set and display - chop; - s/.*?<\?lsmb if (.+?) \?>/$1/; + # check if it is set and display + chop; + s/.*?<\?lsmb if (.+?) \?>/$1/; - if (/\s/) { - @a = split; - $ok = eval "$self->{$a[0]} $a[1] $a[2]"; - } else { - $ok = $self->{$_}; - } + if (/\s/) { + @a = split; + $ok = eval "$self->{$a[0]} $a[1] $a[2]"; + } + else { + $ok = $self->{$_}; + } - if ($ok) { - while ($_ = shift) { - last if (/<\?lsmb end /); - # store line in $par - $par .= $_; - } + if ($ok) { + while ( $_ = shift ) { + last if (/<\?lsmb end /); - $_ = $par; + # store line in $par + $par .= $_; + } - } else { + $_ = $par; - while ($_ = shift) { - last if (/<\?lsmb end /); - } + } + else { - next; - } - } + while ( $_ = shift ) { + last if (/<\?lsmb end /); + } - # check for <?lsmb include filename ?> - if (/<\?lsmb include /) { + next; + } + } - # get the filename - chomp $var; - $var =~ s/.*?<\?lsmb include (.+?) \?>/$1/; + # check for <?lsmb include filename ?> + if (/<\?lsmb include /) { - # remove / .. for security reasons - $var =~ s/(\/|\.\.)//g; + # get the filename + chomp $var; + $var =~ s/.*?<\?lsmb include (.+?) \?>/$1/; - # assume loop after 10 includes of the same file - next if ($include{$var} > 10); + # remove / .. for security reasons + $var =~ s/(\/|\.\.)//g; - unless (open(INC, '<', "$self->{templates}/$self->{language_code}/$var")) { - $err = $!; - $self->cleanup; - $self->error("$self->{templates}/$self->{language_code}/$var : $err"); - } + # assume loop after 10 includes of the same file + next if ( $include{$var} > 10 ); - unshift(@_, <INC>); - close(INC); + unless ( + open( INC, '<', "$self->{templates}/$self->{language_code}/$var" + ) + ) + { + $err = $!; + $self->cleanup; + $self->error( + "$self->{templates}/$self->{language_code}/$var : $err"); + } - $include{$var}++; + unshift( @_, <INC> ); + close(INC); - next; - } + $include{$var}++; - print OUT $self->format_line($_); + next; + } - } + print OUT $self->format_line($_); - close(OUT); + } - delete $self->{countitemnotes}; + close(OUT); - # Convert the tex file to postscript - if ($self->{format} =~ /(postscript|pdf)/) { + delete $self->{countitemnotes}; - use Cwd; - $self->{cwd} = cwd(); - $self->{tmpdir} = "$self->{cwd}/${LedgerSMB::Sysconfig::userspath}"; - $self->{tmpdir} = "${LedgerSMB::Sysconfig::userspath}" if - ${LedgerSMB::Sysconfig::userspath} =~ /^\//; + # Convert the tex file to postscript + if ( $self->{format} =~ /(postscript|pdf)/ ) { - unless (chdir("${LedgerSMB::Sysconfig::userspath}")) { - $err = $!; - $self->cleanup; - $self->error("chdir : $err"); - } + use Cwd; + $self->{cwd} = cwd(); + $self->{tmpdir} = "$self->{cwd}/${LedgerSMB::Sysconfig::userspath}"; + $self->{tmpdir} = "${LedgerSMB::Sysconfig::userspath}" + if ${LedgerSMB::Sysconfig::userspath} =~ /^\//; - $self->{tmpfile} =~ s/${LedgerSMB::Sysconfig::userspath}\///g; + unless ( chdir("${LedgerSMB::Sysconfig::userspath}") ) { + $err = $!; + $self->cleanup; + $self->error("chdir : $err"); + } - $self->{errfile} = $self->{tmpfile}; - $self->{errfile} =~ s/tex$/err/; + $self->{tmpfile} =~ s/${LedgerSMB::Sysconfig::userspath}\///g; - my $r = 1; - if ($self->{format} eq 'postscript') { + $self->{errfile} = $self->{tmpfile}; + $self->{errfile} =~ s/tex$/err/; - system("latex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"); + my $r = 1; + if ( $self->{format} eq 'postscript' ) { - while ($self->rerun_latex) { - system("latex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"); - last if ++$r > 4; - } + system( +"latex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}" + ); - $self->{tmpfile} =~ s/tex$/dvi/; - $self->error($self->cleanup) if ! (-f $self->{tmpfile}); + while ( $self->rerun_latex ) { + system( +"latex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}" + ); + last if ++$r > 4; + } - system("dvips $self->{tmpfile} -o -q"); - $self->error($self->cleanup."dvips : $!") if ($?); - $self->{tmpfile} =~ s/dvi$/ps/; - } + $self->{tmpfile} =~ s/tex$/dvi/; + $self->error( $self->cleanup ) if !( -f $self->{tmpfile} ); - if ($self->{format} eq 'pdf') { - system("pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"); + system("dvips $self->{tmpfile} -o -q"); + $self->error( $self->cleanup . "dvips : $!" ) if ($?); + $self->{tmpfile} =~ s/dvi$/ps/; + } - while ($self->rerun_latex) { - system("pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"); - last if ++$r > 4; - } + if ( $self->{format} eq 'pdf' ) { + system( +"pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}" + ); - $self->{tmpfile} =~ s/tex$/pdf/; - $self->error($self->cleanup) if ! (-f $self->{tmpfile}); - } - } + while ( $self->rerun_latex ) { + system( +"pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}" + ); + last if ++$r > 4; + } + $self->{tmpfile} =~ s/tex$/pdf/; + $self->error( $self->cleanup ) if !( -f $self->{tmpfile} ); + } + } - if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { + if ( $self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email' ) { - if ($self->{media} eq 'email') { + if ( $self->{media} eq 'email' ) { - use LedgerSMB::Mailer; + use LedgerSMB::Mailer; - my $mail = new Mailer; + my $mail = new Mailer; - for (qw(cc bcc subject message version format charset)) { - $mail->{$_} = $self->{$_} - } + for (qw(cc bcc subject message version format charset)) { + $mail->{$_} = $self->{$_}; + } - $mail->{to} = qq|$self->{email}|; - $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; - $mail->{notify} = $self->{notify}; - $mail->{fileid} = "$fileid."; + $mail->{to} = qq|$self->{email}|; + $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + $mail->{notify} = $self->{notify}; + $mail->{fileid} = "$fileid."; - # if we send html or plain text inline - if (($self->{format} =~ /(html|txt)/) && - ($self->{sendmode} eq 'inline')) { + # if we send html or plain text inline + if ( ( $self->{format} =~ /(html|txt)/ ) + && ( $self->{sendmode} eq 'inline' ) ) + { - my $br = ""; - $br = "<br>" if $self->{format} eq 'html'; + my $br = ""; + $br = "<br>" if $self->{format} eq 'html'; - $mail->{contenttype} = "text/$self->{format}"; + $mail->{contenttype} = "text/$self->{format}"; - $mail->{message} =~ s/\r?\n/$br\n/g; - $myconfig->{signature} =~ s/\\n/$br\n/g; - $mail->{message} .= "$br\n-- $br\n$myconfig->{signature}\n$br" if $myconfig->{signature}; + $mail->{message} =~ s/\r?\n/$br\n/g; + $myconfig->{signature} =~ s/\\n/$br\n/g; + $mail->{message} .= "$br\n-- $br\n$myconfig->{signature}\n$br" + if $myconfig->{signature}; - unless (open(IN, '<', $self->{tmpfile})) { - $err = $!; - $self->cleanup; - $self->error("$self->{tmpfile} : $err"); - } + unless ( open( IN, '<', $self->{tmpfile} ) ) { + $err = $!; + $self->cleanup; + $self->error("$self->{tmpfile} : $err"); + } - while (<IN>) { - $mail->{message} .= $_; - } + while (<IN>) { + $mail->{message} .= $_; + } - close(IN); + close(IN); - } else { + } + else { - @{ $mail->{attachments} } = ($self->{tmpfile}); + @{ $mail->{attachments} } = ( $self->{tmpfile} ); - $myconfig->{signature} =~ s/\\n/\n/g; - $mail->{message} .= "\n-- \n$myconfig->{signature}" if $myconfig->{signature}; + $myconfig->{signature} =~ s/\\n/\n/g; + $mail->{message} .= "\n-- \n$myconfig->{signature}" + if $myconfig->{signature}; - } + } - if ($err = $mail->send) { - $self->cleanup; - $self->error($err); - } + if ( $err = $mail->send ) { + $self->cleanup; + $self->error($err); + } - } else { + } + else { - $self->{OUT} = $temphash{out}; + $self->{OUT} = $temphash{out}; $self->{printmode} = $temphash{printmode}; - unless (open(IN, '<', $self->{tmpfile})) { - $err = $!; - $self->cleanup; - $self->error("$self->{tmpfile} : $err"); - } + unless ( open( IN, '<', $self->{tmpfile} ) ) { + $err = $!; + $self->cleanup; + $self->error("$self->{tmpfile} : $err"); + } - binmode(IN); + binmode(IN); - $self->{copies} = 1 if $self->{media} =~ /(screen|email|queue)/; + $self->{copies} = 1 if $self->{media} =~ /(screen|email|queue)/; - chdir("$self->{cwd}"); + chdir("$self->{cwd}"); - for my $i (1 .. $self->{copies}) { - if ($self->{OUT}) { + for my $i ( 1 .. $self->{copies} ) { + if ( $self->{OUT} ) { - unless (open(OUT, $self->{printmode}, $self->{OUT})) { - $err = $!; - $self->cleanup; - $self->error("$self->{OUT} : $err"); - } + unless ( open( OUT, $self->{printmode}, $self->{OUT} ) ) { + $err = $!; + $self->cleanup; + $self->error("$self->{OUT} : $err"); + } - } else { + } + else { - # launch application - print qq|Content-Type: application/$self->{format}\n|. - qq|Content-Disposition: attachment; filename="$self->{tmpfile}"\n\n|; + # launch application + print qq|Content-Type: application/$self->{format}\n| + . qq|Content-Disposition: attachment; filename="$self->{tmpfile}"\n\n|; - unless (open(OUT, ">-")) { - $err = $!; - $self->cleanup; - $self->error("STDOUT : $err"); - } - } + unless ( open( OUT, ">-" ) ) { + $err = $!; + $self->cleanup; + $self->error("STDOUT : $err"); + } + } - binmode(OUT); + binmode(OUT); - while (<IN>) { - print OUT $_; - } + while (<IN>) { + print OUT $_; + } - close(OUT); - seek IN, 0, 0; - } + close(OUT); + seek IN, 0, 0; + } - close(IN); - } + close(IN); + } - $self->cleanup; - } + $self->cleanup; + } } - sub format_line { - my $self = shift; + my $self = shift; - $_ = shift; - my $i = shift; + $_ = shift; + my $i = shift; - my $str; - my $newstr; - my $pos; - my $l; - my $lf; - my $line; - my $var = ""; - my %a; - my $offset; - my $pad; - my $item; + my $str; + my $newstr; + my $pos; + my $l; + my $lf; + my $line; + my $var = ""; + my %a; + my $offset; + my $pad; + my $item; - while (/<\?lsmb (.+?) \?>/) { + while (/<\?lsmb (.+?) \?>/) { - %a = (); + %a = (); - foreach $item (split / /, $1) { - my ($key, $value) = split /=/, $item; + foreach $item ( split / /, $1 ) { + my ( $key, $value ) = split /=/, $item; - if ($value ne "") { - $a{$key} = $value; - } else { - $var = $item; - } - } + if ( $value ne "" ) { + $a{$key} = $value; + } + else { + $var = $item; + } + } - $str = (defined $i) ? $self->{$var}[$i] : $self->{$var}; - $newstr = $str; + $str = ( defined $i ) ? $self->{$var}[$i] : $self->{$var}; + $newstr = $str; - $self->{countitemnotes} = 1 if $var eq 'itemnotes'; + $self->{countitemnotes} = 1 if $var eq 'itemnotes'; - $var = $1; - if ($var =~ /^if\s+not\s+/) { + $var = $1; + if ( $var =~ /^if\s+not\s+/ ) { - if ($str) { + if ($str) { - $var =~ s/if\s+not\s+//; - s/<\?lsmb if\s+not\s+$var \?>.*?(<\?lsmb end\s+$var \?>|$)//s; + $var =~ s/if\s+not\s+//; + s/<\?lsmb if\s+not\s+$var \?>.*?(<\?lsmb end\s+$var \?>|$)//s; - } else { - s/<\?lsmb $var \?>//; - } + } + else { + s/<\?lsmb $var \?>//; + } - next; - } + next; + } - if ($var =~ /^if\s+/) { + if ( $var =~ /^if\s+/ ) { - if ($str) { - s/<\?lsmb $var \?>//; - } else { - $var =~ s/if\s+//; - s/<\?lsmb if\s+$var \?>.*?(<\?lsmb end\s+$var \?>|$)//s; - } + if ($str) { + s/<\?lsmb $var \?>//; + } + else { + $var =~ s/if\s+//; + s/<\?lsmb if\s+$var \?>.*?(<\?lsmb end\s+$var \?>|$)//s; + } - next; - } + next; + } - if ($var =~ /^end\s+/) { - s/<\?lsmb $var \?>//; - next; - } + if ( $var =~ /^end\s+/ ) { + s/<\?lsmb $var \?>//; + next; + } - if ($a{align} || $a{width} || $a{offset}) { + if ( $a{align} || $a{width} || $a{offset} ) { - $newstr = ""; - $offset = 0; - $lf = ""; + $newstr = ""; + $offset = 0; + $lf = ""; - foreach $str (split /\n/, $str) { + foreach $str ( split /\n/, $str ) { - $line = $str; - $l = length $str; + $line = $str; + $l = length $str; - do { + do { - if (($pos = length $str) > $a{width}) { + if ( ( $pos = length $str ) > $a{width} ) { - if (($pos = rindex $str, " ", $a{width}) > 0) { - $line = substr($str, 0, $pos); - } + if ( ( $pos = rindex $str, " ", $a{width} ) > 0 ) { + $line = substr( $str, 0, $pos ); + } - $pos = length $str if $pos == -1; - } + $pos = length $str if $pos == -1; + } - $l = length $line; + $l = length $line; - # pad left, right or center - $l = ($a{width} - $l); + # pad left, right or center + $l = ( $a{width} - $l ); - $pad = " " x $l; + $pad = " " x $l; - if ($a{align} =~ /right/i) { - $line = " " x $offset . $pad . $line; - } + if ( $a{align} =~ /right/i ) { + $line = " " x $offset . $pad . $line; + } - if ($a{align} =~ /left/i) { - $line = " " x $offset . $line . $pad; - } + if ( $a{align} =~ /left/i ) { + $line = " " x $offset . $line . $pad; + } - if ($a{align} =~ /center/i) { - $pad = " " x ($l/2); - $line = " " x $offset . $pad . $line; - $pad = " " x ($l/2); - $line .= $pad; - } + if ( $a{align} =~ /center/i ) { + $pad = " " x ( $l / 2 ); + $line = " " x $offset . $pad . $line; + $pad = " " x ( $l / 2 ); + $line .= $pad; + } - $newstr .= "$lf$line"; + $newstr .= "$lf$line"; - $str = substr($str, $pos + 1); - $line = $str; - $lf = "\n"; + $str = substr( $str, $pos + 1 ); + $line = $str; + $lf = "\n"; - $offset = $a{offset}; + $offset = $a{offset}; - } while ($str); - } - } + } while ($str); + } + } - s/<\?lsmb (.+?) \?>/$newstr/; + s/<\?lsmb (.+?) \?>/$newstr/; - } + } - $_; + $_; } - sub cleanup { - my $self = shift; + my $self = shift; - chdir("$self->{tmpdir}"); + chdir("$self->{tmpdir}"); - my @err = (); + my @err = (); - if (-f "$self->{errfile}") { - open(FH, '<', "$self->{errfile}"); - @err = <FH>; - close(FH); - } + if ( -f "$self->{errfile}" ) { + open( FH, '<', "$self->{errfile}" ); + @err = <FH>; + close(FH); + } - if ($self->{tmpfile}) { - # strip extension - $self->{tmpfile} =~ s/\.\w+$//g; - my $tmpfile = $self->{tmpfile}; - unlink(<$tmpfile.*>); - } + if ( $self->{tmpfile} ) { - chdir("$self->{cwd}"); + # strip extension + $self->{tmpfile} =~ s/\.\w+$//g; + my $tmpfile = $self->{tmpfile}; + unlink(<$tmpfile.*>); + } - "@err"; -} + chdir("$self->{cwd}"); + "@err"; +} sub rerun_latex { - my $self = shift; + my $self = shift; - my $a = 0; + my $a = 0; - if (-f "$self->{errfile}") { - open(FH, '<', "$self->{errfile}"); - $a = grep /(longtable Warning:|Warning:.*?LastPage)/, <FH>; - close(FH); - } + if ( -f "$self->{errfile}" ) { + open( FH, '<', "$self->{errfile}" ); + $a = grep /(longtable Warning:|Warning:.*?LastPage)/, <FH>; + close(FH); + } - $a; + $a; } - sub format_string { - my ($self, @fields) = @_; - - my $format = $self->{format}; - - if ($self->{format} =~ /(postscript|pdf)/) { - $format = 'tex'; - } - - my %replace = ( - 'order' => { - html => [ '<', '>', '\n', '\r' ], - txt => [ '\n', '\r' ], - tex => [ quotemeta('\\'), '&', '\n','\r', - '\$', '%', '_', '#', - quotemeta('^'), '{', '}', '<', '>', '£' - ] }, - html => { '<' => '<', '>' => '>','\n' => '<br />', - '\r' => '<br />' }, - txt => { '\n' => "\n", '\r' => "\r" }, - tex => {'&' => '\&', '$' => '\$', '%' => '\%', '_' => '\_', - '#' => '\#', quotemeta('^') => '\^\\', '{' => '\{', - '}' => '\}', '<' => '$<$', '>' => '$>$', - '\n' => '\newline ', '\r' => '\newline ', - '£' => '\pounds ', quotemeta('\\') => '/'} - ); - - my $key; - - foreach $key (@{ $replace{order}{$format} }) { - for (@fields) { $self->{$_} =~ s/$key/$replace{$format}{$key}/g } - } + my ( $self, @fields ) = @_; + + my $format = $self->{format}; + + if ( $self->{format} =~ /(postscript|pdf)/ ) { + $format = 'tex'; + } + + my %replace = ( + 'order' => { + html => [ '<', '>', '\n', '\r' ], + txt => [ '\n', '\r' ], + tex => [ + quotemeta('\\'), '&', '\n', '\r', + '\$', '%', '_', '#', + quotemeta('^'), '{', '}', '<', + '>', '£' + ] + }, + html => { + '<' => '<', + '>' => '>', + '\n' => '<br />', + '\r' => '<br />' + }, + txt => { '\n' => "\n", '\r' => "\r" }, + tex => { + '&' => '\&', + '$' => '\$', + '%' => '\%', + '_' => '\_', + '#' => '\#', + quotemeta('^') => '\^\\', + '{' => '\{', + '}' => '\}', + '<' => '$<$', + '>' => '$>$', + '\n' => '\newline ', + '\r' => '\newline ', + '£' => '\pounds ', + quotemeta('\\') => '/' + } + ); + + my $key; + + foreach $key ( @{ $replace{order}{$format} } ) { + for (@fields) { $self->{$_} =~ s/$key/$replace{$format}{$key}/g } + } } - sub datetonum { - my ($self, $myconfig, $date, $picture) = @_; + my ( $self, $myconfig, $date, $picture ) = @_; - if ($date && $date =~ /\D/) { + if ( $date && $date =~ /\D/ ) { - if ($myconfig->{dateformat} =~ /^yy/) { - ($yy, $mm, $dd) = split /\D/, $date; - } + if ( $myconfig->{dateformat} =~ /^yy/ ) { + ( $yy, $mm, $dd ) = split /\D/, $date; + } - if ($myconfig->{dateformat} =~ /^mm/) { - ($mm, $dd, $yy) = split /\D/, $date; - } + if ( $myconfig->{dateformat} =~ /^mm/ ) { + ( $mm, $dd, $yy ) = split /\D/, $date; + } - if ($myconfig->{dateformat} =~ /^dd/) { - ($dd, $mm, $yy) = split /\D/, $date; - } + if ( $myconfig->{dateformat} =~ /^dd/ ) { + ( $dd, $mm, $yy ) = split /\D/, $date; + } - $dd *= 1; - $mm *= 1; - $yy += 2000 if length $yy == 2; + $dd *= 1; + $mm *= 1; + $yy += 2000 if length $yy == 2; - $dd = substr("0$dd", -2); - $mm = substr("0$mm", -2); + $dd = substr( "0$dd", -2 ); + $mm = substr( "0$mm", -2 ); - $date = "$yy$mm$dd"; - } + $date = "$yy$mm$dd"; + } - $date; + $date; } - sub add_date { - my ($self, $myconfig, $date, $repeat, $unit) = @_; + my ( $self, $myconfig, $date, $repeat, $unit ) = @_; - use Time::Local; + use Time::Local; - my $diff = 0; - my $spc = $myconfig->{dateformat}; - $spc =~ s/\w//g; - $spc = substr($spc, 0, 1); + my $diff = 0; + my $spc = $myconfig->{dateformat}; + $spc =~ s/\w//g; + $spc = substr( $spc, 0, 1 ); - if ($date) { + if ($date) { - if ($date =~ /\D/) { + if ( $date =~ /\D/ ) { - if ($myconfig->{dateformat} =~ /^yy/) { - ($yy, $mm, $dd) = split /\D/, $date; - } + if ( $myconfig->{dateformat} =~ /^yy/ ) { + ( $yy, $mm, $dd ) = split /\D/, $date; + } - if ($myconfig->{dateformat} =~ /^mm/) { - ($mm, $dd, $yy) = split /\D/, $date; - } + if ( $myconfig->{dateformat} =~ /^mm/ ) { + ( $mm, $dd, $yy ) = split /\D/, $date; + } - if ($myconfig->{dateformat} =~ /^dd/) { - ($dd, $mm, $yy) = split /\D/, $date; - } + if ( $myconfig->{dateformat} =~ /^dd/ ) { + ( $dd, $mm, $yy ) = split /\D/, $date; + } - } else { - # ISO - ($yy, $mm, $dd) =~ /(....)(..)(..)/; - } + } + else { - if ($unit eq 'days') { - $diff = $repeat * 86400; - } + # ISO + ( $yy, $mm, $dd ) =~ /(....)(..)(..)/; + } - if ($unit eq 'weeks') { - $diff = $repeat * 604800; - } + if ( $unit eq 'days' ) { + $diff = $repeat * 86400; + } - if ($unit eq 'months') { - $diff = $mm + $repeat; + if ( $unit eq 'weeks' ) { + $diff = $repeat * 604800; + } - my $whole = int($diff / 12); - $yy += $whole; + if ( $unit eq 'months' ) { + $diff = $mm + $repeat; - $mm = ($diff % 12) + 1; - $diff = 0; - } + my $whole = int( $diff / 12 ); + $yy += $whole; - if ($unit eq 'years') { - $yy++; - } + $mm = ( $diff % 12 ) + 1; + $diff = 0; + } - $mm--; + if ( $unit eq 'years' ) { + $yy++; + } - @t = localtime(timelocal(0,0,0,$dd,$mm,$yy) + $diff); + $mm--; - $t[4]++; - $mm = substr("0$t[4]",-2); - $dd = substr("0$t[3]",-2); - $yy = $t[5] + 1900; + @t = localtime( timelocal( 0, 0, 0, $dd, $mm, $yy ) + $diff ); - if ($date =~ /\D/) { + $t[4]++; + $mm = substr( "0$t[4]", -2 ); + $dd = substr( "0$t[3]", -2 ); + $yy = $t[5] + 1900; - if ($myconfig->{dateformat} =~ /^yy/) { - $date = "$yy$spc$mm$spc$dd"; - } + if ( $date =~ /\D/ ) { - if ($myconfig->{dateformat} =~ /^mm/) { - $date = "$mm$spc$dd$spc$yy"; - } + if ( $myconfig->{dateformat} =~ /^yy/ ) { + $date = "$yy$spc$mm$spc$dd"; + } - if ($myconfig->{dateformat} =~ /^dd/) { - $date = "$dd$spc$mm$spc$yy"; - } + if ( $myconfig->{dateformat} =~ /^mm/ ) { + $date = "$mm$spc$dd$spc$yy"; + } - } else { - $date = "$yy$mm$dd"; - } - } + if ( $myconfig->{dateformat} =~ /^dd/ ) { + $date = "$dd$spc$mm$spc$yy"; + } - $date; -} + } + else { + $date = "$yy$mm$dd"; + } + } + $date; +} sub print_button { - my ($self, $button, $name) = @_; - - print qq|<button class="submit" type="submit" name="action" value="$name" accesskey="$button->{$name}{key}" title="$button->{$name}{value} [Alt-$button->{$name}{key}]">$button->{$name}{value}</button>\n|; -} + my ( $self, $button, $name ) = @_; + print +qq|<button class="submit" type="submit" name="action" value="$name" accesskey="$button->{$name}{key}" title="$button->{$name}{value} [Alt-$button->{$name}{key}]">$button->{$name}{value}</button>\n|; +} # Database routines used throughout sub db_init { - my ($self, $myconfig) = @_; - $self->{dbh} = $self->dbconnect_noauto($myconfig) || $self->dberror(); + my ( $self, $myconfig ) = @_; + $self->{dbh} = $self->dbconnect_noauto($myconfig) || $self->dberror(); - my $query = - "SELECT t.extends, + my $query = "SELECT t.extends, coalesce (t.table_name, 'custom_' || extends) || ':' || f.field_name as field_def FROM custom_table_catalog t JOIN custom_field_catalog f USING (table_id)"; - my $sth = $self->{dbh}->prepare($query); - $sth->execute; - my $ref; - while ($ref = $sth->fetchrow_hashref(NAME_lc)){ - push @{$self->{custom_db_fields}{$ref->{extends}}}, - $ref->{field_def}; - } + my $sth = $self->{dbh}->prepare($query); + $sth->execute; + my $ref; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $self->{custom_db_fields}{ $ref->{extends} } }, + $ref->{field_def}; + } } sub run_custom_queries { - my ($self, $tablename, $query_type, $linenum) = @_; - my $dbh = $self->{dbh}; - if ($query_type !~ /^(select|insert|update)$/i){ - $self->error($locale->text( - "Passed incorrect query type to run_custom_queries." - )); - } - my @rc; - my %temphash; - my @templist; - 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; - my $ins_values; - $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, [ @data ]; - } - } - if ($query_type eq 'INSERT'){ - for (@rc){ - $query = shift (@{$_}); - $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 @{$_}; - $sth = $self->{dbh}->prepare($query); - $sth->execute($self->{id}); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %{$ref}){ - $self->{$_} = $ref->{$_}; - } - } - } - @rc; + my ( $self, $tablename, $query_type, $linenum ) = @_; + my $dbh = $self->{dbh}; + if ( $query_type !~ /^(select|insert|update)$/i ) { + $self->error( + $locale->text( + "Passed incorrect query type to run_custom_queries." + ) + ); + } + my @rc; + my %temphash; + my @templist; + 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; + my $ins_values; + $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, [@data]; + } + } + if ( $query_type eq 'INSERT' ) { + for (@rc) { + $query = shift( @{$_} ); + $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 @{$_}; + $sth = $self->{dbh}->prepare($query); + $sth->execute( $self->{id} ); + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %{$ref} ) { + $self->{$_} = $ref->{$_}; + } + } + } + @rc; } - sub dbconnect { - my ($self, $myconfig) = @_; + my ( $self, $myconfig ) = @_; - # connect to database - my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}) or $self->dberror; + # connect to database + my $dbh = DBI->connect( $myconfig->{dbconnect}, + $myconfig->{dbuser}, $myconfig->{dbpasswd} ) + or $self->dberror; - # set db options - if ($myconfig->{dboptions}) { - $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions}); - } + # set db options + if ( $myconfig->{dboptions} ) { + $dbh->do( $myconfig->{dboptions} ) + || $self->dberror( $myconfig->{dboptions} ); + } - $dbh; + $dbh; } - sub dbconnect_noauto { - my ($self, $myconfig) = @_; + my ( $self, $myconfig ) = @_; - # connect to database - $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, {AutoCommit => 0}) or $self->dberror; + # connect to database + $dbh = DBI->connect( + $myconfig->{dbconnect}, $myconfig->{dbuser}, + $myconfig->{dbpasswd}, { AutoCommit => 0 } + ) or $self->dberror; - # set db options - if ($myconfig->{dboptions}) { - $dbh->do($myconfig->{dboptions}); - } + # set db options + if ( $myconfig->{dboptions} ) { + $dbh->do( $myconfig->{dboptions} ); + } - $dbh; + $dbh; } - sub dbquote { - my ($self, $var) = @_; + my ( $self, $var ) = @_; - if ($var eq ''){ - $_ = "NULL"; - } else { - $_ = $self->{dbh}->quote($var); - } - $_; + if ( $var eq '' ) { + $_ = "NULL"; + } + else { + $_ = $self->{dbh}->quote($var); + } + $_; } - sub update_balance { - # This is a dangerous private function. All apps calling it must - # be careful to avoid SQL injection issues - my ($self, $dbh, $table, $field, $where, $value) = @_; + # This is a dangerous private function. All apps calling it must + # be careful to avoid SQL injection issues - # if we have a value, go do it - if ($value) { - # retrieve balance from table - my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE"; - my ($balance) = $dbh->selectrow_array($query); + my ( $self, $dbh, $table, $field, $where, $value ) = @_; - $balance += $value; - # update balance - $query = "UPDATE $table SET $field = $balance WHERE $where"; - $dbh->do($query) || $self->dberror($query); - } -} + # if we have a value, go do it + if ($value) { + + # retrieve balance from table + my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE"; + my ($balance) = $dbh->selectrow_array($query); + + $balance += $value; + # update balance + $query = "UPDATE $table SET $field = $balance WHERE $where"; + $dbh->do($query) || $self->dberror($query); + } +} sub update_exchangerate { - my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; + my ( $self, $dbh, $curr, $transdate, $buy, $sell ) = @_; - # some sanity check for currency - return if ($curr eq ""); + # some sanity check for currency + return if ( $curr eq "" ); - my $query = qq| + my $query = qq| SELECT curr FROM exchangerate WHERE curr = ? AND transdate = ? FOR UPDATE|; - my $sth = $self->{dbh}->prepare($query); - $sth->execute($curr, $transdate) || $self->dberror($query); - - my $set; - my @queryargs; - - if ($buy && $sell) { - $set = "buy = ?, sell = ?"; - @queryargs = ($buy, $sell); - } elsif ($buy) { - $set = "buy = ?"; - @queryargs = ($buy); - } elsif ($sell) { - $set = "sell = ?"; - @queryargs = ($sell); - } - - if ($sth->fetchrow_array) { - $query = qq|UPDATE exchangerate + my $sth = $self->{dbh}->prepare($query); + $sth->execute( $curr, $transdate ) || $self->dberror($query); + + my $set; + my @queryargs; + + if ( $buy && $sell ) { + $set = "buy = ?, sell = ?"; + @queryargs = ( $buy, $sell ); + } + elsif ($buy) { + $set = "buy = ?"; + @queryargs = ($buy); + } + elsif ($sell) { + $set = "sell = ?"; + @queryargs = ($sell); + } + + if ( $sth->fetchrow_array ) { + $query = qq|UPDATE exchangerate SET $set WHERE curr = ? AND transdate = ?|; - push (@queryargs, $curr, $transdate); + push( @queryargs, $curr, $transdate ); - } else { - $query = qq| + } + else { + $query = qq| INSERT INTO exchangerate ( curr, buy, sell, transdate) VALUES (?, ?, ?, ?)|; - @queryargs = ($curr, $buy, $sell, $transdate); - } - $sth->finish; - $sth = $self->{dbh}->prepare($query); + @queryargs = ( $curr, $buy, $sell, $transdate ); + } + $sth->finish; + $sth = $self->{dbh}->prepare($query); - $sth->execute(@queryargs) || $self->dberror($query); + $sth->execute(@queryargs) || $self->dberror($query); } - sub save_exchangerate { - my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_; + my ( $self, $myconfig, $currency, $transdate, $rate, $fld ) = @_; - my ($buy, $sell) = (0, 0); - $buy = $rate if $fld eq 'buy'; - $sell = $rate if $fld eq 'sell'; + my ( $buy, $sell ) = ( 0, 0 ); + $buy = $rate if $fld eq 'buy'; + $sell = $rate if $fld eq 'sell'; - $self->update_exchangerate( - $self->{dbh}, - $currency, - $transdate, - $buy, - $sell); + $self->update_exchangerate( $self->{dbh}, $currency, $transdate, $buy, + $sell ); - $dbh->commit; + $dbh->commit; } - sub get_exchangerate { - my ($self, $dbh, $curr, $transdate, $fld) = @_; + my ( $self, $dbh, $curr, $transdate, $fld ) = @_; - my $exchangerate = 1; + my $exchangerate = 1; - if ($transdate) { - my $query = qq| + if ($transdate) { + my $query = qq| SELECT $fld FROM exchangerate WHERE curr = ? AND transdate = ?|; - $sth = $self->{dbh}->prepare($query); - $sth->execute($curr, $transdate); + $sth = $self->{dbh}->prepare($query); + $sth->execute( $curr, $transdate ); - ($exchangerate) = $sth->fetchrow_array; - } + ($exchangerate) = $sth->fetchrow_array; + } - $exchangerate; - $sth->finish; - $self->{dbh}->commit; + $exchangerate; + $sth->finish; + $self->{dbh}->commit; } - sub check_exchangerate { - my ($self, $myconfig, $currency, $transdate, $fld) = @_; - - return "" unless $transdate; + my ( $self, $myconfig, $currency, $transdate, $fld ) = @_; + return "" unless $transdate; - my $query = qq| + my $query = qq| SELECT $fld FROM exchangerate WHERE curr = ? AND transdate = ?|; - my $sth = $self->{dbh}->prepare($query); - $sth->execute($currenct, $transdate); - my ($exchangerate) = $sth->fetchrow_array; + my $sth = $self->{dbh}->prepare($query); + $sth->execute( $currenct, $transdate ); + my ($exchangerate) = $sth->fetchrow_array; - $sth->finish; - $self->{dbh}->commit; + $sth->finish; + $self->{dbh}->commit; - $exchangerate; + $exchangerate; } - sub add_shipto { - my ($self, $dbh, $id) = @_; + my ( $self, $dbh, $id ) = @_; - my $shipto; + my $shipto; - foreach my $item (qw(name address1 address2 city state - zipcode country contact phone fax email)) { + foreach my $item ( + qw(name address1 address2 city state + zipcode country contact phone fax email) + ) + { - if ($self->{"shipto$item"} ne "") { - $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"}); - } - } + if ( $self->{"shipto$item"} ne "" ) { + $shipto = 1 if ( $self->{$item} ne $self->{"shipto$item"} ); + } + } - if ($shipto) { - my $query = qq| + if ($shipto) { + my $query = qq| INSERT INTO shipto (trans_id, shiptoname, shiptoaddress1, shiptoaddress2, shiptocity, shiptostate, @@ -1678,125 +1757,123 @@ sub add_shipto { VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |; - $sth = $self->{dbh}->prepare($query) || $self->dberror($query); - $sth->execute( - $id, $self->{shiptoname}, $self->{shiptoaddress1}, - $self->{shiptoaddress2}, $self->{shiptocity}, - $self->{shiptostate}, - $self->{shiptozipcode}, $self->{shiptocountry}, - $self->{shiptocontact}, $self->{shiptophone}, - $self->{shiptofax}, $self->{shiptoemail} - ) || $self->dberror($query); - $sth->finish; - $self->{dbh}->commit; - } + $sth = $self->{dbh}->prepare($query) || $self->dberror($query); + $sth->execute( + $id, $self->{shiptoname}, + $self->{shiptoaddress1}, $self->{shiptoaddress2}, + $self->{shiptocity}, $self->{shiptostate}, + $self->{shiptozipcode}, $self->{shiptocountry}, + $self->{shiptocontact}, $self->{shiptophone}, + $self->{shiptofax}, $self->{shiptoemail} + ) || $self->dberror($query); + $sth->finish; + $self->{dbh}->commit; + } } - sub get_employee { - my ($self, $dbh) = @_; + my ( $self, $dbh ) = @_; - my $login = $self->{login}; - $login =~ s/@.*//; + my $login = $self->{login}; + $login =~ s/@.*//; - my $query = qq|SELECT name, id + my $query = qq|SELECT name, id FROM employees WHERE login = ?|; - $sth = $self->{dbh}->prepare($query); - $sth->execute($login); - my (@a) = $sth->fetchrow_array(); - $a[1] *= 1; + $sth = $self->{dbh}->prepare($query); + $sth->execute($login); + my (@a) = $sth->fetchrow_array(); + $a[1] *= 1; - $sth->finish; - $self->{dbh}->commit; + $sth->finish; + $self->{dbh}->commit; - @a; + @a; } - # this sub gets the id and name from $table sub get_name { - my ($self, $myconfig, $table, $transdate) = @_; + my ( $self, $myconfig, $table, $transdate ) = @_; - # connect to database + # connect to database - my @queryargs; - my $where; - if ($transdate) { - $where = qq| + my @queryargs; + my $where; + if ($transdate) { + $where = qq| AND (startdate IS NULL OR startdate <= ?) AND (enddate IS NULL OR enddate >= ?)|; - @queryargs = ($transdate, $transdate); - } + @queryargs = ( $transdate, $transdate ); + } - my $name = $self->like(lc $self->{$table}); + my $name = $self->like( lc $self->{$table} ); - my $query = qq| + my $query = qq| SELECT * FROM $table WHERE (lower(name) LIKE ? OR ${table}number LIKE ?) $where ORDER BY name|; - unshift(@queryargs, $name, $name); - my $sth = $self->{dbh}->prepare($query); + unshift( @queryargs, $name, $name ); + my $sth = $self->{dbh}->prepare($query); - $sth->execute(@queryargs) || $self->dberror($query); + $sth->execute(@queryargs) || $self->dberror($query); - my $i = 0; - @{ $self->{name_list} } = (); + my $i = 0; + @{ $self->{name_list} } = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{name_list} }, $ref); - $i++; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push( @{ $self->{name_list} }, $ref ); + $i++; + } - $sth->finish; - $self->{dbh}->commit; + $sth->finish; + $self->{dbh}->commit; - $i; + $i; } - sub all_vc { - my ($self, $myconfig, $vc, $module, $dbh, $transdate, $job) = @_; + my ( $self, $myconfig, $vc, $module, $dbh, $transdate, $job ) = @_; - my $ref; - my $disconnect = 0; + my $ref; + my $disconnect = 0; - $dbh = $self->{dbh}; + $dbh = $self->{dbh}; - my $sth; + my $sth; - my $query = qq|SELECT count(*) FROM $vc|; - my $where; - my @queryargs = (); + my $query = qq|SELECT count(*) FROM $vc|; + my $where; + my @queryargs = (); - if ($transdate) { - $query .= qq| WHERE (startdate IS NULL OR startdate <= ?) + if ($transdate) { + $query .= qq| WHERE (startdate IS NULL OR startdate <= ?) AND (enddate IS NULL OR enddate >= ?)|; - @queryargs = ($transdate, $transdate); - } + @queryargs = ( $transdate, $transdate ); + } + + $sth = $dbh->prepare($query); - $sth = $dbh->prepare($query); + $sth->execute(@queryargs); - $sth->execute(@queryargs); + my ($count) = $sth->fetchrow_array; - my ($count) = $sth->fetchrow_array; + $sth->finish; + @queryargs = (); - $sth->finish; - @queryargs = (); - # build selection list - if ($count < $myconfig->{vclimit}) { + # build selection list + if ( $count < $myconfig->{vclimit} ) { - $self->{"${vc}_id"} *= 1; + $self->{"${vc}_id"} *= 1; - $query = qq|SELECT id, name + $query = qq|SELECT id, name FROM $vc WHERE 1=1 $where @@ -1808,310 +1885,312 @@ sub all_vc { WHERE id = ? ORDER BY name|; - push(@queryargs, $self->{"${vc}_id"}); + push( @queryargs, $self->{"${vc}_id"} ); - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $self->dberror($query); - @{ $self->{"all_$vc"} } = (); + @{ $self->{"all_$vc"} } = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{"all_$vc"} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $self->{"all_$vc"} }, $ref; + } - $sth->finish; + $sth->finish; - } + } - # get self - if (! $self->{employee_id}) { - ($self->{employee}, $self->{employee_id}) = split /--/, $self->{employee}; - ($self->{employee}, $self->{employee_id}) = $self->get_employee($dbh) unless $self->{employee_id}; - } + # get self + if ( !$self->{employee_id} ) { + ( $self->{employee}, $self->{employee_id} ) = split /--/, + $self->{employee}; + ( $self->{employee}, $self->{employee_id} ) = $self->get_employee($dbh) + unless $self->{employee_id}; + } - $self->all_employees($myconfig, $dbh, $transdate, 1); + $self->all_employees( $myconfig, $dbh, $transdate, 1 ); - $self->all_departments($myconfig, $dbh, $vc); + $self->all_departments( $myconfig, $dbh, $vc ); - $self->all_projects($myconfig, $dbh, $transdate, $job); + $self->all_projects( $myconfig, $dbh, $transdate, $job ); - # get language codes - $query = qq|SELECT * + # get language codes + $query = qq|SELECT * FROM language ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); - $self->{all_language} = (); + $self->{all_language} = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_language} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $self->{all_language} }, $ref; + } - $sth->finish; - $self->all_taxaccounts($myconfig, $dbh, $transdate); - $self->{dbh}->commit; + $sth->finish; + $self->all_taxaccounts( $myconfig, $dbh, $transdate ); + $self->{dbh}->commit; } - sub all_taxaccounts { - my ($self, $myconfig, $dbh2, $transdate) = @_; + my ( $self, $myconfig, $dbh2, $transdate ) = @_; - my $dbh = $self->{dbh}; + my $dbh = $self->{dbh}; - my $sth; - my $query; - my $where; + my $sth; + my $query; + my $where; - my @queryargs = (); + my @queryargs = (); - if ($transdate) { - $where = qq| AND (t.validto >= ? OR t.validto IS NULL)|; - push(@queryargs, $transdate); - } + if ($transdate) { + $where = qq| AND (t.validto >= ? OR t.validto IS NULL)|; + push( @queryargs, $transdate ); + } - if ($self->{taxaccounts}) { + if ( $self->{taxaccounts} ) { - # rebuild tax rates - $query = qq|SELECT t.rate, t.taxnumber + # rebuild tax rates + $query = qq|SELECT t.rate, t.taxnumber FROM tax t JOIN chart c ON (c.id = t.chart_id) WHERE c.accno = ? $where ORDER BY accno, validto|; - $sth = $dbh->prepare($query) || $self->dberror($query); + $sth = $dbh->prepare($query) || $self->dberror($query); - foreach my $accno (split / /, $self->{taxaccounts}) { - $sth->execute($accno, @queryargs); - ($self->{"${accno}_rate"}, $self->{"${accno}_taxnumber"}) = $sth->fetchrow_array; - $sth->finish; - } - } - $self->{dbh}->commit; + foreach my $accno ( split / /, $self->{taxaccounts} ) { + $sth->execute( $accno, @queryargs ); + ( $self->{"${accno}_rate"}, $self->{"${accno}_taxnumber"} ) = + $sth->fetchrow_array; + $sth->finish; + } + } + $self->{dbh}->commit; } - sub all_employees { - my ($self, $myconfig, $dbh2, $transdate, $sales) = @_; + my ( $self, $myconfig, $dbh2, $transdate, $sales ) = @_; + + my $dbh = $self->{dbh}; + my @whereargs = (); - my $dbh = $self->{dbh}; - my @whereargs = (); - # setup employees/sales contacts - my $query = qq|SELECT id, name + # setup employees/sales contacts + my $query = qq|SELECT id, name FROM employees WHERE 1 = 1|; - if ($transdate) { - $query .= qq| AND (startdate IS NULL OR startdate <= ?) + if ($transdate) { + $query .= qq| AND (startdate IS NULL OR startdate <= ?) AND (enddate IS NULL OR enddate >= ?)|; - @whereargs = ($transdate, $transdate); - } else { - $query .= qq| AND enddate IS NULL|; - } - - if ($sales) { - $query .= qq| AND sales = '1'|; - } - - $query .= qq| ORDER BY name|; - my $sth = $dbh->prepare($query); - $sth->execute(@whereargs) || $self->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_employee} }, $ref; - } - - $sth->finish; - $dbh->commit; + @whereargs = ( $transdate, $transdate ); + } + else { + $query .= qq| AND enddate IS NULL|; + } + + if ($sales) { + $query .= qq| AND sales = '1'|; + } + + $query .= qq| ORDER BY name|; + my $sth = $dbh->prepare($query); + $sth->execute(@whereargs) || $self->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $self->{all_employee} }, $ref; + } + + $sth->finish; + $dbh->commit; } - - sub all_projects { - my ($self, $myconfig, $dbh2, $transdate, $job) = @_; + my ( $self, $myconfig, $dbh2, $transdate, $job ) = @_; - my $dbh = $self->{dbh}; - my @queryargs = (); + my $dbh = $self->{dbh}; + my @queryargs = (); - my $where = "1 = 1"; + my $where = "1 = 1"; - $where = qq|id NOT IN (SELECT id + $where = qq|id NOT IN (SELECT id FROM parts - WHERE project_id > 0)| if ! $job; + WHERE project_id > 0)| if !$job; - my $query = qq|SELECT * + my $query = qq|SELECT * FROM project WHERE $where|; - if ($self->{language_code}) { + if ( $self->{language_code} ) { - $query = qq| + $query = qq| SELECT pr.*, t.description AS translation FROM project pr LEFT JOIN translation t ON (t.trans_id = pr.id) WHERE t.language_code = ?|; - push(@queryargs, $self->{language_code}); - } + push( @queryargs, $self->{language_code} ); + } - if ($transdate) { - $query .= qq| AND (startdate IS NULL OR startdate <= ?) + if ($transdate) { + $query .= qq| AND (startdate IS NULL OR startdate <= ?) AND (enddate IS NULL OR enddate >= ?)|; - push(@queryargs, $transdate, $transdate); - } + push( @queryargs, $transdate, $transdate ); + } - $query .= qq| ORDER BY projectnumber|; + $query .= qq| ORDER BY projectnumber|; - $sth = $dbh->prepare($query); - $sth->execute(@queryargs)|| $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $self->dberror($query); - @{ $self->{all_project} } = (); + @{ $self->{all_project} } = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_project} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $self->{all_project} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub all_departments { - my ($self, $myconfig, $dbh2, $vc) = @_; + my ( $self, $myconfig, $dbh2, $vc ) = @_; - $dbh = $self->{dbh}; + $dbh = $self->{dbh}; - my $where = "1 = 1"; + my $where = "1 = 1"; - if ($vc) { - if ($vc eq 'customer') { - $where = " role = 'P'"; - } - } + if ($vc) { + if ( $vc eq 'customer' ) { + $where = " role = 'P'"; + } + } - my $query = qq|SELECT id, description + my $query = qq|SELECT id, description FROM department WHERE $where ORDER BY 2|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); - @{ $self->{all_department} } = (); + @{ $self->{all_department} } = (); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_department} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $self->{all_department} }, $ref; + } - $sth->finish; - $self->all_years($myconfig); - $dbh->commit; + $sth->finish; + $self->all_years($myconfig); + $dbh->commit; } - sub all_years { - my ($self, $myconfig, $dbh2) = @_; + my ( $self, $myconfig, $dbh2 ) = @_; - $dbh = $self->{dbh}; + $dbh = $self->{dbh}; - # get years - my $query = qq| + # get years + my $query = qq| SELECT (SELECT MIN(transdate) FROM acc_trans), (SELECT MAX(transdate) FROM acc_trans)|; - my ($startdate, $enddate) = $dbh->selectrow_array($query); - - if ($myconfig->{dateformat} =~ /^yy/) { - ($startdate) = split /\W/, $startdate; - ($enddate) = split /\W/, $enddate; - } else { - (@_) = split /\W/, $startdate; - $startdate = $_[2]; - (@_) = split /\W/, $enddate; - $enddate = $_[2]; - } - - $self->{all_years} = (); - $startdate = substr($startdate,0,4); - $enddate = substr($enddate,0,4); - - while ($enddate >= $startdate) { - push @{ $self->{all_years} }, $enddate--; - } - - #this should probably be changed to use locale - %{ $self->{all_month} } = ( - '01' => 'January', - '02' => 'February', - '03' => 'March', - '04' => 'April', - '05' => 'May ', - '06' => 'June', - '07' => 'July', - '08' => 'August', - '09' => 'September', - '10' => 'October', - '11' => 'November', - '12' => 'December' ); - - $dbh->commit; + my ( $startdate, $enddate ) = $dbh->selectrow_array($query); + + if ( $myconfig->{dateformat} =~ /^yy/ ) { + ($startdate) = split /\W/, $startdate; + ($enddate) = split /\W/, $enddate; + } + else { + (@_) = split /\W/, $startdate; + $startdate = $_[2]; + (@_) = split /\W/, $enddate; + $enddate = $_[2]; + } + + $self->{all_years} = (); + $startdate = substr( $startdate, 0, 4 ); + $enddate = substr( $enddate, 0, 4 ); + + while ( $enddate >= $startdate ) { + push @{ $self->{all_years} }, $enddate--; + } + + #this should probably be changed to use locale + %{ $self->{all_month} } = ( + '01' => 'January', + '02' => 'February', + '03' => 'March', + '04' => 'April', + '05' => 'May ', + '06' => 'June', + '07' => 'July', + '08' => 'August', + '09' => 'September', + '10' => 'October', + '11' => 'November', + '12' => 'December' + ); + + $dbh->commit; } - sub create_links { - my ($self, $module, $myconfig, $vc, $job) = @_; - - # get last customers or vendors - my ($query, $sth); + my ( $self, $module, $myconfig, $vc, $job ) = @_; - $dbh = $self->{dbh}; + # get last customers or vendors + my ( $query, $sth ); - my %xkeyref = (); + $dbh = $self->{dbh}; + my %xkeyref = (); - # now get the account numbers - $query = qq|SELECT accno, description, link + # now get the account numbers + $query = qq|SELECT accno, description, link FROM chart WHERE link LIKE ? ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute("%"."$module%") || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( "%" . "$module%" ) || $self->dberror($query); + + $self->{accounts} = ""; - $self->{accounts} = ""; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + foreach my $key ( split /:/, $ref->{link} ) { - foreach my $key (split /:/, $ref->{link}) { + if ( $key =~ /$module/ ) { - if ($key =~ /$module/) { - # cross reference for keys - $xkeyref{$ref->{accno}} = $key; + # cross reference for keys + $xkeyref{ $ref->{accno} } = $key; - push @{ $self->{"${module}_links"}{$key} }, - { accno => $ref->{accno}, - description => $ref->{description} }; + push @{ $self->{"${module}_links"}{$key} }, + { + accno => $ref->{accno}, + description => $ref->{description} + }; - $self->{accounts} .= "$ref->{accno} " - unless $key =~ /tax/; - } - } - } + $self->{accounts} .= "$ref->{accno} " + unless $key =~ /tax/; + } + } + } - $sth->finish; + $sth->finish; - my $arap = ($vc eq 'customer') ? 'ar' : 'ap'; + my $arap = ( $vc eq 'customer' ) ? 'ar' : 'ap'; - if ($self->{id}) { + if ( $self->{id} ) { - $query = qq| + $query = qq| SELECT a.invnumber, a.transdate, a.${vc}_id, a.datepaid, a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes, @@ -2126,43 +2205,42 @@ sub create_links { LEFT JOIN department d ON (d.id = a.department_id) WHERE a.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ) || $self->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); + $ref = $sth->fetchrow_hashref(NAME_lc); - foreach $key (keys %$ref) { - $self->{$key} = $ref->{$key}; - } + foreach $key ( keys %$ref ) { + $self->{$key} = $ref->{$key}; + } - $sth->finish; + $sth->finish; - - # get printed, emailed - $query = qq| + # get printed, emailed + $query = qq| SELECT s.printed, s.emailed, s.spoolfile, s.formname FROM status s WHERE s.trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ) || $self->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $self->{printed} .= "$ref->{formname} " - if $ref->{printed}; - $self->{emailed} .= "$ref->{formname} " - if $ref->{emailed}; - $self->{queued} .= "$ref->{formname} ". - "$ref->{spoolfile} " if $ref->{spoolfile}; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $self->{printed} .= "$ref->{formname} " + if $ref->{printed}; + $self->{emailed} .= "$ref->{formname} " + if $ref->{emailed}; + $self->{queued} .= "$ref->{formname} " . "$ref->{spoolfile} " + if $ref->{spoolfile}; + } - $sth->finish; - for (qw(printed emailed queued)) { $self->{$_} =~ s/ +$//g } + $sth->finish; + for (qw(printed emailed queued)) { $self->{$_} =~ s/ +$//g } - # get recurring - $self->get_recurring($dbh); + # get recurring + $self->get_recurring($dbh); - # get amounts from individual entries - $query = qq| + # get amounts from individual entries + $query = qq| SELECT c.accno, c.description, a.source, a.amount, a.memo, a.transdate, a.cleared, a.project_id, p.projectnumber @@ -2173,98 +2251,99 @@ sub create_links { AND a.fx_transaction = '0' ORDER BY transdate|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}) || $self->dberror($query); - + $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ) || $self->dberror($query); - my $fld = ($vc eq 'customer') ? 'buy' : 'sell'; + my $fld = ( $vc eq 'customer' ) ? 'buy' : 'sell'; - $self->{exchangerate} = $self->get_exchangerate($dbh, - $self->{currency}, $self->{transdate}, $fld); + $self->{exchangerate} = + $self->get_exchangerate( $dbh, $self->{currency}, $self->{transdate}, + $fld ); - # store amounts in {acc_trans}{$key} for multiple accounts - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{exchangerate} = $self->get_exchangerate($dbh, - $self->{currency}, - $ref->{transdate}, - $fld); + # store amounts in {acc_trans}{$key} for multiple accounts + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{exchangerate} = + $self->get_exchangerate( $dbh, $self->{currency}, + $ref->{transdate}, $fld ); - push @{ $self->{acc_trans}{$xkeyref{$ref->{accno}}} }, - $ref; - } + push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref; + } - $sth->finish; + $sth->finish; - for (qw(curr closedto revtrans)){ - $query = qq| + for (qw(curr closedto revtrans)) { + $query = qq| SELECT value FROM defaults WHERE setting_key = '$_'|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); - ($val) = $sth->fetchrow_array(); - if ($_ eq 'curr'){ - $self->{currencies} = $val; - } else { - $self->{$_} = $val; - } - $sth->finish; - } + ($val) = $sth->fetchrow_array(); + if ( $_ eq 'curr' ) { + $self->{currencies} = $val; + } + else { + $self->{$_} = $val; + } + $sth->finish; + } - } else { + } + else { - for (qw(current_date curr closedto revtrans)){ - $query = qq| + for (qw(current_date curr closedto revtrans)) { + $query = qq| SELECT value FROM defaults WHERE setting_key = '$_'|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - ($val) = $sth->fetchrow_array(); - if ($_ eq 'curr'){ - $self->{currencies} = $val; - } elsif ($_ eq 'current_date'){ - $self->{transdate} = $val; - } else { - $self->{$_} = $val; - } - $sth->finish; - } - - if (! $self->{"$self->{vc}_id"}) { - $self->lastname_used($myconfig, $dbh, $vc, $module); - } - } - - $self->all_vc($myconfig, $vc, $module, $dbh, $self->{transdate}, $job); - $self->{dbh}->commit; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + ($val) = $sth->fetchrow_array(); + if ( $_ eq 'curr' ) { + $self->{currencies} = $val; + } + elsif ( $_ eq 'current_date' ) { + $self->{transdate} = $val; + } + else { + $self->{$_} = $val; + } + $sth->finish; + } + + if ( !$self->{"$self->{vc}_id"} ) { + $self->lastname_used( $myconfig, $dbh, $vc, $module ); + } + } + + $self->all_vc( $myconfig, $vc, $module, $dbh, $self->{transdate}, $job ); + $self->{dbh}->commit; } - sub lastname_used { - my ($self, $myconfig, $dbh2, $vc, $module) = @_; + my ( $self, $myconfig, $dbh2, $vc, $module ) = @_; - $vc ||= $self->{vc}; - my $dbh = $self->{dbh}; + $vc ||= $self->{vc}; + my $dbh = $self->{dbh}; - my $arap = ($vc eq 'customer') ? "ar" : "ap"; - my $where = "1 = 1"; - my $sth; + my $arap = ( $vc eq 'customer' ) ? "ar" : "ap"; + my $where = "1 = 1"; + my $sth; - if ($self->{type} =~ /_order/) { - $arap = 'oe'; - $where = "quotation = '0'"; - } + if ( $self->{type} =~ /_order/ ) { + $arap = 'oe'; + $where = "quotation = '0'"; + } - if ($self->{type} =~ /_quotation/) { - $arap = 'oe'; - $where = "quotation = '1'"; - } + if ( $self->{type} =~ /_quotation/ ) { + $arap = 'oe'; + $where = "quotation = '1'"; + } - my $query = qq| + my $query = qq| SELECT id FROM $arap WHERE id IN @@ -2272,11 +2351,11 @@ sub lastname_used { FROM $arap WHERE $where AND ${vc}_id > 0)|; - my ($trans_id) = $dbh->selectrow_array($query); + my ($trans_id) = $dbh->selectrow_array($query); - $trans_id *= 1; + $trans_id *= 1; - $query = qq| + $query = qq| SELECT ct.name AS $vc, a.curr AS currency, a.${vc}_id, current_date + ct.terms AS duedate, a.department_id, d.description AS department, ct.notes, @@ -2286,273 +2365,269 @@ sub lastname_used { LEFT JOIN department d ON (a.department_id = d.id) WHERE a.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($trans_id)|| $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute($trans_id) || $self->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $self->{$_} = $ref->{$_} } - $sth->finish; - $dbh->commit; + my $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $self->{$_} = $ref->{$_} } + $sth->finish; + $dbh->commit; } - - sub current_date { - my ($self, $myconfig, $thisdate, $days) = @_; + my ( $self, $myconfig, $thisdate, $days ) = @_; - my $dbh = $self->{dbh}; - my $query; + my $dbh = $self->{dbh}; + my $query; - $days *= 1; - if ($thisdate) { + $days *= 1; + if ($thisdate) { - my $dateformat = $myconfig->{dateformat}; + my $dateformat = $myconfig->{dateformat}; - if ($myconfig->{dateformat} !~ /^y/) { - my @a = split /\D/, $thisdate; - $dateformat .= "yy" if (length $a[2] > 2); - } + if ( $myconfig->{dateformat} !~ /^y/ ) { + my @a = split /\D/, $thisdate; + $dateformat .= "yy" if ( length $a[2] > 2 ); + } - if ($thisdate !~ /\D/) { - $dateformat = 'yyyymmdd'; - } + if ( $thisdate !~ /\D/ ) { + $dateformat = 'yyyymmdd'; + } - $query = qq|SELECT to_date(?, ?) + $query = qq|SELECT to_date(?, ?) + ?::interval AS thisdate|; - @queryargs = ($thisdate, $dateformat, $days); - - } else { - $query = qq|SELECT current_date AS thisdate|; - @queryargs = (); - } - - $sth = $dbh->prepare($query); - $sth->execute(@queryargs); - ($thisdate) = $sth->fetchrow_array; - $dbh->commit; - $thisdate; + @queryargs = ( $thisdate, $dateformat, $days ); + + } + else { + $query = qq|SELECT current_date AS thisdate|; + @queryargs = (); + } + + $sth = $dbh->prepare($query); + $sth->execute(@queryargs); + ($thisdate) = $sth->fetchrow_array; + $dbh->commit; + $thisdate; } - sub like { - my ($self, $str) = @_; - "%$str%"; + my ( $self, $str ) = @_; + "%$str%"; } - sub redo_rows { - my ($self, $flds, $new, $count, $numrows) = @_; + my ( $self, $flds, $new, $count, $numrows ) = @_; - my @ndx = (); + my @ndx = (); - for (1 .. $count) { - push @ndx, { num => $new->[$_-1]->{runningnumber}, ndx => $_ } - } + for ( 1 .. $count ) { + push @ndx, { num => $new->[ $_ - 1 ]->{runningnumber}, ndx => $_ }; + } - my $i = 0; - # fill rows - foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) { - $i++; - $j = $item->{ndx} - 1; - for (@{$flds}) { $self->{"${_}_$i"} = $new->[$j]->{$_} } - } + my $i = 0; - # delete empty rows - for $i ($count + 1 .. $numrows) { - for (@{$flds}) { delete $self->{"${_}_$i"} } - } -} + # fill rows + foreach my $item ( sort { $a->{num} <=> $b->{num} } @ndx ) { + $i++; + $j = $item->{ndx} - 1; + for ( @{$flds} ) { $self->{"${_}_$i"} = $new->[$j]->{$_} } + } + # delete empty rows + for $i ( $count + 1 .. $numrows ) { + for ( @{$flds} ) { delete $self->{"${_}_$i"} } + } +} sub get_partsgroup { - my ($self, $myconfig, $p) = @_; + my ( $self, $myconfig, $p ) = @_; - my $dbh = $self->{dbh}; + my $dbh = $self->{dbh}; - my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup + my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup FROM partsgroup pg JOIN parts p ON (p.partsgroup_id = pg.id)|; - my $where; - my $sortorder = "partsgroup"; + my $where; + my $sortorder = "partsgroup"; - if ($p->{searchitems} eq 'part') { - $where = qq| WHERE (p.inventory_accno_id > 0 + if ( $p->{searchitems} eq 'part' ) { + $where = qq| WHERE (p.inventory_accno_id > 0 AND p.income_accno_id > 0)|; - } + } - if ($p->{searchitems} eq 'service') { - $where = qq| WHERE p.inventory_accno_id IS NULL|; - } + if ( $p->{searchitems} eq 'service' ) { + $where = qq| WHERE p.inventory_accno_id IS NULL|; + } - if ($p->{searchitems} eq 'assembly') { - $where = qq| WHERE p.assembly = '1'|; - } + if ( $p->{searchitems} eq 'assembly' ) { + $where = qq| WHERE p.assembly = '1'|; + } - if ($p->{searchitems} eq 'labor') { - $where = qq| WHERE p.inventory_accno_id > 0 AND p.income_accno_id IS NULL|; - } + if ( $p->{searchitems} eq 'labor' ) { + $where = + qq| WHERE p.inventory_accno_id > 0 AND p.income_accno_id IS NULL|; + } - if ($p->{searchitems} eq 'nolabor') { - $where = qq| WHERE p.income_accno_id > 0|; - } + if ( $p->{searchitems} eq 'nolabor' ) { + $where = qq| WHERE p.income_accno_id > 0|; + } - if ($p->{all}) { - $query = qq|SELECT id, partsgroup + if ( $p->{all} ) { + $query = qq|SELECT id, partsgroup FROM partsgroup|; - } - my @queryargs = (); + } + my @queryargs = (); - if ($p->{language_code}) { - $sortorder = "translation"; + if ( $p->{language_code} ) { + $sortorder = "translation"; - $query = qq| + $query = qq| SELECT DISTINCT pg.id, pg.partsgroup, t.description AS translation FROM partsgroup pg JOIN parts p ON (p.partsgroup_id = pg.id) LEFT JOIN translation t ON (t.trans_id = pg.id AND t.language_code = ?)|; - @queryargs = ($p->{language_code}); - } + @queryargs = ( $p->{language_code} ); + } - $query .= qq| $where ORDER BY $sortorder|; + $query .= qq| $where ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute(@queryargs)|| $self->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $self->dberror($query); - $self->{all_partsgroup} = (); + $self->{all_partsgroup} = (); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_partsgroup} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $self->{all_partsgroup} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub update_status { - my ($self, $myconfig) = @_; + my ( $self, $myconfig ) = @_; - # no id return - return unless $self->{id}; + # no id return + return unless $self->{id}; - my $dbh = $self->{dbh}; + my $dbh = $self->{dbh}; - my %queued = split / +/, $self->{queued}; - my $spoolfile = ($queued{$self->{formname}}) ? "'$queued{$self->{formname}}'" : undef; + my %queued = split / +/, $self->{queued}; + my $spoolfile = + ( $queued{ $self->{formname} } ) ? "'$queued{$self->{formname}}'" : undef; - my $query = qq|DELETE FROM status + my $query = qq|DELETE FROM status WHERE formname = ? AND trans_id = ?|; - $sth=$dbh->prepare($query); - $sth->execute($self->{formname}, $self->{id}) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $self->{formname}, $self->{id} ) || $self->dberror($query); - $sth->finish; + $sth->finish; - my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; - my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + my $printed = ( $self->{printed} =~ /$self->{formname}/ ) ? "1" : "0"; + my $emailed = ( $self->{emailed} =~ /$self->{formname}/ ) ? "1" : "0"; - $query = qq| + $query = qq| INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) VALUES (?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}, $printed, $emailed, $spoolfile, - $self->{formname}); - $sth->finish; + $sth = $dbh->prepare($query); + $sth->execute( $self->{id}, $printed, $emailed, $spoolfile, + $self->{formname} ); + $sth->finish; - $dbh->commit; + $dbh->commit; } - sub save_status { - my ($self) = @_; + my ($self) = @_; - $dbh = $self->{dbh}; + $dbh = $self->{dbh}; - my $formnames = $self->{printed}; - my $emailforms = $self->{emailed}; + my $formnames = $self->{printed}; + my $emailforms = $self->{emailed}; - my $query = qq|DELETE FROM status + my $query = qq|DELETE FROM status WHERE trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($self->{id}); - $sth->finish; + my $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ); + $sth->finish; - my %queued; - my $formname; + my %queued; + my $formname; - if ($self->{queued}) { + if ( $self->{queued} ) { - %queued = split / +/, $self->{queued}; + %queued = split / +/, $self->{queued}; - foreach $formname (keys %queued) { + foreach $formname ( keys %queued ) { - $printed = ($self->{printed} =~ /$formname/) ? "1" : "0"; - $emailed = ($self->{emailed} =~ /$formname/) ? "1" : "0"; + $printed = ( $self->{printed} =~ /$formname/ ) ? "1" : "0"; + $emailed = ( $self->{emailed} =~ /$formname/ ) ? "1" : "0"; - if ($queued{$formname}) { - $query = qq| + if ( $queued{$formname} ) { + $query = qq| INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) VALUES (?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}, $pinted, $emailed, - $queued{$formname}, $formname) - || $self->dberror($query); - $sth->finish; - } + $sth = $dbh->prepare($query); + $sth->execute( $self->{id}, $pinted, $emailed, + $queued{$formname}, $formname ) + || $self->dberror($query); + $sth->finish; + } - $formnames =~ s/$formname//; - $emailforms =~ s/$formname//; + $formnames =~ s/$formname//; + $emailforms =~ s/$formname//; - } - } + } + } - # save printed, emailed info - $formnames =~ s/^ +//g; - $emailforms =~ s/^ +//g; + # save printed, emailed info + $formnames =~ s/^ +//g; + $emailforms =~ s/^ +//g; - my %status = (); - for (split / +/, $formnames) { $status{$_}{printed} = 1 } - for (split / +/, $emailforms) { $status{$_}{emailed} = 1 } + my %status = (); + for ( split / +/, $formnames ) { $status{$_}{printed} = 1 } + for ( split / +/, $emailforms ) { $status{$_}{emailed} = 1 } - foreach my $formname (keys %status) { - $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0"; - $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0"; + foreach my $formname ( keys %status ) { + $printed = ( $formnames =~ /$self->{formname}/ ) ? "1" : "0"; + $emailed = ( $emailforms =~ /$self->{formname}/ ) ? "1" : "0"; - $query = qq| + $query = qq| INSERT INTO status (trans_id, printed, emailed, formname) VALUES (?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}, $printed, $emailed, $formname); - $sth->finish; - } - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $self->{id}, $printed, $emailed, $formname ); + $sth->finish; + } + $dbh->commit; } - sub get_recurring { - my ($self) = @_; + my ($self) = @_; - $dbh = $self->{dbh}; - my $query = qq/ + $dbh = $self->{dbh}; + my $query = qq/ SELECT s.*, se.formname || ':' || se.format AS emaila, se.message, sp.formname || ':' || sp.format || ':' || sp.printer AS printa @@ -2561,596 +2636,631 @@ sub get_recurring { LEFT JOIN recurringprint sp ON (s.id = sp.id) WHERE s.id = ?/; - my $sth = $dbh->prepare($query); - $sth->execute($self->{id}) || $self->dberror($query); - - for (qw(email print)) { $self->{"recurring$_"} = "" } - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - for (keys %$ref) { $self->{"recurring$_"} = $ref->{$_} } - $self->{recurringemail} .= "$ref->{emaila}:"; - $self->{recurringprint} .= "$ref->{printa}:"; - for (qw(emaila printa)) { delete $self->{"recurring$_"} } - } - - $sth->finish; - chop $self->{recurringemail}; - chop $self->{recurringprint}; - - if ($self->{recurringstartdate}) { - $self->{recurringreference} = $self->escape($self->{recurringreference},1); - $self->{recurringmessage} = $self->escape($self->{recurringmessage},1); - for (qw(reference startdate repeat unit howmany - payment print email message)) { - - $self->{recurring} .= qq|$self->{"recurring$_"},| - } - - chop $self->{recurring}; - } - $dbh->commit; + my $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ) || $self->dberror($query); + + for (qw(email print)) { $self->{"recurring$_"} = "" } + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + for ( keys %$ref ) { $self->{"recurring$_"} = $ref->{$_} } + $self->{recurringemail} .= "$ref->{emaila}:"; + $self->{recurringprint} .= "$ref->{printa}:"; + for (qw(emaila printa)) { delete $self->{"recurring$_"} } + } + + $sth->finish; + chop $self->{recurringemail}; + chop $self->{recurringprint}; + + if ( $self->{recurringstartdate} ) { + $self->{recurringreference} = + $self->escape( $self->{recurringreference}, 1 ); + $self->{recurringmessage} = + $self->escape( $self->{recurringmessage}, 1 ); + for ( + qw(reference startdate repeat unit howmany + payment print email message) + ) + { + + $self->{recurring} .= qq|$self->{"recurring$_"},|; + } + + chop $self->{recurring}; + } + $dbh->commit; } - sub save_recurring { - my ($self, $dbh2, $myconfig) = @_; + my ( $self, $dbh2, $myconfig ) = @_; - my $dbh = $self->{dbh}; + my $dbh = $self->{dbh}; - my $query; + my $query; - $query = qq|DELETE FROM recurring + $query = qq|DELETE FROM recurring WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ) || $self->dberror($query); - $query = qq|DELETE FROM recurringemail + $query = qq|DELETE FROM recurringemail WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ) || $self->dberror($query); - $query = qq|DELETE FROM recurringprint + $query = qq|DELETE FROM recurringprint WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $self->{id} ) || $self->dberror($query); - if ($self->{recurring}) { + if ( $self->{recurring} ) { - my %s = (); - ($s{reference}, $s{startdate}, $s{repeat}, $s{unit}, - $s{howmany}, $s{payment}, $s{print}, $s{email}, - $s{message}) - = split /,/, $self->{recurring}; + my %s = (); + ( + $s{reference}, $s{startdate}, $s{repeat}, + $s{unit}, $s{howmany}, $s{payment}, + $s{print}, $s{email}, $s{message} + ) = split /,/, $self->{recurring}; - if ($s{howmany} == 0){ - $self->error("Cannot set to recur 0 times"); - } - for (qw(reference message)) { $s{$_} = $self->unescape($s{$_}) } - for (qw(repeat howmany payment)) { $s{$_} *= 1 } + if ( $s{howmany} == 0 ) { + $self->error("Cannot set to recur 0 times"); + } + for (qw(reference message)) { $s{$_} = $self->unescape( $s{$_} ) } + for (qw(repeat howmany payment)) { $s{$_} *= 1 } - # calculate enddate - my $advance = $s{repeat} * ($s{howmany} - 1); - my %interval; - $interval{'Pg'} = - "(date '$s{startdate}' + interval '$advance $s{unit}')"; + # calculate enddate + my $advance = $s{repeat} * ( $s{howmany} - 1 ); + my %interval; + $interval{'Pg'} = + "(date '$s{startdate}' + interval '$advance $s{unit}')"; - $query = qq|SELECT $interval{$myconfig->{dbdriver}}|; + $query = qq|SELECT $interval{$myconfig->{dbdriver}}|; - my ($enddate) = $dbh->selectrow_array($query); + my ($enddate) = $dbh->selectrow_array($query); - # calculate nextdate - $query = qq| + # calculate nextdate + $query = qq| SELECT current_date - date ? AS a, date ? - current_date AS b|; - $sth = $dbh->prepare($query); - $sth->execute($s{startdate}, $enddate); - my ($a, $b) = $sth->fetchrow_array; - - if ($a + $b) { - $advance = int(($a / ($a + $b)) * ($s{howmany} - 1) + 1) * $s{repeat}; - } else { - $advance = 0; - } + $sth = $dbh->prepare($query); + $sth->execute( $s{startdate}, $enddate ); + my ( $a, $b ) = $sth->fetchrow_array; - my $nextdate = $enddate; - if ($advance > 0) { - if ($advance < ($s{repeat} * $s{howmany})) { - %interval = ( 'Pg' => "(date '$s{startdate}' + interval '$advance $s{unit}')", - 'DB2' => qq|(date ('$s{startdate}') + "$advance $s{unit}")|,); + if ( $a + $b ) { + $advance = + int( ( $a / ( $a + $b ) ) * ( $s{howmany} - 1 ) + 1 ) * + $s{repeat}; + } + else { + $advance = 0; + } - $interval{Oracle} = $interval{PgPP} = $interval{Pg}; + my $nextdate = $enddate; + if ( $advance > 0 ) { + if ( $advance < ( $s{repeat} * $s{howmany} ) ) { + %interval = ( + 'Pg' => + "(date '$s{startdate}' + interval '$advance $s{unit}')", + 'DB2' => qq|(date ('$s{startdate}') + "$advance $s{unit}")|, + ); + $interval{Oracle} = $interval{PgPP} = $interval{Pg}; - $query = qq|SELECT $interval{$myconfig->{dbdriver}}|; + $query = qq|SELECT $interval{$myconfig->{dbdriver}}|; - ($nextdate) = $dbh->selectrow_array($query); - } + ($nextdate) = $dbh->selectrow_array($query); + } - } else { - $nextdate = $s{startdate}; - } + } + else { + $nextdate = $s{startdate}; + } - if ($self->{recurringnextdate}) { + if ( $self->{recurringnextdate} ) { - $nextdate = $self->{recurringnextdate}; + $nextdate = $self->{recurringnextdate}; - $query = qq|SELECT '$enddate' - date '$nextdate'|; + $query = qq|SELECT '$enddate' - date '$nextdate'|; - if ($dbh->selectrow_array($query) < 0) { - undef $nextdate; - } - } + if ( $dbh->selectrow_array($query) < 0 ) { + undef $nextdate; + } + } - $self->{recurringpayment} *= 1; + $self->{recurringpayment} *= 1; - $query = qq| + $query = qq| INSERT INTO recurring (id, reference, startdate, enddate, nextdate, repeat, unit, howmany, payment) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute($self->{id}, $s{reference}, $s{startdate}, - $enddate, $nextdate, $s{repeat}, $s{unit}, $s{howmany}, - $s{payment}); + $sth = $dbh->prepare($query); + $sth->execute( + $self->{id}, $s{reference}, $s{startdate}, + $enddate, $nextdate, $s{repeat}, + $s{unit}, $s{howmany}, $s{payment} + ); + my @p; + my $p; + my $i; + my $sth; - my @p; - my $p; - my $i; - my $sth; + if ( $s{email} ) { - if ($s{email}) { - # formname:format - @p = split /:/, $s{email}; + # formname:format + @p = split /:/, $s{email}; - $query = qq|INSERT INTO recurringemail (id, formname, format, message) + $query = + qq|INSERT INTO recurringemail (id, formname, format, message) VALUES (?, ?, ?, ?)|; - $sth = $dbh->prepare($query) || $self->dberror($query); + $sth = $dbh->prepare($query) || $self->dberror($query); - for ($i = 0; $i <= $#p; $i += 2) { - $sth->execute($self->{id}, $p[$i], $p[$i+1], - $s{message}); - } + for ( $i = 0 ; $i <= $#p ; $i += 2 ) { + $sth->execute( $self->{id}, $p[$i], $p[ $i + 1 ], $s{message} ); + } - $sth->finish; - } + $sth->finish; + } - if ($s{print}) { - # formname:format:printer - @p = split /:/, $s{print}; + if ( $s{print} ) { - $query = qq|INSERT INTO recurringprint (id, formname, format, printer) + # formname:format:printer + @p = split /:/, $s{print}; + + $query = + qq|INSERT INTO recurringprint (id, formname, format, printer) VALUES (?, ?, ?, ?)|; - $sth = $dbh->prepare($query) || $self->dberror($query); + $sth = $dbh->prepare($query) || $self->dberror($query); - for ($i = 0; $i <= $#p; $i += 3) { - $p = ($p[$i+2]) ? $p[$i+2] : ""; - $sth->execute($self->{id}, $p[$i], $p[$i+1], $p); - } + for ( $i = 0 ; $i <= $#p ; $i += 3 ) { + $p = ( $p[ $i + 2 ] ) ? $p[ $i + 2 ] : ""; + $sth->execute( $self->{id}, $p[$i], $p[ $i + 1 ], $p ); + } - $sth->finish; - } - } + $sth->finish; + } + } - $dbh->commit; + $dbh->commit; } - sub save_intnotes { - my ($self, $myconfig, $vc) = @_; + my ( $self, $myconfig, $vc ) = @_; - # no id return - return unless $self->{id}; + # no id return + return unless $self->{id}; - my $dbh = $self->dbconnect($myconfig); + my $dbh = $self->dbconnect($myconfig); - my $query = qq|UPDATE $vc SET intnotes = ? WHERE id = ?|; + my $query = qq|UPDATE $vc SET intnotes = ? WHERE id = ?|; - $sth=$dbh->prepare($query); - $sth->execute($self->{intnotes}, $self->{id}) || $self->dberror($query); - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $self->{intnotes}, $self->{id} ) || $self->dberror($query); + $dbh->commit; } - sub update_defaults { - my ($self, $myconfig, $fld) = @_; + my ( $self, $myconfig, $fld ) = @_; - if (!$self->{dbh} && $self){ - $self->db_init($myconfig); - } - - my $dbh = $self->{dbh}; + if ( !$self->{dbh} && $self ) { + $self->db_init($myconfig); + } - if (!$self){ - $dbh = $_[3]; - } + my $dbh = $self->{dbh}; - my $query = qq| + if ( !$self ) { + $dbh = $_[3]; + } + + my $query = qq| SELECT value FROM defaults WHERE setting_key = ? FOR UPDATE|; - $sth = $dbh->prepare($query); - $sth->execute($fld); - ($_) = $sth->fetchrow_array(); - - $_ = "0" unless $_; - - # check for and replace - # <?lsmb DATE ?>, <?lsmb YYMMDD ?>, <?lsmb YEAR ?>, <?lsmb MONTH ?>, <?lsmb DAY ?> or variations of - # <?lsmb NAME 1 1 3 ?>, <?lsmb BUSINESS ?>, <?lsmb BUSINESS 10 ?>, <?lsmb CURR... ?> - # <?lsmb DESCRIPTION 1 1 3 ?>, <?lsmb ITEM 1 1 3 ?>, <?lsmb PARTSGROUP 1 1 3 ?> only for parts - # <?lsmb PHONE ?> for customer and vendors - - my $num = $_; - ($num) = $num =~ /(\d+)/; - - if (defined $num) { - my $incnum; - # if we have leading zeros check how long it is - - if ($num =~ /^0/) { - my $l = length $num; - $incnum = $num + 1; - $l -= length $incnum; - - # pad it out with zeros - my $padzero = "0" x $l; - $incnum = ("0" x $l) . $incnum; - } else { - $incnum = $num + 1; - } - - s/$num/$incnum/; - } - - my $dbvar = $_; - my $var = $_; - my $str; - my $param; - - if (/<\?lsmb /) { - - while (/<\?lsmb /) { - - s/<\?lsmb .*? \?>//; - last unless $&; - $param = $&; - $str = ""; - - if ($param =~ /<\?lsmb date \?>/i) { - $str = ($self->split_date($myconfig->{dateformat}, $self->{transdate}))[0]; - $var =~ s/$param/$str/; - } - - if ($param =~ /<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i) { - - my $fld = lc $&; - $fld =~ s/<\?lsmb //; - - if ($fld =~ /name/) { - if ($self->{type}) { - $fld = $self->{vc}; - } - } - - my $p = $param; - $p =~ s/(<|>|%)//g; - my @p = split / /, $p; - my @n = split / /, uc $self->{$fld}; - - if ($#p > 0) { - - for (my $i = 1; $i <= $#p; $i++) { - $str .= substr($n[$i-1], 0, $p[$i]); - } - - } else { - ($str) = split /--/, $self->{$fld}; - } - - $var =~ s/$param/$str/; - $var =~ s/\W//g if $fld eq 'phone'; - } - - if ($param =~ /<\?lsmb (yy|mm|dd)/i) { - - my $p = $param; - $p =~ s/(<|>|%)//g; - my $spc = $p; - $spc =~ s/\w//g; - $spc = substr($spc, 0, 1); - my %d = ( yy => 1, mm => 2, dd => 3 ); - my @p = (); - - my @a = $self->split_date($myconfig->{dateformat}, $self->{transdate}); - for (sort keys %d) { push @p, $a[$d{$_}] if ($p =~ /$_/) } - $str = join $spc, @p; - $var =~ s/$param/$str/; - } - - if ($param =~ /<\?lsmb curr/i) { - $var =~ s/$param/$self->{currency}/; - } - } - } - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute($fld); + ($_) = $sth->fetchrow_array(); + + $_ = "0" unless $_; + +# check for and replace +# <?lsmb DATE ?>, <?lsmb YYMMDD ?>, <?lsmb YEAR ?>, <?lsmb MONTH ?>, <?lsmb DAY ?> or variations of +# <?lsmb NAME 1 1 3 ?>, <?lsmb BUSINESS ?>, <?lsmb BUSINESS 10 ?>, <?lsmb CURR... ?> +# <?lsmb DESCRIPTION 1 1 3 ?>, <?lsmb ITEM 1 1 3 ?>, <?lsmb PARTSGROUP 1 1 3 ?> only for parts +# <?lsmb PHONE ?> for customer and vendors + + my $num = $_; + ($num) = $num =~ /(\d+)/; + + if ( defined $num ) { + my $incnum; + + # if we have leading zeros check how long it is + + if ( $num =~ /^0/ ) { + my $l = length $num; + $incnum = $num + 1; + $l -= length $incnum; + + # pad it out with zeros + my $padzero = "0" x $l; + $incnum = ( "0" x $l ) . $incnum; + } + else { + $incnum = $num + 1; + } + + s/$num/$incnum/; + } + + my $dbvar = $_; + my $var = $_; + my $str; + my $param; + + if (/<\?lsmb /) { + + while (/<\?lsmb /) { + + s/<\?lsmb .*? \?>//; + last unless $&; + $param = $&; + $str = ""; + + if ( $param =~ /<\?lsmb date \?>/i ) { + $str = ( + $self->split_date( + $myconfig->{dateformat}, + $self->{transdate} + ) + )[0]; + $var =~ s/$param/$str/; + } + + if ( $param =~ +/<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i + ) + { + + my $fld = lc $&; + $fld =~ s/<\?lsmb //; + + if ( $fld =~ /name/ ) { + if ( $self->{type} ) { + $fld = $self->{vc}; + } + } + + my $p = $param; + $p =~ s/(<|>|%)//g; + my @p = split / /, $p; + my @n = split / /, uc $self->{$fld}; + + if ( $#p > 0 ) { + + for ( my $i = 1 ; $i <= $#p ; $i++ ) { + $str .= substr( $n[ $i - 1 ], 0, $p[$i] ); + } + + } + else { + ($str) = split /--/, $self->{$fld}; + } + + $var =~ s/$param/$str/; + $var =~ s/\W//g if $fld eq 'phone'; + } + + if ( $param =~ /<\?lsmb (yy|mm|dd)/i ) { + + my $p = $param; + $p =~ s/(<|>|%)//g; + my $spc = $p; + $spc =~ s/\w//g; + $spc = substr( $spc, 0, 1 ); + my %d = ( yy => 1, mm => 2, dd => 3 ); + my @p = (); + + my @a = $self->split_date( $myconfig->{dateformat}, + $self->{transdate} ); + for ( sort keys %d ) { push @p, $a[ $d{$_} ] if ( $p =~ /$_/ ) } + $str = join $spc, @p; + $var =~ s/$param/$str/; + } + + if ( $param =~ /<\?lsmb curr/i ) { + $var =~ s/$param/$self->{currency}/; + } + } + } + + $query = qq| UPDATE defaults SET value = ? WHERE setting_key = ?|; - $sth = $dbh->prepare($query); - $sth->execute($dbvar, $fld) || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $dbvar, $fld ) || $self->dberror($query); - $dbh->commit; + $dbh->commit; - $var; + $var; } sub db_prepare_vars { - my $self = shift; + my $self = shift; - for (@_){ - if (!$self->{$_} and $self->{$_} ne "0"){ - undef $self->{$_}; - } - } + for (@_) { + if ( !$self->{$_} and $self->{$_} ne "0" ) { + undef $self->{$_}; + } + } } sub split_date { - my ($self, $dateformat, $date) = @_; - - my @d = localtime; - my $mm; - my $dd; - my $yy; - my $rv; - - if (! $date) { - $dd = $d[3]; - $mm = ++$d[4]; - $yy = substr($d[5],-2); - $mm = substr("0$mm", -2); - $dd = substr("0$dd", -2); - } - - if ($dateformat =~ /^yy/) { - - if ($date) { - - if ($date =~ /\D/) { - ($yy, $mm, $dd) = split /\D/, $date; - $mm *= 1; - $dd *= 1; - $mm = substr("0$mm", -2); - $dd = substr("0$dd", -2); - $yy = substr($yy, -2); - $rv = "$yy$mm$dd"; - } else { - $rv = $date; - } - } else { - $rv = "$yy$mm$dd"; - } - } - - if ($dateformat =~ /^mm/) { - - if ($date) { - - if ($date =~ /\D/) { - ($mm, $dd, $yy) = split /\D/, $date; - $mm *= 1; - $dd *= 1; - $mm = substr("0$mm", -2); - $dd = substr("0$dd", -2); - $yy = substr($yy, -2); - $rv = "$mm$dd$yy"; - } else { - $rv = $date; - } - } else { - $rv = "$mm$dd$yy"; - } - } - - if ($dateformat =~ /^dd/) { - - if ($date) { - - if ($date =~ /\D/) { - ($dd, $mm, $yy) = split /\D/, $date; - $mm *= 1; - $dd *= 1; - $mm = substr("0$mm", -2); - $dd = substr("0$dd", -2); - $yy = substr($yy, -2); - $rv = "$dd$mm$yy"; - } else { - $rv = $date; - } - } else { - $rv = "$dd$mm$yy"; - } - } - - ($rv, $yy, $mm, $dd); + my ( $self, $dateformat, $date ) = @_; + + my @d = localtime; + my $mm; + my $dd; + my $yy; + my $rv; + + if ( !$date ) { + $dd = $d[3]; + $mm = ++$d[4]; + $yy = substr( $d[5], -2 ); + $mm = substr( "0$mm", -2 ); + $dd = substr( "0$dd", -2 ); + } + + if ( $dateformat =~ /^yy/ ) { + + if ($date) { + + if ( $date =~ /\D/ ) { + ( $yy, $mm, $dd ) = split /\D/, $date; + $mm *= 1; + $dd *= 1; + $mm = substr( "0$mm", -2 ); + $dd = substr( "0$dd", -2 ); + $yy = substr( $yy, -2 ); + $rv = "$yy$mm$dd"; + } + else { + $rv = $date; + } + } + else { + $rv = "$yy$mm$dd"; + } + } + + if ( $dateformat =~ /^mm/ ) { + + if ($date) { + + if ( $date =~ /\D/ ) { + ( $mm, $dd, $yy ) = split /\D/, $date; + $mm *= 1; + $dd *= 1; + $mm = substr( "0$mm", -2 ); + $dd = substr( "0$dd", -2 ); + $yy = substr( $yy, -2 ); + $rv = "$mm$dd$yy"; + } + else { + $rv = $date; + } + } + else { + $rv = "$mm$dd$yy"; + } + } + + if ( $dateformat =~ /^dd/ ) { + + if ($date) { + + if ( $date =~ /\D/ ) { + ( $dd, $mm, $yy ) = split /\D/, $date; + $mm *= 1; + $dd *= 1; + $mm = substr( "0$mm", -2 ); + $dd = substr( "0$dd", -2 ); + $yy = substr( $yy, -2 ); + $rv = "$dd$mm$yy"; + } + else { + $rv = $date; + } + } + else { + $rv = "$dd$mm$yy"; + } + } + + ( $rv, $yy, $mm, $dd ); } - sub from_to { - my ($self, $yyyy, $mm, $interval) = @_; + my ( $self, $yyyy, $mm, $interval ) = @_; - my @t; - my $dd = 1; - my $fromdate = "$yyyy-${mm}-01"; - my $bd = 1; + my @t; + my $dd = 1; + my $fromdate = "$yyyy-${mm}-01"; + my $bd = 1; - if (defined $interval) { + if ( defined $interval ) { - if ($interval == 12) { - $yyyy++; - } else { + if ( $interval == 12 ) { + $yyyy++; + } + else { - if (($mm += $interval) > 12) { - $mm -= 12; - $yyyy++; - } + if ( ( $mm += $interval ) > 12 ) { + $mm -= 12; + $yyyy++; + } - if ($interval == 0) { - @t = localtime(time); - $dd = $t[3]; - $mm = $t[4] + 1; - $yyyy = $t[5] + 1900; - $bd = 0; - } - } + if ( $interval == 0 ) { + @t = localtime(time); + $dd = $t[3]; + $mm = $t[4] + 1; + $yyyy = $t[5] + 1900; + $bd = 0; + } + } - } else { + } + else { - if (++$mm > 12) { - $mm -= 12; - $yyyy++; - } - } + if ( ++$mm > 12 ) { + $mm -= 12; + $yyyy++; + } + } - $mm--; - @t = localtime(Time::Local::timelocal(0,0,0,$dd,$mm,$yyyy) - $bd); + $mm--; + @t = localtime( Time::Local::timelocal( 0, 0, 0, $dd, $mm, $yyyy ) - $bd ); - $t[4]++; - $t[4] = substr("0$t[4]",-2); - $t[3] = substr("0$t[3]",-2); - $t[5] += 1900; + $t[4]++; + $t[4] = substr( "0$t[4]", -2 ); + $t[3] = substr( "0$t[3]", -2 ); + $t[5] += 1900; - ($self->format_date($fromdate), - $self->format_date("$t[5]-$t[4]-$t[3]")); + ( $self->format_date($fromdate), $self->format_date("$t[5]-$t[4]-$t[3]") ); } sub audittrail { - my ($self, $dbh, $myconfig, $audittrail) = @_; + my ( $self, $dbh, $myconfig, $audittrail ) = @_; - # table, $reference, $formname, $action, $id, $transdate) = @_; + # table, $reference, $formname, $action, $id, $transdate) = @_; - my $query; - my $rv; - my $disconnect; + my $query; + my $rv; + my $disconnect; - if (! $dbh) { - $dbh = $self->{dbh}; - } + if ( !$dbh ) { + $dbh = $self->{dbh}; + } - # if we have an id add audittrail, otherwise get a new timestamp + # if we have an id add audittrail, otherwise get a new timestamp - my @queryargs; + my @queryargs; - if ($audittrail->{id}) { + if ( $audittrail->{id} ) { - $query = qq| + $query = qq| SELECT value FROM defaults WHERE setting_key = 'audittrail'|; - if ($dbh->selectrow_array($query)) { + if ( $dbh->selectrow_array($query) ) { - my ($null, $employee_id) = $self->get_employee($dbh); + my ( $null, $employee_id ) = $self->get_employee($dbh); - if ($self->{audittrail} && !$myconfig) { + if ( $self->{audittrail} && !$myconfig ) { - chop $self->{audittrail}; + chop $self->{audittrail}; - my @a = split /\|/, $self->{audittrail}; - my %newtrail = (); - my $key; - my $i; - my @flds = qw(tablename reference formname action transdate); + my @a = split /\|/, $self->{audittrail}; + my %newtrail = (); + my $key; + my $i; + my @flds = qw(tablename reference formname action transdate); - # put into hash and remove dups - while (@a) { - $key = "$a[2]$a[3]"; - $i = 0; - $newtrail{$key} = { map { $_ => $a[$i++] } @flds }; - splice @a, 0, 5; - } + # put into hash and remove dups + while (@a) { + $key = "$a[2]$a[3]"; + $i = 0; + $newtrail{$key} = { map { $_ => $a[ $i++ ] } @flds }; + splice @a, 0, 5; + } - $query = qq| + $query = qq| INSERT INTO audittrail (trans_id, tablename, reference, formname, action, transdate, employee_id) VALUES (?, ?, ?, ?, ?, ?, ?)|; - my $sth = $dbh->prepare($query) || $self->dberror($query); + my $sth = $dbh->prepare($query) || $self->dberror($query); - foreach $key (sort { $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate} } keys %newtrail) { + foreach $key ( + sort { + $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate} + } keys %newtrail + ) + { - $i = 2; - $sth->bind_param(1, $audittrail->{id}); + $i = 2; + $sth->bind_param( 1, $audittrail->{id} ); - for (@flds) { $sth->bind_param($i++, $newtrail{$key}{$_}) } - $sth->bind_param($i++, $employee_id); - $sth->execute || $self->dberror; - $sth->finish; - } - } + for (@flds) { + $sth->bind_param( $i++, $newtrail{$key}{$_} ); + } + $sth->bind_param( $i++, $employee_id ); + $sth->execute || $self->dberror; + $sth->finish; + } + } - if ($audittrail->{transdate}) { + if ( $audittrail->{transdate} ) { - $query = qq| + $query = qq| INSERT INTO audittrail ( trans_id, tablename, reference, formname, action, employee_id, transdate) VALUES (?, ?, ?, ?, ?, ?, ?)|; - @queryargs = ( - $audittrail->{id}, - $audittrail->{tablename}, - $audittrail->{reference}, - $audittrail->{formname}, - $audittrail->{action}, - $employee_id, - $audittrail->{transdate} - ); - } else { - $query = qq| + @queryargs = ( + $audittrail->{id}, $audittrail->{tablename}, + $audittrail->{reference}, $audittrail->{formname}, + $audittrail->{action}, $employee_id, + $audittrail->{transdate} + ); + } + else { + $query = qq| INSERT INTO audittrail (trans_id, tablename, reference, formname, action, employee_id) VALUES (?, ?, ?, ?, ?, ?)|; - @queryargs = ( - $audittrail->{id}, - $audittrail->{tablename}, - $audittrail->{reference}, - $audittrail->{formname}, - $audittrail->{action}, - $employee_id, - ); - } - - $sth = $dbh->prepare($query); - $sth->execute(@queryargs)||$self->dberror($query); - } - - } else { - - $query = qq|SELECT current_timestamp|; - my ($timestamp) = $dbh->selectrow_array($query); - - $rv = "$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|"; - } - - $dbh->commit; - $rv; + @queryargs = ( + $audittrail->{id}, $audittrail->{tablename}, + $audittrail->{reference}, $audittrail->{formname}, + $audittrail->{action}, $employee_id, + ); + } + + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $self->dberror($query); + } + + } + else { + + $query = qq|SELECT current_timestamp|; + my ($timestamp) = $dbh->selectrow_array($query); + + $rv = +"$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|"; + } + + $dbh->commit; + $rv; } 1; diff --git a/LedgerSMB/GL.pm b/LedgerSMB/GL.pm index dab7b0a1..a5c39dbb 100644 --- a/LedgerSMB/GL.pm +++ b/LedgerSMB/GL.pm @@ -1,5 +1,5 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ # @@ -33,141 +33,138 @@ package GL; - sub delete_transaction { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my %audittrail = ( - tablename => 'gl', - reference => $form->{reference}, - formname => 'transaction', - action => 'deleted', - id => $form->{id} ); + my %audittrail = ( + tablename => 'gl', + reference => $form->{reference}, + formname => 'transaction', + action => 'deleted', + id => $form->{id} + ); - $form->audittrail($dbh, "", \%audittrail); - my $id = $dbh->quote($form->{id}); - my $query = qq|DELETE FROM gl WHERE id = $id|; - $dbh->do($query) || $form->dberror($query); + $form->audittrail( $dbh, "", \%audittrail ); + my $id = $dbh->quote( $form->{id} ); + my $query = qq|DELETE FROM gl WHERE id = $id|; + $dbh->do($query) || $form->dberror($query); - $query = qq|DELETE FROM acc_trans WHERE trans_id = $id|; - $dbh->do($query) || $form->dberror($query); + $query = qq|DELETE FROM acc_trans WHERE trans_id = $id|; + $dbh->do($query) || $form->dberror($query); - # commit and redirect - my $rc = $dbh->commit; + # commit and redirect + my $rc = $dbh->commit; - $rc; + $rc; } - sub post_transaction { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + my $null; + my $project_id; + my $department_id; + my $i; - my $null; - my $project_id; - my $department_id; - my $i; + # connect to database, turn off AutoCommit + my $dbh = $form->{dbh}; - # connect to database, turn off AutoCommit - my $dbh = $form->{dbh}; + my $query; + my $sth; - my $query; - my $sth; + my $id = $dbh->quote( $form->{id} ); + if ( $form->{id} ) { - my $id = $dbh->quote($form->{id}); - if ($form->{id}) { + $query = qq|SELECT id FROM gl WHERE id = $id|; + ( $form->{id} ) = $dbh->selectrow_array($query); - $query = qq|SELECT id FROM gl WHERE id = $id|; - ($form->{id}) = $dbh->selectrow_array($query); + if ( $form->{id} ) { - if ($form->{id}) { - # delete individual transactions - $query = qq| + # delete individual transactions + $query = qq| DELETE FROM acc_trans WHERE trans_id = $id|; - $dbh->do($query) || $form->dberror($query); - } - } + $dbh->do($query) || $form->dberror($query); + } + } - if (! $form->{id}) { + if ( !$form->{id} ) { - my $uid = localtime; - $uid .= "$$"; + my $uid = localtime; + $uid .= "$$"; - $query = qq| + $query = qq| INSERT INTO gl (reference, employee_id) VALUES ('$uid', (SELECT id FROM employee WHERE login = ?))|; - $sth = $dbh->prepare($query); - $sth->execute($form->{login}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{login} ) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM gl WHERE reference = '$uid'|; - - ($form->{id}) = $dbh->selectrow_array($query); - } - ($null, $department_id) = split /--/, $form->{department}; - $department_id *= 1; + ( $form->{id} ) = $dbh->selectrow_array($query); + } - $form->{reference} = $form->update_defaults( - $myconfig, 'glnumber', $dbh) - unless $form->{reference}; - $form->{reference} ||= $form->{id}; + ( $null, $department_id ) = split /--/, $form->{department}; + $department_id *= 1; - $query = qq| + $form->{reference} = $form->update_defaults( $myconfig, 'glnumber', $dbh ) + unless $form->{reference}; + $form->{reference} ||= $form->{id}; + + $query = qq| UPDATE gl - SET reference = |.$dbh->quote($form->{reference}).qq|, - description = |.$dbh->quote($form->{description}).qq|, - notes = |.$dbh->quote($form->{notes}).qq|, + SET reference = | . $dbh->quote( $form->{reference} ) . qq|, + description = | . $dbh->quote( $form->{description} ) . qq|, + notes = | . $dbh->quote( $form->{notes} ) . qq|, transdate = ?, department_id = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{transdate}, $department_id, $form->{id}) - || $form->dberror($query); - - my $amount = 0; - my $posted = 0; - my $debit; - my $credit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{transdate}, $department_id, $form->{id} ) + || $form->dberror($query); - # insert acc_trans transactions - for $i (1 .. $form->{rowcount}) { + my $amount = 0; + my $posted = 0; + my $debit; + my $credit; - $debit = $form->parse_amount($myconfig, $form->{"debit_$i"}); - $credit = $form->parse_amount($myconfig, $form->{"credit_$i"}); + # insert acc_trans transactions + for $i ( 1 .. $form->{rowcount} ) { - # extract accno - ($accno) = split(/--/, $form->{"accno_$i"}); + $debit = $form->parse_amount( $myconfig, $form->{"debit_$i"} ); + $credit = $form->parse_amount( $myconfig, $form->{"credit_$i"} ); - if ($credit) { - $amount = $credit; - $posted = 0; - } + # extract accno + ($accno) = split( /--/, $form->{"accno_$i"} ); - if ($debit) { - $amount = $debit * -1; - $posted = 0; - } + if ($credit) { + $amount = $credit; + $posted = 0; + } - # add the record - if (! $posted) { + if ($debit) { + $amount = $debit * -1; + $posted = 0; + } - ($null, $project_id) = split /--/, - $form->{"projectnumber_$i"}; - $project_id ||= undef; + # add the record + if ( !$posted ) { + ( $null, $project_id ) = split /--/, $form->{"projectnumber_$i"}; + $project_id ||= undef; - $query = qq| + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, source, project_id, @@ -177,232 +174,228 @@ sub post_transaction { WHERE accno = ?), ?, ?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno, $amount, - $form->{transdate}, $form->{"source_$i"}, - $project_id, $form->{"fx_transaction_$i"}, - $form->{"memo_$i"}, $form->{"cleared_$i"} - ) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( + $form->{id}, $accno, + $amount, $form->{transdate}, + $form->{"source_$i"}, $project_id, + $form->{"fx_transaction_$i"}, $form->{"memo_$i"}, + $form->{"cleared_$i"} + ) || $form->dberror($query); - $posted = 1; - } - } + $posted = 1; + } + } - my %audittrail = ( - tablename => 'gl', - reference => $form->{reference}, - formname => 'transaction', - action => 'posted', - id => $form->{id} ); + my %audittrail = ( + tablename => 'gl', + reference => $form->{reference}, + formname => 'transaction', + action => 'posted', + id => $form->{id} + ); - $form->audittrail($dbh, "", \%audittrail); + $form->audittrail( $dbh, "", \%audittrail ); - $form->save_recurring($dbh, $myconfig); + $form->save_recurring( $dbh, $myconfig ); - # commit and redirect - my $rc = $dbh->commit; + # commit and redirect + my $rc = $dbh->commit; - $rc; + $rc; } - - sub all_transactions { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - my $query; - my $sth; - my $var; - my $null; - - my ($glwhere, $arwhere, $apwhere) = ("1 = 1", "1 = 1", "1 = 1"); - - if ($form->{reference} ne "") { - $var = $dbh->quote($form->like(lc $form->{reference})); - $glwhere .= " AND lower(g.reference) LIKE $var"; - $arwhere .= " AND lower(a.invnumber) LIKE $var"; - $apwhere .= " AND lower(a.invnumber) LIKE $var"; - } - - if ($form->{department} ne "") { - ($null, $var) = split /--/, $form->{department}; - $var = $dbh->quote($var); - $glwhere .= " AND g.department_id = $var"; - $arwhere .= " AND a.department_id = $var"; - $apwhere .= " AND a.department_id = $var"; - } - - if ($form->{source} ne "") { - $var = $dbh->quote($form->like(lc $form->{source})); - $glwhere .= " AND lower(ac.source) LIKE $var"; - $arwhere .= " AND lower(ac.source) LIKE $var"; - $apwhere .= " AND lower(ac.source) LIKE $var"; - } - - if ($form->{memo} ne "") { - $var = $form->like(lc $form->{memo}); - $glwhere .= " AND lower(ac.memo) LIKE $var"; - $arwhere .= " AND lower(ac.memo) LIKE $var"; - $apwhere .= " AND lower(ac.memo) LIKE $var"; - } - - ($form->{datefrom}, $form->{dateto}) = $form->from_to( - $form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - if ($form->{datefrom}) { - $glwhere .= " AND ac.transdate >= ". - $dbh->quote($form->{datefrom}); - $arwhere .= " AND ac.transdate >= ". - $dbh->quote($form->{datefrom}); - $apwhere .= " AND ac.transdate >= ". - $dbh->quote($form->{datefrom}); - } - - if ($form->{dateto}) { - $glwhere .= " AND ac.transdate <= ". - $dbh->quote($form->{dateto}); - $arwhere .= " AND ac.transdate <= ". - $dbh->quote($form->{dateto}); - $apwhere .= " AND ac.transdate <= ". - $dbh->quote($form->{dateto}); - } - - if ($form->{amountfrom}) { - $glwhere .= " AND abs(ac.amount) >= ". - $dbh->quote($form->{amountfrom}); - $arwhere .= " AND abs(ac.amount) >= ". - $dbh->quote($form->{amountfrom}); - $apwhere .= " AND abs(ac.amount) >= ". - $dbh->quote($form->{amountfrom}); - } - - if ($form->{amountto}) { - $glwhere .= " AND abs(ac.amount) <= ". - $dbh->quote($form->{amountto}); - $arwhere .= " AND abs(ac.amount) <= ". - $dbh->quote($form->{amountto}); - $apwhere .= " AND abs(ac.amount) <= ". - $dbh->quote($form->{amountto}); - } - - if ($form->{description}) { - - $var = $dbh->quote($form->like(lc $form->{description})); - $glwhere .= " AND lower(g.description) LIKE $var"; - $arwhere .= " AND (lower(ct.name) LIKE $var + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + my $query; + my $sth; + my $var; + my $null; + + my ( $glwhere, $arwhere, $apwhere ) = ( "1 = 1", "1 = 1", "1 = 1" ); + + if ( $form->{reference} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{reference} ) ); + $glwhere .= " AND lower(g.reference) LIKE $var"; + $arwhere .= " AND lower(a.invnumber) LIKE $var"; + $apwhere .= " AND lower(a.invnumber) LIKE $var"; + } + + if ( $form->{department} ne "" ) { + ( $null, $var ) = split /--/, $form->{department}; + $var = $dbh->quote($var); + $glwhere .= " AND g.department_id = $var"; + $arwhere .= " AND a.department_id = $var"; + $apwhere .= " AND a.department_id = $var"; + } + + if ( $form->{source} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{source} ) ); + $glwhere .= " AND lower(ac.source) LIKE $var"; + $arwhere .= " AND lower(ac.source) LIKE $var"; + $apwhere .= " AND lower(ac.source) LIKE $var"; + } + + if ( $form->{memo} ne "" ) { + $var = $form->like( lc $form->{memo} ); + $glwhere .= " AND lower(ac.memo) LIKE $var"; + $arwhere .= " AND lower(ac.memo) LIKE $var"; + $apwhere .= " AND lower(ac.memo) LIKE $var"; + } + + ( $form->{datefrom}, $form->{dateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + if ( $form->{datefrom} ) { + $glwhere .= " AND ac.transdate >= " . $dbh->quote( $form->{datefrom} ); + $arwhere .= " AND ac.transdate >= " . $dbh->quote( $form->{datefrom} ); + $apwhere .= " AND ac.transdate >= " . $dbh->quote( $form->{datefrom} ); + } + + if ( $form->{dateto} ) { + $glwhere .= " AND ac.transdate <= " . $dbh->quote( $form->{dateto} ); + $arwhere .= " AND ac.transdate <= " . $dbh->quote( $form->{dateto} ); + $apwhere .= " AND ac.transdate <= " . $dbh->quote( $form->{dateto} ); + } + + if ( $form->{amountfrom} ) { + $glwhere .= + " AND abs(ac.amount) >= " . $dbh->quote( $form->{amountfrom} ); + $arwhere .= + " AND abs(ac.amount) >= " . $dbh->quote( $form->{amountfrom} ); + $apwhere .= + " AND abs(ac.amount) >= " . $dbh->quote( $form->{amountfrom} ); + } + + if ( $form->{amountto} ) { + $glwhere .= + " AND abs(ac.amount) <= " . $dbh->quote( $form->{amountto} ); + $arwhere .= + " AND abs(ac.amount) <= " . $dbh->quote( $form->{amountto} ); + $apwhere .= + " AND abs(ac.amount) <= " . $dbh->quote( $form->{amountto} ); + } + + if ( $form->{description} ) { + + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $glwhere .= " AND lower(g.description) LIKE $var"; + $arwhere .= " AND (lower(ct.name) LIKE $var OR lower(ac.memo) LIKE $var OR a.id IN (SELECT DISTINCT trans_id FROM invoice WHERE lower(description) LIKE $var))"; - $apwhere .= " AND (lower(ct.name) LIKE $var + $apwhere .= " AND (lower(ct.name) LIKE $var OR lower(ac.memo) LIKE $var OR a.id IN (SELECT DISTINCT trans_id FROM invoice WHERE lower(description) LIKE $var))"; - } - - if ($form->{notes}) { - $var = $dbh->quote($form->like(lc $form->{notes})); - $glwhere .= " AND lower(g.notes) LIKE $var"; - $arwhere .= " AND lower(a.notes) LIKE $var"; - $apwhere .= " AND lower(a.notes) LIKE $var"; - } - - if ($form->{accno}) { - $var = $dbh->quote($form->{accno}); - $glwhere .= " AND c.accno = $var"; - $arwhere .= " AND c.accno = $var"; - $apwhere .= " AND c.accno = $var"; - } - - if ($form->{gifi_accno}) { - $var = $dbh->quote($form->{gifiaccno}); - $glwhere .= " AND c.gifi_accno = $var"; - $arwhere .= " AND c.gifi_accno = $var"; - $apwhere .= " AND c.gifi_accno = $var"; - } - - if ($form->{category} ne 'X') { - $var = $dbh->quote($form->{gifiaccno}); - $glwhere .= " AND c.category = $var"; - $arwhere .= " AND c.category = $var"; - $apwhere .= " AND c.category = $var"; - } - - if ($form->{accno}) { - my $accno = $dbh->quote($form->{accno}); - - # get category for account - $query = qq|SELECT category, link, contra, description + } + + if ( $form->{notes} ) { + $var = $dbh->quote( $form->like( lc $form->{notes} ) ); + $glwhere .= " AND lower(g.notes) LIKE $var"; + $arwhere .= " AND lower(a.notes) LIKE $var"; + $apwhere .= " AND lower(a.notes) LIKE $var"; + } + + if ( $form->{accno} ) { + $var = $dbh->quote( $form->{accno} ); + $glwhere .= " AND c.accno = $var"; + $arwhere .= " AND c.accno = $var"; + $apwhere .= " AND c.accno = $var"; + } + + if ( $form->{gifi_accno} ) { + $var = $dbh->quote( $form->{gifiaccno} ); + $glwhere .= " AND c.gifi_accno = $var"; + $arwhere .= " AND c.gifi_accno = $var"; + $apwhere .= " AND c.gifi_accno = $var"; + } + + if ( $form->{category} ne 'X' ) { + $var = $dbh->quote( $form->{gifiaccno} ); + $glwhere .= " AND c.category = $var"; + $arwhere .= " AND c.category = $var"; + $apwhere .= " AND c.category = $var"; + } + + if ( $form->{accno} ) { + my $accno = $dbh->quote( $form->{accno} ); + + # get category for account + $query = qq|SELECT category, link, contra, description FROM chart WHERE accno = $accno|; - ($form->{category}, $form->{link}, $form->{contra}, - $form->{account_description}) = $dbh->selectrow_array($query); + ( + $form->{category}, $form->{link}, $form->{contra}, + $form->{account_description} + ) = $dbh->selectrow_array($query); - if ($form->{datefrom}) { + if ( $form->{datefrom} ) { - $query = qq| + $query = qq| SELECT SUM(ac.amount) FROM acc_trans ac JOIN chart c ON (ac.chart_id = c.id) WHERE c.accno = $accno - AND ac.transdate < date |. - $dbh->quote($form->{datefrom}); + AND ac.transdate < date | . $dbh->quote( $form->{datefrom} ); - ($form->{balance}) = $dbh->selectrow_array($query); - } - } + ( $form->{balance} ) = $dbh->selectrow_array($query); + } + } - if ($form->{gifi_accno}) { - my $gifi = $dbh->quote($form->{gifi_accno}); + if ( $form->{gifi_accno} ) { + my $gifi = $dbh->quote( $form->{gifi_accno} ); - # get category for account - $query = qq|SELECT c.category, c.link, c.contra, g.description + # get category for account + $query = qq|SELECT c.category, c.link, c.contra, g.description FROM chart c LEFT JOIN gifi g ON (g.accno = c.gifi_accno) WHERE c.gifi_accno = $gifi|; - ($form->{category}, $form->{link}, $form->{contra}, - $form->{gifi_account_description}) = $dbh->selectrow_array( - $query); + ( + $form->{category}, $form->{link}, $form->{contra}, + $form->{gifi_account_description} + ) = $dbh->selectrow_array($query); - if ($form->{datefrom}) { + if ( $form->{datefrom} ) { - $query = qq| + $query = qq| SELECT SUM(ac.amount) FROM acc_trans ac JOIN chart c ON (ac.chart_id = c.id) WHERE c.gifi_accno = $gifi - AND ac.transdate < date |. - $dbh->quote($form->{datefrom}); + AND ac.transdate < date | . $dbh->quote( $form->{datefrom} ); - ($form->{balance}) = $dbh->selectrow_array($query); - } - } + ( $form->{balance} ) = $dbh->selectrow_array($query); + } + } - my $false = 'FALSE'; + my $false = 'FALSE'; - my %ordinal = ( - id => 1, - reference => 4, - description => 5, - transdate => 6, - source => 7, - accno => 9, - department => 15, - memo => 16 ); + my %ordinal = ( + id => 1, + reference => 4, + description => 5, + transdate => 6, + source => 7, + accno => 9, + department => 15, + memo => 16 + ); - my @a = (id, transdate, reference, source, description, accno); - my $sortorder = $form->sort_order(\@a, \%ordinal); + my @a = ( id, transdate, reference, source, description, accno ); + my $sortorder = $form->sort_order( \@a, \%ordinal ); - my $query = qq|SELECT g.id, 'gl' AS type, $false AS invoice, g.reference, + my $query = qq|SELECT g.id, 'gl' AS type, $false AS invoice, g.reference, g.description, ac.transdate, ac.source, ac.amount, c.accno, c.gifi_accno, g.notes, c.link, '' AS till, ac.cleared, d.description AS department, @@ -442,150 +435,153 @@ sub all_transactions { WHERE $apwhere ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - - # gl - if ($ref->{type} eq "gl") { - $ref->{module} = "gl"; - } - - # ap - if ($ref->{type} eq "ap") { - - if ($ref->{invoice}) { - $ref->{module} = "ir"; - } else { - $ref->{module} = "ap"; - } - } - - # ar - if ($ref->{type} eq "ar") { - - if ($ref->{invoice}) { - $ref->{module} = ($ref->{till}) ? "ps" : "is"; - } else { - $ref->{module} = "ar"; - } - } - - if ($ref->{amount} < 0) { - $ref->{debit} = $ref->{amount} * -1; - $ref->{credit} = 0; - } else { - $ref->{credit} = $ref->{amount}; - $ref->{debit} = 0; - } - - push @{ $form->{GL} }, $ref; - } - - $sth->finish; - $dbh->commit; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + # gl + if ( $ref->{type} eq "gl" ) { + $ref->{module} = "gl"; + } + + # ap + if ( $ref->{type} eq "ap" ) { + + if ( $ref->{invoice} ) { + $ref->{module} = "ir"; + } + else { + $ref->{module} = "ap"; + } + } + + # ar + if ( $ref->{type} eq "ar" ) { + + if ( $ref->{invoice} ) { + $ref->{module} = ( $ref->{till} ) ? "ps" : "is"; + } + else { + $ref->{module} = "ar"; + } + } + + if ( $ref->{amount} < 0 ) { + $ref->{debit} = $ref->{amount} * -1; + $ref->{credit} = 0; + } + else { + $ref->{credit} = $ref->{amount}; + $ref->{debit} = 0; + } + + push @{ $form->{GL} }, $ref; + } + + $sth->finish; + $dbh->commit; } - sub transaction { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my ($query, $sth, $ref); + my ( $query, $sth, $ref ); - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - if ($form->{id}) { + if ( $form->{id} ) { - $query = "SELECT setting_key, value + $query = "SELECT setting_key, value FROM defaults WHERE setting_key IN ('closedto', 'revtrans')"; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $results = $sth->fetchall_hashref('setting_key'); - $form->{closedto} = $results->{'closedto'}->{'value'}; - $form->{revtrans} = $results->{'revtrans'}->{'value'}; - $sth->finish; + my $results = $sth->fetchall_hashref('setting_key'); + $form->{closedto} = $results->{'closedto'}->{'value'}; + $form->{revtrans} = $results->{'revtrans'}->{'value'}; + $sth->finish; - $query = qq|SELECT g.*, d.description AS department + $query = qq|SELECT g.*, d.description AS department FROM gl g LEFT JOIN department d ON (d.id = g.department_id) WHERE g.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - # retrieve individual rows - $query = qq|SELECT ac.*, c.accno, c.description, p.projectnumber + # retrieve individual rows + $query = qq|SELECT ac.*, c.accno, c.description, p.projectnumber FROM acc_trans ac JOIN chart c ON (ac.chart_id = c.id) LEFT JOIN project p ON (p.id = ac.project_id) WHERE ac.trans_id = ? ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { - if ($ref->{fx_transaction}) { - $form->{transfer} = 1; - } - push @{ $form->{GL} }, $ref; - } + if ( $ref->{fx_transaction} ) { + $form->{transfer} = 1; + } + push @{ $form->{GL} }, $ref; + } - # get recurring transaction - $form->get_recurring($dbh); + # get recurring transaction + $form->get_recurring($dbh); - } else { + } + else { - $query = "SELECT current_date AS transdate, setting_key, value + $query = "SELECT current_date AS transdate, setting_key, value FROM defaults WHERE setting_key IN ('closedto', 'revtrans')"; - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - my $results = $sth->fetchall_hashref('setting_key'); - $form->{closedto} = $results->{'closedto'}->{'value'}; - $form->{revtrans} = $results->{'revtrans'}->{'value'}; - $form->{transdate} = $results->{'revtrans'}->{'transdate'}; - } + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $results = $sth->fetchall_hashref('setting_key'); + $form->{closedto} = $results->{'closedto'}->{'value'}; + $form->{revtrans} = $results->{'revtrans'}->{'value'}; + $form->{transdate} = $results->{'revtrans'}->{'transdate'}; + } - $sth->finish; + $sth->finish; - # get chart of accounts - $query = qq|SELECT accno,description + # get chart of accounts + $query = qq|SELECT accno,description FROM chart WHERE charttype = 'A' ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_accno} }, $ref; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_accno} }, $ref; + } - $sth->finish; + $sth->finish; - # get departments - $form->all_departments($myconfig, $dbh); + # get departments + $form->all_departments( $myconfig, $dbh ); - # get projects - $form->all_projects($myconfig, $dbh, $form->{transdate}); + # get projects + $form->all_projects( $myconfig, $dbh, $form->{transdate} ); - $dbh->commit; + $dbh->commit; } diff --git a/LedgerSMB/HR.pm b/LedgerSMB/HR.pm index 33e9b18a..c9869e15 100644 --- a/LedgerSMB/HR.pm +++ b/LedgerSMB/HR.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -33,103 +33,102 @@ package HR; - sub get_employee { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $query; - my $sth; - my $ref; - my $notid = ""; - - if ($form->{id}) { - $query = qq|SELECT e.* FROM employees e WHERE e.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror(__FILE__.':'.__LINE__.':'.$query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - - # check if employee can be deleted, orphaned - $form->{status} = "orphaned" unless $ref->{login}; - - - $ref->{employeelogin} = $ref->{login}; - delete $ref->{login}; - for (keys %$ref) { $form->{$_} = $ref->{$_} } - - $sth->finish; - - # get manager - $form->{managerid} *= 1; - - $sth = $dbh->prepare("SELECT name FROM employees WHERE id = ?"); - $sth->execute($form->{managerid}); - ($form->{manager}) = $sth->fetchrow_array; - - - $notid = qq|AND id != |.$dbh->quote($form->{id}); - - } else { - - ($form->{startdate}) = $dbh->selectrow_array("SELECT current_date"); - - } - - # get managers - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $query; + my $sth; + my $ref; + my $notid = ""; + + if ( $form->{id} ) { + $query = qq|SELECT e.* FROM employees e WHERE e.id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) + || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query ); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + # check if employee can be deleted, orphaned + $form->{status} = "orphaned" unless $ref->{login}; + + $ref->{employeelogin} = $ref->{login}; + delete $ref->{login}; + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + + $sth->finish; + + # get manager + $form->{managerid} *= 1; + + $sth = $dbh->prepare("SELECT name FROM employees WHERE id = ?"); + $sth->execute( $form->{managerid} ); + ( $form->{manager} ) = $sth->fetchrow_array; + + $notid = qq|AND id != | . $dbh->quote( $form->{id} ); + + } + else { + + ( $form->{startdate} ) = $dbh->selectrow_array("SELECT current_date"); + + } + + # get managers + $query = qq| SELECT id, name FROM employees WHERE sales = '1' AND role = 'manager' $notid ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror(__FILE__.':'.__LINE__.':'.$query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query ); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_manager} }, $ref; - } - $sth->finish; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_manager} }, $ref; + } + $sth->finish; - $dbh->commit; + $dbh->commit; } - - sub save_employee { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; - my $query; - my $sth; + my $dbh = $form->{dbh}; + my $query; + my $sth; - if (! $form->{id}) { - my $uid = localtime; - $uid .= "$$"; + if ( !$form->{id} ) { + my $uid = localtime; + $uid .= "$$"; - $query = qq|INSERT INTO employees (name) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror(__FILE__.':'.__LINE__.':'.$query); - - $query = qq|SELECT id FROM employees WHERE name = '$uid'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror(__FILE__.':'.__LINE__.':'.$query); + $query = qq|INSERT INTO employees (name) VALUES ('$uid')|; + $dbh->do($query) + || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query ); - ($form->{id}) = $sth->fetchrow_array; - $sth->finish; - } + $query = qq|SELECT id FROM employees WHERE name = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute + || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query ); - my ($null, $managerid) = split /--/, $form->{manager}; - $managerid *= 1; - $form->{sales} *= 1; + ( $form->{id} ) = $sth->fetchrow_array; + $sth->finish; + } - $form->{employeenumber} = $form->update_defaults( - $myconfig, "employeenumber", $dbh) - if ! $form->{employeenumber}; + my ( $null, $managerid ) = split /--/, $form->{manager}; + $managerid *= 1; + $form->{sales} *= 1; - $query = qq| + $form->{employeenumber} = + $form->update_defaults( $myconfig, "employeenumber", $dbh ) + if !$form->{employeenumber}; + + $query = qq| UPDATE employees SET employeenumber = ?, name = ?, @@ -153,109 +152,106 @@ sub save_employee { bic = ?, managerid = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $form->{dob} ||= undef; - $form->{startdate} ||= undef; - $form->{enddate} ||= undef; - $sth->execute( - $form->{employeenumber}, $form->{name}, $form->{address1}, - $form->{address2}, $form->{city}, $form->{state}, - $form->{zipcode}, $form->{country}, $form->{workphone}, - $form->{homephone}, $form->{startdate}, $form->{enddate}, - $form->{notes}, $form->{role}, $form->{sales}, $form->{email}, - $form->{ssn}, $form->{dob}, $form->{iban}, $form->{bic}, - $managerid, $form->{id} - ) || $form->dberror(__FILE__.':'.__LINE__.':'.$query); - - - $dbh->commit; + $sth = $dbh->prepare($query); + $form->{dob} ||= undef; + $form->{startdate} ||= undef; + $form->{enddate} ||= undef; + $sth->execute( + $form->{employeenumber}, $form->{name}, $form->{address1}, + $form->{address2}, $form->{city}, $form->{state}, + $form->{zipcode}, $form->{country}, $form->{workphone}, + $form->{homephone}, $form->{startdate}, $form->{enddate}, + $form->{notes}, $form->{role}, $form->{sales}, + $form->{email}, $form->{ssn}, $form->{dob}, + $form->{iban}, $form->{bic}, $managerid, + $form->{id} + ) || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query ); + + $dbh->commit; } - sub delete_employee { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; - # connect to database - my $dbh = $form->{dbh}; + # delete employee - # delete employee - - my $query = qq| + my $query = qq| DELETE FROM employees - WHERE id = |.$dbh->quote($form->{id}); - $dbh->do($query) || $form->dberror(__FILE__.':'.__LINE__.':'.$query); + WHERE id = | . $dbh->quote( $form->{id} ); + $dbh->do($query) + || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query ); - $dbh->commit; + $dbh->commit; } - sub employees { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $where = "1 = 1"; - $form->{sort} = ($form->{sort}) ? $form->{sort} : "name"; - my @a = qw(name); - my $sortorder = $form->sort_order(\@a); - - my $var; - - if ($form->{startdatefrom}) { - $where .= " AND e.startdate >= ". - $dbh->quote($form->{startdatefrom}); - } - if ($form->{startdateto}) { - $where .= " AND e.startddate <= ". - $dbh->quote($form->{startdateto}); - } - if ($form->{name} ne "") { - $var = $dbh->quote($form->like(lc $form->{name})); - $where .= " AND lower(e.name) LIKE $var"; - } - if ($form->{notes} ne "") { - $var = $dbh->quote($form->like(lc $form->{notes})); - $where .= " AND lower(e.notes) LIKE $var"; - } - if ($form->{sales} eq 'Y') { - $where .= " AND e.sales = '1'"; - } - if ($form->{status} eq 'orphaned') { - $where .= qq| AND e.login IS NULL|; - } - if ($form->{status} eq 'active') { - $where .= qq| AND e.enddate IS NULL|; - } - if ($form->{status} eq 'inactive') { - $where .= qq| AND e.enddate <= current_date|; - } - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $where = "1 = 1"; + $form->{sort} = ( $form->{sort} ) ? $form->{sort} : "name"; + my @a = qw(name); + my $sortorder = $form->sort_order( \@a ); + + my $var; + + if ( $form->{startdatefrom} ) { + $where .= + " AND e.startdate >= " . $dbh->quote( $form->{startdatefrom} ); + } + if ( $form->{startdateto} ) { + $where .= " AND e.startddate <= " . $dbh->quote( $form->{startdateto} ); + } + if ( $form->{name} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{name} ) ); + $where .= " AND lower(e.name) LIKE $var"; + } + if ( $form->{notes} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{notes} ) ); + $where .= " AND lower(e.notes) LIKE $var"; + } + if ( $form->{sales} eq 'Y' ) { + $where .= " AND e.sales = '1'"; + } + if ( $form->{status} eq 'orphaned' ) { + $where .= qq| AND e.login IS NULL|; + } + if ( $form->{status} eq 'active' ) { + $where .= qq| AND e.enddate IS NULL|; + } + if ( $form->{status} eq 'inactive' ) { + $where .= qq| AND e.enddate <= current_date|; + } + + my $query = qq| SELECT e.*, m.name AS manager FROM employees e LEFT JOIN employees m ON (m.id = e.managerid) WHERE $where ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror(__FILE__.':'.__LINE__.':'.$query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . ':' . $query ); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{address} = ""; - for (qw(address1 address2 city state zipcode country)) { - $ref->{address} .= "$ref->{$_} "; - } - push @{ $form->{all_employee} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{address} = ""; + for (qw(address1 address2 city state zipcode country)) { + $ref->{address} .= "$ref->{$_} "; + } + push @{ $form->{all_employee} }, $ref; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - 1; diff --git a/LedgerSMB/IC.pm b/LedgerSMB/IC.pm index 5594c176..943f6b36 100644 --- a/LedgerSMB/IC.pm +++ b/LedgerSMB/IC.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -33,15 +33,14 @@ package IC; - sub get_part { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to db - my $dbh = $form->{dbh}; - my $i; + # connect to db + my $dbh = $form->{dbh}; + my $i; - my $query = qq| + my $query = qq| SELECT p.*, c1.accno AS inventory_accno, c1.description AS inventory_description, c2.accno AS income_accno, @@ -54,23 +53,23 @@ sub get_part { LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) WHERE p.id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - - # copy to $form variables - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; - - # part, service item or labor - $form->{item} = ($form->{inventory_accno_id}) ? 'part' : 'service'; - $form->{item} = 'labor' if ! $form->{income_accno_id}; - - if ($form->{assembly}) { - $form->{item} = 'assembly'; - - # retrieve assembly items - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + my $ref = $sth->fetchrow_hashref(NAME_lc); + + # copy to $form variables + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; + + # part, service item or labor + $form->{item} = ( $form->{inventory_accno_id} ) ? 'part' : 'service'; + $form->{item} = 'labor' if !$form->{income_accno_id}; + + if ( $form->{assembly} ) { + $form->{item} = 'assembly'; + + # retrieve assembly items + $query = qq| SELECT p.id, p.partnumber, p.description, p.sellprice, p.weight, a.qty, a.bom, a.adj, p.unit, p.lastcost, p.listprice, @@ -80,67 +79,65 @@ sub get_part { LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) WHERE a.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $form->{assembly_rows} = 0; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{assembly_rows}++; - foreach my $key ( keys %{ $ref } ) { - $form->{"${key}_$form->{assembly_rows}"} - = $ref->{$key}; - } - } - $sth->finish; - - } - - # setup accno hash for <option checked> - # {amount} is used in create_links - for (qw(inventory income expense)) { - $form->{amount}{"IC_$_"} - = { - accno => $form->{"${_}_accno"}, - description => $form->{"${_}_description"} - }; - }; - - - if ($form->{item} =~ /(part|assembly)/) { - - if ($form->{makemodel} ne "") { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $form->{assembly_rows} = 0; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{assembly_rows}++; + foreach my $key ( keys %{$ref} ) { + $form->{"${key}_$form->{assembly_rows}"} = $ref->{$key}; + } + } + $sth->finish; + + } + + # setup accno hash for <option checked> + # {amount} is used in create_links + for (qw(inventory income expense)) { + $form->{amount}{"IC_$_"} = { + accno => $form->{"${_}_accno"}, + description => $form->{"${_}_description"} + }; + } + + if ( $form->{item} =~ /(part|assembly)/ ) { + + if ( $form->{makemodel} ne "" ) { + $query = qq| SELECT make, model FROM makemodel WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{makemodels} }, $ref; - } - $sth->finish; - } - } - - # now get accno for taxes - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{makemodels} }, $ref; + } + $sth->finish; + } + } + + # now get accno for taxes + $query = qq| SELECT c.accno FROM chart c, partstax pt WHERE pt.chart_id = c.id AND pt.parts_id = ?|; - - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - while (($key) = $sth->fetchrow_array) { - $form->{amount}{$key} = $key; - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + while ( ($key) = $sth->fetchrow_array ) { + $form->{amount}{$key} = $key; + } - $sth->finish; + $sth->finish; - my $id = $dbh->quote($form->{id}); - # is it an orphan - $query = qq| + my $id = $dbh->quote( $form->{id} ); + + # is it an orphan + $query = qq| SELECT parts_id FROM invoice WHERE parts_id = $id UNION SELECT parts_id FROM orderitems WHERE parts_id = $id @@ -148,20 +145,21 @@ sub get_part { SELECT parts_id FROM assembly WHERE parts_id = $id UNION SELECT parts_id FROM jcitems WHERE parts_id = $id|; - ($form->{orphaned}) = $dbh->selectrow_array($query); - $form->{orphaned} = !$form->{orphaned}; + ( $form->{orphaned} ) = $dbh->selectrow_array($query); + $form->{orphaned} = !$form->{orphaned}; + + $form->{orphaned} = 0 if $form->{project_id}; - $form->{orphaned} = 0 if $form->{project_id}; + if ( $form->{item} eq 'assembly' ) { + if ( $form->{orphaned} ) { + $form->{orphaned} = !$form->{onhand}; + } + } - if ($form->{item} eq 'assembly') { - if ($form->{orphaned}) { - $form->{orphaned} = !$form->{onhand}; - } - } + if ( $form->{item} =~ /(part|service)/ ) { - if ($form->{item} =~ /(part|service)/) { - # get vendors - $query = qq| + # get vendors + $query = qq| SELECT v.id, v.name, pv.partnumber, pv.lastcost, pv.leadtime, pv.curr AS vendorcurr @@ -169,19 +167,19 @@ sub get_part { JOIN vendor v ON (v.id = pv.vendor_id) WHERE pv.parts_id = ? ORDER BY 2|; - - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{vendormatrix} }, $ref; - } - $sth->finish; - } - - # get matrix - if ($form->{item} ne 'labor') { - $query = qq| + + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{vendormatrix} }, $ref; + } + $sth->finish; + } + + # get matrix + if ( $form->{item} ne 'labor' ) { + $query = qq| SELECT pc.pricebreak, pc.sellprice AS customerprice, pc.curr AS customercurr, pc.validfrom, pc.validto, c.name, c.id AS cid, @@ -191,202 +189,203 @@ sub get_part { LEFT JOIN pricegroup g ON (g.id = pc.pricegroup_id) WHERE pc.parts_id = ? ORDER BY c.name, g.pricegroup, pc.pricebreak|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{customermatrix} }, $ref; - } - $sth->finish; - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{customermatrix} }, $ref; + } + $sth->finish; + } - $form->run_custom_queries('parts', 'SELECT'); - -} + $form->run_custom_queries( 'parts', 'SELECT' ); +} sub save { - my ($self, $myconfig, $form) = @_; - - ($form->{inventory_accno}) = split(/--/, $form->{IC_inventory}); - ($form->{expense_accno}) = split(/--/, $form->{IC_expense}); - ($form->{income_accno}) = split(/--/, $form->{IC_income}); - - my $dbh = $form->{dbh}; - - # undo amount formatting - for (qw(rop weight listprice sellprice lastcost stock)) { - $form->{$_} = $form->parse_amount($myconfig, $form->{$_}); - } - - $form->{makemodel} = (($form->{make_1}) || ($form->{model_1})) ? 1 : 0; - - $form->{assembly} = ($form->{item} eq 'assembly') ? 1 : 0; - for (qw(alternate obsolete onhand)) { $form->{$_} *= 1 } - - my $query; - my $sth; - my $i; - my $null; - my $vendor_id; - my $customer_id; - - if ($form->{id}) { - - # get old price - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + ( $form->{inventory_accno} ) = split( /--/, $form->{IC_inventory} ); + ( $form->{expense_accno} ) = split( /--/, $form->{IC_expense} ); + ( $form->{income_accno} ) = split( /--/, $form->{IC_income} ); + + my $dbh = $form->{dbh}; + + # undo amount formatting + for (qw(rop weight listprice sellprice lastcost stock)) { + $form->{$_} = $form->parse_amount( $myconfig, $form->{$_} ); + } + + $form->{makemodel} = + ( ( $form->{make_1} ) || ( $form->{model_1} ) ) ? 1 : 0; + + $form->{assembly} = ( $form->{item} eq 'assembly' ) ? 1 : 0; + for (qw(alternate obsolete onhand)) { $form->{$_} *= 1 } + + my $query; + my $sth; + my $i; + my $null; + my $vendor_id; + my $customer_id; + + if ( $form->{id} ) { + + # get old price + $query = qq| SELECT id, listprice, sellprice, lastcost, weight, project_id FROM parts WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - my ($id, $listprice, $sellprice, $lastcost, $weight, - $project_id) - = $sth->fetchrow_array(); - - if ($id) { - - if (!$project_id) { - # if item is part of an assembly - # adjust all assemblies - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + my ( $id, $listprice, $sellprice, $lastcost, $weight, $project_id ) = + $sth->fetchrow_array(); + + if ($id) { + + if ( !$project_id ) { + + # if item is part of an assembly + # adjust all assemblies + $query = qq| SELECT id, qty, adj FROM assembly WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || - $form->dberror($query); - while (my ($id, $qty, $adj) - = $sth->fetchrow_array) { - - &update_assembly( - $dbh, $form, $id, $qty, $adj, - $listprice * 1, $sellprice * 1, - $lastcost * 1, $weight * 1); - } - $sth->finish; - } - - if ($form->{item} =~ /(part|service)/) { - # delete partsvendor records - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) + || $form->dberror($query); + while ( my ( $id, $qty, $adj ) = $sth->fetchrow_array ) { + + &update_assembly( + $dbh, $form, + $id, $qty, + $adj, $listprice * 1, + $sellprice * 1, $lastcost * 1, + $weight * 1 + ); + } + $sth->finish; + } + + if ( $form->{item} =~ /(part|service)/ ) { + + # delete partsvendor records + $query = qq| DELETE FROM partsvendor WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) - || $form->dberror($query); - } - - if ($form->{item} !~ /(service|labor)/) { - # delete makemodel records - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) + || $form->dberror($query); + } + + if ( $form->{item} !~ /(service|labor)/ ) { + + # delete makemodel records + $query = qq| DELETE FROM makemodel WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) - || $form->dberror($query); - } - - if ($form->{item} eq 'assembly') { - - if ($form->{onhand}) { - &adjust_inventory( - $dbh, $form, $form->{id}, - $form->{onhand} * -1); - } - - if ($form->{orphaned}) { - # delete assembly records - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) + || $form->dberror($query); + } + + if ( $form->{item} eq 'assembly' ) { + + if ( $form->{onhand} ) { + &adjust_inventory( $dbh, $form, $form->{id}, + $form->{onhand} * -1 ); + } + + if ( $form->{orphaned} ) { + + # delete assembly records + $query = qq| DELETE FROM assembly WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) - || $form->dberror($query); - } else { + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) + || $form->dberror($query); + } + else { - for $i (1 .. - $form->{assembly_rows} - 1) { + for $i ( 1 .. $form->{assembly_rows} - 1 ) { - # update BOM, A only - for (qw(bom adj)) { - $form->{"${_}_$i"} - *= 1; - } + # update BOM, A only + for (qw(bom adj)) { + $form->{"${_}_$i"} *= 1; + } - $query = qq| + $query = qq| UPDATE assembly SET bom = ?, adj = ? WHERE id = ? AND parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{"bom_$i"}, - $form->{"adj_$i"}, - $form->{id}, - $form->{"id_$i"} - )|| $form->dberror( - $query); - } - } + $sth = $dbh->prepare($query); + $sth->execute( + $form->{"bom_$i"}, $form->{"adj_$i"}, + $form->{id}, $form->{"id_$i"} + ) || $form->dberror($query); + } + } - $form->{onhand} += $form->{stock}; + $form->{onhand} += $form->{stock}; - } + } - # delete tax records - $query = qq|DELETE FROM partstax WHERE parts_id = ?|; + # delete tax records + $query = qq|DELETE FROM partstax WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id})|| $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - # delete matrix - $query = qq| + # delete matrix + $query = qq| DELETE FROM partscustomer WHERE parts_id = ?|; - - $sth = $dbh->prepare($query); - $sth->execute($form->{id})|| $form->dberror($query); - } else { - $query = qq|INSERT INTO parts (id) VALUES (?)|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id})|| $form->dberror($query); - } - - } - - - if (!$form->{id}) { - my $uid = localtime; - $uid .= "$$"; - - $query = qq|INSERT INTO parts (partnumber) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); - - $query = qq|SELECT id FROM parts WHERE partnumber = '$uid'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - ($form->{id}) = $sth->fetchrow_array; - $sth->finish; - - $form->{orphaned} = 1; - $form->{onhand} = ($form->{stock} * 1) - if $form->{item} eq 'assembly'; - } - - my $partsgroup_id; - ($null, $partsgroup_id) = split /--/, $form->{partsgroup}; - $partsgroup_id *= 1; - - $form->{partnumber} = $form->update_defaults( - $myconfig, "partnumber", $dbh) if ! $form->{partnumber}; - - if (!$form->{priceupdate}){ - $form->{priceupdate} = 'now'; - } - $query = qq| + + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } + else { + $query = qq|INSERT INTO parts (id) VALUES (?)|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } + + } + + if ( !$form->{id} ) { + my $uid = localtime; + $uid .= "$$"; + + $query = qq|INSERT INTO parts (partnumber) VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM parts WHERE partnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + ( $form->{id} ) = $sth->fetchrow_array; + $sth->finish; + + $form->{orphaned} = 1; + $form->{onhand} = ( $form->{stock} * 1 ) + if $form->{item} eq 'assembly'; + } + + my $partsgroup_id; + ( $null, $partsgroup_id ) = split /--/, $form->{partsgroup}; + $partsgroup_id *= 1; + + $form->{partnumber} = + $form->update_defaults( $myconfig, "partnumber", $dbh ) + if !$form->{partnumber}; + + if ( !$form->{priceupdate} ) { + $form->{priceupdate} = 'now'; + } + $query = qq| UPDATE parts SET partnumber = ?, description = ?, @@ -414,212 +413,205 @@ sub save { microfiche = ?, partsgroup_id = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{partnumber}, $form->{description}, $form->{makemodel}, - $form->{alternate}, $form->{assembly}, $form->{listprice}, - $form->{sellprice}, $form->{lastcost}, $form->{weight}, - $form->{priceupdate}, $form->{unit}, $form->{notes}, - $form->{rop}, $form->{bin}, $form->{inventory_accno}, - $form->{income_accno}, $form->{expense_accno}, - $form->{obsolete}, $form->{image}, $form->{drawing}, - $form->{microfiche}, $partsgroup_id, $form->{id} - ) || $form->dberror($query); - - - # insert makemodel records - if ($form->{item} =~ /(part|assembly)/) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{partnumber}, $form->{description}, + $form->{makemodel}, $form->{alternate}, + $form->{assembly}, $form->{listprice}, + $form->{sellprice}, $form->{lastcost}, + $form->{weight}, $form->{priceupdate}, + $form->{unit}, $form->{notes}, + $form->{rop}, $form->{bin}, + $form->{inventory_accno}, $form->{income_accno}, + $form->{expense_accno}, $form->{obsolete}, + $form->{image}, $form->{drawing}, + $form->{microfiche}, $partsgroup_id, + $form->{id} + ) || $form->dberror($query); + + # insert makemodel records + if ( $form->{item} =~ /(part|assembly)/ ) { + $query = qq| INSERT INTO makemodel (parts_id, make, model) VALUES (?, ?, ?)|; - $sth = $dbh->prepare($query) || $form->dberror($query); - for $i (1 .. $form->{makemodel_rows}) { - if (($form->{"make_$i"} ne "") - || ($form->{"model_$i"} ne "")) { - $sth->execute( - $form->{id}, $form->{"make_$i"}, - $form->{"model_$i"} - ) || $form->dberror($query); - } - } - } - - - # insert taxes - $query = qq| + $sth = $dbh->prepare($query) || $form->dberror($query); + for $i ( 1 .. $form->{makemodel_rows} ) { + if ( ( $form->{"make_$i"} ne "" ) + || ( $form->{"model_$i"} ne "" ) ) + { + $sth->execute( $form->{id}, $form->{"make_$i"}, + $form->{"model_$i"} ) + || $form->dberror($query); + } + } + } + + # insert taxes + $query = qq| INSERT INTO partstax (parts_id, chart_id) VALUES (?, (SELECT id FROM chart WHERE accno = ?))|; - $sth = $dbh->prepare($query); - for (split / /, $form->{taxaccounts}) { - if ($form->{"IC_tax_$_"}) { - $sth->execute($form->{id}, $_) - || $form->dberror($query); - } - } - - - @a = localtime; - $a[5] += 1900; - $a[4]++; - $a[4] = substr("0$a[4]", -2); - $a[3] = substr("0$a[3]", -2); - my $shippingdate = "$a[5]$a[4]$a[3]"; - - ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); - - # add assembly records - if ($form->{item} eq 'assembly' && !$project_id) { - - if ($form->{orphaned}) { - $query = qq| + $sth = $dbh->prepare($query); + for ( split / /, $form->{taxaccounts} ) { + if ( $form->{"IC_tax_$_"} ) { + $sth->execute( $form->{id}, $_ ) + || $form->dberror($query); + } + } + + @a = localtime; + $a[5] += 1900; + $a[4]++; + $a[4] = substr( "0$a[4]", -2 ); + $a[3] = substr( "0$a[3]", -2 ); + my $shippingdate = "$a[5]$a[4]$a[3]"; + + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + + # add assembly records + if ( $form->{item} eq 'assembly' && !$project_id ) { + + if ( $form->{orphaned} ) { + $query = qq| INSERT INTO assembly (id, parts_id, qty, bom, adj) VALUES (?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - for $i (1 .. $form->{assembly_rows}) { - $form->{"qty_$i"} = $form->parse_amount( - $myconfig, $form->{"qty_$i"}); - if(!$form->{"bom_$i"}){ + $sth = $dbh->prepare($query); + for $i ( 1 .. $form->{assembly_rows} ) { + $form->{"qty_$i"} = + $form->parse_amount( $myconfig, $form->{"qty_$i"} ); + if ( !$form->{"bom_$i"} ) { $form->{"bom_$i"} = undef; } - - if ($form->{"id_$i"} && $form->{"qty_$i"}){ - $sth->execute( - $form->{id}, $form->{"id_$i"}, - $form->{"qty_$i"}, $form->{"bom_$i"}, - $form->{"adj_$i"} - ) || $form->dberror($query); + + if ( $form->{"id_$i"} && $form->{"qty_$i"} ) { + $sth->execute( + $form->{id}, $form->{"id_$i"}, + $form->{"qty_$i"}, $form->{"bom_$i"}, + $form->{"adj_$i"} + ) || $form->dberror($query); + } + } + } + + # adjust onhand for the parts + if ( $form->{onhand} ) { + &adjust_inventory( $dbh, $form, $form->{id}, $form->{onhand} ); + } + } + + # add vendors + if ( $form->{item} ne 'assembly' ) { + $updparts{ $form->{id} } = 1; + + for $i ( 1 .. $form->{vendor_rows} ) { + if ( ( $form->{"vendor_$i"} ne "" ) + && $form->{"lastcost_$i"} ) + { + + ( $null, $vendor_id ) = split /--/, $form->{"vendor_$i"}; + + for (qw(lastcost leadtime)) { + $form->{"${_}_$i"} = + $form->parse_amount( $myconfig, $form->{"${_}_$i"} ); } - } - } - # adjust onhand for the parts - if ($form->{onhand}) { - &adjust_inventory( - $dbh, $form, $form->{id}, $form->{onhand}); - } - } - - - # add vendors - if ($form->{item} ne 'assembly') { - $updparts{$form->{id}} = 1; - - for $i (1 .. $form->{vendor_rows}) { - if (($form->{"vendor_$i"} ne "") - && $form->{"lastcost_$i"}) { - - ($null, $vendor_id) - = split /--/, $form->{"vendor_$i"}; - - for (qw(lastcost leadtime)) { - $form->{"${_}_$i"} - = $form->parse_amount( - $myconfig, - $form->{"${_}_$i"}); - } - - $query = qq| + + $query = qq| INSERT INTO partsvendor (vendor_id, parts_id, partnumber, lastcost, leadtime, curr) VALUES (?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $vendor_id, $form->{id}, - $form->{"partnumber_$i"}, - $form->{"lastcost_$i"}, - $form->{"leadtime_$i"}, - $form->{"vendorcurr_$i"} - )|| $form->dberror($query); - } - } - } - - - # add pricematrix - for $i (1 .. $form->{customer_rows}) { - - for (qw(pricebreak customerprice)) { - $form->{"${_}_$i"} = $form->parse_amount( - $myconfig, $form->{"${_}_$i"}); - } - - if ($form->{"customerprice_$i"}) { - - ($null, $customer_id) - = split /--/, $form->{"customer_$i"}; - $customer_id *= 1; - - ($null, $pricegroup_id) - = split /--/, $form->{"pricegroup_$i"}; - - my $validfrom; - my $validto; - $validfrom = $form->{"validfrom_$i"} if $form->{"validfrom_$i"}; - $validto = $form->{"validto_$i"} if $form->{"validto_$i"}; - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $vendor_id, $form->{id}, + $form->{"partnumber_$i"}, $form->{"lastcost_$i"}, + $form->{"leadtime_$i"}, $form->{"vendorcurr_$i"} + ) || $form->dberror($query); + } + } + } + + # add pricematrix + for $i ( 1 .. $form->{customer_rows} ) { + + for (qw(pricebreak customerprice)) { + $form->{"${_}_$i"} = + $form->parse_amount( $myconfig, $form->{"${_}_$i"} ); + } + + if ( $form->{"customerprice_$i"} ) { + + ( $null, $customer_id ) = split /--/, $form->{"customer_$i"}; + $customer_id *= 1; + + ( $null, $pricegroup_id ) = split /--/, $form->{"pricegroup_$i"}; + + my $validfrom; + my $validto; + $validfrom = $form->{"validfrom_$i"} if $form->{"validfrom_$i"}; + $validto = $form->{"validto_$i"} if $form->{"validto_$i"}; + $query = qq| INSERT INTO partscustomer (parts_id, customer_id, pricegroup_id, pricebreak, sellprice, curr, validfrom, validto) VALUES (?, ?, ?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $customer_id, $pricegroup_id, - $form->{"pricebreak_$i"}, - $form->{"customerprice_$i"}, - $form->{"customercurr_$i"}, - $validfrom, $validto - )|| $form->dberror($query); - } - } - - my $rc = $dbh->commit; - - $form->run_custom_queries('parts', 'UPDATE'); - $rc; - -} + $sth = $dbh->prepare($query); + $sth->execute( + $form->{id}, $customer_id, + $pricegroup_id, $form->{"pricebreak_$i"}, + $form->{"customerprice_$i"}, $form->{"customercurr_$i"}, + $validfrom, $validto + ) || $form->dberror($query); + } + } + my $rc = $dbh->commit; + $form->run_custom_queries( 'parts', 'UPDATE' ); + $rc; + +} sub update_assembly { - my ($dbh, $form, $id, $qty, $adj, $listprice, $sellprice, $lastcost, - $weight) = @_; - - my $formlistprice = $form->{listprice}; - my $formsellprice = $form->{sellprice}; - - if (!$adj) { - $formlistprice = $listprice; - $formsellprice = $sellprice; - } - - my $query = qq|SELECT id, qty, adj FROM assembly WHERE parts_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); - - $form->{$id} = 1; # Not sure what this is for... - # In fact, we don't seem to use it... Chris T - - while (my ($pid, $aqty, $aadj) = $sth->fetchrow_array) { - &update_assembly($dbh, $form, $pid, $aqty * $qty, $aadj, - $listprice, $sellprice, $lastcost, $weight) - if !$form->{$pid}; - } - $sth->finish; - $qty = $dbh->quote($qty); - $formlistprice = $dbh->quote($formlistprice ); - $listprice = $dbh->quote($listprice ); - $formsellprice = $dbh->quote($formsellprice ); - $formlastcost = $dbh->quote($form->{lastcost}); - $lastcost = $dbh->quote($lastcost); - $weight = $dbh->quote($weight); - $id = $dbh->quote($id); - - $query = qq| + my ( + $dbh, $form, $id, $qty, $adj, + $listprice, $sellprice, $lastcost, $weight + ) = @_; + + my $formlistprice = $form->{listprice}; + my $formsellprice = $form->{sellprice}; + + if ( !$adj ) { + $formlistprice = $listprice; + $formsellprice = $sellprice; + } + + my $query = qq|SELECT id, qty, adj FROM assembly WHERE parts_id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); + + $form->{$id} = 1; # Not sure what this is for... + # In fact, we don't seem to use it... Chris T + + while ( my ( $pid, $aqty, $aadj ) = $sth->fetchrow_array ) { + &update_assembly( + $dbh, $form, $pid, $aqty * $qty, $aadj, + $listprice, $sellprice, $lastcost, $weight + ) if !$form->{$pid}; + } + $sth->finish; + $qty = $dbh->quote($qty); + $formlistprice = $dbh->quote($formlistprice); + $listprice = $dbh->quote($listprice); + $formsellprice = $dbh->quote($formsellprice); + $formlastcost = $dbh->quote( $form->{lastcost} ); + $lastcost = $dbh->quote($lastcost); + $weight = $dbh->quote($weight); + $id = $dbh->quote($id); + + $query = qq| UPDATE parts SET listprice = listprice + $qty * ($formlistprice - $listprice), @@ -630,47 +622,43 @@ sub update_assembly { weight = weight + $qty * ($form->{weight} - $weight) WHERE id = $id|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); + + delete $form->{$id}; - delete $form->{$id}; - } +sub retrieve_assemblies { + my ( $self, $myconfig, $form ) = @_; + # connect to database + my $dbh = $form->{dbh}; -sub retrieve_assemblies { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $where = '1 = 1'; - - if ($form->{partnumber} ne "") { - my $partnumber = $dbh->quote($form->like( - lc $form->{partnumber})); - $where .= " AND lower(p.partnumber) LIKE $partnumber"; - } - - if ($form->{description} ne "") { - my $description = $dbh->($form->like(lc $form->{description})); - $where .= " AND lower(p.description) LIKE $description"; - } - $where .= qq| AND p.obsolete = '0' + my $where = '1 = 1'; + + if ( $form->{partnumber} ne "" ) { + my $partnumber = $dbh->quote( $form->like( lc $form->{partnumber} ) ); + $where .= " AND lower(p.partnumber) LIKE $partnumber"; + } + + if ( $form->{description} ne "" ) { + my $description = $dbh->( $form->like( lc $form->{description} ) ); + $where .= " AND lower(p.description) LIKE $description"; + } + $where .= qq| AND p.obsolete = '0' AND p.project_id IS NULL|; - my %ordinal = ( - 'partnumber' => 2, - 'description' => 3, - 'bin' => 4 - ); - - my @a = qw(partnumber description bin); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - - # retrieve assembly items - my $query = qq| + my %ordinal = ( + 'partnumber' => 2, + 'description' => 3, + 'bin' => 4 + ); + + my @a = qw(partnumber description bin); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + # retrieve assembly items + my $query = qq| SELECT p.id, p.partnumber, p.description, p.bin, p.onhand, p.rop FROM parts p @@ -678,338 +666,328 @@ sub retrieve_assemblies { AND p.assembly = '1' ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $query = qq| SELECT sum(p.inventory_accno_id), p.assembly FROM parts p JOIN assembly a ON (a.parts_id = p.id) WHERE a.id = ? GROUP BY p.assembly|; - my $svh = $dbh->prepare($query) || $form->dberror($query); - - my $inh; - if ($form->{checkinventory}) { - $query = qq| + my $svh = $dbh->prepare($query) || $form->dberror($query); + + my $inh; + if ( $form->{checkinventory} ) { + $query = qq| SELECT p.id, p.onhand, a.qty FROM parts p JOIN assembly a ON (a.parts_id = p.id) WHERE (p.inventory_accno_id > 0 OR p.assembly) AND p.income_accno_id > 0 AND a.id = ?|; - $inh = $dbh->prepare($query) || $form->dberror($query); - } - - my %available = (); - my %required; - my $ref; - my $aref; - my $stock; - my $howmany; - my $ok; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $svh->execute($ref->{id}); - ($ref->{inventory}, $ref->{assembly}) = $svh->fetchrow_array; - $svh->finish; - - if ($ref->{inventory} || $ref->{assembly}) { - $ok = 1; - if ($form->{checkinventory}) { - $inh->execute($ref->{id}) - || $form->dberror($query);; - $ok = 0; - %required = (); - - while ($aref - = $inh->fetchrow_hashref(NAME_lc)) { - - $available{$aref->{id}} = - (exists $available{$aref->{id}}) - ? $available{$aref->{id}} - : $aref->{onhand}; - $required{$aref->{id}} = $aref->{qty}; - - if ($available{$aref->{id}} - >= $aref->{qty}) { - - $howmany = - ($aref->{qty}) - ? int $available{ - $aref->{id}} - /$aref->{qty} - : 1; - if ($stock) { - $stock = - ($stock - > $howmany) - ? $howmany - : $stock; - } else { - $stock = $howmany; - } - $ok = 1; - - $available{$aref->{id}} - -= $aref->{qty} - * $stock; - - } else { - $ok = 0; - for (keys %required) { - $available{$_} += - $required{$_} - * $stock; - } - $stock = 0; - last; - } - } - $inh->finish; - $ref->{stock} = $stock; - - } - push @{ $form->{assembly_items} }, $ref if $ok; - } - } - $sth->finish; - - $dbh->commit; - -} + $inh = $dbh->prepare($query) || $form->dberror($query); + } + + my %available = (); + my %required; + my $ref; + my $aref; + my $stock; + my $howmany; + my $ok; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $svh->execute( $ref->{id} ); + ( $ref->{inventory}, $ref->{assembly} ) = $svh->fetchrow_array; + $svh->finish; + + if ( $ref->{inventory} || $ref->{assembly} ) { + $ok = 1; + if ( $form->{checkinventory} ) { + $inh->execute( $ref->{id} ) + || $form->dberror($query); + $ok = 0; + %required = (); + + while ( $aref = $inh->fetchrow_hashref(NAME_lc) ) { + + $available{ $aref->{id} } = + ( exists $available{ $aref->{id} } ) + ? $available{ $aref->{id} } + : $aref->{onhand}; + $required{ $aref->{id} } = $aref->{qty}; + + if ( $available{ $aref->{id} } >= $aref->{qty} ) { + + $howmany = + ( $aref->{qty} ) + ? int $available{ $aref->{id} } / $aref->{qty} + : 1; + if ($stock) { + $stock = + ( $stock > $howmany ) + ? $howmany + : $stock; + } + else { + $stock = $howmany; + } + $ok = 1; + + $available{ $aref->{id} } -= $aref->{qty} * $stock; + + } + else { + $ok = 0; + for ( keys %required ) { + $available{$_} += $required{$_} * $stock; + } + $stock = 0; + last; + } + } + $inh->finish; + $ref->{stock} = $stock; + } + push @{ $form->{assembly_items} }, $ref if $ok; + } + } + $sth->finish; + + $dbh->commit; + +} sub restock_assemblies { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; - - for my $i (1 .. $form->{rowcount}) { - $form->{"qty_$i"} = $form->parse_amount( - $myconfig, $form->{"qty_$i"}); + # connect to database + my $dbh = $form->{dbh}; - if ($form->{"qty_$i"}) { - &adjust_inventory( - $dbh, $form, $form->{"id_$i"}, - $form->{"qty_$i"}); - } - - } + for my $i ( 1 .. $form->{rowcount} ) { + $form->{"qty_$i"} = $form->parse_amount( $myconfig, $form->{"qty_$i"} ); - my $rc = $dbh->commit; + if ( $form->{"qty_$i"} ) { + &adjust_inventory( $dbh, $form, $form->{"id_$i"}, + $form->{"qty_$i"} ); + } - $rc; + } -} + my $rc = $dbh->commit; + $rc; + +} sub adjust_inventory { - # Private method. Do not commit transaction at end of function... - my ($dbh, $form, $id, $qty) = @_; - my $query = qq| + # Private method. Do not commit transaction at end of function... + my ( $dbh, $form, $id, $qty ) = @_; + + my $query = qq| SELECT p.id, p.inventory_accno_id, p.assembly, a.qty FROM parts p JOIN assembly a ON (a.parts_id = p.id) WHERE a.id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { - # is it a service item then loop - if (! $ref->{inventory_accno_id}) { - next if ! $ref->{assembly}; - } - - # adjust parts onhand - $form->update_balance( - $dbh, "parts", "onhand", qq|id = $ref->{id}|, - $qty * $ref->{qty} * -1); - } + # is it a service item then loop + if ( !$ref->{inventory_accno_id} ) { + next if !$ref->{assembly}; + } - $sth->finish; + # adjust parts onhand + $form->update_balance( + $dbh, "parts", "onhand", + qq|id = $ref->{id}|, + $qty * $ref->{qty} * -1 + ); + } - # update assembly - $form->update_balance($dbh, "parts", "onhand", qq|id = $id|, $qty); + $sth->finish; -} + # update assembly + $form->update_balance( $dbh, "parts", "onhand", qq|id = $id|, $qty ); +} sub delete { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $query; - - $query = qq|DELETE FROM parts WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM partstax WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - - if ($form->{item} ne 'assembly') { - $query = qq|DELETE FROM partsvendor WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - } - - # check if it is a part, assembly or service - if ($form->{item} ne 'service') { - $query = qq|DELETE FROM makemodel WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - } - - if ($form->{item} eq 'assembly') { - $query = qq|DELETE FROM assembly WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - } - - - $query = qq|DELETE FROM inventory WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM partscustomer WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM translation WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - # commit - my $rc = $dbh->commit; - - $rc; - -} + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $query; + + $query = qq|DELETE FROM parts WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM partstax WHERE parts_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + if ( $form->{item} ne 'assembly' ) { + $query = qq|DELETE FROM partsvendor WHERE parts_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } + + # check if it is a part, assembly or service + if ( $form->{item} ne 'service' ) { + $query = qq|DELETE FROM makemodel WHERE parts_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } + + if ( $form->{item} eq 'assembly' ) { + $query = qq|DELETE FROM assembly WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } + $query = qq|DELETE FROM inventory WHERE parts_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM partscustomer WHERE parts_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM translation WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + # commit + my $rc = $dbh->commit; + + $rc; + +} sub assembly_item { - my ($self, $myconfig, $form) = @_; - my $dbh = $form->{dbh}; - - my $i = $form->{assembly_rows}; - my $var; - my $null; - my $where = "p.obsolete = '0'"; - - if ($form->{"partnumber_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"partnumber_$i"})); - $where .= " AND lower(p.partnumber) LIKE $var"; - } - if ($form->{"description_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"description_$i"})); - $where .= " AND lower(p.description) LIKE $var"; - } - if ($form->{"partsgroup_$i"} ne "") { - ($null, $var) = split /--/, $form->{"partsgroup_$i"}; - $var = $dbh->quote($var); - $where .= qq| AND p.partsgroup_id = $var|; - } - - if ($form->{id}) { - $where .= " AND p.id != ".$dbh->quote($form->{id}); - } - - if ($form->{"description_$i"} ne "") { - $where .= " ORDER BY p.description"; - } else { - $where .= " ORDER BY p.partnumber"; - } - - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + my $dbh = $form->{dbh}; + + my $i = $form->{assembly_rows}; + my $var; + my $null; + my $where = "p.obsolete = '0'"; + + if ( $form->{"partnumber_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"partnumber_$i"} ) ); + $where .= " AND lower(p.partnumber) LIKE $var"; + } + if ( $form->{"description_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"description_$i"} ) ); + $where .= " AND lower(p.description) LIKE $var"; + } + if ( $form->{"partsgroup_$i"} ne "" ) { + ( $null, $var ) = split /--/, $form->{"partsgroup_$i"}; + $var = $dbh->quote($var); + $where .= qq| AND p.partsgroup_id = $var|; + } + + if ( $form->{id} ) { + $where .= " AND p.id != " . $dbh->quote( $form->{id} ); + } + + if ( $form->{"description_$i"} ne "" ) { + $where .= " ORDER BY p.description"; + } + else { + $where .= " ORDER BY p.partnumber"; + } + + my $query = qq| SELECT p.id, p.partnumber, p.description, p.sellprice, p.weight, p.onhand, p.unit, p.lastcost, pg.partsgroup, p.partsgroup_id FROM parts p LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) WHERE $where|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{item_list} }, $ref; - } - - $sth->finish; - -} + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{item_list} }, $ref; + } + + $sth->finish; +} sub all_parts { - my ($self, $myconfig, $form) = @_; - - $dbh = $form->{dbh}; - my $where = '1 = 1'; - my $null; - my $var; - my $ref; - - for (qw(partnumber drawing microfiche)) { - if ($form->{$_} ne "") { - $var = $dbh->quote($form->like(lc $form->{$_})); - $where .= " AND lower(p.$_) LIKE $var"; - } - } - # special case for description - if ($form->{description} ne "") { - unless ($form->{bought} || $form->{sold} || $form->{onorder} - || $form->{ordered} || $form->{rfq} || $form->{quoted} - ) { - - $var = $dbh->quote($form->like( - lc $form->{description})); - $where .= " AND lower(p.description) LIKE $var"; - } - } - - # assembly components - my $assemblyflds; - if ($form->{searchitems} eq 'component') { - $assemblyflds = qq|, p1.partnumber AS assemblypartnumber, + my ( $self, $myconfig, $form ) = @_; + + $dbh = $form->{dbh}; + my $where = '1 = 1'; + my $null; + my $var; + my $ref; + + for (qw(partnumber drawing microfiche)) { + if ( $form->{$_} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{$_} ) ); + $where .= " AND lower(p.$_) LIKE $var"; + } + } + + # special case for description + if ( $form->{description} ne "" ) { + unless ( $form->{bought} + || $form->{sold} + || $form->{onorder} + || $form->{ordered} + || $form->{rfq} + || $form->{quoted} ) + { + + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= " AND lower(p.description) LIKE $var"; + } + } + + # assembly components + my $assemblyflds; + if ( $form->{searchitems} eq 'component' ) { + $assemblyflds = qq|, p1.partnumber AS assemblypartnumber, a.id AS assembly_id|; - } - - # special case for serialnumber - if ($form->{l_serialnumber}) { - if ($form->{serialnumber} ne "") { - $var = $dbh->quote( - $form->like(lc $form->{serialnumber})); - $where .= " AND lower(i.serialnumber) LIKE $var"; - } - } - - if (($form->{warehouse} ne "") || $form->{l_warehouse}) { - $form->{l_warehouse} = 1; - } - - if ($form->{searchitems} eq 'part') { - $where .= " AND p.inventory_accno_id > 0 AND p.income_accno_id > 0"; - } - if ($form->{searchitems} eq 'assembly') { - $form->{bought} = ""; - $where .= " AND p.assembly = '1'"; - } - if ($form->{searchitems} eq 'service') { - $where .= " AND p.assembly = '0' AND p.inventory_accno_id IS NULL"; - } - if ($form->{searchitems} eq 'labor') { - $where .= " AND p.inventory_accno_id > 0 AND p.income_accno_id IS NULL"; - } - - # items which were never bought, sold or on an order - if ($form->{itemstatus} eq 'orphaned') { - $where .= qq| + } + + # special case for serialnumber + if ( $form->{l_serialnumber} ) { + if ( $form->{serialnumber} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{serialnumber} ) ); + $where .= " AND lower(i.serialnumber) LIKE $var"; + } + } + + if ( ( $form->{warehouse} ne "" ) || $form->{l_warehouse} ) { + $form->{l_warehouse} = 1; + } + + if ( $form->{searchitems} eq 'part' ) { + $where .= " AND p.inventory_accno_id > 0 AND p.income_accno_id > 0"; + } + if ( $form->{searchitems} eq 'assembly' ) { + $form->{bought} = ""; + $where .= " AND p.assembly = '1'"; + } + if ( $form->{searchitems} eq 'service' ) { + $where .= " AND p.assembly = '0' AND p.inventory_accno_id IS NULL"; + } + if ( $form->{searchitems} eq 'labor' ) { + $where .= " AND p.inventory_accno_id > 0 AND p.income_accno_id IS NULL"; + } + + # items which were never bought, sold or on an order + if ( $form->{itemstatus} eq 'orphaned' ) { + $where .= qq| AND p.onhand = 0 AND p.id NOT IN (SELECT p.id FROM parts p JOIN invoice i @@ -1023,65 +1001,67 @@ sub all_parts { AND p.id NOT IN (SELECT p.id FROM parts p JOIN jcitems j ON (p.id = j.parts_id))|; - } - - if ($form->{itemstatus} eq 'active') { - $where .= " AND p.obsolete = '0'"; - } - if ($form->{itemstatus} eq 'obsolete') { - $where .= " AND p.obsolete = '1'"; - } - if ($form->{itemstatus} eq 'onhand') { - $where .= " AND p.onhand > 0"; - } - if ($form->{itemstatus} eq 'short') { - $where .= " AND p.onhand < p.rop"; - } - - my $makemodelflds = qq|, '', ''|;; - my $makemodeljoin; - - if (($form->{make} ne "") || $form->{l_make} || ($form->{model} ne "") - || $form->{l_model}) { - $makemodelflds = qq|, m.make, m.model|; - $makemodeljoin = qq|LEFT JOIN makemodel m ON (m.parts_id = p.id)|; - - if ($form->{make} ne "") { - $var = $dbh->quote($form->like(lc $form->{make})); - $where .= " AND lower(m.make) LIKE $var"; - } - if ($form->{model} ne "") { - $var = $dbh->quote($form->like(lc $form->{model})); - $where .= " AND lower(m.model) LIKE $var"; - } - } - if ($form->{partsgroup} ne "") { - ($null, $var) = split /--/, $form->{partsgroup}; - $where .= qq| AND p.partsgroup_id = | . $dbh->quote($var); - } - - - my %ordinal = ( - 'partnumber' => 2, - 'description' => 3, - 'bin' => 6, - 'priceupdate' => 13, - 'drawing' => 15, - 'microfiche' => 16, - 'partsgroup' => 18, - 'make' => 21, - 'model' => 22, - 'assemblypartnumber' => 23 - ); - - my @a = qw(partnumber description); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $query = qq|SELECT value FROM defaults WHERE setting_key = 'curr'|; - my ($curr) = $dbh->selectrow_array($query); - $curr =~ s/:.*//; - $curr = $dbh->quote($curr); - my $flds = qq| + } + + if ( $form->{itemstatus} eq 'active' ) { + $where .= " AND p.obsolete = '0'"; + } + if ( $form->{itemstatus} eq 'obsolete' ) { + $where .= " AND p.obsolete = '1'"; + } + if ( $form->{itemstatus} eq 'onhand' ) { + $where .= " AND p.onhand > 0"; + } + if ( $form->{itemstatus} eq 'short' ) { + $where .= " AND p.onhand < p.rop"; + } + + my $makemodelflds = qq|, '', ''|; + my $makemodeljoin; + + if ( ( $form->{make} ne "" ) + || $form->{l_make} + || ( $form->{model} ne "" ) + || $form->{l_model} ) + { + $makemodelflds = qq|, m.make, m.model|; + $makemodeljoin = qq|LEFT JOIN makemodel m ON (m.parts_id = p.id)|; + + if ( $form->{make} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{make} ) ); + $where .= " AND lower(m.make) LIKE $var"; + } + if ( $form->{model} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{model} ) ); + $where .= " AND lower(m.model) LIKE $var"; + } + } + if ( $form->{partsgroup} ne "" ) { + ( $null, $var ) = split /--/, $form->{partsgroup}; + $where .= qq| AND p.partsgroup_id = | . $dbh->quote($var); + } + + my %ordinal = ( + 'partnumber' => 2, + 'description' => 3, + 'bin' => 6, + 'priceupdate' => 13, + 'drawing' => 15, + 'microfiche' => 16, + 'partsgroup' => 18, + 'make' => 21, + 'model' => 22, + 'assemblypartnumber' => 23 + ); + + my @a = qw(partnumber description); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $query = qq|SELECT value FROM defaults WHERE setting_key = 'curr'|; + my ($curr) = $dbh->selectrow_array($query); + $curr =~ s/:.*//; + $curr = $dbh->quote($curr); + my $flds = qq| p.id, p.partnumber, p.description, p.onhand, p.unit, p.bin, p.sellprice, p.listprice, p.lastcost, p.rop, p.avgcost, @@ -1092,7 +1072,7 @@ sub all_parts { $makemodelflds $assemblyflds |; - $query = qq| + $query = qq| SELECT $flds FROM parts p LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) @@ -1103,12 +1083,12 @@ sub all_parts { WHERE $where ORDER BY $sortorder|; - # redo query for components report - if ($form->{searchitems} eq 'component') { - - $flds =~ s/p.onhand/a.qty AS onhand/; - - $query = qq| + # redo query for components report + if ( $form->{searchitems} eq 'component' ) { + + $flds =~ s/p.onhand/a.qty AS onhand/; + + $query = qq| SELECT $flds FROM assembly a JOIN parts p ON (a.parts_id = p.id) @@ -1120,91 +1100,92 @@ sub all_parts { $makemodeljoin WHERE $where ORDER BY $sortorder|; - } - - - # rebuild query for bought and sold items - if ($form->{bought} || $form->{sold} || $form->{onorder} - || $form->{ordered} || $form->{rfq} || $form->{quoted} - ) { - - $form->sort_order(); - @a = qw(partnumber description curr employee name - serialnumber id); - push @a, "invnumber" if ($form->{bought} || $form->{sold}); - push @a, "ordnumber" if ($form->{onorder} || $form->{ordered}); - push @a, "quonumber" if ($form->{rfq} || $form->{quoted}); - - %ordinal = ( - 'partnumber' => 2, - 'description' => 3, - 'serialnumber' => 4, - 'bin' => 7, - 'priceupdate' => 14, - 'partsgroup' => 19, - 'invnumber' => 20, - 'ordnumber' => 21, - 'quonumber' => 22, - 'name' => 24, - 'employee' => 25, - 'curr' => 26, - 'make' => 29, - 'model' => 30 - ); - - $sortorder = $form->sort_order(\@a, \%ordinal); - - my $union = ""; - $query = ""; - - if ($form->{bought} || $form->{sold}) { - - my $invwhere = "$where"; - my $transdate = - ($form->{method} eq 'accrual') - ? "transdate" - : "datepaid"; - - $invwhere .= " AND i.assemblyitem = '0'"; - $invwhere .= " AND a.$transdate >= " . - $dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $invwhere .= " AND a.$transdate <= " . - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; - - if ($form->{description} ne "") { - $var = dbh->quote( - $form->like(lc $form->{description})); - $invwhere .= - " AND lower(i.description) LIKE $var"; - } - - if ($form->{open} || $form->{closed}) { - if ($form->{open} && $form->{closed}) { - if ($form->{method} eq 'cash') { - $invwhere .= - " AND a.amount = a.paid"; - } - } else { - if ($form->{open}) { - if ($form->{method} eq 'cash') { - $invwhere .= - " AND a.id = 0"; - } else { - $invwhere .= - " AND NOT a.amount = a.paid"; - } - } else { - $invwhere .= - " AND a.amount = a.paid"; - } - } - } else { - $invwhere .= " AND a.id = 0"; - } - - my $flds = qq| + } + + # rebuild query for bought and sold items + if ( $form->{bought} + || $form->{sold} + || $form->{onorder} + || $form->{ordered} + || $form->{rfq} + || $form->{quoted} ) + { + + $form->sort_order(); + @a = qw(partnumber description curr employee name + serialnumber id); + push @a, "invnumber" if ( $form->{bought} || $form->{sold} ); + push @a, "ordnumber" if ( $form->{onorder} || $form->{ordered} ); + push @a, "quonumber" if ( $form->{rfq} || $form->{quoted} ); + + %ordinal = ( + 'partnumber' => 2, + 'description' => 3, + 'serialnumber' => 4, + 'bin' => 7, + 'priceupdate' => 14, + 'partsgroup' => 19, + 'invnumber' => 20, + 'ordnumber' => 21, + 'quonumber' => 22, + 'name' => 24, + 'employee' => 25, + 'curr' => 26, + 'make' => 29, + 'model' => 30 + ); + + $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $union = ""; + $query = ""; + + if ( $form->{bought} || $form->{sold} ) { + + my $invwhere = "$where"; + my $transdate = + ( $form->{method} eq 'accrual' ) + ? "transdate" + : "datepaid"; + + $invwhere .= " AND i.assemblyitem = '0'"; + $invwhere .= + " AND a.$transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $invwhere .= + " AND a.$transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; + + if ( $form->{description} ne "" ) { + $var = dbh->quote( $form->like( lc $form->{description} ) ); + $invwhere .= " AND lower(i.description) LIKE $var"; + } + + if ( $form->{open} || $form->{closed} ) { + if ( $form->{open} && $form->{closed} ) { + if ( $form->{method} eq 'cash' ) { + $invwhere .= " AND a.amount = a.paid"; + } + } + else { + if ( $form->{open} ) { + if ( $form->{method} eq 'cash' ) { + $invwhere .= " AND a.id = 0"; + } + else { + $invwhere .= " AND NOT a.amount = a.paid"; + } + } + else { + $invwhere .= " AND a.amount = a.paid"; + } + } + } + else { + $invwhere .= " AND a.id = 0"; + } + + my $flds = qq| p.id, p.partnumber, i.description, i.serialnumber, i.qty AS onhand, i.unit, p.bin, i.sellprice, p.listprice, p.lastcost, p.rop, @@ -1215,13 +1196,11 @@ sub all_parts { e.name AS employee, a.curr, a.till, p.notes $makemodelfld|; + if ( $form->{bought} ) { + my $rflds = $flds; + $rflds =~ s/i.qty AS onhand/i.qty * -1 AS onhand/; - if ($form->{bought}) { - my $rflds = $flds; - $rflds =~ - s/i.qty AS onhand/i.qty * -1 AS onhand/; - - $query = qq| + $query = qq| SELECT $rflds, 'ir' AS module, '' AS type, (SELECT sell @@ -1242,12 +1221,12 @@ sub all_parts { ON (a.employee_id = e.id) $makemodeljoin WHERE $invwhere|; - $union = " + $union = " UNION ALL"; - } + } - if ($form->{sold}) { - $query .= qq| + if ( $form->{sold} ) { + $query .= qq| $union SELECT $flds, 'is' AS module, '' AS type, @@ -1269,39 +1248,39 @@ sub all_parts { ON (a.employee_id = e.id) $makemodeljoin WHERE $invwhere|; - $union = " + $union = " UNION ALL"; - } - } + } + } - if ($form->{onorder} || $form->{ordered}) { - my $ordwhere = "$where + if ( $form->{onorder} || $form->{ordered} ) { + my $ordwhere = "$where AND a.quotation = '0'"; - $ordwhere .= " AND a.transdate >= ". - $dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $ordwhere .= " AND a.transdate <= ". - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; - - if ($form->{description} ne "") { - $var = $dbh->quote( - $form->like(lc $form->{description})); - $ordwhere .= " AND lower(i.description) LIKE $var"; - } - - if ($form->{open} || $form->{closed}) { - unless ($form->{open} && $form->{closed}) { - $ordwhere .= " AND a.closed = '0'" - if $form->{open}; - $ordwhere .= " AND a.closed = '1'" - if $form->{closed}; - } - } else { - $ordwhere .= " AND a.id = 0"; - } - - $flds = qq| + $ordwhere .= + " AND a.transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $ordwhere .= + " AND a.transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; + + if ( $form->{description} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $ordwhere .= " AND lower(i.description) LIKE $var"; + } + + if ( $form->{open} || $form->{closed} ) { + unless ( $form->{open} && $form->{closed} ) { + $ordwhere .= " AND a.closed = '0'" + if $form->{open}; + $ordwhere .= " AND a.closed = '1'" + if $form->{closed}; + } + } + else { + $ordwhere .= " AND a.id = 0"; + } + + $flds = qq| p.id, p.partnumber, i.description, i.serialnumber, i.qty AS onhand, i.unit, p.bin, i.sellprice, p.listprice, p.lastcost, p.rop, @@ -1313,8 +1292,8 @@ sub all_parts { p.notes $makemodelfld|; - if ($form->{ordered}) { - $query .= qq| + if ( $form->{ordered} ) { + $query .= qq| $union SELECT $flds, 'oe' AS module, 'sales_order' AS type, @@ -1336,12 +1315,12 @@ sub all_parts { $makemodeljoin WHERE $ordwhere AND a.customer_id > 0|; - $union = " + $union = " UNION ALL"; - } - - if ($form->{onorder}) { - $flds = qq| + } + + if ( $form->{onorder} ) { + $flds = qq| p.id, p.partnumber, i.description, i.serialnumber, i.qty AS onhand, i.unit, p.bin, i.sellprice, p.listprice, @@ -1353,8 +1332,8 @@ sub all_parts { i.trans_id, ct.name,e.name AS employee, a.curr, '0' AS till, p.notes $makemodelfld|; - - $query .= qq| + + $query .= qq| $union SELECT $flds, 'oe' AS module, 'purchase_order' AS type, @@ -1376,39 +1355,38 @@ sub all_parts { $makemodeljoin WHERE $ordwhere AND a.vendor_id > 0|; - } - - } - - if ($form->{rfq} || $form->{quoted}) { - my $quowhere = "$where + } + + } + + if ( $form->{rfq} || $form->{quoted} ) { + my $quowhere = "$where AND a.quotation = '1'"; - $quowhere .= " AND a.transdate >= ". - $dbh->quote($form->{transdatefrom}) - if $form->{transdatefrom}; - $quowhere .= " AND a.transdate <= ". - $dbh->quote($form->{transdateto}) - if $form->{transdateto}; - - if ($form->{description} ne "") { - $var = $dbh->quote( - $form->like(lc $form->{description})); - $quowhere .= " AND lower(i.description) LIKE $var"; - } - - if ($form->{open} || $form->{closed}) { - unless ($form->{open} && $form->{closed}) { - $ordwhere .= " AND a.closed = '0'" - if $form->{open}; - $ordwhere .= " AND a.closed = '1'" - if $form->{closed}; - } - } else { - $ordwhere .= " AND a.id = 0"; - } - - - $flds = qq| + $quowhere .= + " AND a.transdate >= " . $dbh->quote( $form->{transdatefrom} ) + if $form->{transdatefrom}; + $quowhere .= + " AND a.transdate <= " . $dbh->quote( $form->{transdateto} ) + if $form->{transdateto}; + + if ( $form->{description} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $quowhere .= " AND lower(i.description) LIKE $var"; + } + + if ( $form->{open} || $form->{closed} ) { + unless ( $form->{open} && $form->{closed} ) { + $ordwhere .= " AND a.closed = '0'" + if $form->{open}; + $ordwhere .= " AND a.closed = '1'" + if $form->{closed}; + } + } + else { + $ordwhere .= " AND a.id = 0"; + } + + $flds = qq| p.id, p.partnumber, i.description, i.serialnumber, i.qty AS onhand, i.unit, p.bin, i.sellprice, p.listprice, p.lastcost, p.rop, @@ -1419,8 +1397,8 @@ sub all_parts { e.name AS employee, a.curr, '0' AS till, p.notes $makemodelfld|; - if ($form->{quoted}) { - $query .= qq| + if ( $form->{quoted} ) { + $query .= qq| $union SELECT $flds, 'oe' AS module, 'sales_quotation' AS type, @@ -1443,12 +1421,12 @@ sub all_parts { $makemodeljoin WHERE $quowhere AND a.customer_id > 0|; - $union = " + $union = " UNION ALL"; - } - - if ($form->{rfq}) { - $flds = qq| + } + + if ( $form->{rfq} ) { + $flds = qq| p.id, p.partnumber, i.description, i.serialnumber, i.qty AS onhand, i.unit, p.bin, i.sellprice, p.listprice, @@ -1461,7 +1439,7 @@ sub all_parts { a.curr, '0' AS till, p.notes $makemodelfld|; - $query .= qq| + $query .= qq| $union SELECT $flds, 'oe' AS module, 'request_quotation' AS type, @@ -1483,44 +1461,44 @@ sub all_parts { $makemodeljoin WHERE $quowhere AND a.vendor_id > 0|; - } + } - } + } - $query .= qq| + $query .= qq| ORDER BY $sortorder|; - } + } - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - $query = qq| + $query = qq| SELECT c.accno FROM chart c JOIN partstax pt ON (pt.chart_id = c.id) WHERE pt.parts_id = ? ORDER BY accno|; - my $pth = $dbh->prepare($query) || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $pth->execute($ref->{id}); - while (($accno) = $pth->fetchrow_array) { - $ref->{tax} .= "$accno "; - } - $pth->finish; - - push @{ $form->{parts} }, $ref; - } - $sth->finish; - - @a = (); - - # include individual items for assembly - if (($form->{searchitems} eq 'assembly') && $form->{individual}) { - - if ($form->{sold} || $form->{ordered} || $form->{quoted}) { - $flds = qq| + my $pth = $dbh->prepare($query) || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $pth->execute( $ref->{id} ); + while ( ($accno) = $pth->fetchrow_array ) { + $ref->{tax} .= "$accno "; + } + $pth->finish; + + push @{ $form->{parts} }, $ref; + } + $sth->finish; + + @a = (); + + # include individual items for assembly + if ( ( $form->{searchitems} eq 'assembly' ) && $form->{individual} ) { + + if ( $form->{sold} || $form->{ordered} || $form->{quoted} ) { + $flds = qq| p.id, p.partnumber, p.description, p.onhand AS perassembly, p.unit, p.bin, p.sellprice, p.listprice, p.lastcost, p.rop, @@ -1528,108 +1506,111 @@ sub all_parts { p.drawing, p.microfiche, p.assembly, pg.partsgroup, p.notes $makemodelflds $assemblyflds |; - } else { - # replace p.onhand with a.qty AS onhand - $flds =~ s/p\.onhand/a.qty AS perassembly/; - } - - for (@{ $form->{parts} }) { - push @a, $_; - $_->{perassembly} = 1; - $flds =~ s/p\.onhand*AS perassembly/p\.onhand, a\.qty AS perassembly/; - push @a, &include_assembly( - $dbh, $myconfig, $form, $_->{id}, $flds, - $makemodeljoin); - push @a, {id => $_->{id}, assemblyitem => 1}; - } - - # copy assemblies to $form->{parts} - @{ $form->{parts} } = @a; - - } - - - @a = (); - if (($form->{warehouse} ne "") || $form->{l_warehouse}) { - - if ($form->{warehouse} ne "") { - my ($desc, $var) = split /--/, $form->{warehouse}; - $var = $dbh->quote($var); - $desc = $dbh->quote($desc); - $query = qq| + } + else { + + # replace p.onhand with a.qty AS onhand + $flds =~ s/p\.onhand/a.qty AS perassembly/; + } + + for ( @{ $form->{parts} } ) { + push @a, $_; + $_->{perassembly} = 1; + $flds =~ + s/p\.onhand*AS perassembly/p\.onhand, a\.qty AS perassembly/; + push @a, + &include_assembly( $dbh, $myconfig, $form, $_->{id}, $flds, + $makemodeljoin ); + push @a, { id => $_->{id}, assemblyitem => 1 }; + } + + # copy assemblies to $form->{parts} + @{ $form->{parts} } = @a; + + } + + @a = (); + if ( ( $form->{warehouse} ne "" ) || $form->{l_warehouse} ) { + + if ( $form->{warehouse} ne "" ) { + my ( $desc, $var ) = split /--/, $form->{warehouse}; + $var = $dbh->quote($var); + $desc = $dbh->quote($desc); + $query = qq| SELECT SUM(qty) AS onhand, $desc AS description FROM inventory WHERE warehouse_id = $var AND parts_id = ?|; - } else { - $query = qq| + } + else { + $query = qq| SELECT SUM(i.qty) AS onhand, w.description AS warehouse FROM inventory i JOIN warehouse w ON (w.id = i.warehouse_id) WHERE i.parts_id = ? GROUP BY w.description|; - } + } - $sth = $dbh->prepare($query) || $form->dberror($query); + $sth = $dbh->prepare($query) || $form->dberror($query); - for (@{ $form->{parts} }) { + for ( @{ $form->{parts} } ) { - $sth->execute($_->{id}) || $form->dberror($query); - - if ($form->{warehouse} ne "") { - - $ref = $sth->fetchrow_hashref(NAME_lc); - if ($ref->{onhand} != 0) { - $_->{onhand} = $ref->{onhand}; - push @a, $_; - } + $sth->execute( $_->{id} ) || $form->dberror($query); - } else { + if ( $form->{warehouse} ne "" ) { - push @a, $_; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - if ($ref->{onhand} > 0) { - push @a, $ref; - } - } - } - - $sth->finish; - } + $ref = $sth->fetchrow_hashref(NAME_lc); + if ( $ref->{onhand} != 0 ) { + $_->{onhand} = $ref->{onhand}; + push @a, $_; + } - @{ $form->{parts} } = @a; + } + else { - } + push @a, $_; - $dbh->commit; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + if ( $ref->{onhand} > 0 ) { + push @a, $ref; + } + } + } -} + $sth->finish; + } + + @{ $form->{parts} } = @a; + + } + + $dbh->commit; +} sub include_assembly { - my ($dbh, $myconfig, $form, $id, $flds, $makemodeljoin) = @_; - - $form->{stagger}++; - if ($form->{stagger} > $form->{pncol}) { - $form->{pncol} = $form->{stagger}; - } - - $form->{$id} = 1; - - - my @a = qw(partnumber description bin); - if ($form->{sort} eq 'partnumber') { - $sortorder = "TRUE"; - } else { - @a = grep !/$form->{sort}/, @a; - $sortorder = "$form->{sort} $form->{direction}, ". join ',', @a; - } - - @a = (); - my $query = qq| + my ( $dbh, $myconfig, $form, $id, $flds, $makemodeljoin ) = @_; + + $form->{stagger}++; + if ( $form->{stagger} > $form->{pncol} ) { + $form->{pncol} = $form->{stagger}; + } + + $form->{$id} = 1; + + my @a = qw(partnumber description bin); + if ( $form->{sort} eq 'partnumber' ) { + $sortorder = "TRUE"; + } + else { + @a = grep !/$form->{sort}/, @a; + $sortorder = "$form->{sort} $form->{direction}, " . join ',', @a; + } + + @a = (); + my $query = qq| SELECT $flds FROM parts p JOIN assembly a ON (a.parts_id = p.id) @@ -1640,69 +1621,68 @@ sub include_assembly { $makemodeljoin WHERE a.id = ? ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{assemblyitem} = 1; - $ref->{stagger} = $form->{stagger}; - - push @a, $ref; - if ($ref->{assembly} && !$form->{$ref->{id}}) { - push @a, &include_assembly( - $dbh, $myconfig, $form, $ref->{id}, $flds, - $makemodeljoin); - if ($form->{stagger} > $form->{pncol}) { - $form->{pncol} = $form->{stagger}; - } - } - } - $sth->finish; - - $form->{$id} = 0; - $form->{stagger}--; - - @a; + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{assemblyitem} = 1; + $ref->{stagger} = $form->{stagger}; + + push @a, $ref; + if ( $ref->{assembly} && !$form->{ $ref->{id} } ) { + push @a, + &include_assembly( $dbh, $myconfig, $form, $ref->{id}, $flds, + $makemodeljoin ); + if ( $form->{stagger} > $form->{pncol} ) { + $form->{pncol} = $form->{stagger}; + } + } + } + $sth->finish; + + $form->{$id} = 0; + $form->{stagger}--; + + @a; } - sub requirements { - my ($self, $myconfig, $form) = @_; - my $dbh = $form->{dbh}; - - my $null; - my $var; - my $ref; - - my $where = qq|p.obsolete = '0'|; - my $dwhere; - - for (qw(partnumber description)) { - if ($form->{$_} ne "") { - $var = $dbh->quote($form->like(lc $form->{$_})); - $where .= qq| AND lower(p.$_) LIKE $var|; - } - } - - if ($form->{partsgroup} ne "") { - ($null, $var) = split /--/, $form->{partsgroup}; - $var = $dbh->quote($var); - $where .= qq| AND p.partsgroup_id = $var|; - } - - # connect to database - - my ($transdatefrom, $transdateto); - if ($form->{year}) { - ($transdatefrom, $transdateto) - = $form->from_to($form->{year}, '01', 12); - - $dwhere = qq| AND a.transdate >= '$transdatefrom' + my ( $self, $myconfig, $form ) = @_; + my $dbh = $form->{dbh}; + + my $null; + my $var; + my $ref; + + my $where = qq|p.obsolete = '0'|; + my $dwhere; + + for (qw(partnumber description)) { + if ( $form->{$_} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{$_} ) ); + $where .= qq| AND lower(p.$_) LIKE $var|; + } + } + + if ( $form->{partsgroup} ne "" ) { + ( $null, $var ) = split /--/, $form->{partsgroup}; + $var = $dbh->quote($var); + $where .= qq| AND p.partsgroup_id = $var|; + } + + # connect to database + + my ( $transdatefrom, $transdateto ); + if ( $form->{year} ) { + ( $transdatefrom, $transdateto ) = + $form->from_to( $form->{year}, '01', 12 ); + + $dwhere = qq| AND a.transdate >= '$transdatefrom' AND a.transdate <= '$transdateto'|; - } - - $query = qq| + } + + $query = qq| SELECT p.id, p.partnumber, p.description, sum(i.qty) AS qty, p.onhand, extract(MONTH FROM a.transdate) AS month, '0' AS so, '0' AS po @@ -1712,19 +1692,19 @@ sub requirements { WHERE $where $dwhere AND p.inventory_accno_id > 0 GROUP BY p.id, p.partnumber, p.description, p.onhand, extract(MONTH FROM a.transdate)|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - my %parts; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $parts{$ref->{id}} = $ref; - } - $sth->finish; - - my %ofld = ( customer => so, vendor => po ); - - for (qw(customer vendor)) { - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my %parts; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $parts{ $ref->{id} } = $ref; + } + $sth->finish; + + my %ofld = ( customer => so, vendor => po ); + + for (qw(customer vendor)) { + $query = qq| SELECT p.id, p.partnumber, p.description, sum(qty) - sum(ship) AS $ofld{$_}, p.onhand, 0 AS month @@ -1736,22 +1716,22 @@ sub requirements { AND a.${_}_id > 0 GROUP BY p.id, p.partnumber, p.description, p.onhand, month|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - if (exists $parts{$ref->{id}}->{$ofld{$_}}) { - $parts{$ref->{id}}->{$ofld{$_}} - += $ref->{$ofld{$_}}; - } else { - $parts{$ref->{id}} = $ref; - } - } - $sth->finish; - } - - # add assemblies from open sales orders - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + if ( exists $parts{ $ref->{id} }->{ $ofld{$_} } ) { + $parts{ $ref->{id} }->{ $ofld{$_} } += $ref->{ $ofld{$_} }; + } + else { + $parts{ $ref->{id} } = $ref; + } + } + $sth->finish; + } + + # add assemblies from open sales orders + $query = qq| SELECT DISTINCT a.id AS orderid, b.id, i.qty - i.ship AS qty FROM parts p JOIN assembly b ON (b.parts_id = p.id) @@ -1760,30 +1740,33 @@ sub requirements { WHERE $where AND (p.inventory_accno_id > 0 OR p.assembly = '1') AND a.closed = '0'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - &requirements_assembly( - $dbh, $form, \%parts, $ref->{id}, $ref->{qty}, $where) - if $ref->{qty}; - } - $sth->finish; - - $dbh->commit; - - for (sort { $parts{$a}->{$form->{sort}} cmp $parts{$b}->{$form->{sort}}} keys %parts) { - push @{ $form->{parts} }, $parts{$_}; - } - -} + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + &requirements_assembly( $dbh, $form, \%parts, $ref->{id}, $ref->{qty}, + $where ) + if $ref->{qty}; + } + $sth->finish; + + $dbh->commit; + + for ( + sort { $parts{$a}->{ $form->{sort} } cmp $parts{$b}->{ $form->{sort} } } + keys %parts + ) + { + push @{ $form->{parts} }, $parts{$_}; + } +} sub requirements_assembly { - my ($dbh, $form, $parts, $id, $qty, $where) = @_; + my ( $dbh, $form, $parts, $id, $qty, $where ) = @_; - # assemblies - my $query = qq| + # assemblies + my $query = qq| SELECT p.id, p.partnumber, p.description, a.qty * ? AS so, p.onhand, p.assembly, p.partsgroup_id FROM assembly a @@ -1797,110 +1780,112 @@ sub requirements_assembly { FROM assembly a JOIN parts p ON (p.id = a.parts_id) WHERE a.id = ? AND p.assembly = '1'|; - - my $sth = $dbh->prepare($query); - $sth->execute($qty, $id, $qty, $id) || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - if ($ref->{assembly}) { - &requirements_assembly( - $dbh, $form, $parts, $ref->{id}, $ref->{so}, - $where); - next; - } - - if (exists $parts->{$ref->{id}}{so}) { - $parts->{$ref->{id}}{so} += $ref->{so}; - } else { - $parts->{$ref->{id}} = $ref; - } - } - $sth->finish; - -} + my $sth = $dbh->prepare($query); + $sth->execute( $qty, $id, $qty, $id ) || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + if ( $ref->{assembly} ) { + &requirements_assembly( $dbh, $form, $parts, $ref->{id}, $ref->{so}, + $where ); + next; + } + + if ( exists $parts->{ $ref->{id} }{so} ) { + $parts->{ $ref->{id} }{so} += $ref->{so}; + } + else { + $parts->{ $ref->{id} } = $ref; + } + } + $sth->finish; + +} sub create_links { - my ($self, $module, $myconfig, $form) = @_; + my ( $self, $module, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; - # connect to database - my $dbh = $form->{dbh}; - - my $ref; + my $ref; - my $query = qq| + my $query = qq| SELECT accno, description, link FROM chart WHERE link LIKE ? ORDER BY accno|; - my $sth = $dbh->prepare($query); - $sth->execute("%$module%") || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - foreach my $key (split /:/, $ref->{link}) { - if ($key =~ /$module/) { - push @{ $form->{"${module}_links"}{$key} }, - { accno => $ref->{accno}, - description => $ref->{description} }; - } - } - } - $sth->finish; - - if ($form->{item} ne 'assembly') { - $query = qq|SELECT count(*) FROM vendor|; - my ($count) = $dbh->selectrow_array($query); - - if ($count < $myconfig->{vclimit}) { - $query = qq|SELECT id, name FROM vendor ORDER BY name|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_vendor} }, $ref; - } - $sth->finish; - } - } - - # pricegroups, customers - $query = qq|SELECT count(*) FROM customer|; - ($count) = $dbh->selectrow_array($query); - - if ($count < $myconfig->{vclimit}) { - $query = qq|SELECT id, name FROM customer ORDER BY name|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_customer} }, $ref; - } - $sth->finish; - } - - $query = qq|SELECT id, pricegroup FROM pricegroup ORDER BY pricegroup|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_pricegroup} }, $ref; - } - $sth->finish; - - - if ($form->{id}) { - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute("%$module%") || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + foreach my $key ( split /:/, $ref->{link} ) { + if ( $key =~ /$module/ ) { + push @{ $form->{"${module}_links"}{$key} }, + { + accno => $ref->{accno}, + description => $ref->{description} + }; + } + } + } + $sth->finish; + + if ( $form->{item} ne 'assembly' ) { + $query = qq|SELECT count(*) FROM vendor|; + my ($count) = $dbh->selectrow_array($query); + + if ( $count < $myconfig->{vclimit} ) { + $query = qq|SELECT id, name FROM vendor ORDER BY name|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_vendor} }, $ref; + } + $sth->finish; + } + } + + # pricegroups, customers + $query = qq|SELECT count(*) FROM customer|; + ($count) = $dbh->selectrow_array($query); + + if ( $count < $myconfig->{vclimit} ) { + $query = qq|SELECT id, name FROM customer ORDER BY name|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_customer} }, $ref; + } + $sth->finish; + } + + $query = qq|SELECT id, pricegroup FROM pricegroup ORDER BY pricegroup|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_pricegroup} }, $ref; + } + $sth->finish; + + if ( $form->{id} ) { + $query = qq| SELECT value FROM defaults WHERE setting_key = 'weightunit'|; - ($form->{weightunit}) = $dbh->selectrow_array($query); - $query = qq| + ( $form->{weightunit} ) = $dbh->selectrow_array($query); + $query = qq| SELECT value FROM defaults WHERE setting_key = 'curr'|; - ($form->{currencies}) = $dbh->selectrow_array($query); + ( $form->{currencies} ) = $dbh->selectrow_array($query); - } else { - # Dieter: FIXME left joins not working - $query = qq| + } + else { + + # Dieter: FIXME left joins not working + $query = qq| SELECT (SELECT value FROM defaults WHERE setting_key = 'weightunit') AS weightunit, current_date AS priceupdate, @@ -1920,46 +1905,45 @@ sub create_links { AND c3.id IN (SELECT value FROM defaults WHERE setting_key = 'expense_accno_id')|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - for (qw(weightunit priceupdate currencies)) { - $form->{$_} = $ref->{$_}; - } - # setup accno hash, {amount} is used in create_links - for (qw(inventory income expense)) { - $form->{amount}{"IC_$_"} - = { - accno => $ref->{"${_}_accno"}, - description => $ref->{"${_}_description"} - }; - } - - $sth->finish; - } - - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); -} + $ref = $sth->fetchrow_hashref(NAME_lc); + for (qw(weightunit priceupdate currencies)) { + $form->{$_} = $ref->{$_}; + } + # setup accno hash, {amount} is used in create_links + for (qw(inventory income expense)) { + $form->{amount}{"IC_$_"} = { + accno => $ref->{"${_}_accno"}, + description => $ref->{"${_}_description"} + }; + } + + $sth->finish; + } + + $dbh->commit; + +} sub get_warehouses { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq|SELECT id, description FROM warehouse|; + my $query = qq|SELECT id, description FROM warehouse|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_warehouse} }, $ref; - } - $sth->finish; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_warehouse} }, $ref; + } + $sth->finish; - $dbh->commit; + $dbh->commit; } diff --git a/LedgerSMB/IR.pm b/LedgerSMB/IR.pm index 87719d4d..1dab91d7 100644 --- a/LedgerSMB/IR.pm +++ b/LedgerSMB/IR.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -37,241 +37,237 @@ use LedgerSMB::PriceMatrix; use LedgerSMB::Sysconfig; use Math::BigFloat; - sub post_invoice { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - for (1 .. $form->{rowcount}){ - unless ($form->{"deliverydate_$_"}){ - $form->{"deliverydate_$_"} = $form->{transdate}; - } - - } - my $query; - my $sth; - my $ref; - my $null; - my $project_id; - my $exchangerate = 0; - my $allocated; - my $taxrate; - my $taxamount; - my $diff = 0; - my $item; - my $invoice_id; - my $keepcleared; - - ($null, $form->{employee_id}) = split /--/, $form->{employee}; - - unless ($form->{employee_id}) { - ($form->{employee}, $form->{employee_id}) - = $form->get_employee($dbh); - } - - ($null, $form->{department_id}) = split(/--/, $form->{department}); - $form->{department_id} *= 1; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + for ( 1 .. $form->{rowcount} ) { + unless ( $form->{"deliverydate_$_"} ) { + $form->{"deliverydate_$_"} = $form->{transdate}; + } + + } + my $query; + my $sth; + my $ref; + my $null; + my $project_id; + my $exchangerate = 0; + my $allocated; + my $taxrate; + my $taxamount; + my $diff = 0; + my $item; + my $invoice_id; + my $keepcleared; + + ( $null, $form->{employee_id} ) = split /--/, $form->{employee}; + + unless ( $form->{employee_id} ) { + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + } + + ( $null, $form->{department_id} ) = split( /--/, $form->{department} ); + $form->{department_id} *= 1; + + $query = qq| SELECT (SELECT value FROM defaults WHERE setting_key = 'fxgain_accno_id') AS fxgain_accno_id, (SELECT value FROM defaults WHERE setting_key = 'fxloss_accno_id') AS fxloss_accno_id|; - my ($fxgain_accno_id, $fxloss_accno_id) = $dbh->selectrow_array($query); - - $query = qq| + my ( $fxgain_accno_id, $fxloss_accno_id ) = $dbh->selectrow_array($query); + + $query = qq| SELECT inventory_accno_id, income_accno_id, expense_accno_id FROM parts WHERE id = ?|; - my $pth = $dbh->prepare($query) || $form->dberror($query); - - my %updparts = (); - - if ($form->{id}) { + my $pth = $dbh->prepare($query) || $form->dberror($query); + + my %updparts = (); + + if ( $form->{id} ) { + + my $sth; - my $sth; + $keepcleared = 1; - $keepcleared = 1; + $query = qq|SELECT id FROM ap WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); - $query = qq|SELECT id FROM ap WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - - if ($sth->fetchrow_array) { - $query = qq| + if ( $sth->fetchrow_array ) { + $query = qq| SELECT p.id, p.inventory_accno_id, p.income_accno_id FROM invoice i JOIN parts p ON (p.id = i.parts_id) WHERE i.trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref) { - if ($ref->{inventory_accno_id} - && $ref->{income_accno_id}) { - - $updparts{$ref->{id}} = 1; - } - } - $sth->finish; - - &reverse_invoice($dbh, $form); - } else { - $query = qq|INSERT INTO ap (id) VALUES (?)|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - } - } - - my $uid = localtime; - $uid .= "$$"; - - if (! $form->{id}) { - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + while ( $ref = $sth->fetchrow_hashref ) { + if ( $ref->{inventory_accno_id} + && $ref->{income_accno_id} ) + { + + $updparts{ $ref->{id} } = 1; + } + } + $sth->finish; + + &reverse_invoice( $dbh, $form ); + } + else { + $query = qq|INSERT INTO ap (id) VALUES (?)|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } + } + + my $uid = localtime; + $uid .= "$$"; + + if ( !$form->{id} ) { + + $query = qq| INSERT INTO ap (invnumber, employee_id) VALUES ('$uid', (SELECT id FROM employee - WHERE login = ?))|; - $sth = $dbh->prepare($query); - $sth->execute($form->{login}) || $form->dberror($query); - - $query = qq|SELECT id FROM ap WHERE invnumber = '$uid'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - ($form->{id}) = $sth->fetchrow_array; - $sth->finish; - - } - - my $amount; - my $grossamount; - my $allocated; - my $invamount = 0; - my $invnetamount = 0; - - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{exchangerate} = 1; - } else { - $exchangerate = - $form->check_exchangerate( - $myconfig, $form->{currency}, - $form->{transdate}, 'sell'); - } - - $form->{exchangerate} = - ($exchangerate) - ? $exchangerate - : $form->parse_amount($myconfig, $form->{exchangerate}); - - for my $i (1 .. $form->{rowcount}) { - $form->{"qty_$i"} = - $form->parse_amount($myconfig, $form->{"qty_$i"}); - - if ($form->{"qty_$i"}) { - - $pth->execute($form->{"id_$i"}); - $ref = $pth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { - $form->{"${_}_$i"} = $ref->{$_}; - } - $pth->finish; - - # project - - if ($form->{"projectnumber_$i"} ne "") { - ($null, $project_id) = - split /--/, $form->{"projectnumber_$i"}; - } - - # undo discount formatting - $form->{"discount_$i"} = - $form->parse_amount( - $myconfig, - $form->{"discount_$i"}) / 100; - - # keep entered selling price - my $fxsellprice = - $form->parse_amount( - $myconfig, $form->{"sellprice_$i"}); - - my ($dec) = ($fxsellprice =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - # deduct discount - $form->{"sellprice_$i"} = - $fxsellprice - $form->round_amount( - $fxsellprice * $form->{"discount_$i"}, - $decimalplaces); - - # linetotal - my $fxlinetotal = $form->round_amount( - $form->{"sellprice_$i"} * $form->{"qty_$i"}, 2); - - $amount = $fxlinetotal * $form->{exchangerate}; - my $linetotal = $form->round_amount($amount, 2); - $fxdiff += $amount - $linetotal; - - @taxaccounts = Tax::init_taxes( - $form, $form->{"taxaccounts_$i"}); - - $tax = Math::BigFloat->bzero(); - $fxtax = Math::BigFloat->bzero(); - - if ($form->{taxincluded}) { - $tax += $amount = Tax::calculate_taxes( - \@taxaccounts, $form, $linetotal, 1); - - $form->{"sellprice_$i"} - -= $amount / $form->{"qty_$i"}; - } else { - $tax += $amount = Tax::calculate_taxes( - \@taxaccounts, $form, $linetotal, 0); - - $fxtax += Tax::calculate_taxes( - \@taxaccounts, $form, $fxlinetotal, 0); - } - - for (@taxaccounts) { - $form->{acc_trans}{$form->{id}}{$_->account}{amount} += $_->value; - } - - $grossamount = $form->round_amount($linetotal, 2); - - if ($form->{taxincluded}) { - $amount = $form->round_amount($tax, 2); - $linetotal -= $form->round_amount( - $tax - $diff, 2); - $diff = ($amount - $tax); - } - - $amount = $form->round_amount($linetotal, 2); - $allocated = 0; - - # adjust and round sellprice - $form->{"sellprice_$i"} = $form->round_amount( - $form->{"sellprice_$i"} * $form->{exchangerate}, - $decimalplaces); - - # save detail record in invoice table - $query = qq| + WHERE login = ?))|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{login} ) || $form->dberror($query); + + $query = qq|SELECT id FROM ap WHERE invnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ( $form->{id} ) = $sth->fetchrow_array; + $sth->finish; + + } + + my $amount; + my $grossamount; + my $allocated; + my $invamount = 0; + my $invnetamount = 0; + + if ( $form->{currency} eq $form->{defaultcurrency} ) { + $form->{exchangerate} = 1; + } + else { + $exchangerate = + $form->check_exchangerate( $myconfig, $form->{currency}, + $form->{transdate}, 'sell' ); + } + + $form->{exchangerate} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount( $myconfig, $form->{exchangerate} ); + + for my $i ( 1 .. $form->{rowcount} ) { + $form->{"qty_$i"} = $form->parse_amount( $myconfig, $form->{"qty_$i"} ); + + if ( $form->{"qty_$i"} ) { + + $pth->execute( $form->{"id_$i"} ); + $ref = $pth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { + $form->{"${_}_$i"} = $ref->{$_}; + } + $pth->finish; + + # project + + if ( $form->{"projectnumber_$i"} ne "" ) { + ( $null, $project_id ) = + split /--/, $form->{"projectnumber_$i"}; + } + + # undo discount formatting + $form->{"discount_$i"} = + $form->parse_amount( $myconfig, $form->{"discount_$i"} ) / 100; + + # keep entered selling price + my $fxsellprice = + $form->parse_amount( $myconfig, $form->{"sellprice_$i"} ); + + my ($dec) = ( $fxsellprice =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + # deduct discount + $form->{"sellprice_$i"} = $fxsellprice - + $form->round_amount( $fxsellprice * $form->{"discount_$i"}, + $decimalplaces ); + + # linetotal + my $fxlinetotal = + $form->round_amount( $form->{"sellprice_$i"} * $form->{"qty_$i"}, + 2 ); + + $amount = $fxlinetotal * $form->{exchangerate}; + my $linetotal = $form->round_amount( $amount, 2 ); + $fxdiff += $amount - $linetotal; + + @taxaccounts = Tax::init_taxes( $form, $form->{"taxaccounts_$i"} ); + + $tax = Math::BigFloat->bzero(); + $fxtax = Math::BigFloat->bzero(); + + if ( $form->{taxincluded} ) { + $tax += $amount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 1 ); + + $form->{"sellprice_$i"} -= $amount / $form->{"qty_$i"}; + } + else { + $tax += $amount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 0 ); + + $fxtax += + Tax::calculate_taxes( \@taxaccounts, $form, $fxlinetotal, 0 ); + } + + for (@taxaccounts) { + $form->{acc_trans}{ $form->{id} }{ $_->account }{amount} += + $_->value; + } + + $grossamount = $form->round_amount( $linetotal, 2 ); + + if ( $form->{taxincluded} ) { + $amount = $form->round_amount( $tax, 2 ); + $linetotal -= $form->round_amount( $tax - $diff, 2 ); + $diff = ( $amount - $tax ); + } + + $amount = $form->round_amount( $linetotal, 2 ); + $allocated = 0; + + # adjust and round sellprice + $form->{"sellprice_$i"} = + $form->round_amount( + $form->{"sellprice_$i"} * $form->{exchangerate}, + $decimalplaces ); + + # save detail record in invoice table + $query = qq| INSERT INTO invoice (description) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM invoice WHERE description = '$uid'|; - ($invoice_id) = $dbh->selectrow_array($query); + ($invoice_id) = $dbh->selectrow_array($query); - $form->debug; + $form->debug; - $query = qq| + $query = qq| UPDATE invoice SET trans_id = ?, parts_id = ?, @@ -287,44 +283,41 @@ sub post_invoice { serialnumber = ?, notes = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $form->{"id_$i"}, - $form->{"description_$i"}, $form->{"qty_$i"} * -1, - $form->{"sellprice_$i"}, $fxsellprice, - $form->{"discount_$i"}, $allocated, - $form->{"unit_$i"}, $form->{"deliverydate_$i"}, - $project_id, $form->{"serialnumber_$i"}, - $form->{"notes_$i"}, $invoice_id) - || $form->dberror($query); - - - if ($form->{"inventory_accno_id_$i"}) { - - # add purchase to inventory - push @{ $form->{acc_trans}{lineitems} }, - {chart_id => - $form->{"inventory_accno_id_$i"}, - amount => $amount, - fxgrossamount => $fxlinetotal + - $form->round_amount($fxtax, 2), - grossamount => $grossamount, - project_id => $project_id, - invoice_id => $invoice_id }; - - - $updparts{$form->{"id_$i"}} = 1; - - # update parts table - $form->update_balance( - $dbh, "parts", "onhand", - qq|id = $form->{"id_$i"}|, - $form->{"qty_$i"}) - unless $form->{shipped}; - - - # check if we sold the item - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{id}, $form->{"id_$i"}, + $form->{"description_$i"}, $form->{"qty_$i"} * -1, + $form->{"sellprice_$i"}, $fxsellprice, + $form->{"discount_$i"}, $allocated, + $form->{"unit_$i"}, $form->{"deliverydate_$i"}, + $project_id, $form->{"serialnumber_$i"}, + $form->{"notes_$i"}, $invoice_id + ) || $form->dberror($query); + + if ( $form->{"inventory_accno_id_$i"} ) { + + # add purchase to inventory + push @{ $form->{acc_trans}{lineitems} }, + { + chart_id => $form->{"inventory_accno_id_$i"}, + amount => $amount, + fxgrossamount => $fxlinetotal + + $form->round_amount( $fxtax, 2 ), + grossamount => $grossamount, + project_id => $project_id, + invoice_id => $invoice_id + }; + + $updparts{ $form->{"id_$i"} } = 1; + + # update parts table + $form->update_balance( $dbh, "parts", "onhand", + qq|id = $form->{"id_$i"}|, + $form->{"qty_$i"} ) + unless $form->{shipped}; + + # check if we sold the item + $query = qq| SELECT i.id, i.qty, i.allocated, i.trans_id, i.project_id, p.inventory_accno_id, @@ -335,28 +328,25 @@ sub post_invoice { WHERE i.parts_id = ? AND (i.qty + i.allocated) > 0 ORDER BY transdate|; - $sth = $dbh->prepare($query); - $sth->execute($form->{"id_$i"}) - || $form->dberror($query); - - my $totalqty = $form->{"qty_$i"}; - - while (my $ref = - $sth->fetchrow_hashref(NAME_lc)) { - - my $qty = $ref->{qty} - + $ref->{allocated}; - - if (($qty - $totalqty) > 0) { - $qty = $totalqty; - } - - $linetotal = $form->round_amount( - $form->{"sellprice_$i"} * $qty, - 2); - - if ($linetotal) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{"id_$i"} ) + || $form->dberror($query); + + my $totalqty = $form->{"qty_$i"}; + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + my $qty = $ref->{qty} + $ref->{allocated}; + + if ( ( $qty - $totalqty ) > 0 ) { + $qty = $totalqty; + } + + $linetotal = + $form->round_amount( $form->{"sellprice_$i"} * $qty, 2 ); + + if ($linetotal) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, @@ -367,19 +357,15 @@ sub post_invoice { VALUES (?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $ref->{trans_id}, - $ref->{inventory_accno_id}, - $linetotal, - $ref->{transdate}, - $ref->{project_id}, - $invoice_id - ) || $form->dberror( - $query); - - # add expense - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $ref->{trans_id}, $ref->{inventory_accno_id}, + $linetotal, $ref->{transdate}, + $ref->{project_id}, $invoice_id + ) || $form->dberror($query); + + # add expense + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, @@ -389,203 +375,199 @@ sub post_invoice { invoice_id) VALUES (?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query) ; - $sth->execute( - $ref->{trans_id}, - $ref->{expense_accno_id}, - $linetotal * -1, - $ref->{transdate}, - $ref->{project_id}, - $invoice_id - ) || $form->dberror( - $query); - } - - # update allocated for sold item - $form->update_balance( - $dbh, "invoice", "allocated", - qq|id = $ref->{id}|, $qty * -1); - - $allocated += $qty; - - last if (($totalqty -= $qty) <= 0); - } - - $sth->finish; - - } else { - - # add purchase to expense - push @{ $form->{acc_trans}{lineitems} }, { - chart_id => - $form->{"expense_accno_id_$i"}, - amount => $amount, - fxgrossamount => $fxlinetotal - + $form->round_amount( - $fxtax, 2), - grossamount => $grossamount, - project_id => $project_id, - invoice_id => $invoice_id }; - - } - } - } - - $form->{paid} = 0; - for $i (1 .. $form->{paidaccounts}) { - $form->{"paid_$i"} = - $form->parse_amount($myconfig, $form->{"paid_$i"}); - $form->{paid} += $form->{"paid_$i"}; - $form->{datepaid} = $form->{"datepaid_$i"} - if ($form->{"datepaid_$i"}); - } - - # add lineitems + tax - $amount = 0; - $grossamount = 0; - $fxgrossamount = 0; - for (@{ $form->{acc_trans}{lineitems} }) { - $amount += $_->{amount}; - $grossamount += $_->{grossamount}; - $fxgrossamount += $_->{fxgrossamount}; - } - $invnetamount = $amount; - - $amount = 0; - for (split / /, $form->{taxaccounts}) { - $amount += $form->{acc_trans}{$form->{id}}{$_}{amount} - = $form->round_amount( - $form->{acc_trans}{$form->{id}}{$_}{amount}, 2); - - $form->{acc_trans}{$form->{id}}{$_}{amount} *= -1; - } - $invamount = $invnetamount + $amount; - - $diff = 0; - if ($form->{taxincluded}) { - $diff = $form->round_amount($grossamount - $invamount, 2); - $invamount += $diff; - } - $fxdiff = $form->round_amount($fxdiff,2); - $invnetamount += $fxdiff; - $invamount += $fxdiff; - - if ($form->round_amount($form->{paid} - $fxgrossamount,2) == 0) { - $form->{paid} = $invamount; - } else { - $form->{paid} = $form->round_amount( - $form->{paid} * $form->{exchangerate}, 2); - } - - foreach $ref (sort { $b->{amount} <=> $a->{amount} } - @ { $form->{acc_trans}{lineitems} }) { - - $amount = $ref->{amount} + $diff + $fxdiff; - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $ref->{trans_id}, $ref->{expense_accno_id}, + $linetotal * -1, $ref->{transdate}, + $ref->{project_id}, $invoice_id + ) || $form->dberror($query); + } + + # update allocated for sold item + $form->update_balance( $dbh, "invoice", "allocated", + qq|id = $ref->{id}|, + $qty * -1 ); + + $allocated += $qty; + + last if ( ( $totalqty -= $qty ) <= 0 ); + } + + $sth->finish; + + } + else { + + # add purchase to expense + push @{ $form->{acc_trans}{lineitems} }, + { + chart_id => $form->{"expense_accno_id_$i"}, + amount => $amount, + fxgrossamount => $fxlinetotal + + $form->round_amount( $fxtax, 2 ), + grossamount => $grossamount, + project_id => $project_id, + invoice_id => $invoice_id + }; + + } + } + } + + $form->{paid} = 0; + for $i ( 1 .. $form->{paidaccounts} ) { + $form->{"paid_$i"} = + $form->parse_amount( $myconfig, $form->{"paid_$i"} ); + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"} + if ( $form->{"datepaid_$i"} ); + } + + # add lineitems + tax + $amount = 0; + $grossamount = 0; + $fxgrossamount = 0; + for ( @{ $form->{acc_trans}{lineitems} } ) { + $amount += $_->{amount}; + $grossamount += $_->{grossamount}; + $fxgrossamount += $_->{fxgrossamount}; + } + $invnetamount = $amount; + + $amount = 0; + for ( split / /, $form->{taxaccounts} ) { + $amount += $form->{acc_trans}{ $form->{id} }{$_}{amount} = + $form->round_amount( $form->{acc_trans}{ $form->{id} }{$_}{amount}, + 2 ); + + $form->{acc_trans}{ $form->{id} }{$_}{amount} *= -1; + } + $invamount = $invnetamount + $amount; + + $diff = 0; + if ( $form->{taxincluded} ) { + $diff = $form->round_amount( $grossamount - $invamount, 2 ); + $invamount += $diff; + } + $fxdiff = $form->round_amount( $fxdiff, 2 ); + $invnetamount += $fxdiff; + $invamount += $fxdiff; + + if ( $form->round_amount( $form->{paid} - $fxgrossamount, 2 ) == 0 ) { + $form->{paid} = $invamount; + } + else { + $form->{paid} = + $form->round_amount( $form->{paid} * $form->{exchangerate}, 2 ); + } + + foreach $ref ( sort { $b->{amount} <=> $a->{amount} } + @{ $form->{acc_trans}{lineitems} } ) + { + + $amount = $ref->{amount} + $diff + $fxdiff; + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, project_id, invoice_id) VALUES (?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $ref->{chart_id}, $amount * -1, - $form->{transdate}, $ref->{project_id}, - $ref->{invoice_id}) || $form->dberror($query); - $diff = 0; - $fxdiff = 0; - } - - $form->{payables} = $invamount; - - delete $form->{acc_trans}{lineitems}; - - # update exchangerate - if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { - $form->update_exchangerate( - $dbh, $form->{currency}, $form->{transdate}, 0, - $form->{exchangerate}); - } - - # record payable - if ($form->{payables}) { - ($accno) = split /--/, $form->{AP}; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{id}, $ref->{chart_id}, $amount * -1, + $form->{transdate}, $ref->{project_id}, $ref->{invoice_id} + ) || $form->dberror($query); + $diff = 0; + $fxdiff = 0; + } + + $form->{payables} = $invamount; + + delete $form->{acc_trans}{lineitems}; + + # update exchangerate + if ( ( $form->{currency} ne $form->{defaultcurrency} ) && !$exchangerate ) { + $form->update_exchangerate( $dbh, $form->{currency}, $form->{transdate}, + 0, $form->{exchangerate} ); + } + + # record payable + if ( $form->{payables} ) { + ($accno) = split /--/, $form->{AP}; + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno, $form->{payables}, - $form->{transdate} - ) || $form->dberror($query); - } - - foreach my $trans_id (keys %{$form->{acc_trans}}) { - foreach my $accno (keys %{ $form->{acc_trans}{$trans_id} }) { - $amount = $form->round_amount( - $form->{acc_trans}{$trans_id}{$accno}{amount}, - 2); - - if ($amount) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno, $form->{payables}, + $form->{transdate} ) + || $form->dberror($query); + } + + foreach my $trans_id ( keys %{ $form->{acc_trans} } ) { + foreach my $accno ( keys %{ $form->{acc_trans}{$trans_id} } ) { + $amount = + $form->round_amount( + $form->{acc_trans}{$trans_id}{$accno}{amount}, 2 ); + + if ($amount) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?)|; - $sth =$dbh->prepare($query); - $sth->execute( - $trans_id, $accno, $amount, - $form->{transdate} - ) || $form->dberror($query); - } - } - } - - # if there is no amount but a payment record payable - if ($invamount == 0) { - $form->{payables} = 1; - } - - my $cleared = 0; - - # record payments and offsetting AP - for my $i (1 .. $form->{paidaccounts}) { - - if ($form->{"paid_$i"}) { - my ($accno) = split /--/, $form->{"AP_paid_$i"}; - $form->{"datepaid_$i"} = $form->{transdate} - unless ($form->{"datepaid_$i"}); - - $form->{datepaid} = $form->{"datepaid_$i"}; - - $exchangerate = 0; - - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{"exchangerate_$i"} = 1; - } else { - $exchangerate = $form->check_exchangerate( - $myconfig, $form->{currency}, - $form->{"datepaid_$i"}, 'sell'); - - $form->{"exchangerate_$i"} = - ($exchangerate) - ? $exchangerate - : $form->parse_amount( - $myconfig, - $form->{"exchangerate_$i"}); - } - - - # record AP - $amount = ($form->round_amount( - $form->{"paid_$i"} * $form->{exchangerate}, - 2)) * -1; - - if ($form->{payables}) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $trans_id, $accno, $amount, $form->{transdate} ) + || $form->dberror($query); + } + } + } + + # if there is no amount but a payment record payable + if ( $invamount == 0 ) { + $form->{payables} = 1; + } + + my $cleared = 0; + + # record payments and offsetting AP + for my $i ( 1 .. $form->{paidaccounts} ) { + + if ( $form->{"paid_$i"} ) { + my ($accno) = split /--/, $form->{"AP_paid_$i"}; + $form->{"datepaid_$i"} = $form->{transdate} + unless ( $form->{"datepaid_$i"} ); + + $form->{datepaid} = $form->{"datepaid_$i"}; + + $exchangerate = 0; + + if ( $form->{currency} eq $form->{defaultcurrency} ) { + $form->{"exchangerate_$i"} = 1; + } + else { + $exchangerate = + $form->check_exchangerate( $myconfig, $form->{currency}, + $form->{"datepaid_$i"}, 'sell' ); + + $form->{"exchangerate_$i"} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount( $myconfig, + $form->{"exchangerate_$i"} ); + } + + # record AP + $amount = ( + $form->round_amount( + $form->{"paid_$i"} * $form->{exchangerate}, 2 + ) + ) * -1; + + if ( $form->{payables} ) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate) @@ -593,19 +575,18 @@ sub post_invoice { WHERE accno = ?), ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $form->{AP}, $amount, - $form->{"datepaid_$i"} - ) || $form->dberror($query); - } - - if ($keepcleared) { - $cleared = ($form->{"cleared_$i"}) ? 1 : 0; - } - - # record payment - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $form->{AP}, $amount, + $form->{"datepaid_$i"} ) + || $form->dberror($query); + } + + if ($keepcleared) { + $cleared = ( $form->{"cleared_$i"} ) ? 1 : 0; + } + + # record payment + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, source, memo, cleared) @@ -613,22 +594,21 @@ sub post_invoice { WHERE accno = ?), ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno, $form->{"paid_$i"}, - $form->{"datepaid_$i"}, $form->{"source_$i"}, - $form->{"memo_$i"}, $cleared - ) || $form->dberror($query); - - # exchangerate difference - $amount = $form->round_amount( - $form->{"paid_$i"} - * $form->{"exchangerate_$i"} - - $form->{"paid_$i"}, - 2); - - if ($amount) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno, $form->{"paid_$i"}, + $form->{"datepaid_$i"}, + $form->{"source_$i"}, $form->{"memo_$i"}, $cleared ) + || $form->dberror($query); + + # exchangerate difference + $amount = $form->round_amount( + $form->{"paid_$i"} * $form->{"exchangerate_$i"} - + $form->{"paid_$i"}, + 2 + ); + + if ($amount) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, source, @@ -636,65 +616,61 @@ sub post_invoice { VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, ?, '1', ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno, $amount, - $form->{"datepaid_$i"}, - $form->{"source_$i"}, $cleared - ) || $form->dberror($query); - - } - - # gain/loss - $amount = $form->round_amount( - $form->round_amount( - $form->{"paid_$i"} - * $form->{exchangerate},2) - - $form->round_amount( - $form->{"paid_$i"} - * $form->{"exchangerate_$i"},2) - , 2); - - if ($amount) { - my $accno_id = - ($amount > 0) - ? $fxgain_accno_id - : $fxloss_accno_id; - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno, $amount, + $form->{"datepaid_$i"}, + $form->{"source_$i"}, $cleared ) + || $form->dberror($query); + + } + + # gain/loss + $amount = $form->round_amount( + $form->round_amount( $form->{"paid_$i"} * $form->{exchangerate}, + 2 ) - $form->round_amount( + $form->{"paid_$i"} * $form->{"exchangerate_$i"}, 2 + ), + 2 + ); + + if ($amount) { + my $accno_id = + ( $amount > 0 ) + ? $fxgain_accno_id + : $fxloss_accno_id; + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, fx_transaction, cleared) VALUES (?, ?, ?, ?, '1', ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno_id, $amount, - $form->{"datepaid_$i"}, $cleared - ) || $form->dberror($query); - } - - # update exchange rate - if (($form->{currency} ne $form->{defaultcurrency}) - && !$exchangerate) { - - $form->update_exchangerate( - $dbh, $form->{currency}, - $form->{"datepaid_$i"}, 0, - $form->{"exchangerate_$i"}); - } - } - } - - # set values which could be empty - $form->{taxincluded} *= 1; - - $form->{invnumber} = - $form->update_defaults($myconfig, "vinumber", $dbh) - unless $form->{invnumber}; - - # save AP record - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno_id, $amount, + $form->{"datepaid_$i"}, $cleared ) + || $form->dberror($query); + } + + # update exchange rate + if ( ( $form->{currency} ne $form->{defaultcurrency} ) + && !$exchangerate ) + { + + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{"datepaid_$i"}, + 0, $form->{"exchangerate_$i"} ); + } + } + } + + # set values which could be empty + $form->{taxincluded} *= 1; + + $form->{invnumber} = $form->update_defaults( $myconfig, "vinumber", $dbh ) + unless $form->{invnumber}; + + # save AP record + $query = qq| UPDATE ap SET invnumber = ?, ordnumber = ?, @@ -719,86 +695,86 @@ sub post_invoice { ponumber = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{invnumber}, $form->{ordnumber}, $form->{quonumber}, - $form->{transdate}, $form->{vendor_id}, $invamount, - $invnetamount, $form->{paid}, $form->{datepaid}, - $form->{duedate}, $form->{shippingpoint}, $form->{shipvia}, - $form->{taxincluded}, $form->{notes}, $form->{intnotes}, - $form->{currency}, $form->{department_id}, $form->{employee_id}, - $form->{language_code}, $form->{ponumber}, $form->{id} - ) || $form->dberror($query); - # add shipto - $form->{name} = $form->{vendor}; - $form->{name} =~ s/--$form->{vendor_id}//; - $form->add_shipto($dbh, $form->{id}); - - my %audittrail = ( - tablename => 'ap', - reference => $form->{invnumber}, - formname => $form->{type}, - action => 'posted', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - my $rc = $dbh->commit; - - foreach $item (keys %updparts) { - $item = $dbh->quote($item); - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{invnumber}, $form->{ordnumber}, $form->{quonumber}, + $form->{transdate}, $form->{vendor_id}, $invamount, + $invnetamount, $form->{paid}, $form->{datepaid}, + $form->{duedate}, $form->{shippingpoint}, $form->{shipvia}, + $form->{taxincluded}, $form->{notes}, $form->{intnotes}, + $form->{currency}, $form->{department_id}, $form->{employee_id}, + $form->{language_code}, $form->{ponumber}, $form->{id} + ) || $form->dberror($query); + + # add shipto + $form->{name} = $form->{vendor}; + $form->{name} =~ s/--$form->{vendor_id}//; + $form->add_shipto( $dbh, $form->{id} ); + + my %audittrail = ( + tablename => 'ap', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'posted', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + my $rc = $dbh->commit; + + foreach $item ( keys %updparts ) { + $item = $dbh->quote($item); + $query = qq| UPDATE parts SET avgcost = avgcost($item), lastcost = lastcost($item) WHERE id = $item|; - $dbh->prepare($query) || $form->dberror($query); - $dbh->commit; - } - - $rc; - -} + $dbh->prepare($query) || $form->dberror($query); + $dbh->commit; + } + $rc; +} sub reverse_invoice { - my ($dbh, $form) = @_; - - my $query = qq|SELECT id FROM ap + my ( $dbh, $form ) = @_; + + my $query = qq|SELECT id FROM ap WHERE id = $form->{id}|; - my ($id) = $dbh->selectrow_array($query); + my ($id) = $dbh->selectrow_array($query); - return unless $id; - - # reverse inventory items - $query = qq| + return unless $id; + + # reverse inventory items + $query = qq| SELECT i.parts_id, p.inventory_accno_id, p.expense_accno_id, i.qty, i.allocated, i.sellprice, i.project_id FROM invoice i, parts p WHERE i.parts_id = p.id AND i.trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $netamount = 0; - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $netamount += $form->round_amount($ref->{sellprice} * $ref->{qty} * -1, 2); - - if ($ref->{inventory_accno_id}) { - # update onhand - $form->update_balance($dbh, - "parts", - "onhand", - qq|id = $ref->{parts_id}|, - $ref->{qty}); - - # if $ref->{allocated} > 0 than we sold that many items - if ($ref->{allocated} > 0) { - - # get references for sold items - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + my $netamount = 0; + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $netamount += + $form->round_amount( $ref->{sellprice} * $ref->{qty} * -1, 2 ); + + if ( $ref->{inventory_accno_id} ) { + + # update onhand + $form->update_balance( $dbh, "parts", "onhand", + qq|id = $ref->{parts_id}|, + $ref->{qty} ); + + # if $ref->{allocated} > 0 than we sold that many items + if ( $ref->{allocated} > 0 ) { + + # get references for sold items + $query = qq| SELECT i.id, i.trans_id, i.allocated, a.transdate FROM invoice i, ar a @@ -806,181 +782,169 @@ sub reverse_invoice { AND i.allocated < 0 AND i.trans_id = a.id ORDER BY transdate DESC|; - my $sth = $dbh->prepare($query); - $sth->execute($ref->{parts_id}) - || $form->dberror($query); - - while (my $pthref = - $sth->fetchrow_hashref(NAME_lc)) { - - my $qty = $ref->{allocated}; - - if (($ref->{allocated} + - $pthref->{allocated}) - > 0) { - $qty = $pthref->{allocated} - * -1; - } - - my $amount = $form->round_amount( - $ref->{sellprice} * $qty, 2); - - #adjust allocated - $form->update_balance( - $dbh, "invoice", "allocated", - qq|id = $pthref->{id}|, $qty); - - # add reversal for sale - $ref->{project_id} *= 1; - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $ref->{parts_id} ) + || $form->dberror($query); + + while ( my $pthref = $sth->fetchrow_hashref(NAME_lc) ) { + + my $qty = $ref->{allocated}; + + if ( ( $ref->{allocated} + $pthref->{allocated} ) > 0 ) { + $qty = $pthref->{allocated} * -1; + } + + my $amount = + $form->round_amount( $ref->{sellprice} * $qty, 2 ); + + #adjust allocated + $form->update_balance( $dbh, "invoice", "allocated", + qq|id = $pthref->{id}|, $qty ); + + # add reversal for sale + $ref->{project_id} *= 1; + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, project_id) VALUES (?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $pthref->{trans_id}, - $ref->{expense_accno_id}, - $amount, $form->{transdate}, - $ref->{project_id} - ) || $form->dberror($query); - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $pthref->{trans_id}, + $ref->{expense_accno_id}, + $amount, $form->{transdate}, $ref->{project_id} ) + || $form->dberror($query); + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, project_id) VALUES (?, ?, ?, ?, ?)|; - $sth = $dbh->do($query); - $sth->execute( - $pthref->{trans_id}, - $ref->{inventory_accno_id}, - $amount * -1, - $form->{transdate}, - $ref->{project_id} - ) || $form->dberror($query); - last if (($ref->{allocated} -= $qty) - <= 0); - } - $sth->finish; - } - } - } - $sth->finish; - - # delete acc_trans - $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; - $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - # delete invoice entries - $query = qq|DELETE FROM invoice WHERE trans_id = ?|; - $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM shipto WHERE trans_id = ?|; - $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $dbh->commit; - -} - + $sth = $dbh->do($query); + $sth->execute( + $pthref->{trans_id}, + $ref->{inventory_accno_id}, + $amount * -1, + $form->{transdate}, $ref->{project_id} + ) || $form->dberror($query); + last if ( ( $ref->{allocated} -= $qty ) <= 0 ); + } + $sth->finish; + } + } + } + $sth->finish; + + # delete acc_trans + $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; + $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + # delete invoice entries + $query = qq|DELETE FROM invoice WHERE trans_id = ?|; + $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM shipto WHERE trans_id = ?|; + $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $dbh->commit; +} sub delete_invoice { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my %audittrail = ( - tablename => 'ap', - reference => $form->{invnumber}, - formname => $form->{type}, - action => 'deleted', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - my $query = qq|SELECT parts_id FROM invoice WHERE trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $item; - my %updparts = (); - while (($item) = $sth->fetchrow_array) { - $updparts{$item} = 1; - } - $sth->finish; - - &reverse_invoice($dbh, $form); - - # delete AP record - $query = qq|DELETE FROM ap WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - # delete spool files - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my %audittrail = ( + tablename => 'ap', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + my $query = qq|SELECT parts_id FROM invoice WHERE trans_id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + my $item; + my %updparts = (); + while ( ($item) = $sth->fetchrow_array ) { + $updparts{$item} = 1; + } + $sth->finish; + + &reverse_invoice( $dbh, $form ); + + # delete AP record + $query = qq|DELETE FROM ap WHERE id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + # delete spool files + $query = qq| SELECT spoolfile FROM status WHERE trans_id = ? AND spoolfile IS NOT NULL|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $spoolfile; - my @spoolfiles = (); - - while (($spoolfile) = $sth->fetchrow_array) { - push @spoolfiles, $spoolfile; - } - $sth->finish; - - # delete status entries - $query = qq|DELETE FROM status WHERE trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - - if ($rc) { - foreach $item (keys %updparts) { - $item = $dbh->quote($item); - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + my $spoolfile; + my @spoolfiles = (); + + while ( ($spoolfile) = $sth->fetchrow_array ) { + push @spoolfiles, $spoolfile; + } + $sth->finish; + + # delete status entries + $query = qq|DELETE FROM status WHERE trans_id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + if ($rc) { + foreach $item ( keys %updparts ) { + $item = $dbh->quote($item); + $query = qq| UPDATE parts SET avgcost = avgcost($item), lastcost = lastcost($item) WHERE id = $item|; - $dbh->do($query) || $form->dberror($query); - } - - foreach $spoolfile (@spoolfiles) { - unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" - if $spoolfile; - } - } - - my $rc = $dbh->commit; - - $rc; - -} + $dbh->do($query) || $form->dberror($query); + } + foreach $spoolfile (@spoolfiles) { + unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" + if $spoolfile; + } + } + my $rc = $dbh->commit; + + $rc; + +} sub retrieve_invoice { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; - my $query; + # connect to database + my $dbh = $form->{dbh}; - if ($form->{id}) { - # get default accounts and last invoice number - $query = qq| + my $query; + + if ( $form->{id} ) { + + # get default accounts and last invoice number + $query = qq| SELECT (select c.accno FROM chart c WHERE c.id = (SELECT value FROM defaults WHERE setting_key = @@ -1012,8 +976,9 @@ sub retrieve_invoice { AS fxloss_accno, (SELECT value FROM defaults WHERE setting_key = 'curr') AS currencies|; - } else { - $query = qq| + } + else { + $query = qq| SELECT (select c.accno FROM chart c WHERE c.id = (SELECT value FROM defaults WHERE setting_key = @@ -1046,48 +1011,47 @@ sub retrieve_invoice { (SELECT value FROM defaults WHERE setting_key = 'curr') AS currencies, current_date AS transdate|; - } - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + } + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { - $form->{$_} = $ref->{$_}; - } - $sth->finish; + my $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { + $form->{$_} = $ref->{$_}; + } + $sth->finish; + if ( $form->{id} ) { - if ($form->{id}) { - - $query = qq| + $query = qq| SELECT a.invnumber, a.transdate, a.duedate, a.ordnumber, a.quonumber, a.paid, a.taxincluded, a.notes, a.intnotes, a.curr AS currency, a.vendor_id, a.language_code, a.ponumber FROM ap a WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { - $form->{$_} = $ref->{$_}; - } - $sth->finish; - - # get shipto - $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { - $form->{$_} = $ref->{$_}; - } - $sth->finish; - - # retrieve individual items - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { + $form->{$_} = $ref->{$_}; + } + $sth->finish; + + # get shipto + $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { + $form->{$_} = $ref->{$_}; + } + $sth->finish; + + # retrieve individual items + $query = qq| SELECT p.partnumber, i.description, i.qty, i.fxsellprice, i.sellprice, i.parts_id AS id, i.unit, p.bin, @@ -1108,113 +1072,112 @@ sub retrieve_invoice { AND t.language_code = ?) WHERE i.trans_id = ? ORDER BY i.id|; - $sth = $dbh->prepare($query); - $sth->execute($form->{language_code}, $form->{id}) - || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{language_code}, $form->{id} ) + || $form->dberror($query); - # exchangerate defaults - &exchangerate_defaults($dbh, $form); + # exchangerate defaults + &exchangerate_defaults( $dbh, $form ); - # price matrix and vendor partnumber - my $pmh = PriceMatrix::price_matrix_query($dbh, $form); + # price matrix and vendor partnumber + my $pmh = PriceMatrix::price_matrix_query( $dbh, $form ); - # tax rates for part - $query = qq| + # tax rates for part + $query = qq| SELECT c.accno FROM chart c JOIN partstax pt ON (pt.chart_id = c.id) WHERE pt.parts_id = ?|; - my $tth = $dbh->prepare($query); - - my $ptref; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - - my ($dec) = ($ref->{fxsellprice} =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - $tth->execute($ref->{id}); - $ref->{taxaccounts} = ""; - my $taxrate = 0; - - while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { - $ref->{taxaccounts} .= "$ptref->{accno} "; - $taxrate += $form->{"$ptref->{accno}_rate"}; - } - - $tth->finish; - chop $ref->{taxaccounts}; - - # price matrix - $ref->{sellprice} = $form->round_amount( - $ref->{fxsellprice} - * $form->{$form->{currency}}, - $decimalplaces); - PriceMatrix::price_matrix( - $pmh, $ref, $decimalplaces, $form, $myconfig); - - $ref->{sellprice} = $ref->{fxsellprice}; - $ref->{qty} *= -1; - - $ref->{partsgroup} = $ref->{partsgrouptranslation} - if $ref->{partsgrouptranslation}; - - push @{ $form->{invoice_details} }, $ref; - - } - - $sth->finish; - - } - - - my $rc = $dbh->commit; - - $rc; - -} + my $tth = $dbh->prepare($query); + + my $ptref; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + my ($dec) = ( $ref->{fxsellprice} =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + $tth->execute( $ref->{id} ); + $ref->{taxaccounts} = ""; + my $taxrate = 0; + + while ( $ptref = $tth->fetchrow_hashref(NAME_lc) ) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + $taxrate += $form->{"$ptref->{accno}_rate"}; + } + + $tth->finish; + chop $ref->{taxaccounts}; + + # price matrix + $ref->{sellprice} = + $form->round_amount( + $ref->{fxsellprice} * $form->{ $form->{currency} }, + $decimalplaces ); + PriceMatrix::price_matrix( $pmh, $ref, $decimalplaces, $form, + $myconfig ); + + $ref->{sellprice} = $ref->{fxsellprice}; + $ref->{qty} *= -1; + + $ref->{partsgroup} = $ref->{partsgrouptranslation} + if $ref->{partsgrouptranslation}; + + push @{ $form->{invoice_details} }, $ref; + + } + + $sth->finish; + + } + + my $rc = $dbh->commit; + $rc; + +} sub retrieve_item { - my ($self, $myconfig, $form) = @_; - - $dbh = $form->{dbh}; - my $i = $form->{rowcount}; - my $null; - my $var; - - # don't include assemblies or obsolete parts - my $where = "WHERE p.assembly = '0' AND p.obsolete = '0'"; - - if ($form->{"partnumber_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"partnumber_$i"})); - $where .= " AND lower(p.partnumber) LIKE $var"; - } - - if ($form->{"description_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"description_$i"})); - if ($form->{language_code} ne "") { - $where .= " AND lower(t1.description) LIKE $var"; - } else { - $where .= " AND lower(p.description) LIKE $var"; - } - } - - if ($form->{"partsgroup_$i"} ne "") { - ($null, $var) = split /--/, $form->{"partsgroup_$i"}; - $var = $dbh->quote($var); - $where .= qq| AND p.partsgroup_id = $var|; - } - - if ($form->{"description_$i"} ne "") { - $where .= " ORDER BY 3"; - } else { - $where .= " ORDER BY 2"; - } - - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + $dbh = $form->{dbh}; + my $i = $form->{rowcount}; + my $null; + my $var; + + # don't include assemblies or obsolete parts + my $where = "WHERE p.assembly = '0' AND p.obsolete = '0'"; + + if ( $form->{"partnumber_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"partnumber_$i"} ) ); + $where .= " AND lower(p.partnumber) LIKE $var"; + } + + if ( $form->{"description_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"description_$i"} ) ); + if ( $form->{language_code} ne "" ) { + $where .= " AND lower(t1.description) LIKE $var"; + } + else { + $where .= " AND lower(p.description) LIKE $var"; + } + } + + if ( $form->{"partsgroup_$i"} ne "" ) { + ( $null, $var ) = split /--/, $form->{"partsgroup_$i"}; + $var = $dbh->quote($var); + $where .= qq| AND p.partsgroup_id = $var|; + } + + if ( $form->{"description_$i"} ne "" ) { + $where .= " ORDER BY 3"; + } + else { + $where .= " ORDER BY 2"; + } + + my $query = qq| SELECT p.id, p.partnumber, p.description, pg.partsgroup, p.partsgroup_id, p.lastcost AS sellprice, p.unit, p.bin, p.onhand, @@ -1230,120 +1193,118 @@ sub retrieve_item { ON (t2.trans_id = p.partsgroup_id AND t2.language_code = ?) $where|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{language_code}, $form->{language_code}) - || $form->dberror($query); - - # foreign currency - &exchangerate_defaults($dbh, $form); - - # taxes - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{language_code}, $form->{language_code} ) + || $form->dberror($query); + + # foreign currency + &exchangerate_defaults( $dbh, $form ); + + # taxes + $query = qq| SELECT c.accno FROM chart c JOIN partstax pt ON (pt.chart_id = c.id) WHERE pt.parts_id = ?|; - my $tth = $dbh->prepare($query) || $form->dberror($query); - - # price matrix - my $pmh = PriceMatrix::price_matrix_query($dbh, $form); - - my $ref; - my $ptref; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - - my ($dec) = ($ref->{sellprice} =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - # get taxes for part - $tth->execute($ref->{id}); - - $ref->{taxaccounts} = ""; - while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { - $ref->{taxaccounts} .= "$ptref->{accno} "; - } - $tth->finish; - chop $ref->{taxaccounts}; - - # get vendor price and partnumber - PriceMatrix::price_matrix( - $pmh, $ref, $decimalplaces, $form, $myconfig); - - $ref->{description} = $ref->{translation} - if $ref->{translation}; - $ref->{partsgroup} = $ref->{grouptranslation} - if $ref->{grouptranslation}; - - push @{ $form->{item_list} }, $ref; - - } - - $sth->finish; - $dbh->commit; - -} + my $tth = $dbh->prepare($query) || $form->dberror($query); + + # price matrix + my $pmh = PriceMatrix::price_matrix_query( $dbh, $form ); + + my $ref; + my $ptref; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + my ($dec) = ( $ref->{sellprice} =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + # get taxes for part + $tth->execute( $ref->{id} ); + + $ref->{taxaccounts} = ""; + while ( $ptref = $tth->fetchrow_hashref(NAME_lc) ) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + } + $tth->finish; + chop $ref->{taxaccounts}; + # get vendor price and partnumber + PriceMatrix::price_matrix( $pmh, $ref, $decimalplaces, $form, + $myconfig ); + + $ref->{description} = $ref->{translation} + if $ref->{translation}; + $ref->{partsgroup} = $ref->{grouptranslation} + if $ref->{grouptranslation}; + + push @{ $form->{item_list} }, $ref; + + } + + $sth->finish; + $dbh->commit; + +} sub exchangerate_defaults { - my ($dbh, $form) = @_; + my ( $dbh, $form ) = @_; - my $var; - - # get default currencies - my $query = qq| + my $var; + + # get default currencies + my $query = qq| SELECT substr(value,1,3), value FROM defaults WHERE setting_key = 'curr'|; - my $eth = $dbh->prepare($query) || $form->dberror($query); - $eth->execute; - ($form->{defaultcurrency}, $form->{currencies}) = $eth->fetchrow_array; - $eth->finish; + my $eth = $dbh->prepare($query) || $form->dberror($query); + $eth->execute; + ( $form->{defaultcurrency}, $form->{currencies} ) = $eth->fetchrow_array; + $eth->finish; - $query = qq| + $query = qq| SELECT sell FROM exchangerate WHERE curr = ? AND transdate = ?|; - my $eth1 = $dbh->prepare($query) || $form->dberror($query); + my $eth1 = $dbh->prepare($query) || $form->dberror($query); - $query = qq/ + $query = qq/ SELECT max(transdate || ' ' || sell || ' ' || curr) FROM exchangerate WHERE curr = ?/; - my $eth2 = $dbh->prepare($query) || $form->dberror($query); - - # get exchange rates for transdate or max - foreach $var (split /:/, substr($form->{currencies},4)) { - $eth1->execute($var, $form->{transdate}); - ($form->{$var}) = $eth1->fetchrow_array; - if (! $form->{$var} ) { - $eth2->execute($var); - - ($form->{$var}) = $eth2->fetchrow_array; - ($null, $form->{$var}) = split / /, $form->{$var}; - $form->{$var} = 1 unless $form->{$var}; - $eth2->finish; - } - $eth1->finish; - } - - $form->{$form->{currency}} = $form->{exchangerate} - if $form->{exchangerate}; - $form->{$form->{currency}} ||= 1; - $form->{$form->{defaultcurrency}} = 1; - -} + my $eth2 = $dbh->prepare($query) || $form->dberror($query); + + # get exchange rates for transdate or max + foreach $var ( split /:/, substr( $form->{currencies}, 4 ) ) { + $eth1->execute( $var, $form->{transdate} ); + ( $form->{$var} ) = $eth1->fetchrow_array; + if ( !$form->{$var} ) { + $eth2->execute($var); + + ( $form->{$var} ) = $eth2->fetchrow_array; + ( $null, $form->{$var} ) = split / /, $form->{$var}; + $form->{$var} = 1 unless $form->{$var}; + $eth2->finish; + } + $eth1->finish; + } + + $form->{ $form->{currency} } = $form->{exchangerate} + if $form->{exchangerate}; + $form->{ $form->{currency} } ||= 1; + $form->{ $form->{defaultcurrency} } = 1; +} sub vendor_details { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; - # get rest for the vendor - my $query = qq| + # connect to database + my $dbh = $form->{dbh}; + + # get rest for the vendor + my $query = qq| SELECT vendornumber, name, address1, address2, city, state, zipcode, country, contact, phone as vendorphone, fax as vendorfax, vendornumber, @@ -1351,45 +1312,46 @@ sub vendor_details { gifi_accno AS gifi, startdate, enddate FROM vendor WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{vendor_id}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{vendor_id} ) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { - $form->{$_} = $ref->{$_}; - } + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { + $form->{$_} = $ref->{$_}; + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub item_links { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT accno, description, link FROM chart WHERE link LIKE '%IC%' ORDER BY accno|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /IC/) { - push @{ $form->{IC_links}{$key} }, - { accno => $ref->{accno}, - description => $ref->{description} }; - } - } - } - - $sth->finish; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + foreach my $key ( split( /:/, $ref->{link} ) ) { + if ( $key =~ /IC/ ) { + push @{ $form->{IC_links}{$key} }, + { + accno => $ref->{accno}, + description => $ref->{description} + }; + } + } + } + + $sth->finish; } 1; diff --git a/LedgerSMB/IS.pm b/LedgerSMB/IS.pm index 86aea81b..be4cbcb1 100644 --- a/LedgerSMB/IS.pm +++ b/LedgerSMB/IS.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -36,625 +36,626 @@ use LedgerSMB::Tax; use LedgerSMB::PriceMatrix; use LedgerSMB::Sysconfig; - sub invoice_details { - use LedgerSMB::CP; - my ($self, $myconfig, $form) = @_; + use LedgerSMB::CP; + my ( $self, $myconfig, $form ) = @_; - $form->{duedate} = $form->{transdate} unless ($form->{duedate}); + $form->{duedate} = $form->{transdate} unless ( $form->{duedate} ); - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT ?::date - ?::date AS terms, value FROM defaults WHERE setting_key = 'weightunit'|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{duedate}, $form->{transdate}) - || $form->dberror($query); - - ($form->{terms}, $form->{weightunit}) = $sth->fetchrow_array; - $sth->finish; - - # this is for the template - $form->{invdate} = $form->{transdate}; - - my $tax = 0; - my $item; - my $i; - my @sortlist = (); - my $projectnumber; - my $projectdescription; - my $projectnumber_id; - my $translation; - my $partsgroup; - - - my @taxaccounts; - my %taxaccounts; - my $tax; - my $taxrate; - my $taxamount; - - my %translations; - - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{duedate}, $form->{transdate} ) + || $form->dberror($query); + + ( $form->{terms}, $form->{weightunit} ) = $sth->fetchrow_array; + $sth->finish; + + # this is for the template + $form->{invdate} = $form->{transdate}; + + my $tax = 0; + my $item; + my $i; + my @sortlist = (); + my $projectnumber; + my $projectdescription; + my $projectnumber_id; + my $translation; + my $partsgroup; + + my @taxaccounts; + my %taxaccounts; + my $tax; + my $taxrate; + my $taxamount; + + my %translations; + + $query = qq| SELECT p.description, t.description FROM project p LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code = ?) WHERE id = ?|; - my $prh = $dbh->prepare($query) || $form->dberror($query); + my $prh = $dbh->prepare($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT inventory_accno_id, income_accno_id, expense_accno_id, assembly, weight FROM parts WHERE id = ?|; - my $pth = $dbh->prepare($query) || $form->dberror($query); - - my $sortby; - - # sort items by project and partsgroup - for $i (1 .. $form->{rowcount} - 1) { - - # account numbers - $pth->execute($form->{"id_$i"}); - $ref = $pth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{"${_}_$i"} = $ref->{$_} } - $pth->finish; - - $projectnumber_id = 0; - $projectnumber = ""; - $form->{partsgroup} = ""; - $form->{projectnumber} = ""; - - if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { - - $inventory_accno_id = - ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) - ? "1" - : ""; - - if ($form->{groupprojectnumber}) { - ($projectnumber, $projectnumber_id) = - split /--/, $form->{"projectnumber_$i"}; - } - if ($form->{grouppartsgroup}) { - ($form->{partsgroup}) = - split /--/, $form->{"partsgroup_$i"}; - } - - if ($projectnumber_id && $form->{groupprojectnumber}) { - if ($translation{$projectnumber_id}) { - $form->{projectnumber} = - $translation{$projectnumber_id}; - } else { - # get project description - $prh->execute($projectnumber_id, - $form->{language_code}); - - ($projectdescription, $translation) = - $prh->fetchrow_array; - - $prh->finish; - - $form->{projectnumber} = - ($translation) - ? "$projectnumber, $translation" - : "$projectnumber, ". - "$projectdescription"; - - $translation{$projectnumber_id} = - $form->{projectnumber}; - } - } - - if ($form->{grouppartsgroup} && $form->{partsgroup}) { - $form->{projectnumber} .= " / " - if $projectnumber_id; - $form->{projectnumber} .= $form->{partsgroup}; - } - - $form->format_string(projectnumber); - - } - - $sortby = qq|$projectnumber$form->{partsgroup}|; - if ($form->{sortby} ne 'runningnumber') { - for (qw(partnumber description bin)) { - $sortby .= $form->{"${_}_$i"} - if $form->{sortby} eq $_; - } - } - - push @sortlist, [ $i, - qq|$projectnumber$form->{partsgroup}|. - qq|$inventory_accno_id|, - $form->{projectnumber}, $projectnumber_id, - $form->{partsgroup}, $sortby ]; - - } - - # sort the whole thing by project and group - @sortlist = sort { $a->[5] cmp $b->[5] } @sortlist; - - my $runningnumber = 1; - my $sameitem = ""; - my $subtotal; - my $k = scalar @sortlist; - my $j = 0; - - foreach $item (@sortlist) { - - $i = $item->[0]; - $j++; - - # heading - if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { - if ($item->[1] ne $sameitem) { - $sameitem = $item->[1]; - - $ok = 0; - - if ($form->{groupprojectnumber}) { - $ok = $form->{"projectnumber_$i"}; - } - if ($form->{grouppartsgroup}) { - $ok = $form->{"partsgroup_$i"} - unless $ok; - } - - if ($ok) { - - if ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) { - - push(@{ $form->{part} }, ""); - push(@{ $form->{service} }, - NULL); - } else { - push(@{ $form->{part} }, NULL); - push(@{ $form->{service} }, ""); - } - - push(@{ $form->{description} }, - $item->[2]); - for ( - qw(taxrates runningnumber number - sku serialnumber bin qty ship - unit deliverydate projectnumber - sellprice listprice netprice - discount discountrate linetotal - weight itemnotes) - ) { - push(@{ $form->{$_} }, ""); - } - push(@{ $form->{lineitems} }, - { amount => 0, tax => 0 }); - } - } - } - - $form->{"qty_$i"} = - $form->parse_amount($myconfig, $form->{"qty_$i"}); - - if ($form->{"qty_$i"}) { - - $form->{totalqty} += $form->{"qty_$i"}; - $form->{totalship} += $form->{"qty_$i"}; - $form->{totalweight} += ($form->{"qty_$i"} - * $form->{"weight_$i"}); - - $form->{totalweightship} += ($form->{"qty_$i"} - * $form->{"weight_$i"}); - - # add number, description and qty to $form->{number}... - push(@{ $form->{runningnumber} }, $runningnumber++); - push(@{ $form->{number} }, $form->{"partnumber_$i"}); - push(@{ $form->{sku} }, $form->{"sku_$i"}); - push(@{ $form->{serialnumber} }, - $form->{"serialnumber_$i"}); - - push(@{ $form->{bin} }, $form->{"bin_$i"}); - push(@{ $form->{description} }, - $form->{"description_$i"}); - push(@{ $form->{itemnotes} }, $form->{"notes_$i"}); - push(@{ $form->{qty} }, - $form->format_amount( - $myconfig, $form->{"qty_$i"})); - - push(@{ $form->{ship} }, - $form->format_amount( - $myconfig, $form->{"qty_$i"})); - - push(@{ $form->{unit} }, $form->{"unit_$i"}); - push(@{ $form->{deliverydate} }, - $form->{"deliverydate_$i"}); - - push(@{ $form->{projectnumber} }, - $form->{"projectnumber_$i"}); - - push(@{ $form->{sellprice} }, $form->{"sellprice_$i"}); - - push(@{ $form->{listprice} }, $form->{"listprice_$i"}); - - push(@{ $form->{weight} }, - $form->format_amount( - $myconfig, - $form->{"weight_$i"} - * $form->{"qty_$i"})); - - my $sellprice = - $form->parse_amount( - $myconfig, $form->{"sellprice_$i"}); - - my ($dec) = ($sellprice =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - my $discount = - $form->round_amount( - $sellprice - * $form->parse_amount( - $myconfig, - $form->{"discount_$i"}) - /100, - $decimalplaces); - - # keep a netprice as well, (sellprice - discount) - $form->{"netprice_$i"} = $sellprice - $discount; - - my $linetotal = $form->round_amount( - $form->{"qty_$i"} * $form->{"netprice_$i"}, 2); - - if ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) { - - push(@{ $form->{part} }, $form->{"sku_$i"}); - push(@{ $form->{service} }, NULL); - $form->{totalparts} += $linetotal; - } else { - push(@{ $form->{service} }, $form->{"sku_$i"}); - push(@{ $form->{part} }, NULL); - $form->{totalservices} += $linetotal; - } - - push(@{ $form->{netprice} }, - ($form->{"netprice_$i"}) - ? $form->format_amount( - $myconfig, $form->{"netprice_$i"}, - $decimalplaces) - : " "); - - $discount = - ($discount) - ? $form->format_amount( - $myconfig, $discount * -1, - $decimalplaces) - : " "; - $linetotal = ($linetotal) ? $linetotal : " "; - - push(@{ $form->{discount} }, $discount); - push(@{ $form->{discountrate} }, - $form->format_amount( - $myconfig, $form->{"discount_$i"})); - - $form->{total} += $linetotal; - - # this is for the subtotals for grouping - $subtotal += $linetotal; - - $form->{"linetotal_$i"} = - $form->format_amount($myconfig, $linetotal, 2); - - push(@{ $form->{linetotal} }, $form->{"linetotal_$i"}); - - @taxaccounts = Tax::init_taxes( - $form, $form->{"taxaccounts_$i"}); - - my $ml = 1; - my @taxrates = (); - - $tax = 0; - - if ($form->{taxincluded}) { - $taxamount = Tax::calculate_taxes( - \@taxaccounts, $form, $linetotal, 1); - $taxbase = ($linetotal - $taxamount); - $tax += Tax::extract_taxes( - \@taxaccounts, $form, $linetotal); - } else { - $taxamount = Tax::calculate_taxes( - \@taxaccounts, $form, $linetotal, 0); - $tax += Tax::apply_taxes( - \@taxaccounts, $form, $linetotal); - } - - foreach $item (@taxaccounts) { - push @taxrates, 100 * $item->rate; - $taxaccounts{$item->account} += $item->value; - if ($form->{taxincluded}) { - $taxbase{$item->account} += $taxbase; - } else { - $taxbase{$item->account} += $linetotal; - } - } - - push(@{ $form->{lineitems} }, - { amount => $linetotal, - tax => $form->round_amount($tax, 2) }); - - push(@{ $form->{taxrates} }, - join' ', sort { $a <=> $b } @taxrates); - - if ($form->{"assembly_$i"}) { - $form->{stagger} = -1; - &assembly_details( - $myconfig, $form, $dbh, - $form->{"id_$i"}, - $oid{$myconfig->{dbdriver}}, - $form->{"qty_$i"}); - } - - } - - # add subtotal - if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { - if ($subtotal) { - if ($j < $k) { - # look at next item - if ($sortlist[$j]->[1] ne $sameitem) { - - if ($form->{"inventory_accno_id_$j"} || $form->{"assembly_$i"}) { - - - push(@{ $form->{part} }, - ""); - push(@{$form->{service}}, - NULL); - } else { - push(@{$form->{service}}, - ""); - - push(@{ $form->{part} }, - NULL); - } - - for ( - qw(taxrates - runningnumber number sku - serialnumber bin qty - ship unit deliverydate - projectnumber sellprice - listprice netprice - discount discountrate - weight itemnotes) - ) { - - push(@{ $form->{$_} }, - "") - } - - push(@{ $form->{description} }, - $form->{groupsubtotaldescription}); - - push(@{ $form->{lineitems} }, - { amount => 0, - tax => 0 }); - - - if ($form->{groupsubtotaldescription} ne "") { - - push(@{ $form->{linetotal} }, - $form->format_amount( - $myconfig, - $subtotal, - 2)); - } else { - push(@{$form->{linetotal}}, - ""); - } - $subtotal = 0; - } - - } else { - - # got last item - if ($form->{groupsubtotaldescription} - ne "") { - - if ($form->{"inventory_accno_id_$j"} || $form->{"assembly_$i"}) { - - push(@{ $form->{part} }, - ""); - - push(@{$form->{service}}, - NULL); - } else { - push(@{$form->{service}}, - ""); - - push(@{ $form->{part} }, - NULL); - } - - for ( - qw(taxrates - runningnumber number sku - serialnumber bin qty - ship unit deliverydate - projectnumber sellprice - listprice netprice - discount discountrate - weight itemnotes) - ) { - - push(@{ $form->{$_} }, - ""); - } - - push(@{ $form->{description} }, - $form->{groupsubtotaldescription}); - - push(@{ $form->{linetotal} }, - $form->format_amount( - $myconfig, - $subtotal, - 2)); - push(@{ $form->{lineitems} }, - { amount => 0, - tax => 0 }); - } - } - } - } - } - - - $tax = 0; - foreach my $item (sort keys %taxaccounts) { - if ($form->round_amount($taxaccounts{$item}, 2)) { - $tax += $taxamount = - $form->round_amount($taxaccounts{$item}, 2); - - push(@{ $form->{taxbaseinclusive} }, - $form->{"${item}_taxbaseinclusive"} - = $form->format_amount( - $myconfig, - $taxbase{$item} + $tax, 2)); - - push(@{ $form->{taxbase} }, - $form->{"${item}_taxbase"} - = $form->format_amount( - $myconfig, $taxbase{$item}, 2)); - - push(@{ $form->{tax} }, - $form->{"${item}_tax"} - = $form->format_amount( - $myconfig, $taxamount, 2)); - - push(@{ $form->{taxdescription} }, - $form->{"${item}_description"}); - - $form->{"${item}_taxrate"} - = $form->format_amount( - $myconfig, - $form->{"${item}_rate"} * 100); - push(@{ $form->{taxrate} }, $form->{"${item}_taxrate"}); - push(@{ $form->{taxnumber} }, - $form->{"${item}_taxnumber"}); - } - } - - # adjust taxes for lineitems - my $total = 0; - for (@{ $form->{lineitems} }) { - $total += $_->{tax}; - } - if ($form->round_amount($total,2) != $form->round_amount($tax,2)) { - # get largest amount - for (reverse sort { $a->{tax} <=> $b->{tax} } - @{ $form->{lineitems} }) { - - $_->{tax} -= $total - $tax; - last; - } - } - $i = 1; - for (@{ $form->{lineitems} }) { - push(@{ $form->{linetax} }, - $form->format_amount($myconfig, $_->{tax}, 2, "")); - } - - - for $i (1 .. $form->{paidaccounts}) { - if ($form->{"paid_$i"}) { - push(@{ $form->{payment} }, $form->{"paid_$i"}); - my ($accno, $description) - = split /--/, $form->{"AR_paid_$i"}; - - push(@{ $form->{paymentaccount} }, $description); - push(@{ $form->{paymentdate} }, $form->{"datepaid_$i"}); - push(@{ $form->{paymentsource} }, $form->{"source_$i"}); - push(@{ $form->{paymentmemo} }, $form->{"memo_$i"}); - - $form->{paid} - += $form->parse_amount( - $myconfig, $form->{"paid_$i"}); - } - } - - for (qw(totalparts totalservices)) { - $form->{$_} = $form->format_amount($myconfig, $form->{$_}, 2); - } - for (qw(totalqty totalship totalweight)) { - $form->{$_} = $form->format_amount($myconfig, $form->{$_}); - } - $form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2); - $form->{invtotal} = - ($form->{taxincluded}) ? $form->{total} : $form->{total} + $tax; - - my $c; - if ($form->{language_code} ne "") { - $c = new CP $form->{language_code}; - } else { - $c = new CP $myconfig->{countrycode}; - } - $c->init; - my $whole; - ($whole, $form->{decimal}) = split /\./, $form->{invtotal}; - $form->{decimal} .= "00"; - $form->{decimal} = substr($form->{decimal}, 0, 2); - $form->{text_decimal} = $c->num2text($form->{decimal} * 1); - $form->{text_amount} = $c->num2text($whole); - $form->{integer_amount} = $form->format_amount($myconfig, $whole); - - $form->format_string(qw(text_amount text_decimal)); - - $form->{total} - = $form->format_amount( - $myconfig, $form->{invtotal} - $form->{paid}, 2); - - $form->{invtotal} - = $form->format_amount($myconfig, $form->{invtotal}, 2); - - $form->{paid} = $form->format_amount($myconfig, $form->{paid}, 2); - - $dbh->commit; - -} + my $pth = $dbh->prepare($query) || $form->dberror($query); + + my $sortby; + + # sort items by project and partsgroup + for $i ( 1 .. $form->{rowcount} - 1 ) { + + # account numbers + $pth->execute( $form->{"id_$i"} ); + $ref = $pth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{"${_}_$i"} = $ref->{$_} } + $pth->finish; + + $projectnumber_id = 0; + $projectnumber = ""; + $form->{partsgroup} = ""; + $form->{projectnumber} = ""; + + if ( $form->{groupprojectnumber} || $form->{grouppartsgroup} ) { + + $inventory_accno_id = + ( $form->{"inventory_accno_id_$i"} || $form->{"assembly_$i"} ) + ? "1" + : ""; + + if ( $form->{groupprojectnumber} ) { + ( $projectnumber, $projectnumber_id ) = + split /--/, $form->{"projectnumber_$i"}; + } + if ( $form->{grouppartsgroup} ) { + ( $form->{partsgroup} ) = + split /--/, $form->{"partsgroup_$i"}; + } + + if ( $projectnumber_id && $form->{groupprojectnumber} ) { + if ( $translation{$projectnumber_id} ) { + $form->{projectnumber} = $translation{$projectnumber_id}; + } + else { + + # get project description + $prh->execute( $projectnumber_id, $form->{language_code} ); + + ( $projectdescription, $translation ) = + $prh->fetchrow_array; + + $prh->finish; + + $form->{projectnumber} = + ($translation) + ? "$projectnumber, $translation" + : "$projectnumber, " . "$projectdescription"; + + $translation{$projectnumber_id} = $form->{projectnumber}; + } + } + + if ( $form->{grouppartsgroup} && $form->{partsgroup} ) { + $form->{projectnumber} .= " / " + if $projectnumber_id; + $form->{projectnumber} .= $form->{partsgroup}; + } + + $form->format_string(projectnumber); + + } + + $sortby = qq|$projectnumber$form->{partsgroup}|; + if ( $form->{sortby} ne 'runningnumber' ) { + for (qw(partnumber description bin)) { + $sortby .= $form->{"${_}_$i"} + if $form->{sortby} eq $_; + } + } + + push @sortlist, + [ + $i, + qq|$projectnumber$form->{partsgroup}| . qq|$inventory_accno_id|, + $form->{projectnumber}, + $projectnumber_id, + $form->{partsgroup}, + $sortby + ]; + + } + + # sort the whole thing by project and group + @sortlist = sort { $a->[5] cmp $b->[5] } @sortlist; + + my $runningnumber = 1; + my $sameitem = ""; + my $subtotal; + my $k = scalar @sortlist; + my $j = 0; + + foreach $item (@sortlist) { + + $i = $item->[0]; + $j++; + + # heading + if ( $form->{groupprojectnumber} || $form->{grouppartsgroup} ) { + if ( $item->[1] ne $sameitem ) { + $sameitem = $item->[1]; + + $ok = 0; + + if ( $form->{groupprojectnumber} ) { + $ok = $form->{"projectnumber_$i"}; + } + if ( $form->{grouppartsgroup} ) { + $ok = $form->{"partsgroup_$i"} + unless $ok; + } + + if ($ok) { + + if ( $form->{"inventory_accno_id_$i"} + || $form->{"assembly_$i"} ) + { + + push( @{ $form->{part} }, "" ); + push( @{ $form->{service} }, NULL ); + } + else { + push( @{ $form->{part} }, NULL ); + push( @{ $form->{service} }, "" ); + } + + push( @{ $form->{description} }, $item->[2] ); + for ( + qw(taxrates runningnumber number + sku serialnumber bin qty ship + unit deliverydate projectnumber + sellprice listprice netprice + discount discountrate linetotal + weight itemnotes) + ) + { + push( @{ $form->{$_} }, "" ); + } + push( @{ $form->{lineitems} }, { amount => 0, tax => 0 } ); + } + } + } + + $form->{"qty_$i"} = $form->parse_amount( $myconfig, $form->{"qty_$i"} ); + + if ( $form->{"qty_$i"} ) { + + $form->{totalqty} += $form->{"qty_$i"}; + $form->{totalship} += $form->{"qty_$i"}; + $form->{totalweight} += + ( $form->{"qty_$i"} * $form->{"weight_$i"} ); + + $form->{totalweightship} += + ( $form->{"qty_$i"} * $form->{"weight_$i"} ); + + # add number, description and qty to $form->{number}... + push( @{ $form->{runningnumber} }, $runningnumber++ ); + push( @{ $form->{number} }, $form->{"partnumber_$i"} ); + push( @{ $form->{sku} }, $form->{"sku_$i"} ); + push( @{ $form->{serialnumber} }, $form->{"serialnumber_$i"} ); + + push( @{ $form->{bin} }, $form->{"bin_$i"} ); + push( @{ $form->{description} }, $form->{"description_$i"} ); + push( @{ $form->{itemnotes} }, $form->{"notes_$i"} ); + push( + @{ $form->{qty} }, + $form->format_amount( $myconfig, $form->{"qty_$i"} ) + ); + + push( + @{ $form->{ship} }, + $form->format_amount( $myconfig, $form->{"qty_$i"} ) + ); + + push( @{ $form->{unit} }, $form->{"unit_$i"} ); + push( @{ $form->{deliverydate} }, $form->{"deliverydate_$i"} ); + + push( @{ $form->{projectnumber} }, $form->{"projectnumber_$i"} ); + + push( @{ $form->{sellprice} }, $form->{"sellprice_$i"} ); + + push( @{ $form->{listprice} }, $form->{"listprice_$i"} ); + + push( + @{ $form->{weight} }, + $form->format_amount( + $myconfig, $form->{"weight_$i"} * $form->{"qty_$i"} + ) + ); + + my $sellprice = + $form->parse_amount( $myconfig, $form->{"sellprice_$i"} ); + + my ($dec) = ( $sellprice =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + my $discount = $form->round_amount( + $sellprice * + $form->parse_amount( $myconfig, $form->{"discount_$i"} ) / + 100, + $decimalplaces + ); + + # keep a netprice as well, (sellprice - discount) + $form->{"netprice_$i"} = $sellprice - $discount; + + my $linetotal = + $form->round_amount( $form->{"qty_$i"} * $form->{"netprice_$i"}, + 2 ); + + if ( $form->{"inventory_accno_id_$i"} + || $form->{"assembly_$i"} ) + { + + push( @{ $form->{part} }, $form->{"sku_$i"} ); + push( @{ $form->{service} }, NULL ); + $form->{totalparts} += $linetotal; + } + else { + push( @{ $form->{service} }, $form->{"sku_$i"} ); + push( @{ $form->{part} }, NULL ); + $form->{totalservices} += $linetotal; + } + + push( + @{ $form->{netprice} }, + ( $form->{"netprice_$i"} ) + ? $form->format_amount( $myconfig, $form->{"netprice_$i"}, + $decimalplaces ) + : " " + ); + + $discount = + ($discount) + ? $form->format_amount( $myconfig, $discount * -1, + $decimalplaces ) + : " "; + $linetotal = ($linetotal) ? $linetotal : " "; + + push( @{ $form->{discount} }, $discount ); + push( + @{ $form->{discountrate} }, + $form->format_amount( $myconfig, $form->{"discount_$i"} ) + ); + + $form->{total} += $linetotal; + + # this is for the subtotals for grouping + $subtotal += $linetotal; + + $form->{"linetotal_$i"} = + $form->format_amount( $myconfig, $linetotal, 2 ); + + push( @{ $form->{linetotal} }, $form->{"linetotal_$i"} ); + + @taxaccounts = Tax::init_taxes( $form, $form->{"taxaccounts_$i"} ); + + my $ml = 1; + my @taxrates = (); + + $tax = 0; + + if ( $form->{taxincluded} ) { + $taxamount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 1 ); + $taxbase = ( $linetotal - $taxamount ); + $tax += Tax::extract_taxes( \@taxaccounts, $form, $linetotal ); + } + else { + $taxamount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 0 ); + $tax += Tax::apply_taxes( \@taxaccounts, $form, $linetotal ); + } + + foreach $item (@taxaccounts) { + push @taxrates, 100 * $item->rate; + $taxaccounts{ $item->account } += $item->value; + if ( $form->{taxincluded} ) { + $taxbase{ $item->account } += $taxbase; + } + else { + $taxbase{ $item->account } += $linetotal; + } + } + + push( + @{ $form->{lineitems} }, + { + amount => $linetotal, + tax => $form->round_amount( $tax, 2 ) + } + ); + + push( @{ $form->{taxrates} }, + join ' ', sort { $a <=> $b } @taxrates ); + + if ( $form->{"assembly_$i"} ) { + $form->{stagger} = -1; + &assembly_details( $myconfig, $form, $dbh, $form->{"id_$i"}, + $oid{ $myconfig->{dbdriver} }, + $form->{"qty_$i"} ); + } + + } + + # add subtotal + if ( $form->{groupprojectnumber} || $form->{grouppartsgroup} ) { + if ($subtotal) { + if ( $j < $k ) { + + # look at next item + if ( $sortlist[$j]->[1] ne $sameitem ) { + + if ( $form->{"inventory_accno_id_$j"} + || $form->{"assembly_$i"} ) + { + + push( @{ $form->{part} }, "" ); + push( @{ $form->{service} }, NULL ); + } + else { + push( @{ $form->{service} }, "" ); + + push( @{ $form->{part} }, NULL ); + } + + for ( + qw(taxrates + runningnumber number sku + serialnumber bin qty + ship unit deliverydate + projectnumber sellprice + listprice netprice + discount discountrate + weight itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + + push( + @{ $form->{description} }, + $form->{groupsubtotaldescription} + ); + + push( + @{ $form->{lineitems} }, + { + amount => 0, + tax => 0 + } + ); + + if ( $form->{groupsubtotaldescription} ne "" ) { + + push( + @{ $form->{linetotal} }, + $form->format_amount( $myconfig, $subtotal, 2 ) + ); + } + else { + push( @{ $form->{linetotal} }, "" ); + } + $subtotal = 0; + } + + } + else { + + # got last item + if ( $form->{groupsubtotaldescription} ne "" ) { + + if ( $form->{"inventory_accno_id_$j"} + || $form->{"assembly_$i"} ) + { + + push( @{ $form->{part} }, "" ); + + push( @{ $form->{service} }, NULL ); + } + else { + push( @{ $form->{service} }, "" ); + + push( @{ $form->{part} }, NULL ); + } + + for ( + qw(taxrates + runningnumber number sku + serialnumber bin qty + ship unit deliverydate + projectnumber sellprice + listprice netprice + discount discountrate + weight itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + + push( + @{ $form->{description} }, + $form->{groupsubtotaldescription} + ); + + push( + @{ $form->{linetotal} }, + $form->format_amount( $myconfig, $subtotal, 2 ) + ); + push( + @{ $form->{lineitems} }, + { + amount => 0, + tax => 0 + } + ); + } + } + } + } + } + + $tax = 0; + foreach my $item ( sort keys %taxaccounts ) { + if ( $form->round_amount( $taxaccounts{$item}, 2 ) ) { + $tax += $taxamount = $form->round_amount( $taxaccounts{$item}, 2 ); + + push( + @{ $form->{taxbaseinclusive} }, + $form->{"${item}_taxbaseinclusive"} = + $form->format_amount( $myconfig, $taxbase{$item} + $tax, 2 ) + ); + + push( + @{ $form->{taxbase} }, + $form->{"${item}_taxbase"} = + $form->format_amount( $myconfig, $taxbase{$item}, 2 ) + ); + + push( + @{ $form->{tax} }, + $form->{"${item}_tax"} = + $form->format_amount( $myconfig, $taxamount, 2 ) + ); + + push( @{ $form->{taxdescription} }, + $form->{"${item}_description"} ); + + $form->{"${item}_taxrate"} = + $form->format_amount( $myconfig, $form->{"${item}_rate"} * 100 ); + push( @{ $form->{taxrate} }, $form->{"${item}_taxrate"} ); + push( @{ $form->{taxnumber} }, $form->{"${item}_taxnumber"} ); + } + } + + # adjust taxes for lineitems + my $total = 0; + for ( @{ $form->{lineitems} } ) { + $total += $_->{tax}; + } + if ( $form->round_amount( $total, 2 ) != $form->round_amount( $tax, 2 ) ) { + + # get largest amount + for ( reverse sort { $a->{tax} <=> $b->{tax} } @{ $form->{lineitems} } ) + { + + $_->{tax} -= $total - $tax; + last; + } + } + $i = 1; + for ( @{ $form->{lineitems} } ) { + push( + @{ $form->{linetax} }, + $form->format_amount( $myconfig, $_->{tax}, 2, "" ) + ); + } + + for $i ( 1 .. $form->{paidaccounts} ) { + if ( $form->{"paid_$i"} ) { + push( @{ $form->{payment} }, $form->{"paid_$i"} ); + my ( $accno, $description ) = split /--/, $form->{"AR_paid_$i"}; + + push( @{ $form->{paymentaccount} }, $description ); + push( @{ $form->{paymentdate} }, $form->{"datepaid_$i"} ); + push( @{ $form->{paymentsource} }, $form->{"source_$i"} ); + push( @{ $form->{paymentmemo} }, $form->{"memo_$i"} ); + + $form->{paid} += + $form->parse_amount( $myconfig, $form->{"paid_$i"} ); + } + } + + for (qw(totalparts totalservices)) { + $form->{$_} = $form->format_amount( $myconfig, $form->{$_}, 2 ); + } + for (qw(totalqty totalship totalweight)) { + $form->{$_} = $form->format_amount( $myconfig, $form->{$_} ); + } + $form->{subtotal} = $form->format_amount( $myconfig, $form->{total}, 2 ); + $form->{invtotal} = + ( $form->{taxincluded} ) ? $form->{total} : $form->{total} + $tax; + + my $c; + if ( $form->{language_code} ne "" ) { + $c = new CP $form->{language_code}; + } + else { + $c = new CP $myconfig->{countrycode}; + } + $c->init; + my $whole; + ( $whole, $form->{decimal} ) = split /\./, $form->{invtotal}; + $form->{decimal} .= "00"; + $form->{decimal} = substr( $form->{decimal}, 0, 2 ); + $form->{text_decimal} = $c->num2text( $form->{decimal} * 1 ); + $form->{text_amount} = $c->num2text($whole); + $form->{integer_amount} = $form->format_amount( $myconfig, $whole ); + + $form->format_string(qw(text_amount text_decimal)); + + $form->{total} = + $form->format_amount( $myconfig, $form->{invtotal} - $form->{paid}, 2 ); + + $form->{invtotal} = $form->format_amount( $myconfig, $form->{invtotal}, 2 ); + + $form->{paid} = $form->format_amount( $myconfig, $form->{paid}, 2 ); + + $dbh->commit; +} sub assembly_details { - my ($myconfig, $form, $dbh2, $id, $oid, $qty) = @_; - $dbh = $form->{dbh}; - my $sm = ""; - my $spacer; - - $form->{stagger}++; - if ($form->{format} eq 'html') { - $spacer = " " x (3 * ($form->{stagger} - 1)) - if $form->{stagger} > 1; - } - if ($form->{format} =~ /(postscript|pdf)/) { - if ($form->{stagger} > 1) { - $spacer = ($form->{stagger} - 1) * 3; - $spacer = '\rule{'.$spacer.'mm}{0mm}'; - } - } - - # get parts and push them onto the stack - my $sortorder = ""; - - if ($form->{grouppartsgroup}) { - $sortorder = qq|ORDER BY pg.partsgroup|; - } - - my $query = qq| + my ( $myconfig, $form, $dbh2, $id, $oid, $qty ) = @_; + $dbh = $form->{dbh}; + my $sm = ""; + my $spacer; + + $form->{stagger}++; + if ( $form->{format} eq 'html' ) { + $spacer = " " x ( 3 * ( $form->{stagger} - 1 ) ) + if $form->{stagger} > 1; + } + if ( $form->{format} =~ /(postscript|pdf)/ ) { + if ( $form->{stagger} > 1 ) { + $spacer = ( $form->{stagger} - 1 ) * 3; + $spacer = '\rule{' . $spacer . 'mm}{0mm}'; + } + } + + # get parts and push them onto the stack + my $sortorder = ""; + + if ( $form->{grouppartsgroup} ) { + $sortorder = qq|ORDER BY pg.partsgroup|; + } + + my $query = qq| SELECT p.partnumber, p.description, p.unit, a.qty, pg.partsgroup, p.partnumber AS sku FROM assembly a @@ -663,119 +664,122 @@ sub assembly_details { WHERE a.bom = '1' AND a.id = ? $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - - for (qw(partnumber description partsgroup)) { - $form->{"a_$_"} = $ref->{$_}; - $form->format_string("a_$_"); - } - - if ($form->{grouppartsgroup} && $ref->{partsgroup} ne $sm) { - for ( - qw(taxrates runningnumber number sku - serialnumber unit qty ship bin deliverydate - projectnumber sellprice listprice netprice - discount discountrate linetotal weight - itemnotes) - ) { - - push(@{ $form->{$_} }, ""); - } - $sm = - ($form->{"a_partsgroup"}) - ? $form->{"a_partsgroup"} - : "--"; - - push(@{ $form->{description} }, "$spacer$sm"); - push(@{ $form->{lineitems} }, - { amount => 0, tax => 0 }); - } - - if ($form->{stagger}) { - - push(@{ $form->{description} }, - $form->format_amount( - $myconfig, - $ref->{qty} * $form->{"qty_$i"}) - .qq| -- $form->{"a_partnumber"}| - .qq|, $form->{"a_description"}|); - - for ( - qw(taxrates runningnumber number sku - serialnumber unit qty ship bin deliverydate - projectnumber sellprice listprice netprice - discount discountrate linetotal weight - itemnotes) - ) { - push(@{ $form->{$_} }, ""); - } - - } else { - - push(@{ $form->{description} }, - qq|$form->{"a_description"}|); - - push(@{ $form->{number} }, $form->{"a_partnumber"}); - push(@{ $form->{sku} }, $form->{"a_partnumber"}); - - for ( - qw(taxrates runningnumber ship serialnumber - reqdate projectnumber sellprice listprice - netprice discount discountrate linetotal weight - itemnotes) - ) { - - push(@{ $form->{$_} }, ""); - } - - } - - push(@{ $form->{lineitems} }, { amount => 0, tax => 0 }); - - push(@{ $form->{qty} }, - $form->format_amount($myconfig, $ref->{qty} * $qty)); - - for (qw(unit bin)) { - $form->{"a_$_"} = $ref->{$_}; - $form->format_string("a_$_"); - push(@{ $form->{$_} }, $form->{"a_$_"}); - } - - } - $sth->finish; - - $form->{stagger}--; - -} + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + for (qw(partnumber description partsgroup)) { + $form->{"a_$_"} = $ref->{$_}; + $form->format_string("a_$_"); + } + + if ( $form->{grouppartsgroup} && $ref->{partsgroup} ne $sm ) { + for ( + qw(taxrates runningnumber number sku + serialnumber unit qty ship bin deliverydate + projectnumber sellprice listprice netprice + discount discountrate linetotal weight + itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + $sm = + ( $form->{"a_partsgroup"} ) + ? $form->{"a_partsgroup"} + : "--"; + + push( @{ $form->{description} }, "$spacer$sm" ); + push( @{ $form->{lineitems} }, { amount => 0, tax => 0 } ); + } + + if ( $form->{stagger} ) { + + push( + @{ $form->{description} }, + $form->format_amount( $myconfig, + $ref->{qty} * $form->{"qty_$i"} ) + . qq| -- $form->{"a_partnumber"}| + . qq|, $form->{"a_description"}| + ); + + for ( + qw(taxrates runningnumber number sku + serialnumber unit qty ship bin deliverydate + projectnumber sellprice listprice netprice + discount discountrate linetotal weight + itemnotes) + ) + { + push( @{ $form->{$_} }, "" ); + } + + } + else { + + push( @{ $form->{description} }, qq|$form->{"a_description"}| ); + + push( @{ $form->{number} }, $form->{"a_partnumber"} ); + push( @{ $form->{sku} }, $form->{"a_partnumber"} ); + + for ( + qw(taxrates runningnumber ship serialnumber + reqdate projectnumber sellprice listprice + netprice discount discountrate linetotal weight + itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + + } + + push( @{ $form->{lineitems} }, { amount => 0, tax => 0 } ); + + push( + @{ $form->{qty} }, + $form->format_amount( $myconfig, $ref->{qty} * $qty ) + ); + + for (qw(unit bin)) { + $form->{"a_$_"} = $ref->{$_}; + $form->format_string("a_$_"); + push( @{ $form->{$_} }, $form->{"a_$_"} ); + } + + } + $sth->finish; + + $form->{stagger}--; +} sub project_description { - my ($self, $dbh2, $id) = @_; - $dbh = $form->{dbh}; - my $query = qq| + my ( $self, $dbh2, $id ) = @_; + $dbh = $form->{dbh}; + my $query = qq| SELECT description FROM project WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($id); - ($_) = $sth->fetchrow_array; + $sth = $dbh->prepare($query); + $sth->execute($id); + ($_) = $sth->fetchrow_array; - $_; + $_; } - sub customer_details { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; - - # get rest for the customer - my $query = qq| + my $dbh = $form->{dbh}; + + # get rest for the customer + my $query = qq| SELECT customernumber, name, address1, address2, city, state, zipcode, country, contact, phone as customerphone, fax as customerfax, @@ -783,232 +787,225 @@ sub customer_details { bic, startdate, enddate FROM customer WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{customer_id}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{customer_id} ) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub post_invoice { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $query; - my $sth; - my $null; - my $project_id; - my $exchangerate = 0; - my $keepcleared = 0; - - %$form->{acc_trans} = (); - - ($null, $form->{employee_id}) = split /--/, $form->{employee}; - unless ($form->{employee_id}) { - ($form->{employee}, $form->{employee_id}) - = $form->get_employee($dbh); - } - - ($null, $form->{department_id}) = split(/--/, $form->{department}); - $form->{department_id} *= 1; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $query; + my $sth; + my $null; + my $project_id; + my $exchangerate = 0; + my $keepcleared = 0; + + %$form->{acc_trans} = (); + + ( $null, $form->{employee_id} ) = split /--/, $form->{employee}; + unless ( $form->{employee_id} ) { + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + } + + ( $null, $form->{department_id} ) = split( /--/, $form->{department} ); + $form->{department_id} *= 1; + + $query = qq| SELECT (SELECT value FROM defaults WHERE setting_key = 'fxgain_accno_id') AS fxgain_accno_id, (SELECT value FROM defaults WHERE setting_key = 'fxloss_accno_id') AS fxloss_accno_id|; - my ($fxgain_accno_id, $fxloss_accno_id) = $dbh->selectrow_array($query); + my ( $fxgain_accno_id, $fxloss_accno_id ) = $dbh->selectrow_array($query); - $query = qq| + $query = qq| SELECT p.assembly, p.inventory_accno_id, p.income_accno_id, p.expense_accno_id, p.project_id FROM parts p WHERE p.id = ?|; - my $pth = $dbh->prepare($query) || $form->dberror($query); - - if ($form->{id}) { - $keepcleared = 1; - $query = qq|SELECT id FROM ar WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - - if ($sth->fetchrow_array) { - &reverse_invoice($dbh, $form); - } else { - $query = qq|INSERT INTO ar (id) VALUES (?)|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - } - - } - - my $uid = localtime; - $uid .= "$$"; - - if (! $form->{id}) { - - $query = qq| + my $pth = $dbh->prepare($query) || $form->dberror($query); + + if ( $form->{id} ) { + $keepcleared = 1; + $query = qq|SELECT id FROM ar WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + + if ( $sth->fetchrow_array ) { + &reverse_invoice( $dbh, $form ); + } + else { + $query = qq|INSERT INTO ar (id) VALUES (?)|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + } + + } + + my $uid = localtime; + $uid .= "$$"; + + if ( !$form->{id} ) { + + $query = qq| INSERT INTO ar (invnumber, employee_id) VALUES ('$uid', ?)|; - $sth = $dbh->prepare($query); - $sth->execute($form->{employee_id}) || $form->dberror($query); - - $query = qq|SELECT id FROM ar WHERE invnumber = '$uid'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - ($form->{id}) = $sth->fetchrow_array; - $sth->finish; - - @queries = $form->run_custom_queries('ar', 'INSERT'); - } - - - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{exchangerate} = 1; - } else { - $exchangerate = - $form->check_exchangerate( - $myconfig, $form->{currency}, - $form->{transdate}, 'buy'); - } - - $form->{exchangerate} = - ($exchangerate) - ? $exchangerate - : $form->parse_amount($myconfig, $form->{exchangerate}); - - my $i; - my $item; - my $allocated = 0; - my $taxrate; - my $tax; - my $fxtax; - my @taxaccounts; - my $amount; - my $grossamount; - my $invamount = 0; - my $invnetamount = 0; - my $diff = 0; - my $ml; - my $invoice_id; - my $ndx; - - foreach $i (1 .. $form->{rowcount}) { - $form->{"qty_$i"} = - $form->parse_amount($myconfig, $form->{"qty_$i"}); - - if ($form->{"qty_$i"}) { - - $pth->execute($form->{"id_$i"}); - $ref = $pth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{"${_}_$i"} = $ref->{$_} } - $pth->finish; - - # project - if ($form->{"projectnumber_$i"}) { - ($null, $project_id) - = split /--/, - $form->{"projectnumber_$i"}; - } - $project_id = $form->{"project_id_$i"} - if $form->{"project_id_$i"}; - - # keep entered selling price - my $fxsellprice = - $form->parse_amount( - $myconfig, $form->{"sellprice_$i"}); - - my ($dec) = ($fxsellprice =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - # undo discount formatting - $form->{"discount_$i"} = - $form->parse_amount( - $myconfig, $form->{"discount_$i"})/100; - - # deduct discount - $form->{"sellprice_$i"} = $fxsellprice - - $form->round_amount( - $fxsellprice * $form->{"discount_$i"}, - $decimalplaces); - - # linetotal - my $fxlinetotal = $form->round_amount( - $form->{"sellprice_$i"} * $form->{"qty_$i"}, 2); - - $amount = $fxlinetotal * $form->{exchangerate}; - my $linetotal = $form->round_amount($amount, 2); - $fxdiff += $amount - $linetotal; - - @taxaccounts = Tax::init_taxes( - $form, $form->{"taxaccounts_$i"}); - $ml = 1; - $tax = 0; - $fxtax = 0; - - if ($form->{taxincluded}) { - $tax += $amount = - Tax::calculate_taxes( - \@taxaccounts, $form, - $linetotal, 1); - $form->{"sellprice_$i"} -= $amount - / $form->{"qty_$i"}; - - $fxtax += Tax::calculate_taxes( - \@taxaccounts, $form, $linetotal, 1); - } else { - $tax += $amount = Tax::calculate_taxes( - \@taxaccounts, $form, $linetotal, 0); - - $fxtax += Tax::calculate_taxes( - \@taxaccounts, $form, $linetotal, 0); - } - - $grossamount = $form->round_amount($linetotal, 2); - - if ($form->{taxincluded}) { - $amount = $form->round_amount($tax, 2); - $linetotal -= $form->round_amount( - $tax - $diff, 2); - $diff = ($amount - $tax); - } - - # add linetotal to income - $amount = $form->round_amount($linetotal, 2); - - push @{ $form->{acc_trans}{lineitems} }, { - chart_id => $form->{"income_accno_id_$i"}, - amount => $amount, - fxgrossamount => $fxlinetotal + $fxtax, - grossamount => $grossamount, - project_id => $project_id }; - - $ndx = $#{@{$form->{acc_trans}{lineitems}}}; - - $form->{"sellprice_$i"} = - $form->round_amount( - $form->{"sellprice_$i"} - * $form->{exchangerate}, - $decimalplaces); - - if ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) { - - if ($form->{"assembly_$i"}) { - # If the assembly consists of all - # services, we don't keep inventory, - # so we should not update it - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{employee_id} ) || $form->dberror($query); + + $query = qq|SELECT id FROM ar WHERE invnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ( $form->{id} ) = $sth->fetchrow_array; + $sth->finish; + + @queries = $form->run_custom_queries( 'ar', 'INSERT' ); + } + + if ( $form->{currency} eq $form->{defaultcurrency} ) { + $form->{exchangerate} = 1; + } + else { + $exchangerate = + $form->check_exchangerate( $myconfig, $form->{currency}, + $form->{transdate}, 'buy' ); + } + + $form->{exchangerate} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount( $myconfig, $form->{exchangerate} ); + + my $i; + my $item; + my $allocated = 0; + my $taxrate; + my $tax; + my $fxtax; + my @taxaccounts; + my $amount; + my $grossamount; + my $invamount = 0; + my $invnetamount = 0; + my $diff = 0; + my $ml; + my $invoice_id; + my $ndx; + + foreach $i ( 1 .. $form->{rowcount} ) { + $form->{"qty_$i"} = $form->parse_amount( $myconfig, $form->{"qty_$i"} ); + + if ( $form->{"qty_$i"} ) { + + $pth->execute( $form->{"id_$i"} ); + $ref = $pth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{"${_}_$i"} = $ref->{$_} } + $pth->finish; + + # project + if ( $form->{"projectnumber_$i"} ) { + ( $null, $project_id ) = split /--/, + $form->{"projectnumber_$i"}; + } + $project_id = $form->{"project_id_$i"} + if $form->{"project_id_$i"}; + + # keep entered selling price + my $fxsellprice = + $form->parse_amount( $myconfig, $form->{"sellprice_$i"} ); + + my ($dec) = ( $fxsellprice =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + # undo discount formatting + $form->{"discount_$i"} = + $form->parse_amount( $myconfig, $form->{"discount_$i"} ) / 100; + + # deduct discount + $form->{"sellprice_$i"} = $fxsellprice - + $form->round_amount( $fxsellprice * $form->{"discount_$i"}, + $decimalplaces ); + + # linetotal + my $fxlinetotal = + $form->round_amount( $form->{"sellprice_$i"} * $form->{"qty_$i"}, + 2 ); + + $amount = $fxlinetotal * $form->{exchangerate}; + my $linetotal = $form->round_amount( $amount, 2 ); + $fxdiff += $amount - $linetotal; + + @taxaccounts = Tax::init_taxes( $form, $form->{"taxaccounts_$i"} ); + $ml = 1; + $tax = 0; + $fxtax = 0; + + if ( $form->{taxincluded} ) { + $tax += $amount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 1 ); + $form->{"sellprice_$i"} -= $amount / $form->{"qty_$i"}; + + $fxtax += + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 1 ); + } + else { + $tax += $amount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 0 ); + + $fxtax += + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 0 ); + } + + $grossamount = $form->round_amount( $linetotal, 2 ); + + if ( $form->{taxincluded} ) { + $amount = $form->round_amount( $tax, 2 ); + $linetotal -= $form->round_amount( $tax - $diff, 2 ); + $diff = ( $amount - $tax ); + } + + # add linetotal to income + $amount = $form->round_amount( $linetotal, 2 ); + + push @{ $form->{acc_trans}{lineitems} }, + { + chart_id => $form->{"income_accno_id_$i"}, + amount => $amount, + fxgrossamount => $fxlinetotal + $fxtax, + grossamount => $grossamount, + project_id => $project_id + }; + + $ndx = $#{ @{ $form->{acc_trans}{lineitems} } }; + + $form->{"sellprice_$i"} = + $form->round_amount( + $form->{"sellprice_$i"} * $form->{exchangerate}, + $decimalplaces ); + + if ( $form->{"inventory_accno_id_$i"} + || $form->{"assembly_$i"} ) + { + + if ( $form->{"assembly_$i"} ) { + + # If the assembly consists of all + # services, we don't keep inventory, + # so we should not update it + $query = qq| SELECT sum( p.inventory_accno_id), p.assembly @@ -1017,55 +1014,52 @@ sub post_invoice { ON (a.parts_id = p.id) WHERE a.id = $form->{"id_$i"} GROUP BY p.assembly|; - $sth = $dbh->prepare($query); - $sth->execute($form->{"id_$i"}) - || $form->dberror($query); - my ($inv, $assembly) - = $sth->fetchrow_array; - $sth->finish; - - if ($inv || $assembly) { - $form->update_balance($dbh, - "parts", - "onhand", - qq|id = |. - qq|$form->{"id_$i"}|, - $form->{"qty_$i"} * -1) - unless $form->{shipped}; - } - - &process_assembly( - $dbh, $form, $form->{"id_$i"}, - $form->{"qty_$i"}, $project_id); - } else { - $form->update_balance( - $dbh, "parts", "onhand", - qq|id = $form->{"id_$i"}|, - $form->{"qty_$i"} * -1) - unless $form->{shipped}; - - $allocated = &cogs( - $dbh, $form, $form->{"id_$i"}, - $form->{"qty_$i"}, $project_id); - } - } - - # save detail record in invoice table - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{"id_$i"} ) + || $form->dberror($query); + my ( $inv, $assembly ) = $sth->fetchrow_array; + $sth->finish; + + if ( $inv || $assembly ) { + $form->update_balance( + $dbh, "parts", "onhand", + qq|id = | . qq|$form->{"id_$i"}|, + $form->{"qty_$i"} * -1 + ) unless $form->{shipped}; + } + + &process_assembly( $dbh, $form, $form->{"id_$i"}, + $form->{"qty_$i"}, $project_id ); + } + else { + $form->update_balance( + $dbh, "parts", "onhand", + qq|id = $form->{"id_$i"}|, + $form->{"qty_$i"} * -1 + ) unless $form->{shipped}; + + $allocated = + &cogs( $dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"}, + $project_id ); + } + } + + # save detail record in invoice table + $query = qq| INSERT INTO invoice (description) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM invoice WHERE description = '$uid'|; - ($invoice_id) = $dbh->selectrow_array($query); + ($invoice_id) = $dbh->selectrow_array($query); - unless ($form->{"deliverydate_$i"}){ - undef $form->{"deliverydate_$i"}; - } - $query = qq| + unless ( $form->{"deliverydate_$i"} ) { + undef $form->{"deliverydate_$i"}; + } + $query = qq| UPDATE invoice SET trans_id = ?, parts_id = ?, @@ -1082,128 +1076,123 @@ sub post_invoice { notes = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $form->{"id_$i"}, - $form->{"description_$i"}, $form->{"qty_$i"}, - $form->{"sellprice_$i"}, $fxsellprice, - $form->{"discount_$i"}, $allocated, - $form->{"unit_$i"}, $form->{"deliverydate_$i"}, - $project_id, $form->{"serialnumber_$i"}, - $form->{"notes_$i"}, $invoice_id) - || $form->dberror($query); - - # add invoice_id - $form->{acc_trans}{lineitems}[$ndx]->{invoice_id} - = $invoice_id; - - } - } - - $form->{paid} = 0; - for $i (1 .. $form->{paidaccounts}) { - $form->{"paid_$i"} = - $form->parse_amount($myconfig, $form->{"paid_$i"}); - $form->{paid} += $form->{"paid_$i"}; - $form->{datepaid} = $form->{"datepaid_$i"} - if ($form->{"paid_$i"}); - } - - # add lineitems + tax - $amount = 0; - $grossamount = 0; - $fxgrossamount = 0; - - for (@{ $form->{acc_trans}{lineitems} }) { - $amount += $_->{amount}; - $grossamount += $_->{grossamount}; - $fxgrossamount += $_->{fxgrossamount}; - } - $invnetamount = $amount; - - $amount = 0; - - for (split / /, $form->{taxaccounts}) { - $amount += - $form->{acc_trans}{$form->{id}}{$_}{amount} = - $form->round_amount( - $form->{acc_trans}{$form->{id}}{$_}{amount}, - 2); - } - $invamount = $invnetamount + $amount; - - $diff = 0; - - if ($form->{taxincluded}) { - $diff = $form->round_amount($grossamount - $invamount, 2); - $invamount += $diff; - } - $fxdiff = $form->round_amount($fxdiff,2); - $invnetamount += $fxdiff; - $invamount += $fxdiff; - - if ($form->round_amount($form->{paid} - $fxgrossamount,2) == 0) { - $form->{paid} = $invamount; - } else { - $form->{paid} = $form->round_amount( - $form->{paid} * $form->{exchangerate}, 2); - } - - foreach $ref (sort { $b->{amount} <=> $a->{amount} } - @ { $form->{acc_trans}{lineitems} }) { - - $amount = $ref->{amount} + $diff + $fxdiff; - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{id}, $form->{"id_$i"}, + $form->{"description_$i"}, $form->{"qty_$i"}, + $form->{"sellprice_$i"}, $fxsellprice, + $form->{"discount_$i"}, $allocated, + $form->{"unit_$i"}, $form->{"deliverydate_$i"}, + $project_id, $form->{"serialnumber_$i"}, + $form->{"notes_$i"}, $invoice_id + ) || $form->dberror($query); + + # add invoice_id + $form->{acc_trans}{lineitems}[$ndx]->{invoice_id} = $invoice_id; + + } + } + + $form->{paid} = 0; + for $i ( 1 .. $form->{paidaccounts} ) { + $form->{"paid_$i"} = + $form->parse_amount( $myconfig, $form->{"paid_$i"} ); + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"} + if ( $form->{"paid_$i"} ); + } + + # add lineitems + tax + $amount = 0; + $grossamount = 0; + $fxgrossamount = 0; + + for ( @{ $form->{acc_trans}{lineitems} } ) { + $amount += $_->{amount}; + $grossamount += $_->{grossamount}; + $fxgrossamount += $_->{fxgrossamount}; + } + $invnetamount = $amount; + + $amount = 0; + + for ( split / /, $form->{taxaccounts} ) { + $amount += $form->{acc_trans}{ $form->{id} }{$_}{amount} = + $form->round_amount( $form->{acc_trans}{ $form->{id} }{$_}{amount}, + 2 ); + } + $invamount = $invnetamount + $amount; + + $diff = 0; + + if ( $form->{taxincluded} ) { + $diff = $form->round_amount( $grossamount - $invamount, 2 ); + $invamount += $diff; + } + $fxdiff = $form->round_amount( $fxdiff, 2 ); + $invnetamount += $fxdiff; + $invamount += $fxdiff; + + if ( $form->round_amount( $form->{paid} - $fxgrossamount, 2 ) == 0 ) { + $form->{paid} = $invamount; + } + else { + $form->{paid} = + $form->round_amount( $form->{paid} * $form->{exchangerate}, 2 ); + } + + foreach $ref ( sort { $b->{amount} <=> $a->{amount} } + @{ $form->{acc_trans}{lineitems} } ) + { + + $amount = $ref->{amount} + $diff + $fxdiff; + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, project_id, invoice_id) VALUES (?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $ref->{chart_id}, $amount, - $form->{transdate}, $ref->{project_id}, - $ref->{invoice_id}) - || $form->dberror($query); - $diff = 0; - $fxdiff = 0; - } - - $form->{receivables} = $invamount * -1; - - delete $form->{acc_trans}{lineitems}; - - # update exchangerate - if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { - $form->update_exchangerate( - $dbh, $form->{currency}, $form->{transdate}, - $form->{exchangerate}, 0); - } - - # record receivable - if ($form->{receivables}) { - ($accno) = split /--/, $form->{AR}; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $ref->{chart_id}, $amount, + $form->{transdate}, $ref->{project_id}, $ref->{invoice_id} ) + || $form->dberror($query); + $diff = 0; + $fxdiff = 0; + } + + $form->{receivables} = $invamount * -1; + + delete $form->{acc_trans}{lineitems}; + + # update exchangerate + if ( ( $form->{currency} ne $form->{defaultcurrency} ) && !$exchangerate ) { + $form->update_exchangerate( $dbh, $form->{currency}, $form->{transdate}, + $form->{exchangerate}, 0 ); + } + + # record receivable + if ( $form->{receivables} ) { + ($accno) = split /--/, $form->{AR}; + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno, $form->{receivables}, - $form->{transdate}) - || $form->dberror($query); - } - - foreach my $trans_id (keys %{$form->{acc_trans}}) { - foreach my $accno (keys %{$form->{acc_trans}{$trans_id}}) { - $amount = $form->round_amount( - $form->{acc_trans}{$trans_id}{$accno}{amount}, - 2); - if ($amount) { - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno, $form->{receivables}, + $form->{transdate} ) + || $form->dberror($query); + } + + foreach my $trans_id ( keys %{ $form->{acc_trans} } ) { + foreach my $accno ( keys %{ $form->{acc_trans}{$trans_id} } ) { + $amount = + $form->round_amount( + $form->{acc_trans}{$trans_id}{$accno}{amount}, 2 ); + if ($amount) { + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate) @@ -1211,78 +1200,73 @@ sub post_invoice { WHERE accno = ?), ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $trans_id, $accno, $amount, - $form->{transdate}) - || $form->dberror($query); - } - } - } - - - # if there is no amount but a payment record receivable - if ($invamount == 0) { - $form->{receivables} = 1; - } - - my $cleared = 0; - - # record payments and offsetting AR - for $i (1 .. $form->{paidaccounts}) { - - if ($form->{"paid_$i"}) { - my ($accno) = split /--/, $form->{"AR_paid_$i"}; - $form->{"datepaid_$i"} = $form->{transdate} - unless ($form->{"datepaid_$i"}); - - $form->{datepaid} = $form->{"datepaid_$i"}; - - $exchangerate = 0; - - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{"exchangerate_$i"} = 1; - } else { - $exchangerate = - $form->check_exchangerate( - $myconfig, $form->{currency}, - $form->{"datepaid_$i"}, 'buy'); - - $form->{"exchangerate_$i"} = - ($exchangerate) - ? $exchangerate - : $form->parse_amount( - $myconfig, - $form->{"exchangerate_$i"}); - } - - - # record AR - $amount = $form->round_amount( - $form->{"paid_$i"} * $form->{exchangerate}, 2); - - if ($form->{receivables}) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $trans_id, $accno, $amount, $form->{transdate} ) + || $form->dberror($query); + } + } + } + + # if there is no amount but a payment record receivable + if ( $invamount == 0 ) { + $form->{receivables} = 1; + } + + my $cleared = 0; + + # record payments and offsetting AR + for $i ( 1 .. $form->{paidaccounts} ) { + + if ( $form->{"paid_$i"} ) { + my ($accno) = split /--/, $form->{"AR_paid_$i"}; + $form->{"datepaid_$i"} = $form->{transdate} + unless ( $form->{"datepaid_$i"} ); + + $form->{datepaid} = $form->{"datepaid_$i"}; + + $exchangerate = 0; + + if ( $form->{currency} eq $form->{defaultcurrency} ) { + $form->{"exchangerate_$i"} = 1; + } + else { + $exchangerate = + $form->check_exchangerate( $myconfig, $form->{currency}, + $form->{"datepaid_$i"}, 'buy' ); + + $form->{"exchangerate_$i"} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount( $myconfig, + $form->{"exchangerate_$i"} ); + } + + # record AR + $amount = + $form->round_amount( $form->{"paid_$i"} * $form->{exchangerate}, + 2 ); + + if ( $form->{receivables} ) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $form->{AR}, $amount, - $form->{"datepaid_$i"}) - || $form->dberror($query); - } - - # record payment - $amount = $form->{"paid_$i"} * -1; - if ($keepcleared) { - $cleared = ($form->{"cleared_$i"}) ? 1 : 0; - } - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $form->{AR}, $amount, + $form->{"datepaid_$i"} ) + || $form->dberror($query); + } + + # record payment + $amount = $form->{"paid_$i"} * -1; + if ($keepcleared) { + $cleared = ( $form->{"cleared_$i"} ) ? 1 : 0; + } + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, source, memo, cleared) @@ -1290,23 +1274,25 @@ sub post_invoice { WHERE accno = ?), ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno, $amount, - $form->{"datepaid_$i"}, $form->{"source_$i"}, - $form->{"memo_$i"}, $cleared) - || $form->dberror($query); - - # exchangerate difference - $amount = $form->round_amount( - ($form->round_amount( - $form->{"paid_$i"} - * $form->{"exchangerate_$i"} - - $form->{"paid_$i"}, 2)) * -1, - 2); - - if ($amount) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno, $amount, $form->{"datepaid_$i"}, + $form->{"source_$i"}, $form->{"memo_$i"}, $cleared ) + || $form->dberror($query); + + # exchangerate difference + $amount = $form->round_amount( + ( + $form->round_amount( + $form->{"paid_$i"} * $form->{"exchangerate_$i"} - + $form->{"paid_$i"}, + 2 + ) + ) * -1, + 2 + ); + + if ($amount) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, source, @@ -1315,68 +1301,67 @@ sub post_invoice { WHERE accno = >), ?, ?, ?, '1', ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno, $amount, - $form->{"datepaid_$i"}, - $form->{"source_$i"}, $cleared ) - || $form->dberror($query); - } - - # gain/loss - $amount = $form->round_amount( - ($form->round_amount( - $form->{"paid_$i"} - * $form->{exchangerate},2) - - $form->round_amount( - $form->{"paid_$i"} - * $form->{"exchangerate_$i"},2) - ) * -1, - 2); - - if ($amount) { - my $accno_id = - ($amount > 0) - ? $fxgain_accno_id - : $fxloss_accno_id; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno, $amount, + $form->{"datepaid_$i"}, + $form->{"source_$i"}, $cleared ) + || $form->dberror($query); + } + + # gain/loss + $amount = $form->round_amount( + ( + $form->round_amount( + $form->{"paid_$i"} * $form->{exchangerate}, 2 ) - + $form->round_amount( + $form->{"paid_$i"} * $form->{"exchangerate_$i"}, 2 + ) + ) * -1, + 2 + ); + + if ($amount) { + my $accno_id = + ( $amount > 0 ) + ? $fxgain_accno_id + : $fxloss_accno_id; + + $query = qq| INSERT INTO acc_trans ( trans_id, chart_id, amount, transdate, fx_transaction, cleared) VALUES (?, ?, ?, ?, '1', ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $accno_id, $amount, - $form->{"datepaid_$i"}, $cleared) - || $form->dberror($query); - } - - # update exchange rate - if (($form->{currency} ne $form->{defaultcurrency}) - && !$exchangerate) { - - $form->update_exchangerate( - $dbh, $form->{currency}, - $form->{"datepaid_$i"}, - $form->{"exchangerate_$i"}, 0); - } - } - } - - # set values which could be empty to 0 - $form->{terms} *= 1; - $form->{taxincluded} *= 1; - - - $form->{invnumber} = - $form->update_defaults($myconfig, "sinumber", $dbh) - unless $form->{invnumber}; - - # save AR record - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $accno_id, $amount, + $form->{"datepaid_$i"}, $cleared ) + || $form->dberror($query); + } + + # update exchange rate + if ( ( $form->{currency} ne $form->{defaultcurrency} ) + && !$exchangerate ) + { + + $form->update_exchangerate( + $dbh, $form->{currency}, + $form->{"datepaid_$i"}, + $form->{"exchangerate_$i"}, 0 + ); + } + } + } + + # set values which could be empty to 0 + $form->{terms} *= 1; + $form->{taxincluded} *= 1; + + $form->{invnumber} = $form->update_defaults( $myconfig, "sinumber", $dbh ) + unless $form->{invnumber}; + + # save AR record + $query = qq| UPDATE ar set invnumber = ?, ordnumber = ?, @@ -1404,49 +1389,52 @@ sub post_invoice { WHERE id = ? |; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{invnumber}, $form->{ordnumber}, $form->{quonumber}, - $form->{transdate}, $form->{customer_id}, $invamount, - $invnetamount, $form->{paid}, $form->{datepaid}, - $form->{duedate}, $form->{shippingpoint}, $form->{shipvia}, - $form->{terms}, $form->{notes}, $form->{intnotes}, - $form->{taxincluded}, $form->{currency}, $form->{department_id}, - $form->{employee_id}, $till, $form->{language_code}, - $form->{ponumber}, $form->{id}) - || $form->dberror($query); - - # add shipto - $form->{name} = $form->{customer}; - $form->{name} =~ s/--$form->{customer_id}//; - $form->add_shipto($dbh, $form->{id}); - - # save printed, emailed and queued - $form->save_status($dbh); - - my %audittrail = ( - tablename => 'ar', - reference => $form->{invnumber}, - formname => $form->{type}, - action => 'posted', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - $form->save_recurring($dbh, $myconfig); - - my $rc = $dbh->commit; - - - $rc; - -} + $sth = $dbh->prepare($query); + $sth->execute( + $form->{invnumber}, $form->{ordnumber}, + $form->{quonumber}, $form->{transdate}, + $form->{customer_id}, $invamount, + $invnetamount, $form->{paid}, + $form->{datepaid}, $form->{duedate}, + $form->{shippingpoint}, $form->{shipvia}, + $form->{terms}, $form->{notes}, + $form->{intnotes}, $form->{taxincluded}, + $form->{currency}, $form->{department_id}, + $form->{employee_id}, $till, + $form->{language_code}, $form->{ponumber}, + $form->{id} + ) || $form->dberror($query); + + # add shipto + $form->{name} = $form->{customer}; + $form->{name} =~ s/--$form->{customer_id}//; + $form->add_shipto( $dbh, $form->{id} ); + + # save printed, emailed and queued + $form->save_status($dbh); + + my %audittrail = ( + tablename => 'ar', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'posted', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + $form->save_recurring( $dbh, $myconfig ); + + my $rc = $dbh->commit; + + $rc; +} sub process_assembly { - my ($dbh2, $form, $id, $totalqty, $project_id) = @_; - my $dbh = $form->{dbh}; - my $query = qq| + my ( $dbh2, $form, $id, $totalqty, $project_id ) = @_; + my $dbh = $form->{dbh}; + my $query = qq| SELECT a.parts_id, a.qty, p.assembly, p.partnumber, p.description, p.unit, p.inventory_accno_id, p.income_accno_id, @@ -1454,58 +1442,56 @@ sub process_assembly { FROM assembly a JOIN parts p ON (a.parts_id = p.id) WHERE a.id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); - - my $allocated; - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - - $allocated = 0; - - $ref->{inventory_accno_id} *= 1; - $ref->{expense_accno_id} *= 1; - - # multiply by number of assemblies - $ref->{qty} *= $totalqty; - - if ($ref->{assembly}) { - &process_assembly( - $dbh, $form, $ref->{parts_id}, $ref->{qty}, - $project_id); - next; - } else { - if ($ref->{inventory_accno_id}) { - $allocated = &cogs( - $dbh, $form, $ref->{parts_id}, - $ref->{qty}, $project_id); - } - } - - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); + + my $allocated; + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + $allocated = 0; + + $ref->{inventory_accno_id} *= 1; + $ref->{expense_accno_id} *= 1; + + # multiply by number of assemblies + $ref->{qty} *= $totalqty; + + if ( $ref->{assembly} ) { + &process_assembly( $dbh, $form, $ref->{parts_id}, $ref->{qty}, + $project_id ); + next; + } + else { + if ( $ref->{inventory_accno_id} ) { + $allocated = + &cogs( $dbh, $form, $ref->{parts_id}, $ref->{qty}, + $project_id ); + } + } + + $query = qq| INSERT INTO invoice (trans_id, description, parts_id, qty, sellprice, fxsellprice, allocated, assemblyitem, unit) VALUES (?, ?, ?, ?, 0, 0, ?, 't', ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $ref->{description}, $ref->{parts_id}, - $ref->{qty}, $allocated, $ref->{unit}) - || $form->dberror($query); - - } + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $ref->{description}, $ref->{parts_id}, + $ref->{qty}, $allocated, $ref->{unit} ) + || $form->dberror($query); - $sth->finish; + } -} + $sth->finish; +} sub cogs { - my ($dbh2, $form, $id, $totalqty, $project_id) = @_; - my $dbh = $form->{dbh}; - my $query = qq| + my ( $dbh2, $form, $id, $totalqty, $project_id ) = @_; + my $dbh = $form->{dbh}; + my $query = qq| SELECT i.id, i.trans_id, i.qty, i.allocated, i.sellprice, i.fxsellprice, p.inventory_accno_id, p.expense_accno_id @@ -1514,235 +1500,235 @@ sub cogs { AND i.parts_id = ? AND (i.qty + i.allocated) < 0 ORDER BY trans_id|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); - - my $allocated = 0; - my $qty; - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - if (($qty = (($ref->{qty} * -1) - $ref->{allocated})) - > $totalqty) { - $qty = $totalqty; - } - - $form->update_balance( - $dbh, "invoice", "allocated", qq|id = $ref->{id}|, - $qty); - - # total expenses and inventory - # sellprice is the cost of the item - my $linetotal = $form->round_amount( - $ref->{sellprice} * $qty, 2); - - # add expense - push @{ $form->{acc_trans}{lineitems} }, { - chart_id => $ref->{expense_accno_id}, - amount => $linetotal * -1, - project_id => $project_id, - invoice_id => $ref->{id} }; - - # deduct inventory - push @{ $form->{acc_trans}{lineitems} }, { - chart_id => $ref->{inventory_accno_id}, - amount => $linetotal, - project_id => $project_id, - invoice_id => $ref->{id} }; - - # add allocated - $allocated += -$qty; - - last if (($totalqty -= $qty) <= 0); - } - - $sth->finish; - - $allocated; - $dbh->commit; + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); + + my $allocated = 0; + my $qty; + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + if ( ( $qty = ( ( $ref->{qty} * -1 ) - $ref->{allocated} ) ) > + $totalqty ) + { + $qty = $totalqty; + } + + $form->update_balance( $dbh, "invoice", "allocated", + qq|id = $ref->{id}|, $qty ); + + # total expenses and inventory + # sellprice is the cost of the item + my $linetotal = $form->round_amount( $ref->{sellprice} * $qty, 2 ); + + # add expense + push @{ $form->{acc_trans}{lineitems} }, + { + chart_id => $ref->{expense_accno_id}, + amount => $linetotal * -1, + project_id => $project_id, + invoice_id => $ref->{id} + }; + + # deduct inventory + push @{ $form->{acc_trans}{lineitems} }, + { + chart_id => $ref->{inventory_accno_id}, + amount => $linetotal, + project_id => $project_id, + invoice_id => $ref->{id} + }; + + # add allocated + $allocated += -$qty; + + last if ( ( $totalqty -= $qty ) <= 0 ); + } + + $sth->finish; + + $allocated; + $dbh->commit; } - - sub reverse_invoice { - my ($dbh2, $form) = @_; - my $dbh = $form->{dbh}; - my $query = qq| + my ( $dbh2, $form ) = @_; + my $dbh = $form->{dbh}; + my $query = qq| SELECT id FROM ar WHERE id = ?|; - my $sth; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - my ($id) = $sth->fetchrow_array; + my $sth; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + my ($id) = $sth->fetchrow_array; - return unless $id; + return unless $id; - # reverse inventory items - my $query = qq| + # reverse inventory items + my $query = qq| SELECT i.id, i.parts_id, i.qty, i.assemblyitem, p.assembly, p.inventory_accno_id FROM invoice i JOIN parts p ON (i.parts_id = p.id) WHERE i.trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - - if ($ref->{inventory_accno_id} || $ref->{assembly}) { - - # if the invoice item is not an assemblyitem - # adjust parts onhand - if (!$ref->{assemblyitem}) { - # adjust onhand in parts table - $form->update_balance( - $dbh, "parts", "onhand", - qq|id = $ref->{parts_id}|, $ref->{qty}); - } - - # loop if it is an assembly - next if ($ref->{assembly}); - - # de-allocated purchases - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + if ( $ref->{inventory_accno_id} || $ref->{assembly} ) { + + # if the invoice item is not an assemblyitem + # adjust parts onhand + if ( !$ref->{assemblyitem} ) { + + # adjust onhand in parts table + $form->update_balance( $dbh, "parts", "onhand", + qq|id = $ref->{parts_id}|, + $ref->{qty} ); + } + + # loop if it is an assembly + next if ( $ref->{assembly} ); + + # de-allocated purchases + $query = qq| SELECT id, trans_id, allocated FROM invoice WHERE parts_id = ? AND allocated > 0 ORDER BY trans_id DESC|; - my $sth = $dbh->prepare($query); - $sth->execute($ref->{parts_id}) - || $form->dberror($query); - - while (my $inhref = $sth->fetchrow_hashref(NAME_lc)) { - $qty = $ref->{qty}; - if (($ref->{qty} - $inhref->{allocated}) > 0) { - $qty = $inhref->{allocated}; - } - - # update invoice - $form->update_balance( - $dbh, "invoice", "allocated", - qq|id = $inhref->{id}|, $qty * -1); - - last if (($ref->{qty} -= $qty) <= 0); - } - $sth->finish; - } - } - - $sth->finish; - - # delete acc_trans - $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; - - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - # delete invoice entries - $query = qq|DELETE FROM invoice WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $dbh->commit; + my $sth = $dbh->prepare($query); + $sth->execute( $ref->{parts_id} ) + || $form->dberror($query); -} + while ( my $inhref = $sth->fetchrow_hashref(NAME_lc) ) { + $qty = $ref->{qty}; + if ( ( $ref->{qty} - $inhref->{allocated} ) > 0 ) { + $qty = $inhref->{allocated}; + } + + # update invoice + $form->update_balance( $dbh, "invoice", "allocated", + qq|id = $inhref->{id}|, + $qty * -1 ); + + last if ( ( $ref->{qty} -= $qty ) <= 0 ); + } + $sth->finish; + } + } + + $sth->finish; + # delete acc_trans + $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + # delete invoice entries + $query = qq|DELETE FROM invoice WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM shipto WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $dbh->commit; + +} sub delete_invoice { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - my $sth; - - &reverse_invoice($dbh, $form); - - my %audittrail = ( - tablename => 'ar', - reference => $form->{invnumber}, - formname => $form->{type}, - action => 'deleted', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - # delete AR record - my $query = qq|DELETE FROM ar WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - # delete spool files - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + my $sth; + + &reverse_invoice( $dbh, $form ); + + my %audittrail = ( + tablename => 'ar', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + # delete AR record + my $query = qq|DELETE FROM ar WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + # delete spool files + $query = qq| SELECT spoolfile FROM status WHERE trans_id = $form->{id} AND spoolfile IS NOT NULL|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $spoolfile; - my @spoolfiles = (); - - while (($spoolfile) = $sth->fetchrow_array) { - push @spoolfiles, $spoolfile; - } - $sth->finish; - - # delete status entries - $query = qq|DELETE FROM status WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $rc = $dbh->commit; - - if ($rc) { - foreach $spoolfile (@spoolfiles) { - unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" - if $spoolfile; - } - } - - $dbh->commit; - - $rc; - -} + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + my $spoolfile; + my @spoolfiles = (); + while ( ($spoolfile) = $sth->fetchrow_array ) { + push @spoolfiles, $spoolfile; + } + $sth->finish; + # delete status entries + $query = qq|DELETE FROM status WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + my $rc = $dbh->commit; + + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" + if $spoolfile; + } + } + + $dbh->commit; + + $rc; + +} sub retrieve_invoice { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; - my $query; + my $query; - if ($form->{id}) { - # get default accounts and last invoice number - $query = qq| + if ( $form->{id} ) { + + # get default accounts and last invoice number + $query = qq| SELECT value AS currencies FROM defaults WHERE setting_key = 'curr'|; - } else { - $query = qq| + } + else { + $query = qq| SELECT value AS currencies, current_date AS transdate FROM defaults WHERE setting_key = 'curr'|; - } - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - my $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; - - - if ($form->{id}) { - - # retrieve invoice - $query = qq| + } + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; + + if ( $form->{id} ) { + + # retrieve invoice + $query = qq| SELECT a.invnumber, a.ordnumber, a.quonumber, a.transdate, a.paid, a.shippingpoint, a.shipvia, a.terms, a.notes, @@ -1755,24 +1741,24 @@ sub retrieve_invoice { LEFT JOIN employees e ON (e.id = a.employee_id) WHERE a.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - # get shipto - $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + # get shipto + $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; - # retrieve individual items - $query = qq| + # retrieve individual items + $query = qq| SELECT i.description, i.qty, i.fxsellprice, i.sellprice, i.discount, i.parts_id AS id, i.unit, i.deliverydate, i.project_id, @@ -1794,115 +1780,116 @@ sub retrieve_invoice { WHERE i.trans_id = ? AND NOT i.assemblyitem = '1' ORDER BY i.id|; - $sth = $dbh->prepare($query); - $sth->execute($form->{language_code}, $form->{id}) - || $form->dberror($query); - - # foreign currency - &exchangerate_defaults($dbh, $form); - - # query for price matrix - my $pmh = PriceMatrix::price_matrix_query($dbh, $form); - - # taxes - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{language_code}, $form->{id} ) + || $form->dberror($query); + + # foreign currency + &exchangerate_defaults( $dbh, $form ); + + # query for price matrix + my $pmh = PriceMatrix::price_matrix_query( $dbh, $form ); + + # taxes + $query = qq| SELECT c.accno FROM chart c JOIN partstax pt ON (pt.chart_id = c.id) WHERE pt.parts_id = ?|; - my $tth = $dbh->prepare($query) || $form->dberror($query); - - my $taxrate; - my $ptref; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - - my ($dec) = ($ref->{fxsellprice} =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - $tth->execute($ref->{id}); - - $ref->{taxaccounts} = ""; - $taxrate = 0; - - while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { - $ref->{taxaccounts} .= "$ptref->{accno} "; - $taxrate += $form->{"$ptref->{accno}_rate"}; - } - $tth->finish; - chop $ref->{taxaccounts}; - - # price matrix - $ref->{sellprice} = - ($ref->{fxsellprice} - * $form->{$form->{currency}}); - PriceMatrix::price_matrix( - $pmh, $ref, $form->{transdate}, $decimalplaces, - $form, $myconfig); - $ref->{sellprice} = $ref->{fxsellprice}; - - $ref->{partsgroup} = $ref->{partsgrouptranslation} - if $ref->{partsgrouptranslation}; - - push @{ $form->{invoice_details} }, $ref; - } - $sth->finish; - - } - - - @queries = $form->run_custom_queries('ar', 'SELECT'); - my $rc = $dbh->commit; - $rc; + my $tth = $dbh->prepare($query) || $form->dberror($query); -} + my $taxrate; + my $ptref; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + my ($dec) = ( $ref->{fxsellprice} =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + $tth->execute( $ref->{id} ); + + $ref->{taxaccounts} = ""; + $taxrate = 0; + + while ( $ptref = $tth->fetchrow_hashref(NAME_lc) ) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + $taxrate += $form->{"$ptref->{accno}_rate"}; + } + $tth->finish; + chop $ref->{taxaccounts}; + # price matrix + $ref->{sellprice} = + ( $ref->{fxsellprice} * $form->{ $form->{currency} } ); + PriceMatrix::price_matrix( $pmh, $ref, $form->{transdate}, + $decimalplaces, $form, $myconfig ); + $ref->{sellprice} = $ref->{fxsellprice}; + + $ref->{partsgroup} = $ref->{partsgrouptranslation} + if $ref->{partsgrouptranslation}; + + push @{ $form->{invoice_details} }, $ref; + } + $sth->finish; + + } + + @queries = $form->run_custom_queries( 'ar', 'SELECT' ); + my $rc = $dbh->commit; + $rc; + +} sub retrieve_item { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $i = $form->{rowcount}; - my $null; - my $var; - - my $where = "WHERE p.obsolete = '0' AND NOT p.income_accno_id IS NULL"; - - if ($form->{"partnumber_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"partnumber_$i"})); - $where .= " AND lower(p.partnumber) LIKE $var"; - } - if ($form->{"description_$i"} ne "") { - $var = $dbh->quote($form->like(lc $form->{"description_$i"})); - - if ($form->{language_code} ne "") { - $where .= " AND lower(t1.description) LIKE $var"; - } else { - $where .= " AND lower(p.description) LIKE $var"; - } - } - - if ($form->{"partsgroup_$i"} ne "") { - ($null, $var) = split /--/, $form->{"partsgroup_$i"}; - $var = $dbh->quote($var); - if ($var == 0) { - # search by partsgroup, this is for the POS - $where .= qq| AND pg.partsgroup = |. - $dbh->quote($form->{"partsgroup_$i"}); - } else { - $where .= qq| AND p.partsgroup_id = $var|; - } - } - - if ($form->{"description_$i"} ne "") { - $where .= " ORDER BY 3"; - } else { - $where .= " ORDER BY 2"; - } - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $i = $form->{rowcount}; + my $null; + my $var; + + my $where = "WHERE p.obsolete = '0' AND NOT p.income_accno_id IS NULL"; + + if ( $form->{"partnumber_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"partnumber_$i"} ) ); + $where .= " AND lower(p.partnumber) LIKE $var"; + } + if ( $form->{"description_$i"} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{"description_$i"} ) ); + + if ( $form->{language_code} ne "" ) { + $where .= " AND lower(t1.description) LIKE $var"; + } + else { + $where .= " AND lower(p.description) LIKE $var"; + } + } + + if ( $form->{"partsgroup_$i"} ne "" ) { + ( $null, $var ) = split /--/, $form->{"partsgroup_$i"}; + $var = $dbh->quote($var); + if ( $var == 0 ) { + + # search by partsgroup, this is for the POS + $where .= + qq| AND pg.partsgroup = | + . $dbh->quote( $form->{"partsgroup_$i"} ); + } + else { + $where .= qq| AND p.partsgroup_id = $var|; + } + } + + if ( $form->{"description_$i"} ne "" ) { + $where .= " ORDER BY 3"; + } + else { + $where .= " ORDER BY 2"; + } + + my $query = qq| SELECT p.id, p.partnumber, p.description, p.sellprice, p.listprice, p.lastcost, p.unit, p.assembly, p.bin, p.onhand, p.notes, p.inventory_accno_id, @@ -1918,120 +1905,115 @@ sub retrieve_item { ON (t2.trans_id = p.partsgroup_id AND t2.language_code = ?) $where|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{language_code}, $form->{language_code}) - || $form->dberror($query); - - my $ref; - my $ptref; - - # setup exchange rates - &exchangerate_defaults($dbh, $form); - - # taxes - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{language_code}, $form->{language_code} ) + || $form->dberror($query); + + my $ref; + my $ptref; + + # setup exchange rates + &exchangerate_defaults( $dbh, $form ); + + # taxes + $query = qq| SELECT c.accno FROM chart c JOIN partstax pt ON (c.id = pt.chart_id) WHERE pt.parts_id = ?|; - my $tth = $dbh->prepare($query) || $form->dberror($query); + my $tth = $dbh->prepare($query) || $form->dberror($query); + # price matrix + my $pmh = PriceMatrix::price_matrix_query( $dbh, $form ); - # price matrix - my $pmh = PriceMatrix::price_matrix_query($dbh, $form); + my $transdate = $form->datetonum( $myconfig, $form->{transdate} ); - my $transdate = $form->datetonum($myconfig, $form->{transdate}); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { - my ($dec) = ($ref->{sellprice} =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; + my ($dec) = ( $ref->{sellprice} =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; - # get taxes for part - $tth->execute($ref->{id}); + # get taxes for part + $tth->execute( $ref->{id} ); - $ref->{taxaccounts} = ""; + $ref->{taxaccounts} = ""; - while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { - $ref->{taxaccounts} .= "$ptref->{accno} "; - } - $tth->finish; - chop $ref->{taxaccounts}; + while ( $ptref = $tth->fetchrow_hashref(NAME_lc) ) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + } + $tth->finish; + chop $ref->{taxaccounts}; - # get matrix - PriceMatrix::price_matrix( - $pmh, $ref, $transdate, $decimalplaces, $form, - $myconfig); + # get matrix + PriceMatrix::price_matrix( $pmh, $ref, $transdate, $decimalplaces, + $form, $myconfig ); - $ref->{description} = $ref->{translation} - if $ref->{translation}; + $ref->{description} = $ref->{translation} + if $ref->{translation}; - $ref->{partsgroup} = $ref->{grouptranslation} - if $ref->{grouptranslation}; - - push @{ $form->{item_list} }, $ref; + $ref->{partsgroup} = $ref->{grouptranslation} + if $ref->{grouptranslation}; - } - - $sth->finish; - $dbh->commit; - -} + push @{ $form->{item_list} }, $ref; + + } + + $sth->finish; + $dbh->commit; +} sub exchangerate_defaults { - my ($dbh2, $form) = @_; - $dbh = $form->{dbh}; + my ( $dbh2, $form ) = @_; + $dbh = $form->{dbh}; + my $var; - my $var; - - # get default currencies - my $query = qq| + # get default currencies + my $query = qq| SELECT substr(value,1,3), value FROM defaults WHERE setting_key = 'curr'|; - my $eth = $dbh->prepare($query) || $form->dberror($query); - $eth->execute; - ($form->{defaultcurrency}, $form->{currencies}) = $eth->fetchrow_array; - $eth->finish; + my $eth = $dbh->prepare($query) || $form->dberror($query); + $eth->execute; + ( $form->{defaultcurrency}, $form->{currencies} ) = $eth->fetchrow_array; + $eth->finish; - $query = qq| + $query = qq| SELECT buy FROM exchangerate WHERE curr = ? AND transdate = ?|; - my $eth1 = $dbh->prepare($query) || $form->dberror($query); + my $eth1 = $dbh->prepare($query) || $form->dberror($query); - $query = qq/ + $query = qq/ SELECT max(transdate || ' ' || buy || ' ' || curr) FROM exchangerate WHERE curr = ?/; - my $eth2 = $dbh->prepare($query) || $form->dberror($query); - - # get exchange rates for transdate or max - foreach $var (split /:/, substr($form->{currencies},4)) { - $eth1->execute($var, $form->{transdate}); - ($form->{$var}) = $eth1->fetchrow_array; - - if (! $form->{$var} ) { - $eth2->execute($var); - - ($form->{$var}) = $eth2->fetchrow_array; - ($null, $form->{$var}) = split / /, $form->{$var}; - $form->{$var} = 1 unless $form->{$var}; - $eth2->finish; - } - $eth1->finish; - } - - $form->{$form->{currency}} = $form->{exchangerate} - if $form->{exchangerate}; - $form->{$form->{currency}} ||= 1; - $form->{$form->{defaultcurrency}} = 1; + my $eth2 = $dbh->prepare($query) || $form->dberror($query); -} + # get exchange rates for transdate or max + foreach $var ( split /:/, substr( $form->{currencies}, 4 ) ) { + $eth1->execute( $var, $form->{transdate} ); + ( $form->{$var} ) = $eth1->fetchrow_array; + + if ( !$form->{$var} ) { + $eth2->execute($var); + ( $form->{$var} ) = $eth2->fetchrow_array; + ( $null, $form->{$var} ) = split / /, $form->{$var}; + $form->{$var} = 1 unless $form->{$var}; + $eth2->finish; + } + $eth1->finish; + } + + $form->{ $form->{currency} } = $form->{exchangerate} + if $form->{exchangerate}; + $form->{ $form->{currency} } ||= 1; + $form->{ $form->{defaultcurrency} } = 1; + +} 1; diff --git a/LedgerSMB/Inifile.pm b/LedgerSMB/Inifile.pm index 839c19f3..1b89502c 100644 --- a/LedgerSMB/Inifile.pm +++ b/LedgerSMB/Inifile.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -35,60 +35,57 @@ package Inifile; - sub new { - my ($type, $file) = @_; + my ( $type, $file ) = @_; - warn "$type has no copy constructor! creating a new object." - if ref($type); - $type = ref($type) || $type; - my $self = bless {}, $type; - $self->add_file($file) if defined $file; + warn "$type has no copy constructor! creating a new object." + if ref($type); + $type = ref($type) || $type; + my $self = bless {}, $type; + $self->add_file($file) if defined $file; - return $self; + return $self; } - sub add_file { - my ($self, $file) = @_; - - my $id = ""; - my %menuorder = (); - - for (@{$self->{ORDER}}) { $menuorder{$_} = 1 } - - open FH, '<', "$file" or Form->error("$file : $!"); - - while (<FH>) { - next if /^(#|;|\s)/; - last if /^\./; - - chop; - - # strip comments - s/\s*(#|;).*//g; - - # remove any trailing whitespace - s/^\s*(.*?)\s*$/$1/; - - if (/^\[/) { - s/(\[|\])//g; - $id = $_; - push @{$self->{ORDER}}, $_ if ! $menuorder{$_}; - $menuorder{$_} = 1; - next; - } - - # add key=value to $id - my ($key, $value) = split /=/, $_, 2; - - $self->{$id}{$key} = $value; - - } - close FH; - -} + my ( $self, $file ) = @_; + + my $id = ""; + my %menuorder = (); + + for ( @{ $self->{ORDER} } ) { $menuorder{$_} = 1 } + + open FH, '<', "$file" or Form->error("$file : $!"); + + while (<FH>) { + next if /^(#|;|\s)/; + last if /^\./; + chop; + + # strip comments + s/\s*(#|;).*//g; + + # remove any trailing whitespace + s/^\s*(.*?)\s*$/$1/; + + if (/^\[/) { + s/(\[|\])//g; + $id = $_; + push @{ $self->{ORDER} }, $_ if !$menuorder{$_}; + $menuorder{$_} = 1; + next; + } + + # add key=value to $id + my ( $key, $value ) = split /=/, $_, 2; + + $self->{$id}{$key} = $value; + + } + close FH; + +} 1; diff --git a/LedgerSMB/JC.pm b/LedgerSMB/JC.pm index fb82c8ee..0fdbcdb9 100644 --- a/LedgerSMB/JC.pm +++ b/LedgerSMB/JC.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -19,7 +19,7 @@ # Author: DWS Systems Inc. # Web: http://www.sql-ledger.org # -# Contributors: +# Contributors: # #====================================================================== # @@ -31,32 +31,31 @@ # #====================================================================== - package JC; use LedgerSMB::IS; use LedgerSMB::PriceMatrix; use LedgerSMB::Sysconfig; - sub get_jcitems { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query = qq|SELECT current_date|; - ($form->{transdate}) = $dbh->selectrow_array($query); - - ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); - - my $dateformat = $myconfig->{dateformat}; - $dateformat =~ s/yy/yyyy/; - $dateformat =~ s/yyyyyy/yyyy/; - - if ($form->{id}) { - # retrieve timecard/storescard - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $query = qq|SELECT current_date|; + ( $form->{transdate} ) = $dbh->selectrow_array($query); + + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + + my $dateformat = $myconfig->{dateformat}; + $dateformat =~ s/yy/yyyy/; + $dateformat =~ s/yyyyyy/yyyy/; + + if ( $form->{id} ) { + + # retrieve timecard/storescard + $query = qq| SELECT j.*, to_char(j.checkedin, 'HH24:MI:SS') AS checkedina, to_char(j.checkedout, 'HH24:MI:SS') @@ -72,124 +71,123 @@ sub get_jcitems { JOIN parts p ON (p.id = j.parts_id) JOIN project pr ON (pr.id = j.project_id) WHERE j.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($dateformat, $form->{id}) - || $form->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; - $form->{project} = ($form->{project}) ? "job" : "project"; - for (qw(checkedin checkedout)) { - $form->{$_} = $form->{"${_}a"}; - delete $form->{"${_}a"}; - } - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $dateformat, $form->{id} ) + || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; + $form->{project} = ( $form->{project} ) ? "job" : "project"; + for (qw(checkedin checkedout)) { + $form->{$_} = $form->{"${_}a"}; + delete $form->{"${_}a"}; + } + + $query = qq| SELECT s.printed, s.spoolfile, s.formname FROM status s WHERE s.formname = ? AND s.trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{type}, $form->{id}) - || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{printed} .= "$ref->{formname} " - if $ref->{printed}; - $form->{queued} .= - "$ref->{formname} $ref->{spoolfile} " - if $ref->{spoolfile}; - } - $sth->finish; - for (qw(printed queued)) { $form->{$_} =~ s/ +$//g } - } - - JC->jcitems_links($myconfig, $form, $dbh); - - # get language codes - $query = qq|SELECT * FROM language ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - $form->{all_language} = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_language} }, $ref; - } - $sth->finish; - - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{type}, $form->{id} ) + || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{printed} .= "$ref->{formname} " + if $ref->{printed}; + $form->{queued} .= "$ref->{formname} $ref->{spoolfile} " + if $ref->{spoolfile}; + } + $sth->finish; + for (qw(printed queued)) { $form->{$_} =~ s/ +$//g } + } + + JC->jcitems_links( $myconfig, $form, $dbh ); + + # get language codes + $query = qq|SELECT * FROM language ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{all_language} = (); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_language} }, $ref; + } + $sth->finish; + + $dbh->commit; } - sub jcitems_links { - my ($self, $myconfig, $form, $dbh) = @_; - - my $disconnect = 0; - - if (! $dbh) { - $dbh = $form->{dbh}; - } - - my $query; - - if ($form->{project_id}) { - $form->{orphaned} = 1; - $query = qq|SELECT parts_id FROM project WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{project_id}); - - if ($sth->fetchrow_array) { - $form->{project} = 'job'; - $query = qq| + my ( $self, $myconfig, $form, $dbh ) = @_; + + my $disconnect = 0; + + if ( !$dbh ) { + $dbh = $form->{dbh}; + } + + my $query; + + if ( $form->{project_id} ) { + $form->{orphaned} = 1; + $query = qq|SELECT parts_id FROM project WHERE id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{project_id} ); + + if ( $sth->fetchrow_array ) { + $form->{project} = 'job'; + $query = qq| SELECT id FROM project WHERE parts_id > 0 AND production > completed AND id = $form->{project_id}|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{project_id}); - ($form->{orphaned}) = $sth->fetchrow_array(); - $sth->finish; - } else { - $form->{project} = 'project'; - } - $sth->finish; - } - - JC->jcparts($myconfig, $form, $dbh); - - $form->all_employees($myconfig, $dbh, $form->{transdate}); - - my $where; - - if ($form->{transdate}) { - $where .= qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{project_id} ); + ( $form->{orphaned} ) = $sth->fetchrow_array(); + $sth->finish; + } + else { + $form->{project} = 'project'; + } + $sth->finish; + } + + JC->jcparts( $myconfig, $form, $dbh ); + + $form->all_employees( $myconfig, $dbh, $form->{transdate} ); + + my $where; + + if ( $form->{transdate} ) { + $where .= qq| AND (enddate IS NULL - OR enddate >= |. - $dbh->quote($form->{transdate}).qq|) - AND (startdate <= |. - $dbh->quote($form->{transdate}).qq| + OR enddate >= | . $dbh->quote( $form->{transdate} ) . qq|) + AND (startdate <= | . $dbh->quote( $form->{transdate} ) . qq| OR startdate IS NULL)|; - } - - if ($form->{project} eq 'job') { - $query = qq| + } + + if ( $form->{project} eq 'job' ) { + $query = qq| SELECT pr.* FROM project pr WHERE pr.parts_id > 0 AND pr.production > pr.completed $where|; - } elsif ($form->{project} eq 'project') { - $query = qq| + } + elsif ( $form->{project} eq 'project' ) { + $query = qq| SELECT pr.* FROM project pr WHERE pr.parts_id IS NULL $where|; - } else { - $query = qq| + } + else { + $query = qq| SELECT pr.* FROM project pr WHERE 1=1 @@ -199,49 +197,48 @@ sub jcitems_links { FROM project pr WHERE pr.parts_id > 0 AND pr.production = pr.completed|; - } + } - if ($form->{project_id}) { - $query .= qq| + if ( $form->{project_id} ) { + $query .= qq| UNION SELECT * FROM project - WHERE id = |.$dbh->quote($form->{project_id}); - } - - $query .= qq| + WHERE id = | . $dbh->quote( $form->{project_id} ); + } + + $query .= qq| ORDER BY projectnumber|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_project} }, $ref; - } - $sth->finish; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_project} }, $ref; + } + $sth->finish; } - sub jcparts { - my ($self, $myconfig, $form, $dbh) = @_; - - my ($null, $project_id) = split /--/, $form->{projectnumber}; - $project_id = $dbh->quote($project_id); - - my $query = qq|SELECT customer_id FROM project WHERE id = $project_id|; - my ($customer_id) = $dbh->selectrow_array($query); - $customer_id = $dbh->quote($customer_id);; - - my $where; - - if ($form->{project} eq 'job') { - $where = " AND p.income_accno_id IS NULL"; - if ($form->{type} eq 'storescard') { - $where = " AND p.inventory_accno_id > 0 + my ( $self, $myconfig, $form, $dbh ) = @_; + + my ( $null, $project_id ) = split /--/, $form->{projectnumber}; + $project_id = $dbh->quote($project_id); + + my $query = qq|SELECT customer_id FROM project WHERE id = $project_id|; + my ($customer_id) = $dbh->selectrow_array($query); + $customer_id = $dbh->quote($customer_id); + + my $where; + + if ( $form->{project} eq 'job' ) { + $where = " AND p.income_accno_id IS NULL"; + if ( $form->{type} eq 'storescard' ) { + $where = " AND p.inventory_accno_id > 0 AND p.income_accno_id > 0"; - } - - $query = qq| + } + + $query = qq| SELECT p.id, p.partnumber, p.description, p.sellprice, p.unit, t.description AS translation @@ -249,16 +246,17 @@ sub jcparts { LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code - = |.$dbh->quote($form->{language_code}).qq|) + = | . $dbh->quote( $form->{language_code} ) . qq|) WHERE p.obsolete = '0' $where|; - } elsif ($form->{project} eq 'project') { - $where = " AND p.inventory_accno_id IS NULL"; - if ($form->{type} eq 'storescard') { - $where = " AND p.inventory_accno_id > 0"; - } - - $query = qq| + } + elsif ( $form->{project} eq 'project' ) { + $where = " AND p.inventory_accno_id IS NULL"; + if ( $form->{type} eq 'storescard' ) { + $where = " AND p.inventory_accno_id > 0"; + } + + $query = qq| SELECT p.id, p.partnumber, p.description, p.sellprice, p.unit, t.description AS translation @@ -266,12 +264,13 @@ sub jcparts { LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code - = |.$dbh->quote($form->{language_code}).qq|) + = | . $dbh->quote( $form->{language_code} ) . qq|) WHERE p.obsolete = '0' AND p.assembly = '0' $where|; - } else { - - $query = qq| + } + else { + + $query = qq| SELECT p.id, p.partnumber, p.description, p.sellprice, p.unit, t.description AS translation @@ -279,7 +278,7 @@ sub jcparts { LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code - = |.$dbh->quote($form->{language_code}).qq|) + = | . $dbh->quote( $form->{language_code} ) . qq|) WHERE p.obsolete = '0' AND p.income_accno_id IS NULL UNION @@ -290,185 +289,183 @@ sub jcparts { LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code - = |.$dbh->quote($form->{language_code}).qq|) + = | . $dbh->quote( $form->{language_code} ) . qq|) WHERE p.obsolete = '0' AND p.assembly = '0' AND p.inventory_accno_id IS NULL|; - } + } - $query .= qq| + $query .= qq| ORDER BY 2|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $pmh = PriceMatrix::price_matrix_query($dbh, $form); - IS::exchangerate_defaults($dbh, $form); + my $pmh = PriceMatrix::price_matrix_query( $dbh, $form ); + IS::exchangerate_defaults( $dbh, $form ); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{description} = $ref->{translation} - if $ref->{translation}; - PriceMatrix::price_matrix( - $pmh, $ref, $form->{transdate}, 4, $form, $myconfig); - push @{ $form->{all_parts} }, $ref; - } - $sth->finish; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{description} = $ref->{translation} + if $ref->{translation}; + PriceMatrix::price_matrix( $pmh, $ref, $form->{transdate}, 4, $form, + $myconfig ); + push @{ $form->{all_parts} }, $ref; + } + $sth->finish; } - sub delete_timecard { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my %audittrail = ( - tablename => 'jcitems', - reference => $form->{id}, - formname => $form->{type}, - action => 'deleted', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - my $query = qq|DELETE FROM jcitems WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id})|| $form->dberror($query); - - # delete spool files - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my %audittrail = ( + tablename => 'jcitems', + reference => $form->{id}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + my $query = qq|DELETE FROM jcitems WHERE id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + # delete spool files + $query = qq| SELECT spoolfile FROM status WHERE formname = ? AND trans_id = ? AND spoolfile IS NOT NULL|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{type}, $form->{id}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{type}, $form->{id} ) || $form->dberror($query); - my $spoolfile; - my @spoolfiles = (); + my $spoolfile; + my @spoolfiles = (); - while (($spoolfile) = $sth->fetchrow_array) { - push @spoolfiles, $spoolfile; - } - $sth->finish; + while ( ($spoolfile) = $sth->fetchrow_array ) { + push @spoolfiles, $spoolfile; + } + $sth->finish; - # delete status entries - $query = qq| + # delete status entries + $query = qq| DELETE FROM status WHERE formname = ? AND trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{type}, $form->{id}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{type}, $form->{id} ) || $form->dberror($query); - my $rc = $dbh->commit; + my $rc = $dbh->commit; - if ($rc) { - foreach $spoolfile (@spoolfiles) { - unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" - if $spoolfile; - } - } + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" + if $spoolfile; + } + } - $dbh->{commit}; + $dbh->{commit}; - $rc; + $rc; } - sub jcitems { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query; - my $where = "1 = 1"; - my $null; - my $var; - - if ($form->{projectnumber}) { - ($null, $var) = split /--/, $form->{projectnumber}; - $var = $dbh->quote($var); - $where .= " AND j.project_id = $var"; - - $query = qq|SELECT parts_id FROM project WHERE id = $var|; - my ($job) = $dbh->selectrow_array($query); - $form->{project} = ($job) ? "job" : "project"; - - } - if ($form->{partnumber}) { - ($null, $var) = split /--/, $form->{partnumber}; - $var = $dbh->quote($var); - $where .= " AND j.parts_id = $var"; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $query; + my $where = "1 = 1"; + my $null; + my $var; + + if ( $form->{projectnumber} ) { + ( $null, $var ) = split /--/, $form->{projectnumber}; + $var = $dbh->quote($var); + $where .= " AND j.project_id = $var"; + + $query = qq|SELECT parts_id FROM project WHERE id = $var|; + my ($job) = $dbh->selectrow_array($query); + $form->{project} = ($job) ? "job" : "project"; + + } + if ( $form->{partnumber} ) { + ( $null, $var ) = split /--/, $form->{partnumber}; + $var = $dbh->quote($var); + $where .= " AND j.parts_id = $var"; + + $query = qq| SELECT inventory_accno_id FROM parts WHERE id = $var|; - my ($job) = $dbh->selectrow_array($query); - $form->{project} = ($job) ? "job" : "project"; - - } - if ($form->{employee}) { - ($null, $var) = split /--/, $form->{employee}; - $var = $dbh->quote($var); - $where .= " AND j.employee_id = $var"; - } - if ($form->{open} || $form->{closed}) { - unless ($form->{open} && $form->{closed}) { - $where .= " AND j.qty != j.allocated" if $form->{open}; - $where .= " AND j.qty = j.allocated" - if $form->{closed}; - } - } - - ($form->{startdatefrom}, $form->{startdateto}) - = $form->from_to( - $form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - $where .= " AND j.checkedin >= ".$dbh->quote($form->{startdatefrom}) - if $form->{startdatefrom}; - $where .= " AND j.checkedout < date ". - $dbh->quote($form->{startdateto})." + 1" - if $form->{startdateto}; - - my %ordinal = ( - id => 1, - description => 2, - transdate => 7, - partnumber => 9, - projectnumber => 10, - projectdescription => 11, - ); - - my @a = (transdate, projectnumber); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $dateformat = $myconfig->{dateformat}; - $dateformat =~ s/yy$/yyyy/; - $dateformat =~ s/yyyyyy/yyyy/; - - if ($form->{project} eq 'job') { - if ($form->{type} eq 'timecard') { - $where .= " + my ($job) = $dbh->selectrow_array($query); + $form->{project} = ($job) ? "job" : "project"; + + } + if ( $form->{employee} ) { + ( $null, $var ) = split /--/, $form->{employee}; + $var = $dbh->quote($var); + $where .= " AND j.employee_id = $var"; + } + if ( $form->{open} || $form->{closed} ) { + unless ( $form->{open} && $form->{closed} ) { + $where .= " AND j.qty != j.allocated" if $form->{open}; + $where .= " AND j.qty = j.allocated" + if $form->{closed}; + } + } + + ( $form->{startdatefrom}, $form->{startdateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + $where .= " AND j.checkedin >= " . $dbh->quote( $form->{startdatefrom} ) + if $form->{startdatefrom}; + $where .= + " AND j.checkedout < date " . $dbh->quote( $form->{startdateto} ) . " + 1" + if $form->{startdateto}; + + my %ordinal = ( + id => 1, + description => 2, + transdate => 7, + partnumber => 9, + projectnumber => 10, + projectdescription => 11, + ); + + my @a = ( transdate, projectnumber ); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $dateformat = $myconfig->{dateformat}; + $dateformat =~ s/yy$/yyyy/; + $dateformat =~ s/yyyyyy/yyyy/; + + if ( $form->{project} eq 'job' ) { + if ( $form->{type} eq 'timecard' ) { + $where .= " AND pr.parts_id > 0 AND p.income_accno_id IS NULL"; - } - - if ($form->{type} eq 'storescard') { - $where .= " + } + + if ( $form->{type} eq 'storescard' ) { + $where .= " AND pr.parts_id > 0 AND p.income_accno_id > 0"; - } - } - if ($form->{project} eq 'project') { - $where .= " AND pr.parts_id IS NULL"; - } - - $query = qq| + } + } + if ( $form->{project} eq 'project' ) { + $where .= " AND pr.parts_id IS NULL"; + } + + $query = qq| SELECT j.id, j.description, j.qty, j.allocated, to_char(j.checkedin, 'HH24:MI') AS checkedin, to_char(j.checkedout, 'HH24:MI') AS checkedout, @@ -487,101 +484,100 @@ sub jcitems { WHERE $where ORDER BY employee, employeenumber, $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute($dateformat) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute($dateformat) || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{project} = ($ref->{parts_id}) ? "job" : "project"; - $ref->{transdate} = $ref->{transdatea}; - delete $ref->{transdatea}; - push @{ $form->{transactions} }, $ref; - } - $sth->finish; - - $dbh->commit; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{project} = ( $ref->{parts_id} ) ? "job" : "project"; + $ref->{transdate} = $ref->{transdatea}; + delete $ref->{transdatea}; + push @{ $form->{transactions} }, $ref; + } + $sth->finish; -} + $dbh->commit; +} sub save { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $query; - my $sth; - - my ($null, $project_id) = split /--/, $form->{projectnumber}; - - if ($form->{id}) { - # check if it was a job - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $query; + my $sth; + + my ( $null, $project_id ) = split /--/, $form->{projectnumber}; + + if ( $form->{id} ) { + + # check if it was a job + $query = qq| SELECT pr.parts_id, pr.production - pr.completed FROM project pr JOIN jcitems j ON (j.project_id = pr.id) WHERE j.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}); - my ($job_id, $qty) = $sth->fetchrow_array(); - $sth->finish; - if ($job_id && $qty == 0) { - return -1; - } - - # check if new one belongs to a job - if ($project_id) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ); + my ( $job_id, $qty ) = $sth->fetchrow_array(); + $sth->finish; + if ( $job_id && $qty == 0 ) { + return -1; + } + + # check if new one belongs to a job + if ($project_id) { + $query = qq| SELECT pr.parts_id, pr.production - pr.completed FROM project pr WHERE pr.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($project_id); - my ($job_id, $qty) = $sth->fetchrow_array(); - - if ($job_id && $qty == 0) { - $dbh->disconnect; - return -2; - } - } - - } else { - my $uid = localtime; - $uid .= "$$"; - - $query = qq|INSERT INTO jcitems (description) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); - - $query = qq|SELECT id FROM jcitems WHERE description = '$uid'|; - ($form->{id}) = $dbh->selectrow_array($query); - } - - for (qw(inhour inmin insec outhour outmin outsec)) { - $form->{$_} = substr("00$form->{$_}", -2); - } - for (qw(qty sellprice allocated)) { - $form->{$_} = $form->parse_amount($myconfig, $form->{$_}); - } - - my $checkedin = "$form->{inhour}$form->{inmin}$form->{insec}"; - my $checkedout = "$form->{outhour}$form->{outmin}$form->{outsec}"; - - my $outdate = $form->{transdate}; - if ($checkedout < $checkedin) { - $outdate = $form->add_date( - $myconfig, $form->{transdate}, 1, 'days'); - } - - ($null, $form->{employee_id}) = split /--/, $form->{employee}; - unless ($form->{employee_id}) { - ($form->{employee}, $form->{employee_id}) - = $form->get_employee($dbh); - } - - my $parts_id; - ($null, $parts_id) = split /--/, $form->{partnumber}; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute($project_id); + my ( $job_id, $qty ) = $sth->fetchrow_array(); + + if ( $job_id && $qty == 0 ) { + $dbh->disconnect; + return -2; + } + } + + } + else { + my $uid = localtime; + $uid .= "$$"; + + $query = qq|INSERT INTO jcitems (description) VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM jcitems WHERE description = '$uid'|; + ( $form->{id} ) = $dbh->selectrow_array($query); + } + + for (qw(inhour inmin insec outhour outmin outsec)) { + $form->{$_} = substr( "00$form->{$_}", -2 ); + } + for (qw(qty sellprice allocated)) { + $form->{$_} = $form->parse_amount( $myconfig, $form->{$_} ); + } + + my $checkedin = "$form->{inhour}$form->{inmin}$form->{insec}"; + my $checkedout = "$form->{outhour}$form->{outmin}$form->{outsec}"; + + my $outdate = $form->{transdate}; + if ( $checkedout < $checkedin ) { + $outdate = $form->add_date( $myconfig, $form->{transdate}, 1, 'days' ); + } + + ( $null, $form->{employee_id} ) = split /--/, $form->{employee}; + unless ( $form->{employee_id} ) { + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + } + + my $parts_id; + ( $null, $parts_id ) = split /--/, $form->{partnumber}; + + $query = qq| UPDATE jcitems SET project_id = ?, parts_id = ?, @@ -596,36 +592,41 @@ sub save { employee_id = ?, notes = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $project_id, $parts_id, $form->{description}, $form->{qty}, - $form->{allocated}, $form->{sellprice}, $form->{sellprice}, - $form->{serialnumber}, - "$form->{transdate} $form->{inhour}:$form->{inmin}:". - $form->{insec}, - "$outdate $form->{outhour}:$form->{outmin}:$form->{outsec}", - $form->{employee_id}, $form->{notes}, $form->{id} - ) || $form->dberror($query); - - # save printed, queued - $form->save_status($dbh); - - my %audittrail = ( - tablename => 'jcitems', - reference => $form->{id}, - formname => $form->{type}, - action => 'saved', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - my $rc = $dbh->commit; - - $rc; + $sth = $dbh->prepare($query); + $sth->execute( + $project_id, + $parts_id, + $form->{description}, + $form->{qty}, + $form->{allocated}, + $form->{sellprice}, + $form->{sellprice}, + $form->{serialnumber}, + "$form->{transdate} $form->{inhour}:$form->{inmin}:" . $form->{insec}, + "$outdate $form->{outhour}:$form->{outmin}:$form->{outsec}", + $form->{employee_id}, + $form->{notes}, + $form->{id} + ) || $form->dberror($query); + + # save printed, queued + $form->save_status($dbh); + + my %audittrail = ( + tablename => 'jcitems', + reference => $form->{id}, + formname => $form->{type}, + action => 'saved', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + my $rc = $dbh->commit; + + $rc; } - - 1; diff --git a/LedgerSMB/Locale.pm b/LedgerSMB/Locale.pm index c6192510..122794b4 100644 --- a/LedgerSMB/Locale.pm +++ b/LedgerSMB/Locale.pm @@ -3,15 +3,15 @@ # Locale support module for LedgerSMB # LedgerSMB::Locale # -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # # @@ -29,17 +29,17 @@ use base 'Locale::Maketext'; use Locale::Maketext::Lexicon; use Encode; -Locale::Maketext::Lexicon->import({ - '*' => [ - Gettext => "${LedgerSMB::Sysconfig::localepath}/*.po", - ], - _auto => 1, - _decode => 1, -}); +Locale::Maketext::Lexicon->import( + { + '*' => [ Gettext => "${LedgerSMB::Sysconfig::localepath}/*.po", ], + _auto => 1, + _decode => 1, + } +); sub text { - my ($self, $text, @params) = @_; - return $self->maketext($text, @params); + my ( $self, $text, @params ) = @_; + return $self->maketext( $text, @params ); } ##sub date { @@ -47,89 +47,94 @@ sub text { ## return $date; ##} sub date { - my ($self, $myconfig, $date, $longformat) = @_; - - my @longmonth = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)); - @longmonth = ("January", "February", "March", "April", "May ", "June", - "July", "August", "September", "October", "November", - "December") if $longformat; - my $longdate = ''; - - return '' if not $date; - - my $spc = ''; - my $yy = ''; - my $mm = ''; - my $dd = ''; - - # get separator - $spc = $myconfig->{dateformat}; - $spc =~ s/\w//g; - $spc = substr($spc, 0, 1); - - if (!$longformat && $date =~ /^\d{4}\D/){ # reparsing date at this point - # causes problems! - return $date; - } - if ($date =~ /\D/) { - - if ($myconfig->{dateformat} =~ /^yy/) { - ($yy, $mm, $dd) = split /\D/, $date; - } - - if ($myconfig->{dateformat} =~ /^mm/) { - ($mm, $dd, $yy) = split /\D/, $date; - } - - if ($myconfig->{dateformat} =~ /^dd/) { - ($dd, $mm, $yy) = split /\D/, $date; - } - - } else { - - $date = substr($date, 2); - ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); - } - - $dd *= 1; - $mm--; - $yy += 2000 if length $yy == 2; - - if ($myconfig->{dateformat} =~ /^dd/) { - - $mm++; - $dd = substr("0$dd", -2); - $mm = substr("0$mm", -2); - $longdate = "$dd$spc$mm$spc$yy"; - - if (defined $longformat) { - $longdate = "$dd"; - $longdate .= ($spc eq '.') ? ". " : " "; - $longdate .= &text($self, $longmonth[--$mm])." $yy"; - } - - } elsif ($myconfig->{dateformat} =~ /^yy/) { - - $mm++; - $dd = substr("0$dd", -2); - $mm = substr("0$mm", -2); - $longdate = "$yy$spc$mm$spc$dd"; - - if (defined $longformat) { - $longdate = &text($self, $longmonth[--$mm])." $dd $yy"; - } - - } else { - - $mm++; - $dd = substr("0$dd", -2); - $mm = substr("0$mm", -2); - $longdate = "$mm$spc$dd$spc$yy"; - - if (defined $longformat) { - $longdate = &text($self, $longmonth[--$mm])." $dd $yy"; - } - } + my ( $self, $myconfig, $date, $longformat ) = @_; + + my @longmonth = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)); + @longmonth = ( + "January", "February", "March", "April", + "May ", "June", "July", "August", + "September", "October", "November", "December" + ) if $longformat; + my $longdate = ''; + + return '' if not $date; + + my $spc = ''; + my $yy = ''; + my $mm = ''; + my $dd = ''; + + # get separator + $spc = $myconfig->{dateformat}; + $spc =~ s/\w//g; + $spc = substr( $spc, 0, 1 ); + + if ( !$longformat && $date =~ /^\d{4}\D/ ) { # reparsing date at this point + # causes problems! + return $date; + } + if ( $date =~ /\D/ ) { + + if ( $myconfig->{dateformat} =~ /^yy/ ) { + ( $yy, $mm, $dd ) = split /\D/, $date; + } + + if ( $myconfig->{dateformat} =~ /^mm/ ) { + ( $mm, $dd, $yy ) = split /\D/, $date; + } + + if ( $myconfig->{dateformat} =~ /^dd/ ) { + ( $dd, $mm, $yy ) = split /\D/, $date; + } + + } + else { + + $date = substr( $date, 2 ); + ( $yy, $mm, $dd ) = ( $date =~ /(..)(..)(..)/ ); + } + + $dd *= 1; + $mm--; + $yy += 2000 if length $yy == 2; + + if ( $myconfig->{dateformat} =~ /^dd/ ) { + + $mm++; + $dd = substr( "0$dd", -2 ); + $mm = substr( "0$mm", -2 ); + $longdate = "$dd$spc$mm$spc$yy"; + + if ( defined $longformat ) { + $longdate = "$dd"; + $longdate .= ( $spc eq '.' ) ? ". " : " "; + $longdate .= &text( $self, $longmonth[ --$mm ] ) . " $yy"; + } + + } + elsif ( $myconfig->{dateformat} =~ /^yy/ ) { + + $mm++; + $dd = substr( "0$dd", -2 ); + $mm = substr( "0$mm", -2 ); + $longdate = "$yy$spc$mm$spc$dd"; + + if ( defined $longformat ) { + $longdate = &text( $self, $longmonth[ --$mm ] ) . " $dd $yy"; + } + + } + else { + + $mm++; + $dd = substr( "0$dd", -2 ); + $mm = substr( "0$mm", -2 ); + $longdate = "$mm$spc$dd$spc$yy"; + + if ( defined $longformat ) { + $longdate = &text( $self, $longmonth[ --$mm ] ) . " $dd $yy"; + } + } } 1; diff --git a/LedgerSMB/Location.pm b/LedgerSMB/Location.pm index dc4b0123..929e1a6c 100644 --- a/LedgerSMB/Location.pm +++ b/LedgerSMB/Location.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::Location - LedgerSMB class for managing Business Locations @@ -38,29 +39,29 @@ our $VERSION = '1.0.0'; our @ISA = qw(LedgerSMB::DBObject); sub AUTOLOAD { - my $self = shift; - my $AUTOLOAD = $LedgerSMB::Location::AUTOLOAD; - $AUTOLOAD =~ s/^.*:://; - my $procname = "location_$AUTOLOAD"; - $self->exec_method(procname => "location_$AUTOLOAD", args => \@_); + my $self = shift; + my $AUTOLOAD = $LedgerSMB::Location::AUTOLOAD; + $AUTOLOAD =~ s/^.*:://; + my $procname = "location_$AUTOLOAD"; + $self->exec_method( procname => "location_$AUTOLOAD", args => \@_ ); } sub save { - $ref = shift @{$self->exec_method(procname =>"location_save")}; - $self->merge($ref, 'id'); + $ref = shift @{ $self->exec_method( procname => "location_save" ) }; + $self->merge( $ref, 'id' ); } sub get { - $ref = shift @{$self->exec_method(procname =>'location_get')}; - $self->merge($ref, keys %{$ref}); + $ref = shift @{ $self->exec_method( procname => 'location_get' ) }; + $self->merge( $ref, keys %{$ref} ); } sub search { - $self->{search_results} = - $self->exec_method(procname => 'location_search'); + $self->{search_results} = + $self->exec_method( procname => 'location_search' ); } sub list_all { - $self->{search_results} = - $self->exec_method(procname => 'location_list_all'); + $self->{search_results} = + $self->exec_method( procname => 'location_list_all' ); } diff --git a/LedgerSMB/Log.pm b/LedgerSMB/Log.pm index 0613132b..d102705d 100644 --- a/LedgerSMB/Log.pm +++ b/LedgerSMB/Log.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::Log - LedgerSMB logging and debugging framework @@ -56,33 +57,34 @@ our $VERSION = '1.0.0'; our $log_line; -sub print { - if (!$LedgerSMB::Sysconfig::logging){ - return 0; - } - shift; - $log_line = sprintf('[%s] [%s] %i %s', scalar(localtime), +shift, $$, join(' ',@_))."\n"; - print STDERR $log_line; +sub print { + if ( !$LedgerSMB::Sysconfig::logging ) { + return 0; + } + shift; + $log_line = sprintf( '[%s] [%s] %i %s', + scalar(localtime), +shift, $$, join( ' ', @_ ) ) + . "\n"; + print STDERR $log_line; } - -sub emerg { shift->print('emerg',@_) } -sub alert { shift->print('alert',@_) } -sub crit { shift->print('crit',@_) } -sub error { shift->print('error',@_) } -sub warn { shift->print('warn',@_) } -sub notice { shift->print('notice',@_) } -sub info { shift->print('info',@_) } -sub debug { shift->print('debug',@_) } - -sub longmess { shift->print('debug',Carp::longmess(@_)) } - -sub dump { - my $self = shift; - my $d = Data::Dumper->new([@_]); - $d->Sortkeys(1); - $self->print('debug',$d->Dump()); +sub emerg { shift->print( 'emerg', @_ ) } +sub alert { shift->print( 'alert', @_ ) } +sub crit { shift->print( 'crit', @_ ) } +sub error { shift->print( 'error', @_ ) } +sub warn { shift->print( 'warn', @_ ) } +sub notice { shift->print( 'notice', @_ ) } +sub info { shift->print( 'info', @_ ) } +sub debug { shift->print( 'debug', @_ ) } + +sub longmess { shift->print( 'debug', Carp::longmess(@_) ) } + +sub dump { + my $self = shift; + my $d = Data::Dumper->new( [@_] ); + $d->Sortkeys(1); + $self->print( 'debug', $d->Dump() ); } 1; diff --git a/LedgerSMB/Mailer.pm b/LedgerSMB/Mailer.pm index 05a711bd..eb1d4a9b 100644 --- a/LedgerSMB/Mailer.pm +++ b/LedgerSMB/Mailer.pm @@ -1,5 +1,5 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ # @@ -19,7 +19,7 @@ # Author: DWS Systems Inc. # Web: http://www.sql-ledger.org # -# Contributors: +# Contributors: # # Original Author and copyright holder: # Dieter Simader dsmimader@sql-ledger.com @@ -40,85 +40,85 @@ use MIME::Base64; use LedgerSMB::Sysconfig; sub new { - my ($type) = @_; - my $self = {}; + my ($type) = @_; + my $self = {}; - bless $self, $type; + bless $self, $type; } - sub send { - my ($self) = @_; - - my $domain = $self->{from}; - $domain =~ s/(.*?\@|>)//g; - my $msgid = "$boundary\@$domain"; - - - $self->{contenttype} = "text/plain" unless $self->{contenttype}; - - my %h; - for (qw(from to cc bcc)) { - $self->{$_} =~ s/\</</g; - $self->{$_} =~ s/\>/>/g; - $self->{$_} =~ s/(\/|\\|\$)//g; - $h{$_} = $self->{$_}; - } - - $h{subject} = - ($self->{subject} =~ /([\x00-\x1F]|[\x7B-\xFFFF])/) - ? "Subject: =?$self->{charset}?B?". - MIME::Base64::encode($self->{subject},"")."?=" - : "Subject: $self->{subject}"; - - my $msg = MIME::Lite->new( - 'From' => $self->{from}, - 'To' => $self->{to}, - 'Cc' => $self->{cc}, - 'Bcc' => $self->{bcc}, - 'Subject' => $self->{subject}, - 'Type' => 'TEXT', - 'Data' => $self->{message}, - ); - $msg->add('Disposition-Notification-To' => $self->{from}) - if $self->{notify}; - $msg->replace('X-Mailer' => "LedgerSMB $self->{version}"); - - if (@{ $self->{attachments} }) { - foreach my $attachment (@{ $self->{attachments} }) { - - my $application = - ($attachment =~ - /(^\w+$)|\.(html|text|txt|sql)$/) - ? "text" - : "application"; - - my $filename = $attachment; - # strip path - $filename =~ s/(.*\/|$self->{fileid})//g; - $msg->attach( - 'Type' => "$application/$self->{format}", - 'Path' => $attachment, - 'Filename' => $filename, - 'Disposition' => 'attachment', - ); - } - - } - - if (${LedgerSMB::Sysconfig::smtphost}) { - $msg->send('smtp', ${LedgerSMB::Sysconfig::smtphost}, - Timeout => ${LedgerSMB::Sysconfig::smtptimeout}) || - return $!; - } else { - $msg->send('sendmail', ${LedgerSMB::Sysconfig::sendmail}) || - return $!; - } - - return ""; - -} + my ($self) = @_; + + my $domain = $self->{from}; + $domain =~ s/(.*?\@|>)//g; + my $msgid = "$boundary\@$domain"; + + $self->{contenttype} = "text/plain" unless $self->{contenttype}; + + my %h; + for (qw(from to cc bcc)) { + $self->{$_} =~ s/\</</g; + $self->{$_} =~ s/\>/>/g; + $self->{$_} =~ s/(\/|\\|\$)//g; + $h{$_} = $self->{$_}; + } + + $h{subject} = + ( $self->{subject} =~ /([\x00-\x1F]|[\x7B-\xFFFF])/ ) + ? "Subject: =?$self->{charset}?B?" + . MIME::Base64::encode( $self->{subject}, "" ) . "?=" + : "Subject: $self->{subject}"; + + my $msg = MIME::Lite->new( + 'From' => $self->{from}, + 'To' => $self->{to}, + 'Cc' => $self->{cc}, + 'Bcc' => $self->{bcc}, + 'Subject' => $self->{subject}, + 'Type' => 'TEXT', + 'Data' => $self->{message}, + ); + $msg->add( 'Disposition-Notification-To' => $self->{from} ) + if $self->{notify}; + $msg->replace( 'X-Mailer' => "LedgerSMB $self->{version}" ); + + if ( @{ $self->{attachments} } ) { + foreach my $attachment ( @{ $self->{attachments} } ) { + + my $application = + ( $attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/ ) + ? "text" + : "application"; + + my $filename = $attachment; + + # strip path + $filename =~ s/(.*\/|$self->{fileid})//g; + $msg->attach( + 'Type' => "$application/$self->{format}", + 'Path' => $attachment, + 'Filename' => $filename, + 'Disposition' => 'attachment', + ); + } + + } + + if ( ${LedgerSMB::Sysconfig::smtphost} ) { + $msg->send( + 'smtp', + ${LedgerSMB::Sysconfig::smtphost}, + Timeout => ${LedgerSMB::Sysconfig::smtptimeout} + ) || return $!; + } + else { + $msg->send( 'sendmail', ${LedgerSMB::Sysconfig::sendmail} ) + || return $!; + } + + return ""; +} 1; diff --git a/LedgerSMB/Menu.pm b/LedgerSMB/Menu.pm index 344bb7d7..d8aad77c 100644 --- a/LedgerSMB/Menu.pm +++ b/LedgerSMB/Menu.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -36,85 +36,83 @@ package Menu; use LedgerSMB::Inifile; @ISA = qw/Inifile/; - sub menuitem { - my ($self, $myconfig, $form, $item) = @_; - - my $module = ($self->{$item}{module}) - ? $self->{$item}{module} : $form->{script}; - my $action = ($self->{$item}{action}) - ? $self->{$item}{action} : "section_menu"; - my $target = ($self->{$item}{target}) - ? $self->{$item}{target} : ""; - - my $level = $form->escape($item); - my $str = qq|<a style="display:block;"|. - qq|href="$module?path=$form->{path}&action=$action&|. - qq|level=$level&login=$form->{login}&|. - qq|timeout=$form->{timeout}&sessionid=$form->{sessionid}|. - qq|&js=$form->{js}|; - - my @vars = qw(module action target href); - - if ($self->{$item}{href}) { - $str = qq|<a href="$self->{$item}{href}|; - @vars = qw(module target href); - } - - for (@vars) { delete $self->{$item}{$_} } - - delete $self->{$item}{submenu}; - - # add other params - foreach my $key (keys %{ $self->{$item} }) { - $str .= "&".$form->escape($key)."="; - ($value, $conf) = split /=/, $self->{$item}{$key}, 2; - $value = "$myconfig->{$value}$conf" - if $self->{$item}{$key} =~ /=/; - - $str .= $form->escape($value); - } - - $str .= qq|#id$form->{tag}| if $target eq 'acc_menu'; - - if ($target) { - $str .= qq|" target="$target"|; - } - else{ - $str .= '"'; - } - - $str .= qq|>|; - -} + my ( $self, $myconfig, $form, $item ) = @_; + my $module = + ( $self->{$item}{module} ) ? $self->{$item}{module} : $form->{script}; + my $action = + ( $self->{$item}{action} ) ? $self->{$item}{action} : "section_menu"; + my $target = ( $self->{$item}{target} ) ? $self->{$item}{target} : ""; -sub access_control { - my ($self, $myconfig, $menulevel) = @_; - - my @menu = (); + my $level = $form->escape($item); + my $str = + qq|<a style="display:block;"| + . qq|href="$module?path=$form->{path}&action=$action&| + . qq|level=$level&login=$form->{login}&| + . qq|timeout=$form->{timeout}&sessionid=$form->{sessionid}| + . qq|&js=$form->{js}|; + + my @vars = qw(module action target href); - if ($menulevel eq "") { - @menu = grep { !/--/ } @{ $self->{ORDER} }; - } else { - @menu = grep { /^${menulevel}--/; } @{ $self->{ORDER} }; - } + if ( $self->{$item}{href} ) { + $str = qq|<a href="$self->{$item}{href}|; + @vars = qw(module target href); + } - my @a = split /;/, $myconfig->{acs}; - my $excl = (); + for (@vars) { delete $self->{$item}{$_} } - # remove --AR, --AP from array - grep { ($a, $b) = split /--/; s/--$a$//; } @a; + delete $self->{$item}{submenu}; - for (@a) { $excl{$_} = 1 } + # add other params + foreach my $key ( keys %{ $self->{$item} } ) { + $str .= "&" . $form->escape($key) . "="; + ( $value, $conf ) = split /=/, $self->{$item}{$key}, 2; + $value = "$myconfig->{$value}$conf" + if $self->{$item}{$key} =~ /=/; - @a = (); - for (@menu) { push @a, $_ unless $excl{$_} } + $str .= $form->escape($value); + } - @a; + $str .= qq|#id$form->{tag}| if $target eq 'acc_menu'; + + if ($target) { + $str .= qq|" target="$target"|; + } + else { + $str .= '"'; + } + + $str .= qq|>|; } +sub access_control { + my ( $self, $myconfig, $menulevel ) = @_; + + my @menu = (); + + if ( $menulevel eq "" ) { + @menu = grep { !/--/ } @{ $self->{ORDER} }; + } + else { + @menu = grep { /^${menulevel}--/; } @{ $self->{ORDER} }; + } + + my @a = split /;/, $myconfig->{acs}; + my $excl = (); + + # remove --AR, --AP from array + grep { ( $a, $b ) = split /--/; s/--$a$//; } @a; + + for (@a) { $excl{$_} = 1 } + + @a = (); + for (@menu) { push @a, $_ unless $excl{$_} } + + @a; + +} 1; diff --git a/LedgerSMB/Num2text.pm b/LedgerSMB/Num2text.pm index 8382df5c..25bdc95f 100644 --- a/LedgerSMB/Num2text.pm +++ b/LedgerSMB/Num2text.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -19,7 +19,7 @@ # Author: DWS Systems Inc. # Web: http://www.sql-ledger.org # -# Contributors: +# Contributors: # #====================================================================== # @@ -33,993 +33,1053 @@ # The conversion routines can be tested with for example: # perl <<EOF -# use LedgerSMB::CP; -# my $c = CP->new('da'); -# $c->init; -# for(0 .. 202, 999 .. 1002, 1999 .. 2002, 999999 .. 1000002, 999999999 .. 1000000002) +# use LedgerSMB::CP; +# my $c = CP->new('da'); +# $c->init; +# for(0 .. 202, 999 .. 1002, 1999 .. 2002, 999999 .. 1000002, 999999999 .. 1000000002) # {print $_.":".$c->num2text($_)."\n";};' # EOF sub init { - my $self = shift; - my $locale = $self->{'locale'}; - my $langtag = substr($locale->language_tag, 0, 2); - $self->{'numrules'} = 'en'; - $self->{'numrules'} = $langtag if - grep {/$langtag/} (qw/ca de es et fr hu it nl ru da/); - $self->{'numrules'} = 'es' if $self->{'numrules'} eq 'ca'; - $self->{'numrules'} = 'de' if $self->{'numrules'} eq 'ru'; - - %{ $self->{numbername} } = - (0 => $locale->text('Zero'), - 1 => $locale->text('One'), - '1o' => $locale->text('One-o'), - 2 => $locale->text('Two'), - 3 => $locale->text('Three'), - 4 => $locale->text('Four'), - 5 => $locale->text('Five'), - 6 => $locale->text('Six'), - 7 => $locale->text('Seven'), - 8 => $locale->text('Eight'), - 9 => $locale->text('Nine'), - 10 => $locale->text('Ten'), - 11 => $locale->text('Eleven'), - '11o' => $locale->text('Eleven-o'), - 12 => $locale->text('Twelve'), - 13 => $locale->text('Thirteen'), - 14 => $locale->text('Fourteen'), - 15 => $locale->text('Fifteen'), - 16 => $locale->text('Sixteen'), - 17 => $locale->text('Seventeen'), - 18 => $locale->text('Eighteen'), - 19 => $locale->text('Nineteen'), - 20 => $locale->text('Twenty'), - 21 => $locale->text('Twenty One'), - '21o' => $locale->text('Twenty One-o'), - 22 => $locale->text('Twenty Two'), - 23 => $locale->text('Twenty Three'), - 24 => $locale->text('Twenty Four'), - 25 => $locale->text('Twenty Five'), - 26 => $locale->text('Twenty Six'), - 27 => $locale->text('Twenty Seven'), - 28 => $locale->text('Twenty Eight'), - 29 => $locale->text('Twenty Nine'), - 30 => $locale->text('Thirty'), - 40 => $locale->text('Forty'), - 50 => $locale->text('Fifty'), - 60 => $locale->text('Sixty'), - 70 => $locale->text('Seventy'), - 80 => $locale->text('Eighty'), - 90 => $locale->text('Ninety'), - 10**2 => $locale->text('Hundred'), - 500 => $locale->text('Five Hundred'), - 700 => $locale->text('Seven Hundred'), - 900 => $locale->text('Nine Hundred'), - 10**3 => $locale->text('Thousand'), - 10**6 => $locale->text('Million'), - 10**9 => $locale->text('Billion'), - 10**12 => $locale->text('Trillion'), - ); + my $self = shift; + my $locale = $self->{'locale'}; + my $langtag = substr( $locale->language_tag, 0, 2 ); + $self->{'numrules'} = 'en'; + $self->{'numrules'} = $langtag + if grep { /$langtag/ } (qw/ca de es et fr hu it nl ru da/); + $self->{'numrules'} = 'es' if $self->{'numrules'} eq 'ca'; + $self->{'numrules'} = 'de' if $self->{'numrules'} eq 'ru'; + + %{ $self->{numbername} } = ( + 0 => $locale->text('Zero'), + 1 => $locale->text('One'), + '1o' => $locale->text('One-o'), + 2 => $locale->text('Two'), + 3 => $locale->text('Three'), + 4 => $locale->text('Four'), + 5 => $locale->text('Five'), + 6 => $locale->text('Six'), + 7 => $locale->text('Seven'), + 8 => $locale->text('Eight'), + 9 => $locale->text('Nine'), + 10 => $locale->text('Ten'), + 11 => $locale->text('Eleven'), + '11o' => $locale->text('Eleven-o'), + 12 => $locale->text('Twelve'), + 13 => $locale->text('Thirteen'), + 14 => $locale->text('Fourteen'), + 15 => $locale->text('Fifteen'), + 16 => $locale->text('Sixteen'), + 17 => $locale->text('Seventeen'), + 18 => $locale->text('Eighteen'), + 19 => $locale->text('Nineteen'), + 20 => $locale->text('Twenty'), + 21 => $locale->text('Twenty One'), + '21o' => $locale->text('Twenty One-o'), + 22 => $locale->text('Twenty Two'), + 23 => $locale->text('Twenty Three'), + 24 => $locale->text('Twenty Four'), + 25 => $locale->text('Twenty Five'), + 26 => $locale->text('Twenty Six'), + 27 => $locale->text('Twenty Seven'), + 28 => $locale->text('Twenty Eight'), + 29 => $locale->text('Twenty Nine'), + 30 => $locale->text('Thirty'), + 40 => $locale->text('Forty'), + 50 => $locale->text('Fifty'), + 60 => $locale->text('Sixty'), + 70 => $locale->text('Seventy'), + 80 => $locale->text('Eighty'), + 90 => $locale->text('Ninety'), + 10**2 => $locale->text('Hundred'), + 500 => $locale->text('Five Hundred'), + 700 => $locale->text('Seven Hundred'), + 900 => $locale->text('Nine Hundred'), + 10**3 => $locale->text('Thousand'), + 10**6 => $locale->text('Million'), + 10**9 => $locale->text('Billion'), + 10**12 => $locale->text('Trillion'), + ); } - sub num2text { - my ($self, $amount) = @_; - - return $self->num2text_de($amount) if $self->{'numrules'} eq 'de'; - return $self->num2text_es($amount) if $self->{'numrules'} eq 'es'; - return $self->num2text_nl($amount) if $self->{'numrules'} eq 'nl'; - return $self->num2text_hu($amount) if $self->{'numrules'} eq 'hu'; - return $self->num2text_et($amount) if $self->{'numrules'} eq 'et'; - return $self->num2text_fr($amount) if $self->{'numrules'} eq 'fr'; - return $self->num2text_it($amount) if $self->{'numrules'} eq 'it'; - return $self->num2text_da($amount) if $self->{'numrules'} eq 'da'; - return $self->num2text_en($amount); + my ( $self, $amount ) = @_; + + return $self->num2text_de($amount) if $self->{'numrules'} eq 'de'; + return $self->num2text_es($amount) if $self->{'numrules'} eq 'es'; + return $self->num2text_nl($amount) if $self->{'numrules'} eq 'nl'; + return $self->num2text_hu($amount) if $self->{'numrules'} eq 'hu'; + return $self->num2text_et($amount) if $self->{'numrules'} eq 'et'; + return $self->num2text_fr($amount) if $self->{'numrules'} eq 'fr'; + return $self->num2text_it($amount) if $self->{'numrules'} eq 'it'; + return $self->num2text_da($amount) if $self->{'numrules'} eq 'da'; + return $self->num2text_en($amount); } - sub num2text_en { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my @a; - my $i; - - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - while (@numblock) { - - $i = $#numblock; - @num = split //, $numblock[$i]; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - if ($numblock[$i] > 99) { - # the one from hundreds - push @textnumber, $self->{numbername}{$num[0]}; - - # add hundred designation - push @textnumber, $self->{numbername}{10**2}; - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - - } - - $numblock[$i] *= 1; - - if ($numblock[$i] > 9) { - # tens - push @textnumber, $self->format_ten_en($numblock[$i]); - } elsif ($numblock[$i] > 0) { - # ones - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - - # add thousand, million - if ($i) { - $num = 10**($i * 3); - push @textnumber, $self->{numbername}{$num}; - } - - pop @numblock; - - } - - join ' ', @textnumber; + my ( $self, $amount ) = @_; -} + return $self->{numbername}{0} unless $amount; + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my @a; + my $i; + + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + while (@numblock) { + + $i = $#numblock; + @num = split //, $numblock[$i]; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + if ( $numblock[$i] > 99 ) { + + # the one from hundreds + push @textnumber, $self->{numbername}{ $num[0] }; + + # add hundred designation + push @textnumber, $self->{numbername}{ 10**2 }; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + + } + + $numblock[$i] *= 1; + + if ( $numblock[$i] > 9 ) { + + # tens + push @textnumber, $self->format_ten_en( $numblock[$i] ); + } + elsif ( $numblock[$i] > 0 ) { + + # ones + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + + # add thousand, million + if ($i) { + $num = 10**( $i * 3 ); + push @textnumber, $self->{numbername}{$num}; + } + + pop @numblock; + + } + + join ' ', @textnumber; -sub format_ten_en { - my ($self, $amount) = @_; - - my $textnumber = ""; - my @num = split //, $amount; - - if ($amount > 20) { - $textnumber = $self->{numbername}{$num[0]*10}; - $amount = $num[1]; - } else { - $textnumber = $self->{numbername}{$amount}; - $amount = 0; - } - - $textnumber .= " ".$self->{numbername}{$amount} if $amount; - - $textnumber; - } +sub format_ten_en { + my ( $self, $amount ) = @_; -sub num2text_de { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my ($i, $appendn); - my @a = (); - - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - my $belowhundred = !$#numblock; - - while (@numblock) { - - $i = $#numblock; - @num = split //, $numblock[$i]; - $appendn = ""; - - $numblock[$i] *= 1; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - if ($numblock[$i] > 99) { - # the one from hundreds - push @textnumber, $self->{numbername}{$num[0]}; - - # add hundred designation - push @textnumber, $self->{numbername}{10**2}; - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - } - - $appendn = 'en' if ($i == 2); - $appendn = 'n' if ($i > 2); - - if ($numblock[$i] > 9) { - # tens - push @textnumber, $self->format_ten_de($numblock[$i], $belowhundred); - } elsif ($numblock[$i] > 1) { - # ones - push @textnumber, $self->{numbername}{$numblock[$i]}; - } elsif ($numblock[$i] == 1) { - if ($i == 0) { - push @textnumber, $self->{numbername}{$numblock[$i]}.'s'; - } else { - if ($i >= 2) { - push @textnumber, $self->{numbername}{$numblock[$i]}.'e'; - } else { - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - } - $appendn = ""; - } - - # add thousand, million - if ($i) { - $amount = 10**($i * 3); - push @textnumber, $self->{numbername}{$amount}.$appendn; - } - - pop @numblock; - - } - - join '', @textnumber; + my $textnumber = ""; + my @num = split //, $amount; + + if ( $amount > 20 ) { + $textnumber = $self->{numbername}{ $num[0] * 10 }; + $amount = $num[1]; + } + else { + $textnumber = $self->{numbername}{$amount}; + $amount = 0; + } + + $textnumber .= " " . $self->{numbername}{$amount} if $amount; + + $textnumber; } +sub num2text_de { + my ( $self, $amount ) = @_; + + return $self->{numbername}{0} unless $amount; + + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my ( $i, $appendn ); + my @a = (); + + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + my $belowhundred = !$#numblock; + + while (@numblock) { + + $i = $#numblock; + @num = split //, $numblock[$i]; + $appendn = ""; + + $numblock[$i] *= 1; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + if ( $numblock[$i] > 99 ) { + + # the one from hundreds + push @textnumber, $self->{numbername}{ $num[0] }; + + # add hundred designation + push @textnumber, $self->{numbername}{ 10**2 }; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + } + + $appendn = 'en' if ( $i == 2 ); + $appendn = 'n' if ( $i > 2 ); + + if ( $numblock[$i] > 9 ) { + + # tens + push @textnumber, + $self->format_ten_de( $numblock[$i], $belowhundred ); + } + elsif ( $numblock[$i] > 1 ) { + + # ones + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + elsif ( $numblock[$i] == 1 ) { + if ( $i == 0 ) { + push @textnumber, $self->{numbername}{ $numblock[$i] } . 's'; + } + else { + if ( $i >= 2 ) { + push @textnumber, + $self->{numbername}{ $numblock[$i] } . 'e'; + } + else { + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + } + $appendn = ""; + } + + # add thousand, million + if ($i) { + $amount = 10**( $i * 3 ); + push @textnumber, $self->{numbername}{$amount} . $appendn; + } + + pop @numblock; + + } + + join '', @textnumber; -sub format_ten_de { - my ($self, $amount, $belowhundred) = @_; - - my $textnumber = ""; - my @num = split //, $amount; - - if ($amount > 20) { - if ($num[1] == 0) { - $textnumber = $self->{numbername}{$amount}; - } else { - if ($belowhundred) { - $amount = $num[0] * 10; - $textnumber = $self->{numbername}{$num[1]}.'und'.$self->{numbername}{$amount}; - } else { - $amount = $num[0] * 10; - $textnumber = $self->{numbername}{$amount}.$self->{numbername}{$num[1]}; - $textnumber .= 's' if ($num[1] == 1); - } - } - } else { - $textnumber = $self->{numbername}{$amount}; - } - - $textnumber; - } +sub format_ten_de { + my ( $self, $amount, $belowhundred ) = @_; + + my $textnumber = ""; + my @num = split //, $amount; + + if ( $amount > 20 ) { + if ( $num[1] == 0 ) { + $textnumber = $self->{numbername}{$amount}; + } + else { + if ($belowhundred) { + $amount = $num[0] * 10; + $textnumber = + $self->{numbername}{ $num[1] } . 'und' + . $self->{numbername}{$amount}; + } + else { + $amount = $num[0] * 10; + $textnumber = + $self->{numbername}{$amount} . $self->{numbername}{ $num[1] }; + $textnumber .= 's' if ( $num[1] == 1 ); + } + } + } + else { + $textnumber = $self->{numbername}{$amount}; + } + + $textnumber; + +} sub num2text_et { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my ($i, $appendit); - my @a = (); - - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - while (@numblock) { - - $i = $#numblock; - $numblock[$i] *= 1; - @num = split //, $numblock[$i]; - - $appendit = "it"; - $hundred = 0; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - if ($numblock[$i] > 99) { - # the one from hundreds - push @textnumber, "$self->{numbername}{$num[0]}$self->{numbername}{10**2}"; - # reduce numblock - $numblock[$i] -= $num[0] * 100; - @num = split //, $numblock[$i]; - $hundred = 1; - } - - if ($numblock[$i] > 19) { - # 20 - 99 - push @textnumber, "$self->{numbername}{$num[0]}kümmend"; - @num = split //, $numblock[$i]; - push @textnumber, $self->{numbername}{$num[1]} if $num[1] > 0; - - } elsif ($numblock[$i] > 10) { - # 11 - 19 - if ($hundred) { - @num = split //, $numblock[$i]; - } - $num = $num[1]; - - push @textnumber, "$self->{numbername}{$num}teist"; - - } elsif ($numblock[$i] > 1) { - # ones - push @textnumber, $self->{numbername}{$numblock[$i]}; - - } elsif ($numblock[$i] == 1) { - push @textnumber, $self->{numbername}{$num[0]}; - $appendit = ""; - - } - - # add thousand, million - if ($i) { - $amount = 10**($i * 3); - $appendit = ($i == 1) ? "" : $appendit; - push @textnumber, "$self->{numbername}{$amount}$appendit"; - } - - pop @numblock; - - } - - join ' ', @textnumber; + my ( $self, $amount ) = @_; -} + return $self->{numbername}{0} unless $amount; + my @textnumber = (); -sub num2text_es { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my $stripun = 0; - my @a = (); - my $i; - - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - # special case for 1000 - if ($numblock[1] eq '1' && $numblock[0] gt '000') { - # remove first array element from textnumber - $stripun = 1; - } - - while (@numblock) { - - $i = $#numblock; - @num = split //, $numblock[$i]; - - $numblock[$i] *= 1; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - if ($numblock[$i] > 99) { - if ($num[0] == 1) { - push @textnumber, $self->{numbername}{10**2}; - } else { - # special case for 500, 700, 900 - if (grep /$num[0]/, (5,7,9)) { - push @textnumber, $self->{numbername}{"${num[0]}00"}; - - } else { - - # the one from hundreds, append cientos - push @textnumber, $self->{numbername}{$num[0]}.$self->{numbername}{10**2}.'s'; - - } - } - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - } - - if ($numblock[$i] > 9) { - # tens - push @textnumber, $self->format_ten_es($numblock[$i], $i); - } elsif ($numblock[$i] > 0) { - # ones - $num = $numblock[$i]; - $num .= 'o' if ($num == 1 && $i == 0); - push @textnumber, $self->{numbername}{$num}; - } - - # add thousand, million - if ($i) { - $num = 10**($i * 3); - if ($numblock[$i] > 1) { - if ($i == 2 || $i == 4) { - $a = $self->{numbername}{$num}."es"; - $a =~ s/ó/o/; - push @textnumber, $a; - } elsif ($i == 3) { - $num = 10**($i * 2); - $a = "$self->{10**3} $self->{numbername}{$num}"."es"; - $a =~ s/ó/o/; - push @textnumber, $a; - } else { - if ($i == 1) { - push @textnumber, $self->{numbername}{$num}; - } else { - push @textnumber, $self->{numbername}{$num}.'s'; - } - } - } else { - push @textnumber, $self->{numbername}{$num}; - } - } - - pop @numblock; - - } - - shift @textnumber if $stripun; - - join ' ', @textnumber; + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my ( $i, $appendit ); + my @a = (); + + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + while (@numblock) { + + $i = $#numblock; + $numblock[$i] *= 1; + @num = split //, $numblock[$i]; + + $appendit = "it"; + $hundred = 0; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + if ( $numblock[$i] > 99 ) { + + # the one from hundreds + push @textnumber, + "$self->{numbername}{$num[0]}$self->{numbername}{10**2}"; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + @num = split //, $numblock[$i]; + $hundred = 1; + } + + if ( $numblock[$i] > 19 ) { + + # 20 - 99 + push @textnumber, "$self->{numbername}{$num[0]}kümmend"; + @num = split //, $numblock[$i]; + push @textnumber, $self->{numbername}{ $num[1] } if $num[1] > 0; + + } + elsif ( $numblock[$i] > 10 ) { + + # 11 - 19 + if ($hundred) { + @num = split //, $numblock[$i]; + } + $num = $num[1]; + + push @textnumber, "$self->{numbername}{$num}teist"; + + } + elsif ( $numblock[$i] > 1 ) { + + # ones + push @textnumber, $self->{numbername}{ $numblock[$i] }; + + } + elsif ( $numblock[$i] == 1 ) { + push @textnumber, $self->{numbername}{ $num[0] }; + $appendit = ""; + + } + + # add thousand, million + if ($i) { + $amount = 10**( $i * 3 ); + $appendit = ( $i == 1 ) ? "" : $appendit; + push @textnumber, "$self->{numbername}{$amount}$appendit"; + } + + pop @numblock; + + } + + join ' ', @textnumber; } +sub num2text_es { + my ( $self, $amount ) = @_; + + return $self->{numbername}{0} unless $amount; + + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my $stripun = 0; + my @a = (); + my $i; + + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + # special case for 1000 + if ( $numblock[1] eq '1' && $numblock[0] gt '000' ) { + + # remove first array element from textnumber + $stripun = 1; + } + + while (@numblock) { + + $i = $#numblock; + @num = split //, $numblock[$i]; + + $numblock[$i] *= 1; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + if ( $numblock[$i] > 99 ) { + if ( $num[0] == 1 ) { + push @textnumber, $self->{numbername}{ 10**2 }; + } + else { + + # special case for 500, 700, 900 + if ( grep /$num[0]/, ( 5, 7, 9 ) ) { + push @textnumber, $self->{numbername}{"${num[0]}00"}; + + } + else { + + # the one from hundreds, append cientos + push @textnumber, + $self->{numbername}{ $num[0] } + . $self->{numbername}{ 10**2 } . 's'; + + } + } + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + } + + if ( $numblock[$i] > 9 ) { + + # tens + push @textnumber, $self->format_ten_es( $numblock[$i], $i ); + } + elsif ( $numblock[$i] > 0 ) { + + # ones + $num = $numblock[$i]; + $num .= 'o' if ( $num == 1 && $i == 0 ); + push @textnumber, $self->{numbername}{$num}; + } + + # add thousand, million + if ($i) { + $num = 10**( $i * 3 ); + if ( $numblock[$i] > 1 ) { + if ( $i == 2 || $i == 4 ) { + $a = $self->{numbername}{$num} . "es"; + $a =~ s/ó/o/; + push @textnumber, $a; + } + elsif ( $i == 3 ) { + $num = 10**( $i * 2 ); + $a = "$self->{10**3} $self->{numbername}{$num}" . "es"; + $a =~ s/ó/o/; + push @textnumber, $a; + } + else { + if ( $i == 1 ) { + push @textnumber, $self->{numbername}{$num}; + } + else { + push @textnumber, $self->{numbername}{$num} . 's'; + } + } + } + else { + push @textnumber, $self->{numbername}{$num}; + } + } + + pop @numblock; + + } + + shift @textnumber if $stripun; + + join ' ', @textnumber; -sub format_ten_es { - my ($self, $amount, $i) = @_; - - my $textnumber = ""; - my @num = split //, $amount; - - if ($amount > 30) { - $textnumber = $self->{numbername}{$num[0]*10}; - $amount = $num[1]; - } else { - $amount .= 'o' if ($num[1] == 1 && $i == 0); - $textnumber = $self->{numbername}{$amount}; - $amount = 0; - } - - $textnumber .= " y ".$self->{numbername}{$amount} if $amount; - - $textnumber; - } +sub format_ten_es { + my ( $self, $amount, $i ) = @_; -sub num2text_fr { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my @a; - my $i; - - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - my $cent=0; - - while (@numblock) { - - $i = $#numblock; - @num = split //, $numblock[$i]; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - if ($numblock[$i] > 99) { - $cent=1; - - # the one from hundreds - - if ($num[0] > 1) { - push @textnumber, $self->{numbername}{$num[0]}; - } - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - - # add hundred designation - if ($num[0] > 1) { - if($numblock[$i] > 0) { - push @textnumber, $self->{numbername}{10**2}; - } else { - push @textnumber, "$self->{numbername}{10**2}s"; - } - } else { - push @textnumber, $self->{numbername}{10**2}; - } - - } - - $numblock[$i] *= 1; - - if ($numblock[$i] > 9) { - # tens - push @textnumber, $self->format_ten_fr($numblock[$i]); - } elsif ($numblock[$i] > 0) { - # ones - if ($i == 1) { - if ($cent == 1) { - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - $cent = 0; - } else { - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - } - - # add thousand, million - if ($i) { - $num = 10**($i * 3); - if ($i == 1) { - push @textnumber, $self->{numbername}{$num}; - } elsif ($numblock[$i] > 1) { - push @textnumber, "$self->{numbername}{$num}s"; - } else { - push @textnumber, "$self->{numbername}{$num}"; - } - } - - pop @numblock; - - } - - join ' ', @textnumber; + my $textnumber = ""; + my @num = split //, $amount; + + if ( $amount > 30 ) { + $textnumber = $self->{numbername}{ $num[0] * 10 }; + $amount = $num[1]; + } + else { + $amount .= 'o' if ( $num[1] == 1 && $i == 0 ); + $textnumber = $self->{numbername}{$amount}; + $amount = 0; + } + + $textnumber .= " y " . $self->{numbername}{$amount} if $amount; + + $textnumber; } +sub num2text_fr { + my ( $self, $amount ) = @_; + + return $self->{numbername}{0} unless $amount; + + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my @a; + my $i; + + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + my $cent = 0; + + while (@numblock) { + + $i = $#numblock; + @num = split //, $numblock[$i]; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + if ( $numblock[$i] > 99 ) { + $cent = 1; + + # the one from hundreds + + if ( $num[0] > 1 ) { + push @textnumber, $self->{numbername}{ $num[0] }; + } + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + + # add hundred designation + if ( $num[0] > 1 ) { + if ( $numblock[$i] > 0 ) { + push @textnumber, $self->{numbername}{ 10**2 }; + } + else { + push @textnumber, "$self->{numbername}{10**2}s"; + } + } + else { + push @textnumber, $self->{numbername}{ 10**2 }; + } + + } + + $numblock[$i] *= 1; + + if ( $numblock[$i] > 9 ) { + + # tens + push @textnumber, $self->format_ten_fr( $numblock[$i] ); + } + elsif ( $numblock[$i] > 0 ) { + + # ones + if ( $i == 1 ) { + if ( $cent == 1 ) { + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + $cent = 0; + } + else { + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + } + + # add thousand, million + if ($i) { + $num = 10**( $i * 3 ); + if ( $i == 1 ) { + push @textnumber, $self->{numbername}{$num}; + } + elsif ( $numblock[$i] > 1 ) { + push @textnumber, "$self->{numbername}{$num}s"; + } + else { + push @textnumber, "$self->{numbername}{$num}"; + } + } + + pop @numblock; + + } + + join ' ', @textnumber; -sub format_ten_fr { - my ($self, $amount) = @_; - - my $textnumber = ""; - my @num = split //, $amount; - - if ($amount > 20) { - if ($num[0] == 8) { - if ($num[1] > 0) { - $textnumber = $self->{numbername}{$num[0]*10}; - } else { - $textnumber = "$self->{numbername}{$num[0]*10}s"; - } - $amount = $num[1]; - } elsif ($num[0] == 7 || $num[0] == 9) { - if ($num[1] > 0) { - $textnumber = $self->{numbername}{($num[0]-1)*10}; - - $textnumber .= " et" if ($num[1] == 1 && $num[0] == 7); - - $amount -= ($num[0]-1)*10; - } else { - $textnumber = $self->{numbername}{$num[0]*10}; - $amount = $num[1]; - } - } else { - $textnumber = $self->{numbername}{$num[0]*10}; - $textnumber .= " et" if ($num[1] == 1); - $amount = $num[1]; - } - } else { - $textnumber = "$self->{numbername}{$amount}"; - $amount = 0; - } - - $textnumber .= " ".$self->{numbername}{$amount} if $amount; - - $textnumber; - } +sub format_ten_fr { + my ( $self, $amount ) = @_; + + my $textnumber = ""; + my @num = split //, $amount; + + if ( $amount > 20 ) { + if ( $num[0] == 8 ) { + if ( $num[1] > 0 ) { + $textnumber = $self->{numbername}{ $num[0] * 10 }; + } + else { + $textnumber = "$self->{numbername}{$num[0]*10}s"; + } + $amount = $num[1]; + } + elsif ( $num[0] == 7 || $num[0] == 9 ) { + if ( $num[1] > 0 ) { + $textnumber = $self->{numbername}{ ( $num[0] - 1 ) * 10 }; + + $textnumber .= " et" if ( $num[1] == 1 && $num[0] == 7 ); + + $amount -= ( $num[0] - 1 ) * 10; + } + else { + $textnumber = $self->{numbername}{ $num[0] * 10 }; + $amount = $num[1]; + } + } + else { + $textnumber = $self->{numbername}{ $num[0] * 10 }; + $textnumber .= " et" if ( $num[1] == 1 ); + $amount = $num[1]; + } + } + else { + $textnumber = "$self->{numbername}{$amount}"; + $amount = 0; + } + + $textnumber .= " " . $self->{numbername}{$amount} if $amount; + + $textnumber; -sub num2text_hu { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my @a; - my $i; - my $res; - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - while (@numblock) { - $i = $#numblock; - @num = split //, $numblock[$i]; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - if ($numblock[$i] > 99) { - push @textnumber, $self->{numbername}{$num[0]}; - - # add hundred designation - push @textnumber, $self->{numbername}{10**2}; - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - - } - - $numblock[$i] *= 1; - if ($numblock[$i] > 9) { - # tens - push @textnumber, $self->format_ten_hu($numblock[$i]); - } elsif ($numblock[$i] > 0) { - # ones - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - - # add thousand, million - if ($i) { - if ($i==1 && $amount < 2000){ - - $num = 10**($i * 3); - push @textnumber, $self->{numbername}{$num}; - } else { - - $num = 10**($i * 3); - push @textnumber, $self->{numbername}{$num}."-"; - } - } - - pop @numblock; - - } - $res=ucfirst join '', @textnumber; - $res=~s/(\-)$//; - return $res; } +sub num2text_hu { + my ( $self, $amount ) = @_; + + return $self->{numbername}{0} unless $amount; + + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my @a; + my $i; + my $res; + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + while (@numblock) { + $i = $#numblock; + @num = split //, $numblock[$i]; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + if ( $numblock[$i] > 99 ) { + push @textnumber, $self->{numbername}{ $num[0] }; + + # add hundred designation + push @textnumber, $self->{numbername}{ 10**2 }; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + + } + + $numblock[$i] *= 1; + if ( $numblock[$i] > 9 ) { + + # tens + push @textnumber, $self->format_ten_hu( $numblock[$i] ); + } + elsif ( $numblock[$i] > 0 ) { + + # ones + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + + # add thousand, million + if ($i) { + if ( $i == 1 && $amount < 2000 ) { + + $num = 10**( $i * 3 ); + push @textnumber, $self->{numbername}{$num}; + } + else { + + $num = 10**( $i * 3 ); + push @textnumber, $self->{numbername}{$num} . "-"; + } + } + + pop @numblock; + + } + $res = ucfirst join '', @textnumber; + $res =~ s/(\-)$//; + return $res; +} sub format_ten_hu { - my ($self, $amount) = @_; + my ( $self, $amount ) = @_; - my $textnumber = ""; - my @num = split //, $amount; - if ($amount > 30) { - $textnumber = $self->{numbername}{$num[0]*10}; - $amount = $num[1]; - } else { - $textnumber = $self->{numbername}{$amount}; - $amount = 0; - } + my $textnumber = ""; + my @num = split //, $amount; + if ( $amount > 30 ) { + $textnumber = $self->{numbername}{ $num[0] * 10 }; + $amount = $num[1]; + } + else { + $textnumber = $self->{numbername}{$amount}; + $amount = 0; + } - $textnumber .= "".$self->{numbername}{$amount} if $amount; + $textnumber .= "" . $self->{numbername}{$amount} if $amount; - $textnumber; + $textnumber; } - sub num2text_nl { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = ('**'); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my ($i, $appendn); - my @a = (); - - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - - while (@numblock) { - - $i = $#numblock; - @num = split //, $numblock[$i]; - - $numblock[$i] *= 1; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - if ($numblock[$i] > 99) { - # the one from hundreds - push @textnumber, $self->{numbername}{$num[0]}; - - # add hundred designation - push @textnumber, $self->{numbername}{10**2}; - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - } - - if ($numblock[$i] > 9) { - # tens - push @textnumber, $self->format_ten_nl($numblock[$i]); - } else { - # ones - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - - # add thousand, million - if ($i) { - $amount = 10**($i * 3); - push @textnumber, $self->{numbername}{$amount}; - } - - pop @numblock; - - } - - push @textnumber, '**'; - join '', @textnumber; + my ( $self, $amount ) = @_; -} + return $self->{numbername}{0} unless $amount; + my @textnumber = ('**'); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my ( $i, $appendn ); + my @a = (); + + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + while (@numblock) { + + $i = $#numblock; + @num = split //, $numblock[$i]; + + $numblock[$i] *= 1; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + if ( $numblock[$i] > 99 ) { + + # the one from hundreds + push @textnumber, $self->{numbername}{ $num[0] }; + + # add hundred designation + push @textnumber, $self->{numbername}{ 10**2 }; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + } + + if ( $numblock[$i] > 9 ) { + + # tens + push @textnumber, $self->format_ten_nl( $numblock[$i] ); + } + else { + + # ones + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + + # add thousand, million + if ($i) { + $amount = 10**( $i * 3 ); + push @textnumber, $self->{numbername}{$amount}; + } + + pop @numblock; + + } + + push @textnumber, '**'; + join '', @textnumber; -sub format_ten_nl { - my ($self, $amount) = @_; - - my $textnumber = ""; - my @num = split //, $amount; - - if ($amount > 20) { - # reverse one and ten and glue together with 'en' - $amount = $num[0] * 10; - $textnumber = $self->{numbername}{$num[1]}.'en'.$self->{numbername}{$amount}; - } else { - $textnumber = $self->{numbername}{$amount}; - } - - $textnumber; - } +sub format_ten_nl { + my ( $self, $amount ) = @_; -sub num2text_it { - my ($self, $amount) = @_; - - return $self->{numbername}{0} unless $amount; - - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my ($i, $appendn); - my @a = (); - - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - while (@numblock) { - - $i = $#numblock; - @num = split //, $numblock[$i]; - - $numblock[$i] *= 1; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - if ($numblock[$i] > 99) { - # the one from hundreds - push @textnumber, $self->{numbername}{$num[0]}; - - # add hundred designation - push @textnumber, $self->{numbername}{10**2}; - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - } - - if ($numblock[$i] > 9) { - # tens - push @textnumber, $self->format_ten_it($numblock[$i]); - } elsif ($numblock[$i] > 1) { - # ones - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - - # add thousand, million - if ($i) { - $amount = 10**($i * 3); - push @textnumber, $self->{numbername}{$amount}; - } - - pop @numblock; - - } - - join '', @textnumber; + my $textnumber = ""; + my @num = split //, $amount; + + if ( $amount > 20 ) { + + # reverse one and ten and glue together with 'en' + $amount = $num[0] * 10; + $textnumber = + $self->{numbername}{ $num[1] } . 'en' . $self->{numbername}{$amount}; + } + else { + $textnumber = $self->{numbername}{$amount}; + } + + $textnumber; } +sub num2text_it { + my ( $self, $amount ) = @_; + + return $self->{numbername}{0} unless $amount; + + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my ( $i, $appendn ); + my @a = (); + + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + while (@numblock) { + + $i = $#numblock; + @num = split //, $numblock[$i]; + + $numblock[$i] *= 1; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + if ( $numblock[$i] > 99 ) { + + # the one from hundreds + push @textnumber, $self->{numbername}{ $num[0] }; + + # add hundred designation + push @textnumber, $self->{numbername}{ 10**2 }; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + } + + if ( $numblock[$i] > 9 ) { + + # tens + push @textnumber, $self->format_ten_it( $numblock[$i] ); + } + elsif ( $numblock[$i] > 1 ) { + + # ones + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + + # add thousand, million + if ($i) { + $amount = 10**( $i * 3 ); + push @textnumber, $self->{numbername}{$amount}; + } + + pop @numblock; + + } + + join '', @textnumber; -sub format_ten_it { - my ($self, $amount) = @_; - - my $textnumber = ""; - my @num = split //, $amount; - - if ($amount > 20) { - if ($num[1] == 0) { - $textnumber = $self->{numbername}{$amount}; - } else { - $amount = $num[0] * 10; - $textnumber = $self->{numbername}{$amount}.$self->{numbername}{$num[1]}; - } - } else { - $textnumber = $self->{numbername}{$amount}; - } - - $textnumber; - } +sub format_ten_it { + my ( $self, $amount ) = @_; + + my $textnumber = ""; + my @num = split //, $amount; + + if ( $amount > 20 ) { + if ( $num[1] == 0 ) { + $textnumber = $self->{numbername}{$amount}; + } + else { + $amount = $num[0] * 10; + $textnumber = + $self->{numbername}{$amount} . $self->{numbername}{ $num[1] }; + } + } + else { + $textnumber = $self->{numbername}{$amount}; + } + + $textnumber; + +} # A special (swedish-like) spelling of danish check numbers sub num2text_da { - my ($self, $amount) = @_; - - # Handle 0 - return $self->{numbername}{0} unless $amount; - - # List of collected digits - my @textnumber = (); - - # split amount into chunks of 3 - my @num = reverse split //, abs($amount); - my @numblock = (); - my @a = (); - while (@num) { - @a = (); - for (1 .. 3) { - push @a, shift @num; - } - push @numblock, join / /, reverse @a; - } - - my $i; - my $bigplural; - while (@numblock) { - $i = $#numblock; - $numblock[$i] *= 1; - - if ($numblock[$i] == 0) { - pop @numblock; - next; - } - - # Plural suffix "er" for million and up, not for tusinde - $bigpluralsuffix = ""; - $bigpluralsuffix = "er" if ($i > 1 && $numblock[$i] > 1); - - if ($numblock[$i] > 99) { - @num = split //, $numblock[$i]; - - # the one from hundreds - push @textnumber, $self->{numbername}{$num[0]}; - - # add hundred designation - push @textnumber, $self->{numbername}{100}; - - # reduce numblock - $numblock[$i] -= $num[0] * 100; - } - - if ($numblock[$i] > 9) { - @num = split //, $numblock[$i]; - - # the one from tens - push @textnumber, $self->{numbername}{$num[0]}; - - # add ten designation - push @textnumber, $self->{numbername}{10}; - - # reduce numblock - $numblock[$i] -= $num[0] * 10; - } - - if ($numblock[$i] > 0) { - # the ones left in the block - if($numblock[$i] == 1 && $i != 1) { - push @textnumber, $self->{numbername}{'1o'}; # Special case for "Et" tusinde - } else { - push @textnumber, $self->{numbername}{$numblock[$i]}; - } - } - - # add thousand, million, etc - if ($i) { - $amount = 10**($i * 3); - push @textnumber, $self->{numbername}{$amount}.$bigpluralsuffix; - } - - pop @numblock; - } - - join '', @textnumber; + my ( $self, $amount ) = @_; + + # Handle 0 + return $self->{numbername}{0} unless $amount; + + # List of collected digits + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my @a = (); + while (@num) { + @a = (); + for ( 1 .. 3 ) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + my $i; + my $bigplural; + while (@numblock) { + $i = $#numblock; + $numblock[$i] *= 1; + + if ( $numblock[$i] == 0 ) { + pop @numblock; + next; + } + + # Plural suffix "er" for million and up, not for tusinde + $bigpluralsuffix = ""; + $bigpluralsuffix = "er" if ( $i > 1 && $numblock[$i] > 1 ); + + if ( $numblock[$i] > 99 ) { + @num = split //, $numblock[$i]; + + # the one from hundreds + push @textnumber, $self->{numbername}{ $num[0] }; + + # add hundred designation + push @textnumber, $self->{numbername}{100}; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + } + + if ( $numblock[$i] > 9 ) { + @num = split //, $numblock[$i]; + + # the one from tens + push @textnumber, $self->{numbername}{ $num[0] }; + + # add ten designation + push @textnumber, $self->{numbername}{10}; + + # reduce numblock + $numblock[$i] -= $num[0] * 10; + } + + if ( $numblock[$i] > 0 ) { + + # the ones left in the block + if ( $numblock[$i] == 1 && $i != 1 ) { + push @textnumber, + $self->{numbername}{'1o'}; # Special case for "Et" tusinde + } + else { + push @textnumber, $self->{numbername}{ $numblock[$i] }; + } + } + + # add thousand, million, etc + if ($i) { + $amount = 10**( $i * 3 ); + push @textnumber, $self->{numbername}{$amount} . $bigpluralsuffix; + } + + pop @numblock; + } + + join '', @textnumber; } diff --git a/LedgerSMB/OE.pm b/LedgerSMB/OE.pm index de624ddd..9dc7cea3 100644 --- a/LedgerSMB/OE.pm +++ b/LedgerSMB/OE.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -23,8 +23,8 @@ # #====================================================================== # -# This file has undergone whitespace cleanup -# +# This file has undergone whitespace cleanup +# #====================================================================== # # Order entry module @@ -36,47 +36,46 @@ package OE; use LedgerSMB::Tax; use LedgerSMB::Sysconfig; - sub transactions { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query; - my $null; - my $var; - my $ordnumber = 'ordnumber'; - my $quotation = '0'; - my $department; - - my $rate = ($form->{vc} eq 'customer') ? 'buy' : 'sell'; - - ($form->{transdatefrom}, $form->{transdateto}) = - $form->from_to($form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - if ($form->{type} =~ /_quotation$/) { - $quotation = '1'; - $ordnumber = 'quonumber'; - } - - my $number = $form->like(lc $form->{$ordnumber}); - my $name = $form->like(lc $form->{$form->{vc}}); - my @dptargs = (); - - for (qw(department employee)) { - if ($form->{$_}) { - ($null, $var) = split /--/, $form->{$_}; - $department .= " AND o.${_}_id = ?"; - push @dptargs, $var; - } - } - - if ($form->{vc} ne 'customer'){ # Sanitize $form->{vc} - $form->{vc} = 'vendor'; - } - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $query; + my $null; + my $var; + my $ordnumber = 'ordnumber'; + my $quotation = '0'; + my $department; + + my $rate = ( $form->{vc} eq 'customer' ) ? 'buy' : 'sell'; + + ( $form->{transdatefrom}, $form->{transdateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + if ( $form->{type} =~ /_quotation$/ ) { + $quotation = '1'; + $ordnumber = 'quonumber'; + } + + my $number = $form->like( lc $form->{$ordnumber} ); + my $name = $form->like( lc $form->{ $form->{vc} } ); + my @dptargs = (); + + for (qw(department employee)) { + if ( $form->{$_} ) { + ( $null, $var ) = split /--/, $form->{$_}; + $department .= " AND o.${_}_id = ?"; + push @dptargs, $var; + } + } + + if ( $form->{vc} ne 'customer' ) { # Sanitize $form->{vc} + $form->{vc} = 'vendor'; + } + my $query = qq| SELECT o.id, o.ordnumber, o.transdate, o.reqdate, o.amount, ct.name, o.netamount, o.$form->{vc}_id, ex.$rate AS exchangerate, o.closed, o.quonumber, @@ -91,35 +90,36 @@ sub transactions { WHERE o.quotation = ? $department|; - my @queryargs = @dptargs; - unshift @queryargs, $quotation; - - my %ordinal = ( - id => 1, - ordnumber => 2, - transdate => 3, - reqdate => 4, - name => 6, - quonumber => 11, - shipvia => 13, - employee => 14, - manager => 15, - curr => 16, - ponumber => 17); - - my @a = (transdate, $ordnumber, name); - push @a, "employee" if $form->{l_employee}; - if ($form->{type} !~ /(ship|receive)_order/) { - push @a, "manager" if $form->{l_manager}; - } - my $sortorder = $form->sort_order(\@a, \%ordinal); - - # build query if type eq (ship|receive)_order - if ($form->{type} =~ /(ship|receive)_order/) { - - my ($warehouse, $warehouse_id) = split /--/, $form->{warehouse}; - - $query = qq| + my @queryargs = @dptargs; + unshift @queryargs, $quotation; + + my %ordinal = ( + id => 1, + ordnumber => 2, + transdate => 3, + reqdate => 4, + name => 6, + quonumber => 11, + shipvia => 13, + employee => 14, + manager => 15, + curr => 16, + ponumber => 17 + ); + + my @a = ( transdate, $ordnumber, name ); + push @a, "employee" if $form->{l_employee}; + if ( $form->{type} !~ /(ship|receive)_order/ ) { + push @a, "manager" if $form->{l_manager}; + } + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + # build query if type eq (ship|receive)_order + if ( $form->{type} =~ /(ship|receive)_order/ ) { + + my ( $warehouse, $warehouse_id ) = split /--/, $form->{warehouse}; + + $query = qq| SELECT DISTINCT o.id, o.ordnumber, o.transdate, o.reqdate, o.amount, ct.name, o.netamount, o.$form->{vc}_id, ex.$rate AS exchangerate, @@ -131,13 +131,13 @@ sub transactions { JOIN orderitems oi ON (oi.trans_id = o.id) JOIN parts p ON (p.id = oi.parts_id)|; - if ($warehouse_id && $form->{type} eq 'ship_order') { - $query .= qq| + if ( $warehouse_id && $form->{type} eq 'ship_order' ) { + $query .= qq| JOIN inventory i ON (oi.parts_id = i.parts_id) |; - } + } - $query .= qq| + $query .= qq| LEFT JOIN employees e ON (o.employee_id = e.id) LEFT JOIN exchangerate ex ON (ex.curr = o.curr @@ -146,10 +146,10 @@ sub transactions { AND (p.inventory_accno_id > 0 OR p.assembly = '1') AND oi.qty != oi.ship $department|; - @queryargs = @dptargs; #reset @queryargs - - if ($warehouse_id && $form->{type} eq 'ship_order') { - $query .= qq| + @queryargs = @dptargs; #reset @queryargs + + if ( $warehouse_id && $form->{type} eq 'ship_order' ) { + $query .= qq| AND i.warehouse_id = ? AND ( SELECT SUM(i.qty) @@ -157,185 +157,192 @@ sub transactions { WHERE oi.parts_id = i.parts_id AND i.warehouse_id = ? ) > 0|; - push(@queryargs, $warehouse_id, $warehouse_id); - } - - } - - if ($form->{"$form->{vc}_id"}) { - $query .= qq| AND o.$form->{vc}_id = $form->{"$form->{vc}_id"}|; - } elsif ($form->{$form->{vc}} ne "") { - $query .= " AND lower(ct.name) LIKE ?"; - push @queryargs, $name; - } - - if ($form->{$ordnumber} ne "") { - $query .= " AND lower(?) LIKE ?"; - push @queryargs, $ordnumber, $number; - $form->{open} = 1; - $form->{closed} = 1; - } - if ($form->{ponumber} ne "") { - $query .= " AND lower(ponumber) LIKE ?"; - push @queryargs, $form->{ponumber}; - } - - if (!$form->{open} && !$form->{closed}) { - $query .= " AND o.id = 0"; - } elsif (!($form->{open} && $form->{closed})) { - $query .= ($form->{open}) ? - " AND o.closed = '0'" : " AND o.closed = '1'"; - } - - if ($form->{shipvia} ne "") { - $var = $form->like(lc $form->{shipvia}); - $query .= " AND lower(o.shipvia) LIKE ?"; - push @queryargs, $var; - } - - if ($form->{description} ne "") { - $var = $form->like(lc $form->{description}); - $query .= " AND o.id IN (SELECT DISTINCT trans_id + push( @queryargs, $warehouse_id, $warehouse_id ); + } + + } + + if ( $form->{"$form->{vc}_id"} ) { + $query .= qq| AND o.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } + elsif ( $form->{ $form->{vc} } ne "" ) { + $query .= " AND lower(ct.name) LIKE ?"; + push @queryargs, $name; + } + + if ( $form->{$ordnumber} ne "" ) { + $query .= " AND lower(?) LIKE ?"; + push @queryargs, $ordnumber, $number; + $form->{open} = 1; + $form->{closed} = 1; + } + if ( $form->{ponumber} ne "" ) { + $query .= " AND lower(ponumber) LIKE ?"; + push @queryargs, $form->{ponumber}; + } + + if ( !$form->{open} && !$form->{closed} ) { + $query .= " AND o.id = 0"; + } + elsif ( !( $form->{open} && $form->{closed} ) ) { + $query .= + ( $form->{open} ) ? " AND o.closed = '0'" : " AND o.closed = '1'"; + } + + if ( $form->{shipvia} ne "" ) { + $var = $form->like( lc $form->{shipvia} ); + $query .= " AND lower(o.shipvia) LIKE ?"; + push @queryargs, $var; + } + + if ( $form->{description} ne "" ) { + $var = $form->like( lc $form->{description} ); + $query .= " AND o.id IN (SELECT DISTINCT trans_id FROM orderitems WHERE lower(description) LIKE '$var')"; - push @queryargs, $var; - } - - if ($form->{transdatefrom}) { - $query .= " AND o.transdate >= ?"; - push @queryargs, $form->{transdatefrom}; - } - if ($form->{transdateto}) { - $query .= " AND o.transdate <= ?"; - push @queryargs, $form->{transdateto}; - } - - $query .= " ORDER by $sortorder"; - - my $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - - my %oid = (); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{exchangerate} = 1 unless $ref->{exchangerate}; - if ($ref->{id} != $oid{id}{$ref->{id}}) { - push @{ $form->{OE} }, $ref; - $oid{vc}{$ref->{curr}}{$ref->{"$form->{vc}_id"}}++; - } - $oid{id}{$ref->{id}} = $ref->{id}; - } - $sth->finish; - - $dbh->commit; - - if ($form->{type} =~ /^consolidate_/) { - @a = (); - foreach $ref (@{ $form->{OE} }) { - push @a, $ref if $oid{vc}{$ref->{curr}} - {$ref->{"$form->{vc}_id"}} > 1; - } - - @{ $form->{OE} } = @a; - } + push @queryargs, $var; + } + + if ( $form->{transdatefrom} ) { + $query .= " AND o.transdate >= ?"; + push @queryargs, $form->{transdatefrom}; + } + if ( $form->{transdateto} ) { + $query .= " AND o.transdate <= ?"; + push @queryargs, $form->{transdateto}; + } + + $query .= " ORDER by $sortorder"; + + my $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + + my %oid = (); + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{exchangerate} = 1 unless $ref->{exchangerate}; + if ( $ref->{id} != $oid{id}{ $ref->{id} } ) { + push @{ $form->{OE} }, $ref; + $oid{vc}{ $ref->{curr} }{ $ref->{"$form->{vc}_id"} }++; + } + $oid{id}{ $ref->{id} } = $ref->{id}; + } + $sth->finish; + + $dbh->commit; + + if ( $form->{type} =~ /^consolidate_/ ) { + @a = (); + foreach $ref ( @{ $form->{OE} } ) { + push @a, $ref + if $oid{vc}{ $ref->{curr} }{ $ref->{"$form->{vc}_id"} } > 1; + } + + @{ $form->{OE} } = @a; + } } - - sub save { - my ($self, $myconfig, $form) = @_; - - $form->db_prepare_vars("quonumber", "transdate", "vendor_id", - "customer_id", "reqdate", "taxincluded", "shippingpoint", - "shipvia", "currency", "department_id", - "employee_id", "language_code", "ponumber", "terms"); - # connect to database, turn off autocommit - my $dbh = $form->{dbh}; - my @queryargs; - my $quotation; - my $ordnumber; - my $numberfld; - $form->{vc} = ($form->{vc} eq 'customer') ? 'customer': 'vendor'; - if ($form->{type} =~ /_order$/) { - $quotation = "0"; - $ordnumber = "ordnumber"; - $numberfld = ($form->{vc} eq 'customer') ? "sonumber" : - "ponumber"; - } else { - $quotation = "1"; - $ordnumber = "quonumber"; - $numberfld = ($form->{vc} eq 'customer') ? "sqnumber" : - "rfqnumber"; - } - - $form->{"$ordnumber"} = $form->update_defaults( - $myconfig, $numberfld, $dbh) - unless $form->{ordnumber}; - - - my $query; - my $sth; - my $null; - my $exchangerate = 0; - - ($null, $form->{employee_id}) = split /--/, $form->{employee}; - if (! $form->{employee_id}) { - ($form->{employee}, $form->{employee_id}) = - $form->get_employee($dbh); - $form->{employee} = "$form->{employee}--$form->{employee_id}"; - } - - my $ml = ($form->{type} eq 'sales_order') ? 1 : -1; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + $form->db_prepare_vars( + "quonumber", "transdate", "vendor_id", "customer_id", + "reqdate", "taxincluded", "shippingpoint", "shipvia", + "currency", "department_id", "employee_id", "language_code", + "ponumber", "terms" + ); + + # connect to database, turn off autocommit + my $dbh = $form->{dbh}; + my @queryargs; + my $quotation; + my $ordnumber; + my $numberfld; + $form->{vc} = ( $form->{vc} eq 'customer' ) ? 'customer' : 'vendor'; + if ( $form->{type} =~ /_order$/ ) { + $quotation = "0"; + $ordnumber = "ordnumber"; + $numberfld = + ( $form->{vc} eq 'customer' ) + ? "sonumber" + : "ponumber"; + } + else { + $quotation = "1"; + $ordnumber = "quonumber"; + $numberfld = + ( $form->{vc} eq 'customer' ) + ? "sqnumber" + : "rfqnumber"; + } + + $form->{"$ordnumber"} = + $form->update_defaults( $myconfig, $numberfld, $dbh ) + unless $form->{ordnumber}; + + my $query; + my $sth; + my $null; + my $exchangerate = 0; + + ( $null, $form->{employee_id} ) = split /--/, $form->{employee}; + if ( !$form->{employee_id} ) { + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + $form->{employee} = "$form->{employee}--$form->{employee_id}"; + } + + my $ml = ( $form->{type} eq 'sales_order' ) ? 1 : -1; + + $query = qq| SELECT p.assembly, p.project_id FROM parts p WHERE p.id = ?|; - my $pth = $dbh->prepare($query) || $form->dberror($query); - - - if ($form->{id}) { - $query = qq|SELECT id FROM oe WHERE id = $form->{id}|; - - if ($dbh->selectrow_array($query)) { - &adj_onhand($dbh, $form, $ml) - if $form->{type} =~ /_order$/; - - $query = qq|DELETE FROM orderitems WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - } else { # id is not in the database - delete $form->{id}; - } - - } - - my $did_insert = 0; - if (! $form->{id}) { - $query = qq|SELECT nextval('id')|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - ($form->{id}) = $sth->fetchrow_array; - $sth->finish; - - my $uid = localtime; - $uid .= "$$"; - if (!$form->{reqdate}){ - $form->{reqdate} = undef; - } - if (!$form->{transdate}){ - $form->{transdate} = "now"; - } - - if (($form->{closed} ne 't') and ($form->{closed} ne "1")){ - $form->{closed} = 'f'; - } - # $form->{id} is safe because it is only pulled *from* the db. - $query = qq| + my $pth = $dbh->prepare($query) || $form->dberror($query); + + if ( $form->{id} ) { + $query = qq|SELECT id FROM oe WHERE id = $form->{id}|; + + if ( $dbh->selectrow_array($query) ) { + &adj_onhand( $dbh, $form, $ml ) + if $form->{type} =~ /_order$/; + + $query = qq|DELETE FROM orderitems WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM shipto WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + } + else { # id is not in the database + delete $form->{id}; + } + + } + + my $did_insert = 0; + if ( !$form->{id} ) { + $query = qq|SELECT nextval('id')|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + ( $form->{id} ) = $sth->fetchrow_array; + $sth->finish; + + my $uid = localtime; + $uid .= "$$"; + if ( !$form->{reqdate} ) { + $form->{reqdate} = undef; + } + if ( !$form->{transdate} ) { + $form->{transdate} = "now"; + } + + if ( ( $form->{closed} ne 't' ) and ( $form->{closed} ne "1" ) ) { + $form->{closed} = 'f'; + } + + # $form->{id} is safe because it is only pulled *from* the db. + $query = qq| INSERT INTO oe (id, ordnumber, quonumber, transdate, vendor_id, customer_id, reqdate, shippingpoint, shipvia, @@ -347,211 +354,207 @@ sub save { ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; - @queryargs = ( - $form->{ordnumber}, $form->{quonumber}, - $form->{transdate}, $form->{vendor_id}, - $form->{customer_id}, $form->{reqdate}, - $form->{shippingpoint}, $form->{shipvia}, - $form->{notes}, $form->{intnotes}, $form->{currency}, - $form->{closed}, $form->{department_id}, - $form->{employee_id}, $form->{language_code}, - $form->{ponumber}, $form->{terms}, $quotation); - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - $sth->finish; - - @queries = $form->run_custom_queries('oe', 'INSERT'); - - } - - my $amount; - my $linetotal; - my $discount; - my $project_id; - my $taxrate; - my $taxamount; - my $fxsellprice; - my %taxbase; - my @taxaccounts; - my %taxaccounts; - my $netamount = 0; - - my $rowcount = $form->{rowcount}; - for my $i (1 .. $rowcount) { - $form->db_prepare_vars("orderitems_id_$i", "id_$i", - "description_$i", "project_id_$i", "ship_$i"); - - for (qw(qty ship)) { - $form->{"${_}_$i"} = $form->parse_amount( - $myconfig, $form->{"${_}_$i"} - ); - } - - $form->{"discount_$i"} = $form->parse_amount( - $myconfig, $form->{"discount_$i"} - ) / 100; - - $form->{"sellprice_$i"} = $form->parse_amount( - $myconfig, $form->{"sellprice_$i"} - ); - - if ($form->{"qty_$i"}) { - $pth->execute($form->{"id_$i"}); - $ref = $pth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{"${_}_$i"} = $ref->{$_} } - $pth->finish; - - $fxsellprice = $form->{"sellprice_$i"}; - - my ($dec) = ($form->{"sellprice_$i"} =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - $discount = $form->round_amount( - $form->{"sellprice_$i"} * - $form->{"discount_$i"}, - $decimalplaces - ); - $form->{"sellprice_$i"} = $form->round_amount( - $form->{"sellprice_$i"} - $discount, - $decimalplaces - ); - - $linetotal = $form->round_amount( - $form->{"sellprice_$i"} * $form->{"qty_$i"}, 2 - ); - - @taxaccounts = Tax::init_taxes($form, - $form->{"taxaccounts_$i"}); - if ($form->{taxincluded}) { - $taxamount = Tax::calculate_taxes(\@taxaccounts, - $form, $linetotal, 1); - $form->{"sellprice_$i"} = Tax::extract_taxes(\@taxaccounts, - $form, $form->{"sellprice_$i"}); - $taxbase = Tax::extract_taxes(\@taxaccounts, - $form, $linetotal); - } else { - $taxamount = Tax::apply_taxes(\@taxaccounts, - $form, $linetotal); - $taxbase = $linetotal; - } - - if (@taxaccounts && $form->round_amount($taxamount, 2) - == 0) { - if ($form->{taxincluded}) { - foreach $item (@taxaccounts) { - $taxamount = - $form->round_amount( - $item->value, 2); - $taxaccounts{$item->account} += - $taxamount; - $taxdiff += $taxamount; - $taxbase{$item->account} += - $taxbase; - } - $taxaccounts{$taxaccounts[0]->account} - += $taxdiff; - } else { - foreach $item (@taxaccounts) { - $taxaccounts{$item->account} += - $item->value; - $taxbase{$item->account} += - $taxbase; - } - } - } else { - foreach $item (@taxaccounts) { - $taxaccounts{$item->account} += - $item->value; - $taxbase{$item->account} += $taxbase; - } - } - - $netamount += $form->{"sellprice_$i"} - * $form->{"qty_$i"}; - - if ($form->{"projectnumber_$i"} ne "") { - ($null, $project_id) - = split /--/, - $form->{"projectnumber_$i"}; - } - $project_id = $form->{"project_id_$i"} - if $form->{"project_id_$i"}; - - if (!$form->{"reqdate_$i"}){ - $form->{"reqdate_$i"} = undef; - } - - @queryargs = (); - # save detail record in orderitems table - $query = qq|INSERT INTO orderitems (|; - if ($form->{"orderitems_id_$i"}){ - $query .= "id, "; - } - $query .= qq| + @queryargs = ( + $form->{ordnumber}, $form->{quonumber}, + $form->{transdate}, $form->{vendor_id}, + $form->{customer_id}, $form->{reqdate}, + $form->{shippingpoint}, $form->{shipvia}, + $form->{notes}, $form->{intnotes}, + $form->{currency}, $form->{closed}, + $form->{department_id}, $form->{employee_id}, + $form->{language_code}, $form->{ponumber}, + $form->{terms}, $quotation + ); + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + $sth->finish; + + @queries = $form->run_custom_queries( 'oe', 'INSERT' ); + + } + + my $amount; + my $linetotal; + my $discount; + my $project_id; + my $taxrate; + my $taxamount; + my $fxsellprice; + my %taxbase; + my @taxaccounts; + my %taxaccounts; + my $netamount = 0; + + my $rowcount = $form->{rowcount}; + for my $i ( 1 .. $rowcount ) { + $form->db_prepare_vars( + "orderitems_id_$i", "id_$i", + "description_$i", "project_id_$i", + "ship_$i" + ); + + for (qw(qty ship)) { + $form->{"${_}_$i"} = + $form->parse_amount( $myconfig, $form->{"${_}_$i"} ); + } + + $form->{"discount_$i"} = + $form->parse_amount( $myconfig, $form->{"discount_$i"} ) / 100; + + $form->{"sellprice_$i"} = + $form->parse_amount( $myconfig, $form->{"sellprice_$i"} ); + + if ( $form->{"qty_$i"} ) { + $pth->execute( $form->{"id_$i"} ); + $ref = $pth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{"${_}_$i"} = $ref->{$_} } + $pth->finish; + + $fxsellprice = $form->{"sellprice_$i"}; + + my ($dec) = ( $form->{"sellprice_$i"} =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + $discount = + $form->round_amount( + $form->{"sellprice_$i"} * $form->{"discount_$i"}, + $decimalplaces ); + $form->{"sellprice_$i"} = + $form->round_amount( $form->{"sellprice_$i"} - $discount, + $decimalplaces ); + + $linetotal = + $form->round_amount( $form->{"sellprice_$i"} * $form->{"qty_$i"}, + 2 ); + + @taxaccounts = Tax::init_taxes( $form, $form->{"taxaccounts_$i"} ); + if ( $form->{taxincluded} ) { + $taxamount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 1 ); + $form->{"sellprice_$i"} = + Tax::extract_taxes( \@taxaccounts, $form, + $form->{"sellprice_$i"} ); + $taxbase = + Tax::extract_taxes( \@taxaccounts, $form, $linetotal ); + } + else { + $taxamount = + Tax::apply_taxes( \@taxaccounts, $form, $linetotal ); + $taxbase = $linetotal; + } + + if ( @taxaccounts && $form->round_amount( $taxamount, 2 ) == 0 ) { + if ( $form->{taxincluded} ) { + foreach $item (@taxaccounts) { + $taxamount = $form->round_amount( $item->value, 2 ); + $taxaccounts{ $item->account } += $taxamount; + $taxdiff += $taxamount; + $taxbase{ $item->account } += $taxbase; + } + $taxaccounts{ $taxaccounts[0]->account } += $taxdiff; + } + else { + foreach $item (@taxaccounts) { + $taxaccounts{ $item->account } += $item->value; + $taxbase{ $item->account } += $taxbase; + } + } + } + else { + foreach $item (@taxaccounts) { + $taxaccounts{ $item->account } += $item->value; + $taxbase{ $item->account } += $taxbase; + } + } + + $netamount += $form->{"sellprice_$i"} * $form->{"qty_$i"}; + + if ( $form->{"projectnumber_$i"} ne "" ) { + ( $null, $project_id ) = split /--/, + $form->{"projectnumber_$i"}; + } + $project_id = $form->{"project_id_$i"} + if $form->{"project_id_$i"}; + + if ( !$form->{"reqdate_$i"} ) { + $form->{"reqdate_$i"} = undef; + } + + @queryargs = (); + + # save detail record in orderitems table + $query = qq|INSERT INTO orderitems (|; + if ( $form->{"orderitems_id_$i"} ) { + $query .= "id, "; + } + $query .= qq| trans_id, parts_id, description, qty, sellprice, discount, unit, reqdate, project_id, ship, serialnumber, notes) VALUES (|; - if ($form->{"orderitems_id_$i"}){ - $query .= "?, "; - push @queryargs, $form->{"orderitems_id_$i"}; - } - $query .= qq| ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - push (@queryargs, - $form->{id}, $form->{"id_$i"}, - $form->{"description_$i"}, $form->{"qty_$i"}, - $fxsellprice, $form->{"discount_$i"}, - $form->{"unit_$i"}, $form->{"reqdate_$i"}, - $project_id, $form->{"ship_$i"}, - $form->{"serialnumber_$i"}, - $form->{"notes_$i"}); - $sth->execute(@queryargs) || $form->dberror($query); - - $form->{"sellprice_$i"} = $fxsellprice; - } - $form->{"discount_$i"} *= 100; - } - - - # set values which could be empty - for (qw(vendor_id customer_id taxincluded closed quotation)) - { $form->{$_} *= 1 } - - # add up the tax - my $tax = 0; - for (keys %taxaccounts) { $tax += $taxaccounts{$_} } - - $amount = $form->round_amount($netamount + $tax, 2); - $netamount = $form->round_amount($netamount, 2); - - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{exchangerate} = 1; - } else { - $exchangerate = $form->check_exchangerate( - $myconfig, $form->{currency}, $form->{transdate}, - ($form->{vc} eq 'customer') ? 'buy' : 'sell'); - } - - $form->{exchangerate} = ($exchangerate) ? $exchangerate : - $form->parse_amount($myconfig, $form->{exchangerate}); - - - ($null, $form->{department_id}) = split(/--/, $form->{department}); - for (qw(department_id terms)) { $form->{$_} *= 1 } - if ($did_insert){ - $query = qq| + if ( $form->{"orderitems_id_$i"} ) { + $query .= "?, "; + push @queryargs, $form->{"orderitems_id_$i"}; + } + $query .= qq| ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; + $sth = $dbh->prepare($query); + push( @queryargs, + $form->{id}, $form->{"id_$i"}, + $form->{"description_$i"}, $form->{"qty_$i"}, + $fxsellprice, $form->{"discount_$i"}, + $form->{"unit_$i"}, $form->{"reqdate_$i"}, + $project_id, $form->{"ship_$i"}, + $form->{"serialnumber_$i"}, $form->{"notes_$i"} ); + $sth->execute(@queryargs) || $form->dberror($query); + + $form->{"sellprice_$i"} = $fxsellprice; + } + $form->{"discount_$i"} *= 100; + } + + # set values which could be empty + for (qw(vendor_id customer_id taxincluded closed quotation)) { + $form->{$_} *= 1; + } + + # add up the tax + my $tax = 0; + for ( keys %taxaccounts ) { $tax += $taxaccounts{$_} } + + $amount = $form->round_amount( $netamount + $tax, 2 ); + $netamount = $form->round_amount( $netamount, 2 ); + + if ( $form->{currency} eq $form->{defaultcurrency} ) { + $form->{exchangerate} = 1; + } + else { + $exchangerate = + $form->check_exchangerate( $myconfig, $form->{currency}, + $form->{transdate}, + ( $form->{vc} eq 'customer' ) ? 'buy' : 'sell' ); + } + + $form->{exchangerate} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount( $myconfig, $form->{exchangerate} ); + + ( $null, $form->{department_id} ) = split( /--/, $form->{department} ); + for (qw(department_id terms)) { $form->{$_} *= 1 } + if ($did_insert) { + $query = qq| UPDATE oe SET amount = ?, netamount = ?, taxincluded = ? WHERE id = ?|; - @queryargs = ($amount, $netamount, $form->{taxincluded}, - $form->{id}); - } else { - # save OE record - $query = qq| + @queryargs = ( $amount, $netamount, $form->{taxincluded}, $form->{id} ); + } + else { + + # save OE record + $query = qq| UPDATE oe set ordnumber = ?, quonumber = ?, @@ -576,215 +579,190 @@ sub save { terms = ? WHERE id = ?|; - if (!$form->{reqdate}){ - $form->{reqdate} = undef; - } - - @queryargs = ($form->{ordnumber}, - $form->{quonumber}, - $form->{transdate}, - $form->{vendor_id}, - $form->{customer_id}, - $amount, - $netamount, - $form->{reqdate}, - $form->{taxincluded}, - $form->{shippingpoint}, - $form->{shipvia}, - $form->{notes}, - $form->{intnotes}, - $form->{currency}, - $form->{closed}, - $quotation, - $form->{department_id}, - $form->{employee_id}, - $form->{language_code}, - $form->{ponumber}, - $form->{terms}, - $form->{id}); - } - $sth = $dbh->prepare($query); - $sth->execute(@queryargs) || $form->dberror($query); - - if (!$did_insert){ - @queries = $form->run_custom_queries('oe', 'UPDATE'); - } - - - $form->{ordtotal} = $amount; - - # add shipto - $form->{name} = $form->{$form->{vc}}; - $form->{name} =~ s/--$form->{"$form->{vc}_id"}//; - $form->add_shipto($dbh, $form->{id}); - - # save printed, emailed, queued - $form->save_status($dbh); - - if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { - if ($form->{vc} eq 'customer') { - $form->update_exchangerate( - $dbh, - $form->{currency}, - $form->{transdate}, - $form->{exchangerate}, - 0); - } - if ($form->{vc} eq 'vendor') { - $form->update_exchangerate( - $dbh, - $form->{currency}, - $form->{transdate}, - 0, - $form->{exchangerate}); - } - } - - - if ($form->{type} =~ /_order$/) { - # adjust onhand - &adj_onhand($dbh, $form, $ml * -1); - &adj_inventory($dbh, $myconfig, $form); - } - - my %audittrail = ( - tablename => 'oe', - reference => ($form->{type} =~ /_order$/) - ? $form->{ordnumber} : $form->{quonumber}, - formname => $form->{type}, - action => 'saved', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - $form->save_recurring($dbh, $myconfig); - - my $rc = $dbh->commit; - - $rc; + if ( !$form->{reqdate} ) { + $form->{reqdate} = undef; + } + + @queryargs = ( + $form->{ordnumber}, $form->{quonumber}, + $form->{transdate}, $form->{vendor_id}, + $form->{customer_id}, $amount, + $netamount, $form->{reqdate}, + $form->{taxincluded}, $form->{shippingpoint}, + $form->{shipvia}, $form->{notes}, + $form->{intnotes}, $form->{currency}, + $form->{closed}, $quotation, + $form->{department_id}, $form->{employee_id}, + $form->{language_code}, $form->{ponumber}, + $form->{terms}, $form->{id} + ); + } + $sth = $dbh->prepare($query); + $sth->execute(@queryargs) || $form->dberror($query); + + if ( !$did_insert ) { + @queries = $form->run_custom_queries( 'oe', 'UPDATE' ); + } + + $form->{ordtotal} = $amount; + + # add shipto + $form->{name} = $form->{ $form->{vc} }; + $form->{name} =~ s/--$form->{"$form->{vc}_id"}//; + $form->add_shipto( $dbh, $form->{id} ); + + # save printed, emailed, queued + $form->save_status($dbh); + + if ( ( $form->{currency} ne $form->{defaultcurrency} ) && !$exchangerate ) { + if ( $form->{vc} eq 'customer' ) { + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{transdate}, $form->{exchangerate}, 0 ); + } + if ( $form->{vc} eq 'vendor' ) { + $form->update_exchangerate( $dbh, $form->{currency}, + $form->{transdate}, 0, $form->{exchangerate} ); + } + } + + if ( $form->{type} =~ /_order$/ ) { + + # adjust onhand + &adj_onhand( $dbh, $form, $ml * -1 ); + &adj_inventory( $dbh, $myconfig, $form ); + } + + my %audittrail = ( + tablename => 'oe', + reference => ( $form->{type} =~ /_order$/ ) + ? $form->{ordnumber} + : $form->{quonumber}, + formname => $form->{type}, + action => 'saved', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + $form->save_recurring( $dbh, $myconfig ); + + my $rc = $dbh->commit; + + $rc; } - - sub delete { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - # delete spool files - my $query = qq| + # delete spool files + my $query = qq| SELECT spoolfile FROM status WHERE trans_id = ? AND spoolfile IS NOT NULL|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - my $spoolfile; - my @spoolfiles = (); + my $spoolfile; + my @spoolfiles = (); - while (($spoolfile) = $sth->fetchrow_array) { - push @spoolfiles, $spoolfile; - } - $sth->finish; + while ( ($spoolfile) = $sth->fetchrow_array ) { + push @spoolfiles, $spoolfile; + } + $sth->finish; - - $query = qq| + $query = qq| SELECT o.parts_id, o.ship, p.inventory_accno_id, p.assembly FROM orderitems o JOIN parts p ON (p.id = o.parts_id) WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - if ($form->{type} =~ /_order$/) { - $ml = ($form->{type} eq 'purchase_order') ? -1 : 1; - while (my ($id, $ship, $inv, $assembly) - = $sth->fetchrow_array) { - $form->update_balance( - $dbh, - "parts", - "onhand", - "id = $id", - $ship * $ml) - if ($inv || $assembly); - } - } - $sth->finish; - - # delete inventory - $query = qq|DELETE FROM inventory WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - $sth->finish; - - # delete status entries - $query = qq|DELETE FROM status WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - $sth->finish; - - # delete OE record - $query = qq|DELETE FROM oe WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - $sth->finish; - - # delete individual entries - $query = qq|DELETE FROM orderitems WHERE trans_id = ?|; - $sth->finish; - - $query = qq|DELETE FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - $sth->finish; - - my %audittrail = ( - tablename => 'oe', - reference => ($form->{type} =~ /_order$/) - ? $form->{ordnumber} : $form->{quonumber}, - formname => $form->{type}, - action => 'deleted', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - my $rc = $dbh->commit; - - if ($rc) { - foreach $spoolfile (@spoolfiles) { - unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" if $spoolfile; - } - } - - $rc; - + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + if ( $form->{type} =~ /_order$/ ) { + $ml = ( $form->{type} eq 'purchase_order' ) ? -1 : 1; + while ( my ( $id, $ship, $inv, $assembly ) = $sth->fetchrow_array ) { + $form->update_balance( $dbh, "parts", "onhand", "id = $id", + $ship * $ml ) + if ( $inv || $assembly ); + } + } + $sth->finish; + + # delete inventory + $query = qq|DELETE FROM inventory WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + $sth->finish; + + # delete status entries + $query = qq|DELETE FROM status WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + $sth->finish; + + # delete OE record + $query = qq|DELETE FROM oe WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + $sth->finish; + + # delete individual entries + $query = qq|DELETE FROM orderitems WHERE trans_id = ?|; + $sth->finish; + + $query = qq|DELETE FROM shipto WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + $sth->finish; + + my %audittrail = ( + tablename => 'oe', + reference => ( $form->{type} =~ /_order$/ ) + ? $form->{ordnumber} + : $form->{quonumber}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + my $rc = $dbh->commit; + + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "${LedgerSMB::Sysconfig::spool}/$spoolfile" if $spoolfile; + } + } + + $rc; + } +sub retrieve { + use LedgerSMB::PriceMatrix; + my ( $self, $myconfig, $form ) = @_; + # connect to database + my $dbh = $form->{dbh}; -sub retrieve { - use LedgerSMB::PriceMatrix; - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query; - my $sth; - my $var; - my $ref; - - $query = qq| + my $query; + my $sth; + my $var; + my $ref; + + $query = qq| SELECT value, current_date FROM defaults WHERE setting_key = 'curr'|; - ($form->{currencies}, $form->{transdate}) = - $dbh->selectrow_array($query); - - if ($form->{id}) { - - # retrieve order - $query = qq| + ( $form->{currencies}, $form->{transdate} ) = $dbh->selectrow_array($query); + + if ( $form->{id} ) { + + # retrieve order + $query = qq| SELECT o.ordnumber, o.transdate, o.reqdate, o.terms, o.taxincluded, o.shippingpoint, o.shipvia, o.notes, o.intnotes, o.curr AS currency, @@ -799,43 +777,42 @@ sub retrieve { LEFT JOIN employees e ON (o.employee_id = e.id) LEFT JOIN department d ON (o.department_id = d.id) WHERE o.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; - - $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{$_} = $ref->{$_} } - $sth->finish; - - # get printed, emailed and queued - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; + + $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } + $sth->finish; + + # get printed, emailed and queued + $query = qq| SELECT s.printed, s.emailed, s.spoolfile, s.formname FROM status s WHERE s.trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{printed} .= "$ref->{formname} " - if $ref->{printed}; - $form->{emailed} .= "$ref->{formname} " - if $ref->{emailed}; - $form->{queued} .= "$ref->{formname} $ref->{spoolfile} " - if $ref->{spoolfile}; - } - $sth->finish; - for (qw(printed emailed queued)) { $form->{$_} =~ s/ +$//g } - - - # retrieve individual items - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{printed} .= "$ref->{formname} " + if $ref->{printed}; + $form->{emailed} .= "$ref->{formname} " + if $ref->{emailed}; + $form->{queued} .= "$ref->{formname} $ref->{spoolfile} " + if $ref->{spoolfile}; + } + $sth->finish; + for (qw(printed emailed queued)) { $form->{$_} =~ s/ +$//g } + + # retrieve individual items + $query = qq| SELECT o.id AS orderitems_id, p.partnumber, p.assembly, o.description, o.qty, o.sellprice, o.parts_id AS id, o.unit, o.discount, p.bin, @@ -855,764 +832,773 @@ sub retrieve { AND t.language_code = ?) WHERE o.trans_id = ? ORDER BY o.id|; - $sth = $dbh->prepare($query); - $sth->execute($form->{language_code}, $form->{id}) - || $form->dberror($query); - - # foreign exchange rates - &exchangerate_defaults($dbh, $form); - - # query for price matrix - my $pmh = PriceMatrix::price_matrix_query($dbh, $form); - - # taxes - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{language_code}, $form->{id} ) + || $form->dberror($query); + + # foreign exchange rates + &exchangerate_defaults( $dbh, $form ); + + # query for price matrix + my $pmh = PriceMatrix::price_matrix_query( $dbh, $form ); + + # taxes + $query = qq| SELECT c.accno FROM chart c JOIN partstax pt ON (pt.chart_id = c.id) WHERE pt.parts_id = ?|; - my $tth = $dbh->prepare($query) || $form->dberror($query); - - my $taxrate; - my $ptref; - my $sellprice; - my $listprice; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - - ($decimalplaces) = ($ref->{sellprice} =~ /\.(\d+)/); - $decimalplaces = length $decimalplaces; - $decimalplaces = ($decimalplaces > 2) ? - $decimalplaces : 2; - - $tth->execute($ref->{id}); - $ref->{taxaccounts} = ""; - $taxrate = 0; - - while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { - $ref->{taxaccounts} .= "$ptref->{accno} "; - $taxrate += $form->{"$ptref->{accno}_rate"}; - } - $tth->finish; - chop $ref->{taxaccounts}; - - # preserve price - $sellprice = $ref->{sellprice}; - - # multiply by exchangerate - $ref->{sellprice} = $form->round_amount( - $ref->{sellprice} * $form->{$form->{currency}}, - $decimalplaces - ); - - for (qw(listprice lastcost)) { - $ref->{$_} = $form->round_amount( - $ref->{$_} / $form->{$form->{currency}}, - $decimalplaces - ); - } - - # partnumber and price matrix - PriceMatrix::price_matrix( - $pmh, $ref, $form->{transdate}, $decimalplaces, - $form, $myconfig); - - $ref->{sellprice} = $sellprice; - - $ref->{partsgroup} = $ref->{partsgrouptranslation} - if $ref->{partsgrouptranslation}; - - push @{ $form->{form_details} }, $ref; - - } - $sth->finish; - - # get recurring transaction - $form->get_recurring; - - @queries = $form->run_custom_queries('oe', 'SELECT'); - $form->{dbh}->commit; - } else { - - # get last name used - $form->lastname_used($myconfig, $dbh, $form->{vc}) - unless $form->{"$form->{vc}_id"}; - - delete $form->{notes}; - - } - - $dbh->commit; + my $tth = $dbh->prepare($query) || $form->dberror($query); -} + my $taxrate; + my $ptref; + my $sellprice; + my $listprice; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + ($decimalplaces) = ( $ref->{sellprice} =~ /\.(\d+)/ ); + $decimalplaces = length $decimalplaces; + $decimalplaces = ( $decimalplaces > 2 ) ? $decimalplaces : 2; + + $tth->execute( $ref->{id} ); + $ref->{taxaccounts} = ""; + $taxrate = 0; + + while ( $ptref = $tth->fetchrow_hashref(NAME_lc) ) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + $taxrate += $form->{"$ptref->{accno}_rate"}; + } + $tth->finish; + chop $ref->{taxaccounts}; + + # preserve price + $sellprice = $ref->{sellprice}; + + # multiply by exchangerate + $ref->{sellprice} = + $form->round_amount( + $ref->{sellprice} * $form->{ $form->{currency} }, + $decimalplaces ); + + for (qw(listprice lastcost)) { + $ref->{$_} = + $form->round_amount( + $ref->{$_} / $form->{ $form->{currency} }, + $decimalplaces ); + } + + # partnumber and price matrix + PriceMatrix::price_matrix( $pmh, $ref, $form->{transdate}, + $decimalplaces, $form, $myconfig ); + $ref->{sellprice} = $sellprice; + + $ref->{partsgroup} = $ref->{partsgrouptranslation} + if $ref->{partsgrouptranslation}; + + push @{ $form->{form_details} }, $ref; + + } + $sth->finish; + + # get recurring transaction + $form->get_recurring; + + @queries = $form->run_custom_queries( 'oe', 'SELECT' ); + $form->{dbh}->commit; + } + else { + + # get last name used + $form->lastname_used( $myconfig, $dbh, $form->{vc} ) + unless $form->{"$form->{vc}_id"}; + + delete $form->{notes}; + + } + + $dbh->commit; + +} sub exchangerate_defaults { - my ($dbh2, $form) = @_; - $dbh = $form->{dbh}; - my $var; - my $buysell = ($form->{vc} eq "customer") ? "buy" : "sell"; - - # get default currencies - my $query = qq| + my ( $dbh2, $form ) = @_; + $dbh = $form->{dbh}; + my $var; + my $buysell = ( $form->{vc} eq "customer" ) ? "buy" : "sell"; + + # get default currencies + my $query = qq| SELECT substr(value,1,3), value FROM defaults WHERE setting_key = 'curr'|; - ($form->{defaultcurrency}, $form->{currencies}) - = $dbh->selectrow_array($query); + ( $form->{defaultcurrency}, $form->{currencies} ) = + $dbh->selectrow_array($query); - $query = qq| + $query = qq| SELECT $buysell FROM exchangerate WHERE curr = ? AND transdate = ?|; - my $eth1 = $dbh->prepare($query) || $form->dberror($query); - $query = qq~ + my $eth1 = $dbh->prepare($query) || $form->dberror($query); + $query = qq~ SELECT max(transdate || ' ' || $buysell || ' ' || curr) FROM exchangerate WHERE curr = ?~; - my $eth2 = $dbh->prepare($query) || $form->dberror($query); - - # get exchange rates for transdate or max - foreach $var (split /:/, substr($form->{currencies},4)) { - $eth1->execute($var, $form->{transdate}); - ($form->{$var}) = $eth1->fetchrow_array; - if (! $form->{$var} ) { - $eth2->execute($var); - - ($form->{$var}) = $eth2->fetchrow_array; - ($null, $form->{$var}) = split / /, $form->{$var}; - $form->{$var} = 1 unless $form->{$var}; - $eth2->finish; - } - $eth1->finish; - } - - $form->{$form->{currency}} = $form->{exchangerate} - if $form->{exchangerate}; - $form->{$form->{currency}} ||= 1; - $form->{$form->{defaultcurrency}} = 1; - -} + my $eth2 = $dbh->prepare($query) || $form->dberror($query); + + # get exchange rates for transdate or max + foreach $var ( split /:/, substr( $form->{currencies}, 4 ) ) { + $eth1->execute( $var, $form->{transdate} ); + ( $form->{$var} ) = $eth1->fetchrow_array; + if ( !$form->{$var} ) { + $eth2->execute($var); + + ( $form->{$var} ) = $eth2->fetchrow_array; + ( $null, $form->{$var} ) = split / /, $form->{$var}; + $form->{$var} = 1 unless $form->{$var}; + $eth2->finish; + } + $eth1->finish; + } + + $form->{ $form->{currency} } = $form->{exchangerate} + if $form->{exchangerate}; + $form->{ $form->{currency} } ||= 1; + $form->{ $form->{defaultcurrency} } = 1; +} sub order_details { - use LedgerSMB::CP; - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - my $query; - my $sth; - - my $item; - my $i; - my @sortlist = (); - my $projectnumber; - my $projectdescription; - my $projectnumber_id; - my $translation; - my $partsgroup; - - my @queryargs; - - my @taxaccounts; - my %taxaccounts; # I don't think this works. - my $tax; - my $taxrate; - my $taxamount; - - my %translations; - - my $language_code = $form->{dbh}->quote($form->{language_code}); - $query = qq| + use LedgerSMB::CP; + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + my $query; + my $sth; + + my $item; + my $i; + my @sortlist = (); + my $projectnumber; + my $projectdescription; + my $projectnumber_id; + my $translation; + my $partsgroup; + + my @queryargs; + + my @taxaccounts; + my %taxaccounts; # I don't think this works. + my $tax; + my $taxrate; + my $taxamount; + + my %translations; + + my $language_code = $form->{dbh}->quote( $form->{language_code} ); + $query = qq| SELECT p.description, t.description FROM project p LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code = $language_code) WHERE id = ?|; - my $prh = $dbh->prepare($query) || $form->dberror($query); + my $prh = $dbh->prepare($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT inventory_accno_id, income_accno_id, expense_accno_id, assembly FROM parts WHERE id = ?|; - my $pth = $dbh->prepare($query) || $form->dberror($query); - - my $sortby; - - # sort items by project and partsgroup - for $i (1 .. $form->{rowcount}) { - - if ($form->{"id_$i"}) { - # account numbers - $pth->execute($form->{"id_$i"}); - $ref = $pth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { $form->{"${_}_$i"} = $ref->{$_} } - $pth->finish; - - $projectnumber_id = 0; - $projectnumber = ""; - $form->{partsgroup} = ""; - $form->{projectnumber} = ""; - - if ($form->{groupprojectnumber} - || $form->{grouppartsgroup}) { - - $inventory_accno_id = - ($form->{"inventory_accno_id_$i"} || - $form->{"assembly_$i"}) ? "1" : ""; - - if ($form->{groupprojectnumber}) { - ($projectnumber, $projectnumber_id) = - split /--/, - $form->{"projectnumber_$i"}; - } - if ($form->{grouppartsgroup}) { - ($form->{partsgroup}) = split /--/, - $form->{"partsgroup_$i"}; - } - - if ($projectnumber_id && - $form->{groupprojectnumber}) { - if ($translation{$projectnumber_id}) { - $form->{projectnumber} = - $translation{$projectnumber_id}; - } else { - # get project description - $prh->execute( - $projectnumber_id); - ($projectdescription, - $translation) = - $prh->fetchrow_array; - $prh->finish; - - $form->{projectnumber} = - ($translation) ? - "$projectnumber, \n" . - "$translation" - : "$projectnumber, \n" . - "$projectdescription"; - - $translation{$projectnumber_id} - = $form->{projectnumber}; - } - } - - if ($form->{grouppartsgroup} - && $form->{partsgroup}) { - $form->{projectnumber} .= " / " - if $projectnumber_id; - $form->{projectnumber} .= - $form->{partsgroup}; - } - - $form->format_string(projectnumber); - - } - - $sortby = qq|$projectnumber$form->{partsgroup}|; - - if ($form->{sortby} ne 'runningnumber') { - for (qw(partnumber description bin)) { - $sortby .= $form->{"${_}_$i"} - if $form->{sortby} eq $_; - } - } - - push @sortlist, [ $i, - "$projectnumber$form->{partsgroup}". - "$inventory_accno_id", - $form->{projectnumber}, $projectnumber_id, - $form->{partsgroup}, $sortby ]; - } - - } - - delete $form->{projectnumber}; - - # sort the whole thing by project and group - @sortlist = sort { $a->[5] cmp $b->[5] } @sortlist; - - - # if there is a warehouse limit picking - if ($form->{warehouse_id} && $form->{formname} =~ - /(pick|packing)_list/) { - # run query to check for inventory - $query = qq| + my $pth = $dbh->prepare($query) || $form->dberror($query); + + my $sortby; + + # sort items by project and partsgroup + for $i ( 1 .. $form->{rowcount} ) { + + if ( $form->{"id_$i"} ) { + + # account numbers + $pth->execute( $form->{"id_$i"} ); + $ref = $pth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { $form->{"${_}_$i"} = $ref->{$_} } + $pth->finish; + + $projectnumber_id = 0; + $projectnumber = ""; + $form->{partsgroup} = ""; + $form->{projectnumber} = ""; + + if ( $form->{groupprojectnumber} + || $form->{grouppartsgroup} ) + { + + $inventory_accno_id = + ( $form->{"inventory_accno_id_$i"} || $form->{"assembly_$i"} ) + ? "1" + : ""; + + if ( $form->{groupprojectnumber} ) { + ( $projectnumber, $projectnumber_id ) = + split /--/, $form->{"projectnumber_$i"}; + } + if ( $form->{grouppartsgroup} ) { + ( $form->{partsgroup} ) = split /--/, + $form->{"partsgroup_$i"}; + } + + if ( $projectnumber_id + && $form->{groupprojectnumber} ) + { + if ( $translation{$projectnumber_id} ) { + $form->{projectnumber} = + $translation{$projectnumber_id}; + } + else { + + # get project description + $prh->execute($projectnumber_id); + ( $projectdescription, $translation ) = + $prh->fetchrow_array; + $prh->finish; + + $form->{projectnumber} = + ($translation) + ? "$projectnumber, \n" . "$translation" + : "$projectnumber, \n" . "$projectdescription"; + + $translation{$projectnumber_id} = + $form->{projectnumber}; + } + } + + if ( $form->{grouppartsgroup} + && $form->{partsgroup} ) + { + $form->{projectnumber} .= " / " + if $projectnumber_id; + $form->{projectnumber} .= $form->{partsgroup}; + } + + $form->format_string(projectnumber); + + } + + $sortby = qq|$projectnumber$form->{partsgroup}|; + + if ( $form->{sortby} ne 'runningnumber' ) { + for (qw(partnumber description bin)) { + $sortby .= $form->{"${_}_$i"} + if $form->{sortby} eq $_; + } + } + + push @sortlist, + [ + $i, + "$projectnumber$form->{partsgroup}" . "$inventory_accno_id", + $form->{projectnumber}, + $projectnumber_id, + $form->{partsgroup}, + $sortby + ]; + } + + } + + delete $form->{projectnumber}; + + # sort the whole thing by project and group + @sortlist = sort { $a->[5] cmp $b->[5] } @sortlist; + + # if there is a warehouse limit picking + if ( $form->{warehouse_id} && $form->{formname} =~ /(pick|packing)_list/ ) { + + # run query to check for inventory + $query = qq| SELECT sum(qty) AS qty FROM inventory WHERE parts_id = ? AND warehouse_id = ?|; - $sth = $dbh->prepare($query) || $form->dberror($query); - - for $i (1 .. $form->{rowcount}) { - $sth->execute($form->{"id_$i"}, $form->{warehouse_id}) - || $form->dberror; - - ($qty) = $sth->fetchrow_array; - $sth->finish; - - $form->{"qty_$i"} = 0 if $qty == 0; - - if ($form->parse_amount($myconfig, $form->{"ship_$i"}) - > $qty) { - $form->{"ship_$i"} = - $form->format_amount($myconfig, $qty); - } - } - } - - - my $runningnumber = 1; - my $sameitem = ""; - my $subtotal; - my $k = scalar @sortlist; - my $j = 0; - - foreach $item (@sortlist) { - $i = $item->[0]; - $j++; - - if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { - if ($item->[1] ne $sameitem) { - $sameitem = $item->[1]; - - $ok = 0; - - if ($form->{groupprojectnumber}) { - $ok = $form->{"projectnumber_$i"}; - } - if ($form->{grouppartsgroup}) { - $ok = $form->{"partsgroup_$i"} - unless $ok; - } - - if ($ok) { - if ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) { - - push(@{ $form->{part} }, ""); - push(@{ $form->{service} }, - NULL); - } else { - push(@{ $form->{part} }, NULL); - push(@{ $form->{service} }, ""); - } - - push(@{ $form->{description} }, - $item->[2]); - for ( - qw(taxrates runningnumber - number sku qty ship unit bin - serialnumber requiredate - projectnumber sellprice - listprice netprice discount - discountrate linetotal weight - itemnotes) - ) { - push(@{ $form->{$_} }, ""); - } - push(@{ $form->{lineitems} }, - { amount => 0, tax => 0 }); - } - } - } - - - $form->{"qty_$i"} = $form->parse_amount( - $myconfig, $form->{"qty_$i"}); - $form->{"ship_$i"} = $form->parse_amount( - $myconfig, $form->{"ship_$i"}); - - if ($form->{"qty_$i"}) { - - $form->{totalqty} += $form->{"qty_$i"}; - $form->{totalship} += $form->{"ship_$i"}; - $form->{totalweight} += ($form->{"weight_$i"} - * $form->{"qty_$i"}); - $form->{totalweightship} += ($form->{"weight_$i"} - * $form->{"ship_$i"}); - - # add number, description and qty to $form->{number} - push(@{ $form->{runningnumber} }, $runningnumber++); - push(@{ $form->{number} }, - qq|$form->{"partnumber_$i"}|); - push(@{ $form->{sku} }, qq|$form->{"sku_$i"}|); - push(@{ $form->{description} }, - qq|$form->{"description_$i"}|); - push(@{ $form->{itemnotes} }, $form->{"notes_$i"}); - push(@{ $form->{qty} }, $form->format_amount( - $myconfig, $form->{"qty_$i"})); - push(@{ $form->{ship} }, $form->format_amount( - $myconfig, $form->{"ship_$i"})); - push(@{ $form->{unit} }, qq|$form->{"unit_$i"}|); - push(@{ $form->{bin} }, qq|$form->{"bin_$i"}|); - push(@{ $form->{serialnumber} }, - qq|$form->{"serialnumber_$i"}|); - push(@{ $form->{requiredate} }, - qq|$form->{"reqdate_$i"}|); - push(@{ $form->{projectnumber} }, - qq|$form->{"projectnumber_$i"}|); - - push(@{ $form->{sellprice} }, $form->{"sellprice_$i"}); - - push(@{ $form->{listprice} }, $form->{"listprice_$i"}); - - push(@{ $form->{weight} }, $form->format_amount( - $myconfig, - $form->{"weight_$i"} * $form->{"ship_$i"})); - - my $sellprice = $form->parse_amount( - $myconfig, $form->{"sellprice_$i"}); - my ($dec) = ($sellprice =~ /\.(\d+)/); - $dec = length $dec; - my $decimalplaces = ($dec > 2) ? $dec : 2; - - my $discount = $form->round_amount( - $sellprice * $form->parse_amount( - $myconfig, - $form->{"discount_$i"}) / 100, - $decimalplaces); - - # keep a netprice as well, (sellprice - discount) - $form->{"netprice_$i"} = $sellprice - $discount; - - my $linetotal = $form->round_amount( - $form->{"qty_$i"} * $form->{"netprice_$i"}, 2); - - if ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) { - - push(@{ $form->{part} }, $form->{"sku_$i"}); - push(@{ $form->{service} }, NULL); - $form->{totalparts} += $linetotal; - } else { - push(@{ $form->{service} }, $form->{"sku_$i"}); - push(@{ $form->{part} }, NULL); - $form->{totalservices} += $linetotal; - } - - push(@{ $form->{netprice} }, - ($form->{"netprice_$i"}) - ? $form->format_amount( - $myconfig, - $form->{"netprice_$i"}, - $decimalplaces) - : " "); - - $discount = ($discount) - ? $form->format_amount( - $myconfig, - $discount * -1, - $decimalplaces) - : " "; - - push(@{ $form->{discount} }, $discount); - push(@{ $form->{discountrate} }, - $form->format_amount($myconfig, - $form->{"discount_$i"})); - - $form->{ordtotal} += $linetotal; - - # this is for the subtotals for grouping - $subtotal += $linetotal; - - $form->{"linetotal_$i"} = $form->format_amount( - $myconfig, $linetotal, 2); - push(@{ $form->{linetotal} }, $form->{"linetotal_$i"}); - - @taxaccounts = Tax::init_taxes($form, - $form->{"taxaccounts_$i"}); - - my $ml = 1; - my @taxrates = (); - - $tax = 0; - - $taxamount = Tax::calculate_taxes(\@taxaccounts, - $form, $linetotal, 1); - $taxbase = Tax::extract_taxes(\@taxaccounts, - $form, $linetotal); - foreach $item (@taxaccounts) { - push @taxrates, Math::BigFloat->new(100) * - $item->rate; - if ($form->{taxincluded}) { - $taxaccounts{$item->account} += - $item->value; - $taxbase{$item->account} += $taxbase; - } else { - Tax::apply_taxes(\@taxaccounts, $form, - $linetotal); - $taxbase{$item->account} += $linetotal; - $taxaccounts{$item->account} += - $item->value; - } - } - if ($form->{taxincluded}) { - $tax += Tax::calculate_taxes(\@taxaccounts, - $form, $linetotal, 1); - } else { - $tax += Tax::calculate_taxes(\@taxaccounts, - $form, $linetotal, 0); - } - - push(@{ $form->{lineitems} }, - { amount => $linetotal, - tax => $form->round_amount($tax, 2) }); - push(@{ $form->{taxrates} }, - join ' ', sort { $a <=> $b } @taxrates); - - if ($form->{"assembly_$i"}) { - $form->{stagger} = -1; - &assembly_details($myconfig, - $form, $dbh, $form->{"id_$i"}, - $oid{$myconfig->{dbdriver}}, - $form->{"qty_$i"}); - } - - } - - # add subtotal - if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { - if ($subtotal) { - if ($j < $k) { - # look at next item - if ($sortlist[$j]->[1] ne $sameitem) { - - if ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) { - - push(@{ $form->{part} }, - ""); - push(@{ - $form->{service} - }, NULL); - } else { - push(@{ - $form->{service} - }, ""); - push(@{ $form->{part} }, - NULL); - } - - for (qw( - taxrates runningnumber - number sku qty ship unit - bin serialnumber - requiredate - projectnumber sellprice - listprice netprice - discount discountrate - weight itemnotes) - ) { - - push(@{ $form->{$_} }, - ""); - } - - push(@{ $form->{description} }, - $form->{groupsubtotaldescription}); - - push(@{ $form->{lineitems} }, - { amount => 0, - tax => 0 }); - - if ($form->{groupsubtotaldescription} - ne "") { - push(@{ - $form->{linetotal} - }, - $form->format_amount($myconfig, $subtotal, 2)); - } else { - push(@{ - $form->{linetotal} - }, ""); - } - $subtotal = 0; - } - - } else { - - # got last item - if ($form->{groupsubtotaldescription} - ne "") { - - if ($form->{"inventory_accno_id_$i"} - || $form->{"assembly_$i"}) { - push(@{ $form->{part} }, - ""); - push(@{ - $form->{service} - }, NULL); - } else { - push(@{ - $form->{service} - }, ""); - push(@{ $form->{part} }, - NULL); - } - - for (qw( - taxrates runningnumber - number sku qty ship unit - bin serialnumber - requiredate - projectnumber sellprice - listprice netprice - discount discountrate - weight itemnotes) - ) { - - push(@{ $form->{$_} }, - ""); - } - - push(@{ $form->{description} }, - $form->{groupsubtotaldescription}); - - push(@{ $form->{linetotal} }, - $form->format_amount( - $myconfig, - $subtotal, - 2)); - push(@{ $form->{lineitems} }, - { amount => 0, - tax => 0 }); - } - } - } - } - } - - - $tax = 0; - - foreach $item (sort keys %taxaccounts) { - if ($form->round_amount($taxaccounts{$item}, 2)) { - $tax += $taxamount = $form->round_amount( - $taxaccounts{$item}, 2); - - push(@{ $form->{taxbaseinclusive} }, - $form->{"${item}_taxbaseinclusive"} - = $form->round_amount( - $taxbase{$item} + $tax, 2)); - push(@{ $form->{taxbase} }, - $form->{"${item}_taxbase"} - = $form->format_amount($myconfig, - $taxbase{$item}, 2)); - push(@{ $form->{tax} }, - $form->{"${item}_tax"} - = $form->format_amount($myconfig, - $taxamount, 2)); - - push(@{ $form->{taxdescription} }, - $form->{"${item}_description"}); - - $form->{"${item}_taxrate"} = - $form->format_amount($myconfig, - $form->{"${item}_rate"} * 100); - - push(@{ $form->{taxrate} }, $form->{"${item}_taxrate"}); - - push(@{ $form->{taxnumber} }, - $form->{"${item}_taxnumber"}); - } - } - - # adjust taxes for lineitems - my $total = 0; - for (@{ $form->{lineitems} }) { - $total += $_->{tax}; - } - if ($form->round_amount($total,2) != $form->round_amount($tax,2)) { - # get largest amount - for (reverse sort { $a->{tax} <=> $b->{tax} } - @{ $form->{lineitems} }) { - - $_->{tax} -= $total - $tax; - last; - } - } - $i = 1; - for (@{ $form->{lineitems} }) { - push(@{ $form->{linetax} }, - $form->format_amount($myconfig, $_->{tax}, 2, "")); - } - - - for (qw(totalparts totalservices)) { - $form->{$_} = $form->format_amount($myconfig, $form->{$_}, 2); - } - for (qw(totalqty totalship totalweight)) { - $form->{$_} = $form->format_amount($myconfig, $form->{$_}); - } - $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal}, - 2); - $form->{ordtotal} = ($form->{taxincluded}) - ? $form->{ordtotal} - : $form->{ordtotal} + $tax; - - my $c; - if ($form->{language_code} ne "") { - $c = new CP $form->{language_code}; - } else { - $c = new CP $myconfig->{countrycode}; - } - $c->init; - my $whole; - ($whole, $form->{decimal}) = split /\./, $form->{ordtotal}; - $form->{decimal} .= "00"; - $form->{decimal} = substr($form->{decimal}, 0, 2); - - $form->{text_decimal} = $c->num2text($form->{decimal} * 1); - $form->{text_amount} = $c->num2text($whole); - $form->{integer_amount} = $form->format_amount($myconfig, $whole); - - # format amounts - $form->{quototal} = $form->{ordtotal} = - $form->format_amount($myconfig, $form->{ordtotal}, 2); - - $form->format_string(qw(text_amount text_decimal)); - - $query = qq| + $sth = $dbh->prepare($query) || $form->dberror($query); + + for $i ( 1 .. $form->{rowcount} ) { + $sth->execute( $form->{"id_$i"}, $form->{warehouse_id} ) + || $form->dberror; + + ($qty) = $sth->fetchrow_array; + $sth->finish; + + $form->{"qty_$i"} = 0 if $qty == 0; + + if ( $form->parse_amount( $myconfig, $form->{"ship_$i"} ) > $qty ) { + $form->{"ship_$i"} = $form->format_amount( $myconfig, $qty ); + } + } + } + + my $runningnumber = 1; + my $sameitem = ""; + my $subtotal; + my $k = scalar @sortlist; + my $j = 0; + + foreach $item (@sortlist) { + $i = $item->[0]; + $j++; + + if ( $form->{groupprojectnumber} || $form->{grouppartsgroup} ) { + if ( $item->[1] ne $sameitem ) { + $sameitem = $item->[1]; + + $ok = 0; + + if ( $form->{groupprojectnumber} ) { + $ok = $form->{"projectnumber_$i"}; + } + if ( $form->{grouppartsgroup} ) { + $ok = $form->{"partsgroup_$i"} + unless $ok; + } + + if ($ok) { + if ( $form->{"inventory_accno_id_$i"} + || $form->{"assembly_$i"} ) + { + + push( @{ $form->{part} }, "" ); + push( @{ $form->{service} }, NULL ); + } + else { + push( @{ $form->{part} }, NULL ); + push( @{ $form->{service} }, "" ); + } + + push( @{ $form->{description} }, $item->[2] ); + for ( + qw(taxrates runningnumber + number sku qty ship unit bin + serialnumber requiredate + projectnumber sellprice + listprice netprice discount + discountrate linetotal weight + itemnotes) + ) + { + push( @{ $form->{$_} }, "" ); + } + push( @{ $form->{lineitems} }, { amount => 0, tax => 0 } ); + } + } + } + + $form->{"qty_$i"} = $form->parse_amount( $myconfig, $form->{"qty_$i"} ); + $form->{"ship_$i"} = + $form->parse_amount( $myconfig, $form->{"ship_$i"} ); + + if ( $form->{"qty_$i"} ) { + + $form->{totalqty} += $form->{"qty_$i"}; + $form->{totalship} += $form->{"ship_$i"}; + $form->{totalweight} += + ( $form->{"weight_$i"} * $form->{"qty_$i"} ); + $form->{totalweightship} += + ( $form->{"weight_$i"} * $form->{"ship_$i"} ); + + # add number, description and qty to $form->{number} + push( @{ $form->{runningnumber} }, $runningnumber++ ); + push( @{ $form->{number} }, qq|$form->{"partnumber_$i"}| ); + push( @{ $form->{sku} }, qq|$form->{"sku_$i"}| ); + push( @{ $form->{description} }, qq|$form->{"description_$i"}| ); + push( @{ $form->{itemnotes} }, $form->{"notes_$i"} ); + push( + @{ $form->{qty} }, + $form->format_amount( $myconfig, $form->{"qty_$i"} ) + ); + push( + @{ $form->{ship} }, + $form->format_amount( $myconfig, $form->{"ship_$i"} ) + ); + push( @{ $form->{unit} }, qq|$form->{"unit_$i"}| ); + push( @{ $form->{bin} }, qq|$form->{"bin_$i"}| ); + push( @{ $form->{serialnumber} }, qq|$form->{"serialnumber_$i"}| ); + push( @{ $form->{requiredate} }, qq|$form->{"reqdate_$i"}| ); + push( @{ $form->{projectnumber} }, + qq|$form->{"projectnumber_$i"}| ); + + push( @{ $form->{sellprice} }, $form->{"sellprice_$i"} ); + + push( @{ $form->{listprice} }, $form->{"listprice_$i"} ); + + push( + @{ $form->{weight} }, + $form->format_amount( + $myconfig, $form->{"weight_$i"} * $form->{"ship_$i"} + ) + ); + + my $sellprice = + $form->parse_amount( $myconfig, $form->{"sellprice_$i"} ); + my ($dec) = ( $sellprice =~ /\.(\d+)/ ); + $dec = length $dec; + my $decimalplaces = ( $dec > 2 ) ? $dec : 2; + + my $discount = $form->round_amount( + $sellprice * + $form->parse_amount( $myconfig, $form->{"discount_$i"} ) / + 100, + $decimalplaces + ); + + # keep a netprice as well, (sellprice - discount) + $form->{"netprice_$i"} = $sellprice - $discount; + + my $linetotal = + $form->round_amount( $form->{"qty_$i"} * $form->{"netprice_$i"}, + 2 ); + + if ( $form->{"inventory_accno_id_$i"} + || $form->{"assembly_$i"} ) + { + + push( @{ $form->{part} }, $form->{"sku_$i"} ); + push( @{ $form->{service} }, NULL ); + $form->{totalparts} += $linetotal; + } + else { + push( @{ $form->{service} }, $form->{"sku_$i"} ); + push( @{ $form->{part} }, NULL ); + $form->{totalservices} += $linetotal; + } + + push( + @{ $form->{netprice} }, + ( $form->{"netprice_$i"} ) + ? $form->format_amount( $myconfig, $form->{"netprice_$i"}, + $decimalplaces ) + : " " + ); + + $discount = + ($discount) + ? $form->format_amount( $myconfig, $discount * -1, + $decimalplaces ) + : " "; + + push( @{ $form->{discount} }, $discount ); + push( + @{ $form->{discountrate} }, + $form->format_amount( $myconfig, $form->{"discount_$i"} ) + ); + + $form->{ordtotal} += $linetotal; + + # this is for the subtotals for grouping + $subtotal += $linetotal; + + $form->{"linetotal_$i"} = + $form->format_amount( $myconfig, $linetotal, 2 ); + push( @{ $form->{linetotal} }, $form->{"linetotal_$i"} ); + + @taxaccounts = Tax::init_taxes( $form, $form->{"taxaccounts_$i"} ); + + my $ml = 1; + my @taxrates = (); + + $tax = 0; + + $taxamount = + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 1 ); + $taxbase = Tax::extract_taxes( \@taxaccounts, $form, $linetotal ); + foreach $item (@taxaccounts) { + push @taxrates, Math::BigFloat->new(100) * $item->rate; + if ( $form->{taxincluded} ) { + $taxaccounts{ $item->account } += $item->value; + $taxbase{ $item->account } += $taxbase; + } + else { + Tax::apply_taxes( \@taxaccounts, $form, $linetotal ); + $taxbase{ $item->account } += $linetotal; + $taxaccounts{ $item->account } += $item->value; + } + } + if ( $form->{taxincluded} ) { + $tax += + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 1 ); + } + else { + $tax += + Tax::calculate_taxes( \@taxaccounts, $form, $linetotal, 0 ); + } + + push( + @{ $form->{lineitems} }, + { + amount => $linetotal, + tax => $form->round_amount( $tax, 2 ) + } + ); + push( @{ $form->{taxrates} }, + join ' ', sort { $a <=> $b } @taxrates ); + + if ( $form->{"assembly_$i"} ) { + $form->{stagger} = -1; + &assembly_details( $myconfig, $form, $dbh, $form->{"id_$i"}, + $oid{ $myconfig->{dbdriver} }, + $form->{"qty_$i"} ); + } + + } + + # add subtotal + if ( $form->{groupprojectnumber} || $form->{grouppartsgroup} ) { + if ($subtotal) { + if ( $j < $k ) { + + # look at next item + if ( $sortlist[$j]->[1] ne $sameitem ) { + + if ( $form->{"inventory_accno_id_$i"} + || $form->{"assembly_$i"} ) + { + + push( @{ $form->{part} }, "" ); + push( @{ $form->{service} }, NULL ); + } + else { + push( @{ $form->{service} }, "" ); + push( @{ $form->{part} }, NULL ); + } + + for ( + qw( + taxrates runningnumber + number sku qty ship unit + bin serialnumber + requiredate + projectnumber sellprice + listprice netprice + discount discountrate + weight itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + + push( + @{ $form->{description} }, + $form->{groupsubtotaldescription} + ); + + push( + @{ $form->{lineitems} }, + { + amount => 0, + tax => 0 + } + ); + + if ( $form->{groupsubtotaldescription} ne "" ) { + push( + @{ $form->{linetotal} }, + $form->format_amount( $myconfig, $subtotal, 2 ) + ); + } + else { + push( @{ $form->{linetotal} }, "" ); + } + $subtotal = 0; + } + + } + else { + + # got last item + if ( $form->{groupsubtotaldescription} ne "" ) { + + if ( $form->{"inventory_accno_id_$i"} + || $form->{"assembly_$i"} ) + { + push( @{ $form->{part} }, "" ); + push( @{ $form->{service} }, NULL ); + } + else { + push( @{ $form->{service} }, "" ); + push( @{ $form->{part} }, NULL ); + } + + for ( + qw( + taxrates runningnumber + number sku qty ship unit + bin serialnumber + requiredate + projectnumber sellprice + listprice netprice + discount discountrate + weight itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + + push( + @{ $form->{description} }, + $form->{groupsubtotaldescription} + ); + + push( + @{ $form->{linetotal} }, + $form->format_amount( $myconfig, $subtotal, 2 ) + ); + push( + @{ $form->{lineitems} }, + { + amount => 0, + tax => 0 + } + ); + } + } + } + } + } + + $tax = 0; + + foreach $item ( sort keys %taxaccounts ) { + if ( $form->round_amount( $taxaccounts{$item}, 2 ) ) { + $tax += $taxamount = $form->round_amount( $taxaccounts{$item}, 2 ); + + push( + @{ $form->{taxbaseinclusive} }, + $form->{"${item}_taxbaseinclusive"} = + $form->round_amount( $taxbase{$item} + $tax, 2 ) + ); + push( + @{ $form->{taxbase} }, + $form->{"${item}_taxbase"} = + $form->format_amount( $myconfig, $taxbase{$item}, 2 ) + ); + push( + @{ $form->{tax} }, + $form->{"${item}_tax"} = + $form->format_amount( $myconfig, $taxamount, 2 ) + ); + + push( @{ $form->{taxdescription} }, + $form->{"${item}_description"} ); + + $form->{"${item}_taxrate"} = + $form->format_amount( $myconfig, $form->{"${item}_rate"} * 100 ); + + push( @{ $form->{taxrate} }, $form->{"${item}_taxrate"} ); + + push( @{ $form->{taxnumber} }, $form->{"${item}_taxnumber"} ); + } + } + + # adjust taxes for lineitems + my $total = 0; + for ( @{ $form->{lineitems} } ) { + $total += $_->{tax}; + } + if ( $form->round_amount( $total, 2 ) != $form->round_amount( $tax, 2 ) ) { + + # get largest amount + for ( reverse sort { $a->{tax} <=> $b->{tax} } @{ $form->{lineitems} } ) + { + + $_->{tax} -= $total - $tax; + last; + } + } + $i = 1; + for ( @{ $form->{lineitems} } ) { + push( + @{ $form->{linetax} }, + $form->format_amount( $myconfig, $_->{tax}, 2, "" ) + ); + } + + for (qw(totalparts totalservices)) { + $form->{$_} = $form->format_amount( $myconfig, $form->{$_}, 2 ); + } + for (qw(totalqty totalship totalweight)) { + $form->{$_} = $form->format_amount( $myconfig, $form->{$_} ); + } + $form->{subtotal} = $form->format_amount( $myconfig, $form->{ordtotal}, 2 ); + $form->{ordtotal} = + ( $form->{taxincluded} ) + ? $form->{ordtotal} + : $form->{ordtotal} + $tax; + + my $c; + if ( $form->{language_code} ne "" ) { + $c = new CP $form->{language_code}; + } + else { + $c = new CP $myconfig->{countrycode}; + } + $c->init; + my $whole; + ( $whole, $form->{decimal} ) = split /\./, $form->{ordtotal}; + $form->{decimal} .= "00"; + $form->{decimal} = substr( $form->{decimal}, 0, 2 ); + + $form->{text_decimal} = $c->num2text( $form->{decimal} * 1 ); + $form->{text_amount} = $c->num2text($whole); + $form->{integer_amount} = $form->format_amount( $myconfig, $whole ); + + # format amounts + $form->{quototal} = $form->{ordtotal} = + $form->format_amount( $myconfig, $form->{ordtotal}, 2 ); + + $form->format_string(qw(text_amount text_decimal)); + + $query = qq| SELECT value FROM defaults WHERE setting_key = 'weightunit'|; - ($form->{weightunit}) = $dbh->selectrow_array($query); - - $dbh->commit; + ( $form->{weightunit} ) = $dbh->selectrow_array($query); -} + $dbh->commit; +} sub assembly_details { - my ($myconfig, $form, $dbh, $id, $oid, $qty) = @_; - - my $sm = ""; - my $spacer; - - $form->{stagger}++; - if ($form->{format} eq 'html') { - $spacer = " " x (3 * ($form->{stagger} - 1)) - if $form->{stagger} > 1; - } - if ($form->{format} =~ /(postscript|pdf)/) { - if ($form->{stagger} > 1) { - $spacer = ($form->{stagger} - 1) * 3; - $spacer = '\rule{'.$spacer.'mm}{0mm}'; - } - } - - # get parts and push them onto the stack - my $sortorder = ""; - - if ($form->{grouppartsgroup}) { - $sortorder = qq|ORDER BY pg.partsgroup, a.id|; - } else { - $sortorder = qq|ORDER BY a.id|; - } - - my $where = ($form->{formname} eq 'work_order') - ? "1 = 1" - : "a.bom = '1'"; - - my $query = qq| + my ( $myconfig, $form, $dbh, $id, $oid, $qty ) = @_; + + my $sm = ""; + my $spacer; + + $form->{stagger}++; + if ( $form->{format} eq 'html' ) { + $spacer = " " x ( 3 * ( $form->{stagger} - 1 ) ) + if $form->{stagger} > 1; + } + if ( $form->{format} =~ /(postscript|pdf)/ ) { + if ( $form->{stagger} > 1 ) { + $spacer = ( $form->{stagger} - 1 ) * 3; + $spacer = '\rule{' . $spacer . 'mm}{0mm}'; + } + } + + # get parts and push them onto the stack + my $sortorder = ""; + + if ( $form->{grouppartsgroup} ) { + $sortorder = qq|ORDER BY pg.partsgroup, a.id|; + } + else { + $sortorder = qq|ORDER BY a.id|; + } + + my $where = + ( $form->{formname} eq 'work_order' ) + ? "1 = 1" + : "a.bom = '1'"; + + my $query = qq| SELECT p.partnumber, p.description, p.unit, a.qty, pg.partsgroup, p.partnumber AS sku, p.assembly, p.id, p.bin @@ -1622,331 +1608,325 @@ sub assembly_details { WHERE $where AND a.id = ? $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - - for (qw(partnumber description partsgroup)) { - $form->{"a_$_"} = $ref->{$_}; - $form->format_string("a_$_"); - } - - if ($form->{grouppartsgroup} && $ref->{partsgroup} ne $sm) { - for (qw( - taxrates number sku unit qty runningnumber ship - bin serialnumber requiredate projectnumber - sellprice listprice netprice discount - discountrate linetotal weight itemnotes) - ) { - - push(@{ $form->{$_} }, ""); - } - $sm = ($form->{"a_partsgroup"}) - ? $form->{"a_partsgroup"} : ""; - push(@{ $form->{description} }, "$spacer$sm"); - - push(@{ $form->{lineitems} }, - { amount => 0, tax => 0 }); - - } - - if ($form->{stagger}) { - - push(@{ $form->{description} }, - qq|$spacer$form->{"a_partnumber"}, |. - qq|$form->{"a_description"}|); - - for (qw( - taxrates number sku runningnumber ship - serialnumber requiredate projectnumber - sellprice listprice netprice discount - discountrate linetotal weight itemnotes) - ) { - - push(@{ $form->{$_} }, "") - } - - } else { - - push(@{ $form->{description} }, - qq|$form->{"a_description"}|); - push(@{ $form->{sku} }, $form->{"a_partnumber"}); - push(@{ $form->{number} }, $form->{"a_partnumber"}); - - for (qw( - taxrates runningnumber ship serialnumber - requiredate projectnumber sellprice listprice - netprice discount discountrate linetotal weight - itemnotes) - ) { - - push(@{ $form->{$_} }, "") - } - - } - - push(@{ $form->{lineitems} }, { amount => 0, tax => 0 }); - - push(@{ $form->{qty} }, $form->format_amount( - $myconfig, $ref->{qty} * $qty)); - - for (qw(unit bin)) { - $form->{"a_$_"} = $ref->{$_}; - $form->format_string("a_$_"); - push(@{ $form->{$_} }, $form->{"a_$_"}); - } - - if ($ref->{assembly} && $form->{formname} eq 'work_order') { - &assembly_details( - $myconfig, $form, $dbh, $ref->{id}, $oid, - $ref->{qty} * $qty); - } - - } - $sth->finish; - - $form->{stagger}--; - -} + my $sth = $dbh->prepare($query); + $sth->execute($id) || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + for (qw(partnumber description partsgroup)) { + $form->{"a_$_"} = $ref->{$_}; + $form->format_string("a_$_"); + } + + if ( $form->{grouppartsgroup} && $ref->{partsgroup} ne $sm ) { + for ( + qw( + taxrates number sku unit qty runningnumber ship + bin serialnumber requiredate projectnumber + sellprice listprice netprice discount + discountrate linetotal weight itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + $sm = ( $form->{"a_partsgroup"} ) ? $form->{"a_partsgroup"} : ""; + push( @{ $form->{description} }, "$spacer$sm" ); + + push( @{ $form->{lineitems} }, { amount => 0, tax => 0 } ); + + } + + if ( $form->{stagger} ) { + + push( + @{ $form->{description} }, + qq|$spacer$form->{"a_partnumber"}, | + . qq|$form->{"a_description"}| + ); + + for ( + qw( + taxrates number sku runningnumber ship + serialnumber requiredate projectnumber + sellprice listprice netprice discount + discountrate linetotal weight itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + + } + else { + + push( @{ $form->{description} }, qq|$form->{"a_description"}| ); + push( @{ $form->{sku} }, $form->{"a_partnumber"} ); + push( @{ $form->{number} }, $form->{"a_partnumber"} ); + + for ( + qw( + taxrates runningnumber ship serialnumber + requiredate projectnumber sellprice listprice + netprice discount discountrate linetotal weight + itemnotes) + ) + { + + push( @{ $form->{$_} }, "" ); + } + + } + + push( @{ $form->{lineitems} }, { amount => 0, tax => 0 } ); + + push( + @{ $form->{qty} }, + $form->format_amount( $myconfig, $ref->{qty} * $qty ) + ); + + for (qw(unit bin)) { + $form->{"a_$_"} = $ref->{$_}; + $form->format_string("a_$_"); + push( @{ $form->{$_} }, $form->{"a_$_"} ); + } + + if ( $ref->{assembly} && $form->{formname} eq 'work_order' ) { + &assembly_details( $myconfig, $form, $dbh, $ref->{id}, $oid, + $ref->{qty} * $qty ); + } + + } + $sth->finish; + + $form->{stagger}--; +} sub project_description { - my ($self, $dbh, $id) = @_; + my ( $self, $dbh, $id ) = @_; - my $query = qq| + my $query = qq| SELECT description FROM project WHERE id = $id|; - ($_) = $dbh->selectrow_array($query); - - $_; + ($_) = $dbh->selectrow_array($query); -} + $_; +} sub get_warehouses { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - # setup warehouses - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + # setup warehouses + my $query = qq| SELECT id, description FROM warehouse ORDER BY 2|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_warehouse} }, $ref; - } - $sth->finish; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_warehouse} }, $ref; + } + $sth->finish; - $dbh->commit; + $dbh->commit; } - sub save_inventory { - my ($self, $myconfig, $form) = @_; - - my ($null, $warehouse_id) = split /--/, $form->{warehouse}; - $warehouse_id *= 1; - - my $ml = ($form->{type} eq 'ship_order') ? -1 : 1; - - my $dbh = $form->{dbh}; - my $sth; - my $wth; - my $serialnumber; - my $ship; - - my ($null, $employee_id) = split /--/, $form->{employee}; - ($null, $employee_id) = $form->get_employee($dbh) if ! $employee_id; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my ( $null, $warehouse_id ) = split /--/, $form->{warehouse}; + $warehouse_id *= 1; + + my $ml = ( $form->{type} eq 'ship_order' ) ? -1 : 1; + + my $dbh = $form->{dbh}; + my $sth; + my $wth; + my $serialnumber; + my $ship; + + my ( $null, $employee_id ) = split /--/, $form->{employee}; + ( $null, $employee_id ) = $form->get_employee($dbh) if !$employee_id; + + $query = qq| SELECT serialnumber, ship FROM orderitems WHERE trans_id = ? AND id = ? FOR UPDATE|; - $sth = $dbh->prepare($query) || $form->dberror($query); + $sth = $dbh->prepare($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT sum(qty) FROM inventory WHERE parts_id = ? AND warehouse_id = ?|; - $wth = $dbh->prepare($query) || $form->dberror($query); - + $wth = $dbh->prepare($query) || $form->dberror($query); + + for my $i ( 1 .. $form->{rowcount} ) { + $form->{"ship_$i"} = 0 unless $form->{"ship_$i"}; - for my $i (1 .. $form->{rowcount}) { - $form->{"ship_$i"} = 0 unless $form->{"ship_$i"}; + $ship = + ( abs( $form->{"ship_$i"} ) > abs( $form->{"qty_$i"} ) ) + ? $form->{"qty_$i"} + : $form->{"ship_$i"}; - $ship = (abs($form->{"ship_$i"}) > abs($form->{"qty_$i"})) - ? $form->{"qty_$i"} - : $form->{"ship_$i"}; - - if ($warehouse_id && $form->{type} eq 'ship_order') { + if ( $warehouse_id && $form->{type} eq 'ship_order' ) { - $wth->execute($form->{"id_$i"}, $warehouse_id) - || $form->dberror; + $wth->execute( $form->{"id_$i"}, $warehouse_id ) + || $form->dberror; - ($qty) = $wth->fetchrow_array; - $wth->finish; + ($qty) = $wth->fetchrow_array; + $wth->finish; - if ($ship > $qty) { - $ship = $qty; - } - } + if ( $ship > $qty ) { + $ship = $qty; + } + } - - if ($ship) { + if ($ship) { - if (!$form->{shippingdate}){ - $form->{shippingdate} = undef; - } + if ( !$form->{shippingdate} ) { + $form->{shippingdate} = undef; + } - $ship *= $ml; - $query = qq| + $ship *= $ml; + $query = qq| INSERT INTO inventory (parts_id, warehouse_id, qty, trans_id, orderitems_id, shippingdate, employee_id) VALUES (?, ?, ?, ?, ?, ?, ?)|; - $sth2 = $dbh->prepare($query); - $sth2->execute( - $form->{"id_$i"}, $warehouse_id, - $ship, $form->{"id"}, - $form->{"orderitems_id_$i"}, - $form->{shippingdate}, - $employee_id - ) || $form->dberror($query); - $sth2->finish; - - # add serialnumber, ship to orderitems - $sth->execute( - $form->{id}, $form->{"orderitems_id_$i"}) - || $form->dberror; - ($serialnumber, $ship) = $sth->fetchrow_array; - $sth->finish; - - $serialnumber .= " " if $serialnumber; - $serialnumber .= qq|$form->{"serialnumber_$i"}|; - $ship += $form->{"ship_$i"}; - - $query = qq| + $sth2 = $dbh->prepare($query); + $sth2->execute( $form->{"id_$i"}, $warehouse_id, $ship, + $form->{"id"}, $form->{"orderitems_id_$i"}, + $form->{shippingdate}, $employee_id ) + || $form->dberror($query); + $sth2->finish; + + # add serialnumber, ship to orderitems + $sth->execute( $form->{id}, $form->{"orderitems_id_$i"} ) + || $form->dberror; + ( $serialnumber, $ship ) = $sth->fetchrow_array; + $sth->finish; + + $serialnumber .= " " if $serialnumber; + $serialnumber .= qq|$form->{"serialnumber_$i"}|; + $ship += $form->{"ship_$i"}; + + $query = qq| UPDATE orderitems SET serialnumber = '$serialnumber', ship = $ship, reqdate = '$form->{shippingdate}' WHERE trans_id = $form->{id} AND id = $form->{"orderitems_id_$i"}|; - $sth2 = $dbh->prepare($query); - $sth2->execute( - $serialnumber, $ship, - $form->{shippingdate}, $form->{id}, - $form->{"orderitems_id_$i"} - ) || $form->dberror($query); - $sth2->finish; - - # update order with ship via - $query = qq| + $sth2 = $dbh->prepare($query); + $sth2->execute( $serialnumber, $ship, $form->{shippingdate}, + $form->{id}, $form->{"orderitems_id_$i"} ) + || $form->dberror($query); + $sth2->finish; + + # update order with ship via + $query = qq| UPDATE oe SET shippingpoint = ?, shipvia = ? WHERE id = ?|; - $sth2 = $dbh->prepare($query); - $sth2->execute( - $form->{shippingpoint}, $form->{shipvia}, - $form->{id} - ) || $form->dberror($query); - $sth2->finish; + $sth2 = $dbh->prepare($query); + $sth2->execute( $form->{shippingpoint}, + $form->{shipvia}, $form->{id} ) + || $form->dberror($query); + $sth2->finish; - # update onhand for parts - $form->update_balance($dbh, - "parts", - "onhand", - qq|id = $form->{"id_$i"}|, - $form->{"ship_$i"} * $ml); + # update onhand for parts + $form->update_balance( + $dbh, "parts", "onhand", + qq|id = $form->{"id_$i"}|, + $form->{"ship_$i"} * $ml + ); - } - } + } + } - my $rc = $dbh->commit; + my $rc = $dbh->commit; - $rc; + $rc; } - sub adj_onhand { - my ($dbh, $form, $ml) = @_; + my ( $dbh, $form, $ml ) = @_; - my $query = qq| + my $query = qq| SELECT oi.parts_id, oi.ship, p.inventory_accno_id, p.assembly FROM orderitems oi JOIN parts p ON (p.id = oi.parts_id) WHERE oi.trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $query = qq| + $query = qq| SELECT sum(p.inventory_accno_id), p.assembly FROM parts p JOIN assembly a ON (a.parts_id = p.id) WHERE a.id = ? GROUP BY p.assembly|; - my $ath = $dbh->prepare($query) || $form->dberror($query); + my $ath = $dbh->prepare($query) || $form->dberror($query); - my $ref; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + my $ref; - if ($ref->{inventory_accno_id} || $ref->{assembly}) { + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { - # do not update if assembly consists of all services - if ($ref->{assembly}) { - $ath->execute($ref->{parts_id}) - || $form->dberror($query); + if ( $ref->{inventory_accno_id} || $ref->{assembly} ) { - my ($inv, $assembly) = $ath->fetchrow_array; - $ath->finish; + # do not update if assembly consists of all services + if ( $ref->{assembly} ) { + $ath->execute( $ref->{parts_id} ) + || $form->dberror($query); - next unless ($inv || $assembly); - - } + my ( $inv, $assembly ) = $ath->fetchrow_array; + $ath->finish; - # adjust onhand in parts table - $form->update_balance($dbh, - "parts", - "onhand", - qq|id = $ref->{parts_id}|, - $ref->{ship} * $ml); - } - } - - $sth->finish; + next unless ( $inv || $assembly ); -} + } + # adjust onhand in parts table + $form->update_balance( + $dbh, "parts", "onhand", + qq|id = $ref->{parts_id}|, + $ref->{ship} * $ml + ); + } + } + + $sth->finish; + +} sub adj_inventory { - my ($dbh, $myconfig, $form) = @_; + my ( $dbh, $myconfig, $form ) = @_; - - # increase/reduce qty in inventory table - my $query = qq| + # increase/reduce qty in inventory table + my $query = qq| SELECT oi.id, oi.parts_id, oi.ship FROM orderitems oi WHERE oi.trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - my $id = $dbh->quote($form->{id}); - $query = qq| + my $id = $dbh->quote( $form->{id} ); + $query = qq| SELECT qty, (SELECT SUM(qty) FROM inventory WHERE trans_id = $id @@ -1954,99 +1934,96 @@ sub adj_inventory { FROM inventory WHERE trans_id = $id AND orderitems_id = ?|; - my $ith = $dbh->prepare($query) || $form->dberror($query); - - my $qty; - my $ml = ($form->{type} =~ /(ship|sales)_order/) ? -1 : 1; - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - - $ith->execute($ref->{id}, $ref->{id}) || $form->dberror($query); - - my $ship = $ref->{ship}; - while (my $inv = $ith->fetchrow_hashref(NAME_lc)) { - - if (($qty = (($inv->{total} * $ml) - $ship)) >= 0) { - $qty = $inv->{qty} * $ml - if ($qty > ($inv->{qty} * $ml)); - - $form->update_balance($dbh, - "inventory", - "qty", - qq|$oid{$myconfig->{dbdriver}} |. - qq|= $inv->{oid}|, - $qty * -1 * $ml); - $ship -= $qty; - } - } - $ith->finish; - - } - $sth->finish; - - # delete inventory entries if qty = 0 - $query = qq| + my $ith = $dbh->prepare($query) || $form->dberror($query); + + my $qty; + my $ml = ( $form->{type} =~ /(ship|sales)_order/ ) ? -1 : 1; + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + $ith->execute( $ref->{id}, $ref->{id} ) || $form->dberror($query); + + my $ship = $ref->{ship}; + while ( my $inv = $ith->fetchrow_hashref(NAME_lc) ) { + + if ( ( $qty = ( ( $inv->{total} * $ml ) - $ship ) ) >= 0 ) { + $qty = $inv->{qty} * $ml + if ( $qty > ( $inv->{qty} * $ml ) ); + + $form->update_balance( + $dbh, "inventory", "qty", + qq|$oid{$myconfig->{dbdriver}} | . qq|= $inv->{oid}|, + $qty * -1 * $ml + ); + $ship -= $qty; + } + } + $ith->finish; + + } + $sth->finish; + + # delete inventory entries if qty = 0 + $query = qq| DELETE FROM inventory WHERE trans_id = ? AND qty = 0|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); } - sub get_inventory { - my ($self, $myconfig, $form) = @_; - - my $where; - my $query; - my $null; - my $fromwarehouse_id; - my $towarehouse_id; - my $var; - - my $dbh = $form->{dbh}; - - if ($form->{partnumber} ne "") { - $var = $dbh->quote($form->like(lc $form->{partnumber})); - $where .= " + my ( $self, $myconfig, $form ) = @_; + + my $where; + my $query; + my $null; + my $fromwarehouse_id; + my $towarehouse_id; + my $var; + + my $dbh = $form->{dbh}; + + if ( $form->{partnumber} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{partnumber} ) ); + $where .= " AND lower(p.partnumber) LIKE '$var'"; - } - if ($form->{description} ne "") { - $var = $dbh->quote($form->like(lc $form->{description})); - $where .= " + } + if ( $form->{description} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= " AND lower(p.description) LIKE '$var'"; - } - if ($form->{partsgroup} ne "") { - ($null, $var) = split /--/, $form->{partsgroup}; - $var = $dbh->quote($var); - $where .= " + } + if ( $form->{partsgroup} ne "" ) { + ( $null, $var ) = split /--/, $form->{partsgroup}; + $var = $dbh->quote($var); + $where .= " AND pg.id = $var"; - } - - - ($null, $fromwarehouse_id) = split /--/, $form->{fromwarehouse}; - $fromwarehouse_id = $dbh->quote($fromwarehouse_id); - - ($null, $towarehouse_id) = split /--/, $form->{towarehouse}; - $towarehouse_id = $dbh->quote($towarehouse_id); - - my %ordinal = ( - partnumber => 2, - description => 3, - partsgroup => 5, - warehouse => 6, - ); - - my @a = (partnumber, warehouse); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - if ($fromwarehouse_id) { - if ($towarehouse_id) { - $where .= " + } + + ( $null, $fromwarehouse_id ) = split /--/, $form->{fromwarehouse}; + $fromwarehouse_id = $dbh->quote($fromwarehouse_id); + + ( $null, $towarehouse_id ) = split /--/, $form->{towarehouse}; + $towarehouse_id = $dbh->quote($towarehouse_id); + + my %ordinal = ( + partnumber => 2, + description => 3, + partsgroup => 5, + warehouse => 6, + ); + + my @a = ( partnumber, warehouse ); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + if ($fromwarehouse_id) { + if ($towarehouse_id) { + $where .= " AND NOT i.warehouse_id = $towarehouse_id"; - } - $query = qq| + } + $query = qq| SELECT p.id, p.partnumber, p.description, sum(i.qty) * 2 AS onhand, sum(i.qty) AS qty, pg.partsgroup, w.description AS warehouse, @@ -2060,9 +2037,10 @@ sub get_inventory { GROUP BY p.id, p.partnumber, p.description, pg.partsgroup, w.description, i.warehouse_id ORDER BY $sortorder|; - } else { - if ($towarehouse_id) { - $query = qq| + } + else { + if ($towarehouse_id) { + $query = qq| SELECT p.id, p.partnumber, p.description, p.onhand, (SELECT SUM(qty) @@ -2076,9 +2054,9 @@ sub get_inventory { WHERE p.onhand > 0 $where UNION|; - } + } - $query .= qq| + $query .= qq| SELECT p.id, p.partnumber, p.description, sum(i.qty) * 2 AS onhand, sum(i.qty) AS qty, pg.partsgroup, w.description AS warehouse, @@ -2092,349 +2070,341 @@ sub get_inventory { GROUP BY p.id, p.partnumber, p.description, pg.partsgroup, w.description, i.warehouse_id ORDER BY $sortorder|; - } - - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{qty} = $ref->{onhand} - $ref->{qty}; - push @{ $form->{all_inventory} }, $ref if $ref->{qty} > 0; - } - $sth->finish; - - $dbh->commit; -} + } + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{qty} = $ref->{onhand} - $ref->{qty}; + push @{ $form->{all_inventory} }, $ref if $ref->{qty} > 0; + } + $sth->finish; + $dbh->commit; +} sub transfer { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); - - my @a = localtime; - $a[5] += 1900; - $a[4]++; - $a[4] = substr("0$a[4]", -2); - $a[3] = substr("0$a[3]", -2); - $shippingdate = "$a[5]$a[4]$a[3]"; - - my %total = (); - - - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + ( $form->{employee}, $form->{employee_id} ) = $form->get_employee($dbh); + + my @a = localtime; + $a[5] += 1900; + $a[4]++; + $a[4] = substr( "0$a[4]", -2 ); + $a[3] = substr( "0$a[3]", -2 ); + $shippingdate = "$a[5]$a[4]$a[3]"; + + my %total = (); + + my $query = qq| INSERT INTO inventory (warehouse_id, parts_id, qty, shippingdate, employee_id) VALUES (?, ?, ?, '$shippingdate', $form->{employee_id})|; - $sth = $dbh->prepare($query) || $form->dberror($query); - - my $qty; - - for my $i (1 .. $form->{rowcount}) { - $qty = $form->parse_amount($myconfig, $form->{"transfer_$i"}); - - $qty = $form->{"qty_$i"} if ($qty > $form->{"qty_$i"}); - - if ($qty > 0) { - # to warehouse - if ($form->{warehouse_id}) { - $sth->execute($form->{warehouse_id}, - $form->{"id_$i"}, $qty, - $shippingdate, $form->{employee_id}) - || $form->dberror; - $sth->finish; - } - - # from warehouse - if ($form->{"warehouse_id_$i"}) { - $sth->execute($form->{"warehouse_id_$i"}, - $form->{"id_$i"}, $qty * -1) - || $form->dberror; - $sth->finish; - } - } - } - - my $rc = $dbh->commit; - $dbh->commit; - - $rc; + $sth = $dbh->prepare($query) || $form->dberror($query); -} + my $qty; + + for my $i ( 1 .. $form->{rowcount} ) { + $qty = $form->parse_amount( $myconfig, $form->{"transfer_$i"} ); + $qty = $form->{"qty_$i"} if ( $qty > $form->{"qty_$i"} ); + + if ( $qty > 0 ) { + + # to warehouse + if ( $form->{warehouse_id} ) { + $sth->execute( $form->{warehouse_id}, $form->{"id_$i"}, $qty, + $shippingdate, $form->{employee_id} ) + || $form->dberror; + $sth->finish; + } + + # from warehouse + if ( $form->{"warehouse_id_$i"} ) { + $sth->execute( $form->{"warehouse_id_$i"}, + $form->{"id_$i"}, $qty * -1 ) + || $form->dberror; + $sth->finish; + } + } + } + + my $rc = $dbh->commit; + $dbh->commit; + + $rc; + +} sub get_soparts { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $id; - my $ref; - - # store required items from selected sales orders - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $id; + my $ref; + + # store required items from selected sales orders + my $query = qq| SELECT p.id, oi.qty - oi.ship AS required, p.assembly FROM orderitems oi JOIN parts p ON (p.id = oi.parts_id) WHERE oi.trans_id = ?|; - my $sth = $dbh->prepare($query) || $form->dberror($query); - - for (my $i = 1; $i <= $form->{rowcount}; $i++) { + my $sth = $dbh->prepare($query) || $form->dberror($query); - if ($form->{"ndx_$i"}) { + for ( my $i = 1 ; $i <= $form->{rowcount} ; $i++ ) { - $sth->execute($form->{"ndx_$i"}); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - &add_items_required( - "", $dbh, $form, $ref->{id}, - $ref->{required}, $ref->{assembly}); - } - $sth->finish; - } + if ( $form->{"ndx_$i"} ) { - } + $sth->execute( $form->{"ndx_$i"} ); - $query = qq|SELECT current_date|; - ($form->{transdate}) = $dbh->selectrow_array($query); - - # foreign exchange rates - &exchangerate_defaults($dbh, $form); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + &add_items_required( "", $dbh, $form, $ref->{id}, + $ref->{required}, $ref->{assembly} ); + } + $sth->finish; + } - $dbh->commit; + } -} + $query = qq|SELECT current_date|; + ( $form->{transdate} ) = $dbh->selectrow_array($query); + + # foreign exchange rates + &exchangerate_defaults( $dbh, $form ); + + $dbh->commit; +} sub add_items_required { - my ($self, $dbh, $form, $parts_id, $required, $assembly) = @_; - - my $query; - my $sth; - my $ref; - - if ($assembly) { - $query = qq| + my ( $self, $dbh, $form, $parts_id, $required, $assembly ) = @_; + + my $query; + my $sth; + my $ref; + + if ($assembly) { + $query = qq| SELECT p.id, a.qty, p.assembly FROM assembly a JOIN parts p ON (p.id = a.parts_id) WHERE a.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - &add_items_required( - "", $dbh, $form, $ref->{id}, - $required * $ref->{qty}, $ref->{assembly}); - } - $sth->finish; - - } else { - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + &add_items_required( "", $dbh, $form, $ref->{id}, + $required * $ref->{qty}, + $ref->{assembly} ); + } + $sth->finish; + + } + else { + + $query = qq| SELECT partnumber, description, lastcost FROM parts WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($parts_id) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - for (keys %$ref) { - $form->{orderitems}{$parts_id}{$_} = $ref->{$_}; - } - $sth->finish; + $sth = $dbh->prepare($query); + $sth->execute($parts_id) || $form->dberror($query); + $ref = $sth->fetchrow_hashref(NAME_lc); + for ( keys %$ref ) { + $form->{orderitems}{$parts_id}{$_} = $ref->{$_}; + } + $sth->finish; - $form->{orderitems}{$parts_id}{required} += $required; + $form->{orderitems}{$parts_id}{required} += $required; - $query = qq| + $query = qq| SELECT pv.partnumber, pv.leadtime, pv.lastcost, pv.curr, pv.vendor_id, v.name FROM partsvendor pv JOIN vendor v ON (v.id = pv.vendor_id) WHERE pv.parts_id = ?|; - $sth = $dbh->prepare($query) || $form->dberror($query); + $sth = $dbh->prepare($query) || $form->dberror($query); - # get cost and vendor - $sth->execute($parts_id); + # get cost and vendor + $sth->execute($parts_id); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - for (keys %$ref) { - $form->{orderitems}{$parts_id}{partsvendor} - {$ref->{vendor_id}}{$_} = $ref->{$_}; - } - } - $sth->finish; - - } + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + for ( keys %$ref ) { + $form->{orderitems}{$parts_id}{partsvendor}{ $ref->{vendor_id} } + {$_} = $ref->{$_}; + } + } + $sth->finish; -} + } +} sub generate_orders { - my ($self, $myconfig, $form) = @_; - - my $i; - my %a; - my $query; - my $sth; - - for ($i = 1; $i <= $form->{rowcount}; $i++) { - for (qw(qty lastcost)) { - $form->{"${_}_$i"} = $form->parse_amount( - $myconfig, $form->{"${_}_$i"}); - } - - if ($form->{"qty_$i"}) { - ($vendor, $vendor_id) = - split /--/, $form->{"vendor_$i"}; - if ($vendor_id) { - $a{$vendor_id}{$form->{"id_$i"}}{qty} - += $form->{"qty_$i"}; - for (qw(curr lastcost)) { - $a{$vendor_id}{$form->{"id_$i"}}{$_} - = $form->{"${_}_$i"}; - } - } - } - } - - # connect to database - my $dbh = $form->{dbh}; - - # foreign exchange rates - &exchangerate_defaults($dbh, $form); - - my $amount; - my $netamount; - my $curr = ""; - my %tax; - my $taxincluded = 0; - my $vendor_id; - - my $description; - my $unit; - - my $sellprice; - - foreach $vendor_id (keys %a) { - - %tax = (); - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $i; + my %a; + my $query; + my $sth; + + for ( $i = 1 ; $i <= $form->{rowcount} ; $i++ ) { + for (qw(qty lastcost)) { + $form->{"${_}_$i"} = + $form->parse_amount( $myconfig, $form->{"${_}_$i"} ); + } + + if ( $form->{"qty_$i"} ) { + ( $vendor, $vendor_id ) = + split /--/, $form->{"vendor_$i"}; + if ($vendor_id) { + $a{$vendor_id}{ $form->{"id_$i"} }{qty} += $form->{"qty_$i"}; + for (qw(curr lastcost)) { + $a{$vendor_id}{ $form->{"id_$i"} }{$_} = $form->{"${_}_$i"}; + } + } + } + } + + # connect to database + my $dbh = $form->{dbh}; + + # foreign exchange rates + &exchangerate_defaults( $dbh, $form ); + + my $amount; + my $netamount; + my $curr = ""; + my %tax; + my $taxincluded = 0; + my $vendor_id; + + my $description; + my $unit; + + my $sellprice; + + foreach $vendor_id ( keys %a ) { + + %tax = (); + + $query = qq| SELECT v.curr, v.taxincluded, t.rate, c.accno FROM vendor v LEFT JOIN vendortax vt ON (v.id = vt.vendor_id) LEFT JOIN tax t ON (t.chart_id = vt.chart_id) LEFT JOIN chart c ON (c.id = t.chart_id) WHERE v.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($vendor_id) || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $curr = $ref->{curr}; - $taxincluded = $ref->{taxincluded}; - $tax{$ref->{accno}} = $ref->{rate}; - } - $sth->finish; - - $curr ||= $form->{defaultcurrency}; - $taxincluded *= 1; - - my $uid = localtime; - $uid .= "$$"; - - # TODO: Make this function insert as much as possible - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute($vendor_id) || $form->dberror($query); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $curr = $ref->{curr}; + $taxincluded = $ref->{taxincluded}; + $tax{ $ref->{accno} } = $ref->{rate}; + } + $sth->finish; + + $curr ||= $form->{defaultcurrency}; + $taxincluded *= 1; + + my $uid = localtime; + $uid .= "$$"; + + # TODO: Make this function insert as much as possible + $query = qq| INSERT INTO oe (ordnumber) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); - - $query = qq|SELECT id FROM oe WHERE ordnumber = '$uid'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - my ($id) = $sth->fetchrow_array; - $sth->finish; - - $amount = 0; - $netamount = 0; - - foreach my $parts_id (keys %{ $a{$vendor_id} }) { - - if (($form->{$curr} - * $form->{$a{$vendor_id}{$parts_id}{curr}}) > 0) { - - $sellprice = $a{$vendor_id}{$parts_id}{lastcost} - / $form->{$curr} - * $form->{$a{$vendor_id}{$parts_id} - {curr}}; - } else { - $sellprice = - $a{$vendor_id}{$parts_id}{lastcost}; - } - $sellprice = $form->round_amount($sellprice, 2); - - my $linetotal = $form->round_amount( - $sellprice * $a{$vendor_id}{$parts_id}{qty}, 2); - - $query = qq| + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM oe WHERE ordnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + my ($id) = $sth->fetchrow_array; + $sth->finish; + + $amount = 0; + $netamount = 0; + + foreach my $parts_id ( keys %{ $a{$vendor_id} } ) { + + if ( ( $form->{$curr} * $form->{ $a{$vendor_id}{$parts_id}{curr} } ) + > 0 ) + { + + $sellprice = + $a{$vendor_id}{$parts_id}{lastcost} / $form->{$curr} * + $form->{ $a{$vendor_id}{$parts_id}{curr} }; + } + else { + $sellprice = $a{$vendor_id}{$parts_id}{lastcost}; + } + $sellprice = $form->round_amount( $sellprice, 2 ); + + my $linetotal = + $form->round_amount( $sellprice * $a{$vendor_id}{$parts_id}{qty}, + 2 ); + + $query = qq| SELECT p.description, p.unit, c.accno FROM parts p LEFT JOIN partstax pt ON (p.id = pt.parts_id) LEFT JOIN chart c ON (c.id = pt.chart_id) WHERE p.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($parts_id) || $form->dberror($query); - - my $rate = 0; - my $taxes = ''; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $description = $ref->{description}; - $unit = $ref->{unit}; - $rate += $tax{$ref->{accno}}; - $taxes .= "$ref->{accno} "; - } - $sth->finish; - chop $taxes; - my @taxaccounts = Tax::init_taxes($form, $taxes); - - $netamount += $linetotal; - if ($taxincluded) { - $amount += $linetotal; - } else { - $amount += $form->round_amount( - Tax::apply_taxes(\@taxaccounts, $form, - $linetotal), 2); - } - - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute($parts_id) || $form->dberror($query); + + my $rate = 0; + my $taxes = ''; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $description = $ref->{description}; + $unit = $ref->{unit}; + $rate += $tax{ $ref->{accno} }; + $taxes .= "$ref->{accno} "; + } + $sth->finish; + chop $taxes; + my @taxaccounts = Tax::init_taxes( $form, $taxes ); + + $netamount += $linetotal; + if ($taxincluded) { + $amount += $linetotal; + } + else { + $amount += + $form->round_amount( + Tax::apply_taxes( \@taxaccounts, $form, $linetotal ), 2 ); + } + + $query = qq| INSERT INTO orderitems (trans_id, parts_id, description, qty, ship, sellprice, unit) VALUES (?, ?, ?, ?, 0, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $id, $parts_id, $description, - $a{vendor_id}{parts_id}{qty}, $sellprice, - $unit - ) || $form->dberror($query); - - } - - my $ordnumber = $form->update_defaults($myconfig, 'ponumber'); - - my $null; - my $employee_id; - my $department_id; - - ($null, $employee_id) = $form->get_employee($dbh); - ($null, $department_id) = split /--/, $form->{department}; - $department_id *= 1; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $id, $parts_id, $description, + $a{vendor_id}{parts_id}{qty}, + $sellprice, $unit ) + || $form->dberror($query); + + } + + my $ordnumber = $form->update_defaults( $myconfig, 'ponumber' ); + + my $null; + my $employee_id; + my $department_id; + + ( $null, $employee_id ) = $form->get_employee($dbh); + ( $null, $department_id ) = split /--/, $form->{department}; + $department_id *= 1; + + $query = qq| UPDATE oe SET ordnumber = ?, transdate = current_date, @@ -2448,152 +2418,149 @@ sub generate_orders { department_id = ?, ponumber = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $ordnumber, $vendor_id, $amount, $netamount, - $taxincluded, $curr, $employee_id, - $department_id, $form->{ponumber}, $id - ) || $form->dberror($query); - - } - - my $rc = $dbh->commit; - - $rc; - -} + $sth = $dbh->prepare($query); + $sth->execute( + $ordnumber, $vendor_id, $amount, + $netamount, $taxincluded, $curr, + $employee_id, $department_id, $form->{ponumber}, + $id + ) || $form->dberror($query); + } + + my $rc = $dbh->commit; + + $rc; + +} sub consolidate_orders { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $i; - my $id; - my $ref; - my %oe = (); - - my $query = qq|SELECT * FROM oe WHERE id = ?|; - my $sth = $dbh->prepare($query) || $form->dberror($query); - - for ($i = 1; $i <= $form->{rowcount}; $i++) { - # retrieve order - if ($form->{"ndx_$i"}) { - $sth->execute($form->{"ndx_$i"}); - - $ref = $sth->fetchrow_hashref(NAME_lc); - $ref->{ndx} = $i; - $oe{oe}{$ref->{curr}}{$ref->{id}} = $ref; - - $oe{vc}{$ref->{curr}}{$ref->{"$form->{vc}_id"}}++; - $sth->finish; - } - } - - $query = qq|SELECT * FROM orderitems WHERE trans_id = ?|; - $sth = $dbh->prepare($query) || $form->dberror($query); - - foreach $curr (keys %{ $oe{oe} }) { - - foreach $id (sort { - $oe{oe}{$curr}{$a}->{ndx} - <=> $oe{oe}{$curr}{$b}->{ndx} } - keys %{ $oe{oe}{$curr} }) { - - # retrieve order - $vc_id = $oe{oe}{$curr}{$id}->{"$form->{vc}_id"}; - - if ($oe{vc}{$oe{oe}{$curr}{$id}->{curr}}{$vc_id} > 1) { - - push @{ $oe{orders}{$curr}{$vc_id} }, $id; - - $sth->execute($id); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $oe{orderitems}{$curr}{$id} }, - $ref; - } - $sth->finish; - - } - } - } - - - my $ordnumber = $form->{ordnumber}; - my $numberfld = ($form->{vc} eq 'customer') ? 'sonumber' : 'ponumber'; - - my ($department, $department_id) = $form->{department}; - $department_id *= 1; - - my $uid = localtime; - $uid .= "$$"; - - my @orderitems = (); - - foreach $curr (keys %{ $oe{orders} }) { - - foreach $vc_id (sort { - $a <=> $b - } keys %{ $oe{orders}{$curr} }) { - - # the orders - @orderitems = (); - $form->{customer_id} = $form->{vendor_id} = 0; - $form->{"$form->{vc}_id"} = $vc_id; - $amount = 0; - $netamount = 0; - - foreach $id (@{ $oe{orders}{$curr}{$vc_id} }) { - - # header - $ref = $oe{oe}{$curr}{$id}; - - $amount += $ref->{amount}; - $netamount += $ref->{netamount}; - - $id = $dbh->quore($id); - foreach $item - (@{ $oe{orderitems}{$curr}{$id} }) { - - push @orderitems, $item; - } - - # close order - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + # connect to database + my $dbh = $form->{dbh}; + + my $i; + my $id; + my $ref; + my %oe = (); + + my $query = qq|SELECT * FROM oe WHERE id = ?|; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + for ( $i = 1 ; $i <= $form->{rowcount} ; $i++ ) { + + # retrieve order + if ( $form->{"ndx_$i"} ) { + $sth->execute( $form->{"ndx_$i"} ); + + $ref = $sth->fetchrow_hashref(NAME_lc); + $ref->{ndx} = $i; + $oe{oe}{ $ref->{curr} }{ $ref->{id} } = $ref; + + $oe{vc}{ $ref->{curr} }{ $ref->{"$form->{vc}_id"} }++; + $sth->finish; + } + } + + $query = qq|SELECT * FROM orderitems WHERE trans_id = ?|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + foreach $curr ( keys %{ $oe{oe} } ) { + + foreach $id ( + sort { $oe{oe}{$curr}{$a}->{ndx} <=> $oe{oe}{$curr}{$b}->{ndx} } + keys %{ $oe{oe}{$curr} } + ) + { + + # retrieve order + $vc_id = $oe{oe}{$curr}{$id}->{"$form->{vc}_id"}; + + if ( $oe{vc}{ $oe{oe}{$curr}{$id}->{curr} }{$vc_id} > 1 ) { + + push @{ $oe{orders}{$curr}{$vc_id} }, $id; + + $sth->execute($id); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $oe{orderitems}{$curr}{$id} }, $ref; + } + $sth->finish; + + } + } + } + + my $ordnumber = $form->{ordnumber}; + my $numberfld = ( $form->{vc} eq 'customer' ) ? 'sonumber' : 'ponumber'; + + my ( $department, $department_id ) = $form->{department}; + $department_id *= 1; + + my $uid = localtime; + $uid .= "$$"; + + my @orderitems = (); + + foreach $curr ( keys %{ $oe{orders} } ) { + + foreach $vc_id ( sort { $a <=> $b } keys %{ $oe{orders}{$curr} } ) { + + # the orders + @orderitems = (); + $form->{customer_id} = $form->{vendor_id} = 0; + $form->{"$form->{vc}_id"} = $vc_id; + $amount = 0; + $netamount = 0; + + foreach $id ( @{ $oe{orders}{$curr}{$vc_id} } ) { + + # header + $ref = $oe{oe}{$curr}{$id}; + + $amount += $ref->{amount}; + $netamount += $ref->{netamount}; + + $id = $dbh->quore($id); + foreach $item ( @{ $oe{orderitems}{$curr}{$id} } ) { + + push @orderitems, $item; + } + + # close order + $query = qq| UPDATE oe SET closed = '1' WHERE id = $id|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - # reset shipped - $query = qq| + # reset shipped + $query = qq| UPDATE orderitems SET ship = 0 WHERE trans_id = $id|; - $dbh->do($query) || $form->dberror($query); - } + $dbh->do($query) || $form->dberror($query); + } - $ordnumber ||= $form->update_defaults( - $myconfig, $numberfld, $dbh); + $ordnumber ||= + $form->update_defaults( $myconfig, $numberfld, $dbh ); - #fixme: Change this - $query = qq| + #fixme: Change this + $query = qq| INSERT INTO oe (ordnumber) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM oe WHERE ordnumber = '$uid'|; - ($id) = $dbh->selectrow_array($query); + ($id) = $dbh->selectrow_array($query); + + $ref->{employee_id} *= 1; - $ref->{employee_id} *= 1; - - $query = qq| + $query = qq| UPDATE oe SET - ordnumber = |.$dbh->quote($ordnumber).qq|, + ordnumber = | . $dbh->quote($ordnumber) . qq|, transdate = current_date, vendor_id = ?, customer_id = ?, @@ -2611,24 +2578,28 @@ sub consolidate_orders { ponumber = ?, department_id = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute ( - $form->{vendor_id}, $form->{customer_id}, $amount, $netamount, - $form->{reqdate}, $form->{taxincluded}, $form->{shippingpoint}, - $form->{notes}, $curr, $ref->{employee_id}, $form->{intnotes}, - $form->{shipvia}, $ref->{language_code}, $form->{po_number}, - $department_id, $id - ) || $form->dberror($query); - - - # add items - foreach $item (@orderitems) { - for (qw( - qty sellprice discount project_id ship) - ) { - $item->{$_} *= 1; - } - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $form->{vendor_id}, $form->{customer_id}, + $amount, $netamount, + $form->{reqdate}, $form->{taxincluded}, + $form->{shippingpoint}, $form->{notes}, + $curr, $ref->{employee_id}, + $form->{intnotes}, $form->{shipvia}, + $ref->{language_code}, $form->{po_number}, + $department_id, $id + ) || $form->dberror($query); + + # add items + foreach $item (@orderitems) { + for ( + qw( + qty sellprice discount project_id ship) + ) + { + $item->{$_} *= 1; + } + $query = qq| INSERT INTO orderitems (trans_id, parts_id, description, qty, sellprice, discount, unit, reqdate, @@ -2636,27 +2607,25 @@ sub consolidate_orders { VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $id, $item->{parts_id}, $item->{description}, - $item->{qty}, $item->{sellprice}, - $item->{discount}, $item->{unit}, - $form->{reqdate}, $item->{project_id}, - $item->{ship}, $item->{serialnumber}, - $item->{notes} - ) || $form->dberror($query); - - } - } - } - - - $rc = $dbh->commit; - - $rc; - -} + $sth = $dbh->prepare($query); + $sth->execute( + $id, $item->{parts_id}, + $item->{description}, $item->{qty}, + $item->{sellprice}, $item->{discount}, + $item->{unit}, $form->{reqdate}, + $item->{project_id}, $item->{ship}, + $item->{serialnumber}, $item->{notes} + ) || $form->dberror($query); + + } + } + } + + $rc = $dbh->commit; + $rc; + +} 1; diff --git a/LedgerSMB/OP.pm b/LedgerSMB/OP.pm index 13f9da01..3a07f036 100644 --- a/LedgerSMB/OP.pm +++ b/LedgerSMB/OP.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -35,37 +35,36 @@ package OP; sub overpayment { - my ($self, $myconfig, $form, $dbh, $amount, $ml) = @_; - - my $fxamount = $form->round_amount($amount * $form->{exchangerate}, 2); - my ($paymentaccno) = split /--/, $form->{account}; + my ( $self, $myconfig, $form, $dbh, $amount, $ml ) = @_; + + my $fxamount = $form->round_amount( $amount * $form->{exchangerate}, 2 ); + my ($paymentaccno) = split /--/, $form->{account}; - my ($null, $department_id) = split /--/, $form->{department}; - $department_id *= 1; + my ( $null, $department_id ) = split /--/, $form->{department}; + $department_id *= 1; - my $uid = localtime; - $uid .= "$$"; + my $uid = localtime; + $uid .= "$$"; - # add AR/AP header transaction with a payment - my $login = $dbh->quote($form->{login}); - $query = qq| + # add AR/AP header transaction with a payment + my $login = $dbh->quote( $form->{login} ); + $query = qq| INSERT INTO $form->{arap} (invnumber, employee_id) VALUES ('$uid', (SELECT id FROM employee WHERE login = $login))|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq|SELECT id FROM $form->{arap} WHERE invnumber = '$uid'|; - ($uid) = $dbh->selectrow_array($query); + $query = qq|SELECT id FROM $form->{arap} WHERE invnumber = '$uid'|; + ($uid) = $dbh->selectrow_array($query); - my $invnumber = $form->{invnumber}; - $invnumber = $form->update_defaults( - $myconfig, - ($form->{arap} eq 'ar') - ? "sinumber" - : "vinumber", - $dbh) unless $invnumber; + my $invnumber = $form->{invnumber}; + $invnumber = + $form->update_defaults( $myconfig, ( $form->{arap} eq 'ar' ) + ? "sinumber" + : "vinumber", $dbh ) + unless $invnumber; - $query = qq| + $query = qq| UPDATE $form->{arap} set invnumber = ?, $form->{vc}_id = ?, @@ -78,63 +77,64 @@ sub overpayment { curr = ?, department_id = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $invnumber, $form->{"$form->{vc}_id"}, $form->{datepaid}, - $form->{datepaid}, $form->{datepaid}, $fxamount, - $form->{currency}, $department_id, $uid - ) || $form->dberror($query); - - # add AR/AP - ($accno) = split /--/, $form->{$form->{ARAP}}; - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $invnumber, $form->{"$form->{vc}_id"}, + $form->{datepaid}, $form->{datepaid}, + $form->{datepaid}, $fxamount, + $form->{currency}, $department_id, + $uid + ) || $form->dberror($query); + + # add AR/AP + ($accno) = split /--/, $form->{ $form->{ARAP} }; + + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute($uid, $accno, $form->{datepaid}, $fxamount * $ml) - || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $uid, $accno, $form->{datepaid}, $fxamount * $ml ) + || $form->dberror($query); - # add payment - $query = qq| + # add payment + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount, source, memo) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $uid, $paymentaccno, $form->{datepaid}, $amount * $ml * -1, - $form->{source}, $form->{memo} - )|| $form->dberror($query); - - # add exchangerate difference - if ($fxamount != $amount) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $uid, $paymentaccno, $form->{datepaid}, $amount * $ml * -1, + $form->{source}, $form->{memo} ) + || $form->dberror($query); + + # add exchangerate difference + if ( $fxamount != $amount ) { + $query = qq| INSERT INTO acc_trans (trans_id, chart_id, transdate, amount, cleared, fx_transaction, source) VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, '1', '1', ?)|; - $sth = $dbh->prepare($query); - $sth->execute($uid, $paymentaccno, $form->{datepaid}, - ($fxamount - $amount) * $ml * -1, $form->{source} - ) || $form->dberror($query); - } - - my %audittrail = ( - tablename => $form->{arap}, - reference => $invnumber, - formname => - ($form->{arap} eq 'ar') - ? 'deposit' - : 'pre-payment', - action => 'posted', - id => $uid ); - - $form->audittrail($dbh, "", \%audittrail); - -} + $sth = $dbh->prepare($query); + $sth->execute( $uid, $paymentaccno, $form->{datepaid}, + ( $fxamount - $amount ) * $ml * -1, + $form->{source} ) + || $form->dberror($query); + } + + my %audittrail = ( + tablename => $form->{arap}, + reference => $invnumber, + formname => ( $form->{arap} eq 'ar' ) + ? 'deposit' + : 'pre-payment', + action => 'posted', + id => $uid + ); + $form->audittrail( $dbh, "", \%audittrail ); + +} 1; diff --git a/LedgerSMB/PE.pm b/LedgerSMB/PE.pm index 099f94ce..209f6767 100644 --- a/LedgerSMB/PE.pm +++ b/LedgerSMB/PE.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -34,61 +34,62 @@ package PE; - sub projects { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - $form->{sort} = "projectnumber" unless $form->{sort}; - my @a = ($form->{sort}); - my %ordinal = ( projectnumber => 2, - description => 3, - startdate => 4, - enddate => 5, - ); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $query; - my $where = "WHERE 1=1"; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + $form->{sort} = "projectnumber" unless $form->{sort}; + my @a = ( $form->{sort} ); + my %ordinal = ( + projectnumber => 2, + description => 3, + startdate => 4, + enddate => 5, + ); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $query; + my $where = "WHERE 1=1"; + + $query = qq| SELECT pr.*, c.name FROM project pr LEFT JOIN customer c ON (c.id = pr.customer_id)|; - if ($form->{type} eq 'job') { - $where .= qq| AND pr.id NOT IN (SELECT DISTINCT id + if ( $form->{type} eq 'job' ) { + $where .= qq| AND pr.id NOT IN (SELECT DISTINCT id FROM parts WHERE project_id > 0)|; - } - - my $var; - if ($form->{projectnumber} ne "") { - $var = $dbh->quote($form->like(lc $form->{projectnumber})); - $where .= " AND lower(pr.projectnumber) LIKE $var"; - } - if ($form->{description} ne "") { - $var = $dbh->quote($form->like(lc $form->{description})); - $where .= " AND lower(pr.description) LIKE $var"; - } - - ($form->{startdatefrom}, $form->{startdateto}) - = $form->from_to( - $form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - if ($form->{startdatefrom}) { - $where .= " AND (pr.startdate IS NULL OR pr.startdate >= ". - $dbh->quote($form->{startdatefrom}).")"; - } - if ($form->{startdateto}) { - $where .= " AND (pr.startdate IS NULL OR pr.startdate <= ". - $dbh->quote($form->{startdateto}).")"; - } - - if ($form->{status} eq 'orphaned') { - $where .= qq| AND pr.id NOT IN (SELECT DISTINCT project_id + } + + my $var; + if ( $form->{projectnumber} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{projectnumber} ) ); + $where .= " AND lower(pr.projectnumber) LIKE $var"; + } + if ( $form->{description} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= " AND lower(pr.description) LIKE $var"; + } + + ( $form->{startdatefrom}, $form->{startdateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + if ( $form->{startdatefrom} ) { + $where .= + " AND (pr.startdate IS NULL OR pr.startdate >= " + . $dbh->quote( $form->{startdatefrom} ) . ")"; + } + if ( $form->{startdateto} ) { + $where .= + " AND (pr.startdate IS NULL OR pr.startdate <= " + . $dbh->quote( $form->{startdateto} ) . ")"; + } + + if ( $form->{status} eq 'orphaned' ) { + $where .= qq| AND pr.id NOT IN (SELECT DISTINCT project_id FROM acc_trans WHERE project_id > 0 UNION @@ -105,66 +106,64 @@ sub projects { WHERE project_id > 0) |; - } - if ($form->{status} eq 'active') { - $where .= qq| + } + if ( $form->{status} eq 'active' ) { + $where .= qq| AND (pr.enddate IS NULL OR pr.enddate >= current_date)|; - } - if ($form->{status} eq 'inactive') { - $where .= qq| AND pr.enddate <= current_date|; - } + } + if ( $form->{status} eq 'inactive' ) { + $where .= qq| AND pr.enddate <= current_date|; + } - $query .= qq| + $query .= qq| $where ORDER BY $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $i = 0; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_project} }, $ref; - $i++; - } + my $i = 0; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_project} }, $ref; + $i++; + } - $sth->finish; - $dbh->commit; - - $i; + $sth->finish; + $dbh->commit; -} + $i; +} sub get_project { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; - my $dbh = $form->{dbh}; + my $query; + my $sth; + my $ref; + my $where; - my $query; - my $sth; - my $ref; - my $where; - - if ($form->{id}) { + if ( $form->{id} ) { - - $query = qq| + $query = qq| SELECT pr.*, c.name AS customer FROM project pr LEFT JOIN customer c ON (c.id = pr.customer_id) WHERE pr.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - - for (keys %$ref) { $form->{$_} = $ref->{$_} } + $ref = $sth->fetchrow_hashref(NAME_lc); - $sth->finish; + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - # check if it is orphaned - $query = qq| + $sth->finish; + + # check if it is orphaned + $query = qq| SELECT count(*) FROM acc_trans WHERE project_id = ? @@ -180,176 +179,170 @@ sub get_project { SELECT count(*) FROM jcitems WHERE project_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $form->{id}, $form->{id}, $form->{id} - )|| $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $form->{id}, $form->{id}, $form->{id} ) + || $form->dberror($query); - my $count; - while (($count) = $sth->fetchrow_array) { - $form->{orphaned} += $count; - } - $sth->finish; - $form->{orphaned} = !$form->{orphaned}; - } + my $count; + while ( ($count) = $sth->fetchrow_array ) { + $form->{orphaned} += $count; + } + $sth->finish; + $form->{orphaned} = !$form->{orphaned}; + } - PE->get_customer($myconfig, $form, $dbh); + PE->get_customer( $myconfig, $form, $dbh ); - $form->run_custom_queries('project', 'SELECT'); + $form->run_custom_queries( 'project', 'SELECT' ); - $dbh->commit; + $dbh->commit; } - sub save_project { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - $form->{customer_id} ||= undef; - - $form->{projectnumber} - = $form->update_defaults($myconfig, "projectnumber", $dbh) - unless $form->{projectnumber}; - my $enddate; - my $startdate; - $enddate = $form->{enddate} if $form->{enddate}; - $startdate = $form->{startdate} if $form->{startdate}; - - if ($form->{id}) { - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + $form->{customer_id} ||= undef; + + $form->{projectnumber} = + $form->update_defaults( $myconfig, "projectnumber", $dbh ) + unless $form->{projectnumber}; + my $enddate; + my $startdate; + $enddate = $form->{enddate} if $form->{enddate}; + $startdate = $form->{startdate} if $form->{startdate}; + + if ( $form->{id} ) { + + $query = qq| UPDATE project SET projectnumber = ?, description = ?, startdate = ?, enddate = ?, customer_id = ? - WHERE id = |.$dbh->quote($form->{id}); - } else { - - $query = qq| + WHERE id = | . $dbh->quote( $form->{id} ); + } + else { + + $query = qq| INSERT INTO project (projectnumber, description, startdate, enddate, customer_id) VALUES (?, ?, ?, ?, ?)|; - } - $sth = $dbh->prepare($query); - $sth->execute( - $form->{projectnumber}, $form->{description}, - $startdate, $enddate, $form->{customer_id} - ) || $form->dberror($query); - $form->run_custom_queries('project', 'UPDATE'); - - $dbh->commit; + } + $sth = $dbh->prepare($query); + $sth->execute( $form->{projectnumber}, + $form->{description}, $startdate, $enddate, $form->{customer_id} ) + || $form->dberror($query); + $form->run_custom_queries( 'project', 'UPDATE' ); -} + $dbh->commit; +} sub list_stock { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; - my $var; - my $where = "1 = 1"; + my $var; + my $where = "1 = 1"; - if ($form->{status} eq 'active') { - $where = qq| + if ( $form->{status} eq 'active' ) { + $where = qq| (pr.enddate IS NULL OR pr.enddate >= current_date) AND pr.completed < pr.production|; - } - if ($form->{status} eq 'inactive') { - $where = qq|pr.completed = pr.production|; - } - - if ($form->{projectnumber}) { - $var = $dbh->quote($form->like(lc $form->{projectnumber})); - $where .= " AND lower(pr.projectnumber) LIKE $var"; - } - - if ($form->{description}) { - $var = $dbh->quote($form->like(lc $form->{description})); - $where .= " AND lower(pr.description) LIKE $var"; - } - - $form->{sort} = "projectnumber" unless $form->{sort}; - my @a = ($form->{sort}); - my %ordinal = ( projectnumber => 2, description => 3 ); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $query = qq| + } + if ( $form->{status} eq 'inactive' ) { + $where = qq|pr.completed = pr.production|; + } + + if ( $form->{projectnumber} ) { + $var = $dbh->quote( $form->like( lc $form->{projectnumber} ) ); + $where .= " AND lower(pr.projectnumber) LIKE $var"; + } + + if ( $form->{description} ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= " AND lower(pr.description) LIKE $var"; + } + + $form->{sort} = "projectnumber" unless $form->{sort}; + my @a = ( $form->{sort} ); + my %ordinal = ( projectnumber => 2, description => 3 ); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $query = qq| SELECT pr.*, p.partnumber FROM project pr JOIN parts p ON (p.id = pr.parts_id) WHERE $where ORDER BY $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_project} }, $ref; - } - $sth->finish; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_project} }, $ref; + } + $sth->finish; - $query = qq|SELECT current_date|; - ($form->{stockingdate}) = $dbh->selectrow_array($query) - if !$form->{stockingdate}; - - $dbh->commit; - -} + $query = qq|SELECT current_date|; + ( $form->{stockingdate} ) = $dbh->selectrow_array($query) + if !$form->{stockingdate}; + $dbh->commit; + +} sub jobs { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - $form->{sort} = "projectnumber" unless $form->{sort}; - my @a = ($form->{sort}); - my %ordinal = (projectnumber => 2, description => 3, startdate => 4); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + $form->{sort} = "projectnumber" unless $form->{sort}; + my @a = ( $form->{sort} ); + my %ordinal = ( projectnumber => 2, description => 3, startdate => 4 ); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $query = qq| SELECT pr.*, p.partnumber, p.onhand, c.name FROM project pr JOIN parts p ON (p.id = pr.parts_id) LEFT JOIN customer c ON (c.id = pr.customer_id) WHERE 1=1|; - if ($form->{projectnumber} ne "") { - $var = $dbh->quote($form->like(lc $form->{projectnumber})); - $query .= " AND lower(pr.projectnumber) LIKE $var"; - } - if ($form->{description} ne "") { - $var = $dbh->quote($form->like(lc $form->{description})); - $query .= " AND lower(pr.description) LIKE $var"; - } - - ($form->{startdatefrom}, $form->{startdateto}) - = $form->from_to($form->{year}, $form->{month}, - $form->{interval}) - if $form->{year} && $form->{month}; - - if ($form->{startdatefrom}) { - $query .= " AND pr.startdate >= ". - $dbh->quote($form->{startdatefrom}); - } - if ($form->{startdateto}) { - $query .= " AND pr.startdate <= ". - $dbh->quote($form->{startdateto}); - } - - if ($form->{status} eq 'active') { - $query .= qq| AND NOT pr.production = pr.completed|; - } - if ($form->{status} eq 'inactive') { - $query .= qq| AND pr.production = pr.completed|; - } - if ($form->{status} eq 'orphaned') { - $query .= qq| + if ( $form->{projectnumber} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{projectnumber} ) ); + $query .= " AND lower(pr.projectnumber) LIKE $var"; + } + if ( $form->{description} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $query .= " AND lower(pr.description) LIKE $var"; + } + + ( $form->{startdatefrom}, $form->{startdateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + if ( $form->{startdatefrom} ) { + $query .= + " AND pr.startdate >= " . $dbh->quote( $form->{startdatefrom} ); + } + if ( $form->{startdateto} ) { + $query .= " AND pr.startdate <= " . $dbh->quote( $form->{startdateto} ); + } + + if ( $form->{status} eq 'active' ) { + $query .= qq| AND NOT pr.production = pr.completed|; + } + if ( $form->{status} eq 'inactive' ) { + $query .= qq| AND pr.production = pr.completed|; + } + if ( $form->{status} eq 'orphaned' ) { + $query .= qq| AND pr.completed = 0 AND (pr.id NOT IN (SELECT DISTINCT project_id @@ -364,42 +357,41 @@ sub jobs { FROM jcitems WHERE project_id > 0) )|; - } + } - $query .= qq| + $query .= qq| ORDER BY $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_project} }, $ref; - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_project} }, $ref; + } - $sth->finish; - - $dbh->commit; - -} + $sth->finish; + $dbh->commit; + +} sub get_job { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - # connect to database - my $dbh = $form->{dbh}; + # connect to database + my $dbh = $form->{dbh}; - my $query; - my $sth; - my $ref; + my $query; + my $sth; + my $ref; - if ($form->{id}) { - $query = qq| + if ( $form->{id} ) { + $query = qq| SELECT value FROM defaults WHERE setting_key = 'weightunit'|; - ($form->{weightunit}) = $dbh->selectrow_array($query); + ( $form->{weightunit} ) = $dbh->selectrow_array($query); - $query = qq| + $query = qq| SELECT pr.*, p.partnumber, p.description AS partdescription, p.unit, p.listprice, p.sellprice, p.priceupdate, @@ -413,25 +405,27 @@ sub get_job { LEFT JOIN chart ch ON (ch.id = p.income_accno_id) LEFT JOIN customer c ON (c.id = pr.customer_id) LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) - WHERE pr.id = |.$dbh->quote($form->{id}); - } else { - $query = qq| + WHERE pr.id = | . $dbh->quote( $form->{id} ); + } + else { + $query = qq| SELECT value, current_date AS startdate FROM defaults WHERE setting_key = 'weightunit'|; - } + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - $ref = $sth->fetchrow_hashref(NAME_lc); - - for (keys %$ref) { $form->{$_} = $ref->{$_} } + $sth->finish; - $sth->finish; + if ( $form->{id} ) { - if ($form->{id}) { - # check if it is orphaned - $query = qq| + # check if it is orphaned + $query = qq| SELECT count(*) FROM invoice WHERE project_id = ? @@ -443,165 +437,167 @@ sub get_job { SELECT count(*) FROM jcitems WHERE project_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{id}, $form->{id}, $form->{id} - )|| $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id}, $form->{id}, $form->{id} ) + || $form->dberror($query); - my $count; + my $count; - my $count; - while (($count) = $sth->fetchrow_array) { - $form->{orphaned} += $count; - } - $sth->finish; + my $count; + while ( ($count) = $sth->fetchrow_array ) { + $form->{orphaned} += $count; + } + $sth->finish; - } + } - $form->{orphaned} = !$form->{orphaned}; - - $query = qq| + $form->{orphaned} = !$form->{orphaned}; + + $query = qq| SELECT accno, description, link FROM chart WHERE link LIKE ? ORDER BY accno|; - $sth = $dbh->prepare($query); - $sth->execute('%IC%') || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - for (split /:/, $ref->{link}) { - if (/IC/) { - push @{ $form->{IC_links}{$_} }, - { accno => $ref->{accno}, - description => $ref->{description} }; - } - } - } - $sth->finish; - - if ($form->{id}) { - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute('%IC%') || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + for ( split /:/, $ref->{link} ) { + if (/IC/) { + push @{ $form->{IC_links}{$_} }, + { + accno => $ref->{accno}, + description => $ref->{description} + }; + } + } + } + $sth->finish; + + if ( $form->{id} ) { + $query = qq| SELECT ch.accno FROM parts p JOIN partstax pt ON (pt.parts_id = p.id) JOIN chart ch ON (pt.chart_id = ch.id) WHERE p.id = ?|; - - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{amount}{$ref->{accno}} = $ref->{accno}; - } - $sth->finish; - } - - PE->get_customer($myconfig, $form, $dbh); - - $dbh->commit; -} + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{amount}{ $ref->{accno} } = $ref->{accno}; + } + $sth->finish; + } + + PE->get_customer( $myconfig, $form, $dbh ); + + $dbh->commit; + +} sub get_customer { - my ($self, $myconfig, $form, $dbh) = @_; - - if (! $dbh) { - $dbh = $form->{dbh}; - } - - my $query; - my $sth; - my $ref; - - if (! $form->{startdate}) { - $query = qq|SELECT current_date|; - ($form->{startdate}) = $dbh->selectrow_array($query); - } - - my $where = qq|(startdate >= |.$dbh->quote($form->{startdate}). - qq| OR startdate IS NULL OR enddate IS NULL)|; - - if ($form->{enddate}) { - $where .= qq| AND (enddate >= |.$dbh->quote($form->{enddate}). - qq| OR enddate IS NULL)|; - } else { - $where .= - qq| AND (enddate >= current_date OR enddate IS NULL)|; - } - - $query = qq| + my ( $self, $myconfig, $form, $dbh ) = @_; + + if ( !$dbh ) { + $dbh = $form->{dbh}; + } + + my $query; + my $sth; + my $ref; + + if ( !$form->{startdate} ) { + $query = qq|SELECT current_date|; + ( $form->{startdate} ) = $dbh->selectrow_array($query); + } + + my $where = + qq|(startdate >= | + . $dbh->quote( $form->{startdate} ) + . qq| OR startdate IS NULL OR enddate IS NULL)|; + + if ( $form->{enddate} ) { + $where .= + qq| AND (enddate >= | + . $dbh->quote( $form->{enddate} ) + . qq| OR enddate IS NULL)|; + } + else { + $where .= qq| AND (enddate >= current_date OR enddate IS NULL)|; + } + + $query = qq| SELECT count(*) FROM customer WHERE $where|; - my ($count) = $dbh->selectrow_array($query); + my ($count) = $dbh->selectrow_array($query); - if ($count < $myconfig->{vclimit}) { - $query = qq| + if ( $count < $myconfig->{vclimit} ) { + $query = qq| SELECT id, name FROM customer WHERE $where|; - if ($form->{customer_id}) { - $query .= qq| + if ( $form->{customer_id} ) { + $query .= qq| UNION SELECT id,name FROM customer - WHERE id = |. - $dbh->quote($form->{customer_id}); - } + WHERE id = | . $dbh->quote( $form->{customer_id} ); + } - $query .= qq| + $query .= qq| ORDER BY name|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - @{ $form->{all_customer} } = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_customer} }, $ref; - } - $sth->finish; - } + @{ $form->{all_customer} } = (); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_customer} }, $ref; + } + $sth->finish; + } } - sub save_job { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my ($income_accno) = split /--/, $form->{IC_income}; - - my ($partsgroup, $partsgroup_id) = split /--/, $form->{partsgroup}; - - if ($form->{id}) { - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my ($income_accno) = split /--/, $form->{IC_income}; + + my ( $partsgroup, $partsgroup_id ) = split /--/, $form->{partsgroup}; + + if ( $form->{id} ) { + $query = qq| SELECT id FROM project - WHERE id = |.$dbh->quote($form->{id}); - ($form->{id}) = $dbh->selectrow_array($query); - } - - if (!$form->{id}) { - my $uid = localtime; - $uid .= "$$"; - - $query = qq| + WHERE id = | . $dbh->quote( $form->{id} ); + ( $form->{id} ) = $dbh->selectrow_array($query); + } + + if ( !$form->{id} ) { + my $uid = localtime; + $uid .= "$$"; + + $query = qq| INSERT INTO project (projectnumber) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM project WHERE projectnumber = '$uid'|; - ($form->{id}) = $dbh->selectrow_array($query); - } + ( $form->{id} ) = $dbh->selectrow_array($query); + } - $form->{projectnumber} - = $form->update_defaults($myconfig, "projectnumber", $dbh) - unless $form->{projectnumber}; + $form->{projectnumber} = + $form->update_defaults( $myconfig, "projectnumber", $dbh ) + unless $form->{projectnumber}; - $query = qq| + $query = qq| UPDATE project SET projectnumber = ?, description = ?, @@ -611,31 +607,30 @@ sub save_job { production = ?, customer_id = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $form->{projectnumber}, $form->{description}, - $form->{startdate}, $form->{enddate}, $form->{id}, - $form->{production}, $form->{customer_id}, $form->{id} - ) || $form->dberror($query); - + $sth = $dbh->prepare($query); + $sth->execute( + $form->{projectnumber}, $form->{description}, $form->{startdate}, + $form->{enddate}, $form->{id}, $form->{production}, + $form->{customer_id}, $form->{id} + ) || $form->dberror($query); + + #### add/edit assembly + $query = qq|SELECT id FROM parts WHERE id = | . $dbh->quote( $form->{id} ); + my ($id) = $dbh->selectrow_array($query); + + if ( !$id ) { + $query = qq| + INSERT INTO parts (id) + VALUES (| . $dbh->quote( $form->{id} ) . qq|)|; + $dbh->do($query) || $form->dberror($query); + } - #### add/edit assembly - $query = qq|SELECT id FROM parts WHERE id = |.$dbh->quote($form->{id}); - my ($id) = $dbh->selectrow_array($query); + my $partnumber = + ( $form->{partnumber} ) + ? $form->{partnumber} + : $form->{projectnumber}; - if (!$id) { - $query = qq| - INSERT INTO parts (id) - VALUES (|.$dbh->quote($form->{id}).qq|)|; - $dbh->do($query) || $form->dberror($query); - } - - my $partnumber = - ($form->{partnumber}) - ? $form->{partnumber} - : $form->{projectnumber}; - - $query = qq| + $query = qq| UPDATE parts SET partnumber = ?, description = ?, @@ -654,155 +649,155 @@ sub save_job { project_id = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - $partnumber, $form->{partdescription}, - $form->{priceupdate}, - $form->parse_amount($myconfig, $form->{listprice}), - $form->parse_amount($myconfig, $form->{sellprice}), - $form->parse_amount($myconfig, $form->{weight}), - $form->{bin}, $form->{unit}, $form->{notes}, - $income_accno, - ($partsgroup_id) ? $partsgroup_id : undef, - $form->{id}, $form->{id} - ) || $form->dberror($query); - - $query = qq|DELETE FROM partstax WHERE parts_id = |. - $dbh->qupte($form->{id}); - $dbh->do($query) || $form->dberror($query); - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + $partnumber, + $form->{partdescription}, + $form->{priceupdate}, + $form->parse_amount( $myconfig, $form->{listprice} ), + $form->parse_amount( $myconfig, $form->{sellprice} ), + $form->parse_amount( $myconfig, $form->{weight} ), + $form->{bin}, + $form->{unit}, + $form->{notes}, + $income_accno, + ($partsgroup_id) ? $partsgroup_id : undef, + $form->{id}, + $form->{id} + ) || $form->dberror($query); + + $query = + qq|DELETE FROM partstax WHERE parts_id = | . $dbh->qupte( $form->{id} ); + $dbh->do($query) || $form->dberror($query); + + $query = qq| INSERT INTO partstax (parts_id, chart_id) VALUES (?, (SELECT id FROM chart WHERE accno = ?))|; - $sth = $dbh->prepare($query); - for (split / /, $form->{taxaccounts}) { - if ($form->{"IC_tax_$_"}) { - $sth->execute($form->{id}, $_) - || $form->dberror($query); - } - } - - $dbh->commit; + $sth = $dbh->prepare($query); + for ( split / /, $form->{taxaccounts} ) { + if ( $form->{"IC_tax_$_"} ) { + $sth->execute( $form->{id}, $_ ) + || $form->dberror($query); + } + } -} + $dbh->commit; +} sub stock_assembly { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $ref; - - my $query = qq|SELECT * FROM project WHERE id = ?|; - my $sth = $dbh->prepare($query) || $form->dberror($query); - - $query = qq|SELECT COUNT(*) FROM parts WHERE project_id = ?|; - my $rvh = $dbh->prepare($query) || $form->dberror($query); - - if (! $form->{stockingdate}) { - $query = qq|SELECT current_date|; - ($form->{stockingdate}) = $dbh->selectrow_array($query); - } - - $query = qq|SELECT * FROM parts WHERE id = ?|; - my $pth = $dbh->prepare($query) || $form->dberror($query); - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $ref; + + my $query = qq|SELECT * FROM project WHERE id = ?|; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + $query = qq|SELECT COUNT(*) FROM parts WHERE project_id = ?|; + my $rvh = $dbh->prepare($query) || $form->dberror($query); + + if ( !$form->{stockingdate} ) { + $query = qq|SELECT current_date|; + ( $form->{stockingdate} ) = $dbh->selectrow_array($query); + } + + $query = qq|SELECT * FROM parts WHERE id = ?|; + my $pth = $dbh->prepare($query) || $form->dberror($query); + + $query = qq| SELECT j.*, p.lastcost FROM jcitems j JOIN parts p ON (p.id = j.parts_id) WHERE j.project_id = ? - AND j.checkedin <= |. - $dbh->quote($form->{stockingdate}).qq| + AND j.checkedin <= | . $dbh->quote( $form->{stockingdate} ) . qq| ORDER BY parts_id|; - my $jth = $dbh->prepare($query) || $form->dberror($query); + my $jth = $dbh->prepare($query) || $form->dberror($query); - $query = qq| + $query = qq| INSERT INTO assembly (id, parts_id, qty, bom, adj) VALUES (?, ?, ?, '0', '0')|; - my $ath = $dbh->prepare($query) || $form->dberror($query); - - my $i = 0; - my $sold; - my $ship; - - while (1) { - $i++; - last unless $form->{"id_$i"}; - - $stock = $form->parse_amount($myconfig, $form->{"stock_$i"}); - - if ($stock) { - $sth->execute($form->{"id_$i"}); - $ref = $sth->fetchrow_hashref(NAME_lc); - - if ($stock >($ref->{production} - $ref->{completed})) { - $stock = $ref->{production} - - $ref->{completed}; - } - if (($stock * -1) > $ref->{completed}) { - $stock = $ref->{completed} * -1; - } - - $pth->execute($form->{"id_$i"}); - $pref = $pth->fetchrow_hashref(NAME_lc); - - my %assembly = (); - my $lastcost = 0; - my $sellprice = 0; - my $listprice = 0; - - $jth->execute($form->{"id_$i"}); - while ($jref = $jth->fetchrow_hashref(NAME_lc)) { - $assembly{qty}{$jref->{parts_id}} - += ($jref->{qty} - $jref->{allocated}); - $assembly{parts_id}{$jref->{parts_id}} - = $jref->{parts_id}; - $assembly{jcitems}{$jref->{id}} = $jref->{id}; - $lastcost += $form->round_amount( - $jref->{lastcost} * ($jref->{qty} - - $jref->{allocated}), - 2); - $sellprice += $form->round_amount( - $jref->{sellprice} * ($jref->{qty} - - $jref->{allocated}), - 2); - $listprice += $form->round_amount( - $jref->{listprice} * ($jref->{qty} - - $jref->{allocated}), - 2); - } - $jth->finish; - - $uid = localtime; - $uid .= "$$"; - - $query = qq| + my $ath = $dbh->prepare($query) || $form->dberror($query); + + my $i = 0; + my $sold; + my $ship; + + while (1) { + $i++; + last unless $form->{"id_$i"}; + + $stock = $form->parse_amount( $myconfig, $form->{"stock_$i"} ); + + if ($stock) { + $sth->execute( $form->{"id_$i"} ); + $ref = $sth->fetchrow_hashref(NAME_lc); + + if ( $stock > ( $ref->{production} - $ref->{completed} ) ) { + $stock = $ref->{production} - $ref->{completed}; + } + if ( ( $stock * -1 ) > $ref->{completed} ) { + $stock = $ref->{completed} * -1; + } + + $pth->execute( $form->{"id_$i"} ); + $pref = $pth->fetchrow_hashref(NAME_lc); + + my %assembly = (); + my $lastcost = 0; + my $sellprice = 0; + my $listprice = 0; + + $jth->execute( $form->{"id_$i"} ); + while ( $jref = $jth->fetchrow_hashref(NAME_lc) ) { + $assembly{qty}{ $jref->{parts_id} } += + ( $jref->{qty} - $jref->{allocated} ); + $assembly{parts_id}{ $jref->{parts_id} } = $jref->{parts_id}; + $assembly{jcitems}{ $jref->{id} } = $jref->{id}; + $lastcost += + $form->round_amount( + $jref->{lastcost} * ( $jref->{qty} - $jref->{allocated} ), + 2 ); + $sellprice += $form->round_amount( + $jref->{sellprice} * ( $jref->{qty} - $jref->{allocated} ), + 2 + ); + $listprice += $form->round_amount( + $jref->{listprice} * ( $jref->{qty} - $jref->{allocated} ), + 2 + ); + } + $jth->finish; + + $uid = localtime; + $uid .= "$$"; + + $query = qq| INSERT INTO parts (partnumber) VALUES ('$uid')|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror($query); - $query = qq| + $query = qq| SELECT id FROM parts WHERE partnumber = '$uid'|; - ($uid) = $dbh->selectrow_array($query); - - $lastcost = $form->round_amount($lastcost / $stock, 2); - $sellprice = - ($pref->{sellprice}) - ? $pref->{sellprice} - : $form->round_amount($sellprice / $stock, 2); - $listprice = - ($pref->{listprice}) - ? $pref->{listprice} - : $form->round_amount($listprice / $stock, 2); - - $rvh->execute($form->{"id_$i"}); - my ($rev) = $rvh->fetchrow_array; - $rvh->finish; - - $query = qq| + ($uid) = $dbh->selectrow_array($query); + + $lastcost = $form->round_amount( $lastcost / $stock, 2 ); + $sellprice = + ( $pref->{sellprice} ) + ? $pref->{sellprice} + : $form->round_amount( $sellprice / $stock, 2 ); + $listprice = + ( $pref->{listprice} ) + ? $pref->{listprice} + : $form->round_amount( $listprice / $stock, 2 ); + + $rvh->execute( $form->{"id_$i"} ); + my ($rev) = $rvh->fetchrow_array; + $rvh->finish; + + $query = qq| UPDATE parts SET partnumber = ?, description = ?, @@ -819,188 +814,181 @@ sub stock_assembly { bin = ?, project_id = ? WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute( - "$pref->{partnumber}-$rev", - $pref->{partdescription}, - $form->{stockingdate}, $pref->{unit}, - $listprice, $sellprice, $lastcost, - $pref->{weight}, $stock, $pref->{notes}, - $pref->{income_accno_id}, $pref->{bin}, - $form->{"id_$i"}, $uid - )|| $form->dberror($query); - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( + "$pref->{partnumber}-$rev", $pref->{partdescription}, + $form->{stockingdate}, $pref->{unit}, + $listprice, $sellprice, + $lastcost, $pref->{weight}, + $stock, $pref->{notes}, + $pref->{income_accno_id}, $pref->{bin}, + $form->{"id_$i"}, $uid + ) || $form->dberror($query); + + $query = qq| INSERT INTO partstax (parts_id, chart_id) SELECT ?, chart_id FROM partstax WHERE parts_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($uid, $pref->{id}) - || $form->dberror($query); - - - $pth->finish; - - for (keys %{$assembly{parts_id}}) { - if ($assembly{qty}{$_}) { - $ath->execute( - $uid, $assembly{parts_id}{$_}, - $form->round_amount( - $assembly{qty}{$_} - / $stock, - 4)); - $ath->finish; - } - } - - $form->update_balance( - $dbh, "project", "completed", - qq|id = $form->{"id_$i"}|, $stock); - - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $uid, $pref->{id} ) + || $form->dberror($query); + + $pth->finish; + + for ( keys %{ $assembly{parts_id} } ) { + if ( $assembly{qty}{$_} ) { + $ath->execute( + $uid, + $assembly{parts_id}{$_}, + $form->round_amount( $assembly{qty}{$_} / $stock, 4 ) + ); + $ath->finish; + } + } + + $form->update_balance( $dbh, "project", "completed", + qq|id = $form->{"id_$i"}|, $stock ); + + $query = qq| UPDATE jcitems SET allocated = qty WHERE allocated != qty AND checkedin <= ? AND project_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{stockingdate}, $form->{"id_$i"}) - || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{stockingdate}, $form->{"id_$i"} ) + || $form->dberror($query); - $sth->finish; - - } + $sth->finish; - } + } - my $rc = $dbh->commit; - - $rc; + } -} + my $rc = $dbh->commit; + $rc; + +} sub delete_project { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - $query = qq|DELETE FROM project WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM translation + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + $query = qq|DELETE FROM project WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM translation WHERE trans_id = $form->{id}|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - my $rc = $dbh->commit; + my $rc = $dbh->commit; - $rc; - -} + $rc; +} sub delete_partsgroup { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - $query = qq|DELETE FROM partsgroup WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM translation WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $rc = $dbh->commit; - - $rc; - -} + my ( $self, $myconfig, $form ) = @_; + my $dbh = $form->{dbh}; -sub delete_pricegroup { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - $query = qq|DELETE FROM pricegroup WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - my $rc = $dbh->commit; - - $rc; + $query = qq|DELETE FROM partsgroup WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM translation WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + my $rc = $dbh->commit; + + $rc; } +sub delete_pricegroup { + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + $query = qq|DELETE FROM pricegroup WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + my $rc = $dbh->commit; + + $rc; + +} sub delete_job { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my %audittrail = ( - tablename => 'project', - reference => $form->{id}, - formname => $form->{type}, - action => 'deleted', - id => $form->{id} ); - - $form->audittrail($dbh, "", \%audittrail); - - my $query = qq|DELETE FROM project WHERE id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM translation WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - # delete all the assemblies - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my %audittrail = ( + tablename => 'project', + reference => $form->{id}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} + ); + + $form->audittrail( $dbh, "", \%audittrail ); + + my $query = qq|DELETE FROM project WHERE id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $query = qq|DELETE FROM translation WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + # delete all the assemblies + $query = qq| DELETE FROM assembly a JOIN parts p ON (a.id = p.id) WHERE p.project_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); - - $query = qq|DELETE FROM parts WHERE project_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - my $rc = $dbh->commit; + $query = qq|DELETE FROM parts WHERE project_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $rc; + my $rc = $dbh->commit; -} + $rc; +} sub partsgroups { - my ($self, $myconfig, $form) = @_; - - my $var; - - my $dbh = $form->{dbh}; - - $form->{sort} = "partsgroup" unless $form->{partsgroup}; - my @a = (partsgroup); - my $sortorder = $form->sort_order(\@a); - - my $query = qq|SELECT g.* FROM partsgroup g|; - - my $where = "1 = 1"; - - if ($form->{partsgroup} ne "") { - $var = $dbh->quote($form->like(lc $form->{partsgroup})); - $where .= " AND lower(partsgroup) LIKE '$var'"; - } - $query .= qq| WHERE $where ORDER BY $sortorder|; - - if ($form->{status} eq 'orphaned') { - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $var; + + my $dbh = $form->{dbh}; + + $form->{sort} = "partsgroup" unless $form->{partsgroup}; + my @a = (partsgroup); + my $sortorder = $form->sort_order( \@a ); + + my $query = qq|SELECT g.* FROM partsgroup g|; + + my $where = "1 = 1"; + + if ( $form->{partsgroup} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{partsgroup} ) ); + $where .= " AND lower(partsgroup) LIKE '$var'"; + } + $query .= qq| WHERE $where ORDER BY $sortorder|; + + if ( $form->{status} eq 'orphaned' ) { + $query = qq| SELECT g.* FROM partsgroup g LEFT JOIN parts p ON (p.partsgroup_id = g.id) @@ -1011,101 +999,98 @@ sub partsgroups { JOIN parts p ON (p.partsgroup_id = g.id) WHERE $where ORDER BY $sortorder|; - } + } - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $i = 0; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{item_list} }, $ref; - $i++; - } + my $i = 0; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{item_list} }, $ref; + $i++; + } - $sth->finish; - - $i; + $sth->finish; -} + $i; +} sub save_partsgroup { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - if ($form->{id}) { - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + if ( $form->{id} ) { + $query = qq| UPDATE partsgroup - SET partsgroup = |. - $dbh->quote($form->{partsgroup}).qq| + SET partsgroup = | . $dbh->quote( $form->{partsgroup} ) . qq| WHERE id = $form->{id}|; - } else { - $query = qq| + } + else { + $query = qq| INSERT INTO partsgroup (partsgroup) - VALUES (|.$dbh->quote($form->{partsgroup}).qq|)|; - } - $dbh->do($query) || $form->dberror($query); + VALUES (| . $dbh->quote( $form->{partsgroup} ) . qq|)|; + } + $dbh->do($query) || $form->dberror($query); - $dbh->commit; + $dbh->commit; } - sub get_partsgroup { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; - - my $query = qq|SELECT * FROM partsgroup WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + my $dbh = $form->{dbh}; - my $ref = $sth->fetchrow_hashref(NAME_lc); - - for (keys %$ref) { $form->{$_} = $ref->{$_} } + my $query = qq|SELECT * FROM partsgroup WHERE id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $sth->finish; + my $ref = $sth->fetchrow_hashref(NAME_lc); - # check if it is orphaned - $query = qq|SELECT count(*) FROM parts WHERE partsgroup_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - ($form->{orphaned}) = $sth->fetchrow_array; - $form->{orphaned} = !$form->{orphaned}; - - $sth->finish; - - $dbh->commit; + $sth->finish; -} + # check if it is orphaned + $query = qq|SELECT count(*) FROM parts WHERE partsgroup_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + ( $form->{orphaned} ) = $sth->fetchrow_array; + $form->{orphaned} = !$form->{orphaned}; + + $sth->finish; + + $dbh->commit; + +} sub pricegroups { - my ($self, $myconfig, $form) = @_; - - my $var; - - my $dbh = $form->{dbh}; - - $form->{sort} = "pricegroup" unless $form->{sort}; - my @a = (pricegroup); - my $sortorder = $form->sort_order(\@a); - - my $query = qq|SELECT g.* FROM pricegroup g|; - - my $where = "1 = 1"; - - if ($form->{pricegroup} ne "") { - $var = $dbh->quote($form->like(lc $form->{pricegroup})); - $where .= " AND lower(pricegroup) LIKE $var"; - } - $query .= qq| + my ( $self, $myconfig, $form ) = @_; + + my $var; + + my $dbh = $form->{dbh}; + + $form->{sort} = "pricegroup" unless $form->{sort}; + my @a = (pricegroup); + my $sortorder = $form->sort_order( \@a ); + + my $query = qq|SELECT g.* FROM pricegroup g|; + + my $where = "1 = 1"; + + if ( $form->{pricegroup} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{pricegroup} ) ); + $where .= " AND lower(pricegroup) LIKE $var"; + } + $query .= qq| WHERE $where ORDER BY $sortorder|; - - if ($form->{status} eq 'orphaned') { - $query = qq| + + if ( $form->{status} eq 'orphaned' ) { + $query = qq| SELECT g.* FROM pricegroup g WHERE $where @@ -1113,396 +1098,387 @@ sub pricegroups { FROM partscustomer WHERE pricegroup_id > 0) ORDER BY $sortorder|; - } + } - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $i = 0; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{item_list} }, $ref; - $i++; - } + my $i = 0; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{item_list} }, $ref; + $i++; + } - $sth->finish; - $dbh->commit; - - $i; + $sth->finish; + $dbh->commit; -} + $i; +} sub save_pricegroup { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - if ($form->{id}) { - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + if ( $form->{id} ) { + $query = qq| UPDATE pricegroup SET pricegroup = ? - WHERE id = |.$dbh->quote($form->{id}); - } else { - $query = qq| + WHERE id = | . $dbh->quote( $form->{id} ); + } + else { + $query = qq| INSERT INTO pricegroup (pricegroup) VALUES (?)|; - } - $sth = $dbh->prepare($query); - $sth->execute($form->{pricegroup}) || $form->dberror($query); - - $dbh->commit; + } + $sth = $dbh->prepare($query); + $sth->execute( $form->{pricegroup} ) || $form->dberror($query); -} + $dbh->commit; +} sub get_pricegroup { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; - - my $query = qq|SELECT * FROM pricegroup WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + my $dbh = $form->{dbh}; - my $ref = $sth->fetchrow_hashref(NAME_lc); - - for (keys %$ref) { $form->{$_} = $ref->{$_} } + my $query = qq|SELECT * FROM pricegroup WHERE id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $sth->finish; + my $ref = $sth->fetchrow_hashref(NAME_lc); - # check if it is orphaned - $query = "SELECT count(*) FROM partscustomer WHERE pricegroup_id = ?"; - $sth = $dbh->prepare($query); - $sth->execute($form->{id}) || $form->dberror($query); + for ( keys %$ref ) { $form->{$_} = $ref->{$_} } - ($form->{orphaned}) = $sth->fetchrow_array; - $form->{orphaned} = !$form->{orphaned}; + $sth->finish; - $sth->finish; - - $dbh->commit; + # check if it is orphaned + $query = "SELECT count(*) FROM partscustomer WHERE pricegroup_id = ?"; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); -} + ( $form->{orphaned} ) = $sth->fetchrow_array; + $form->{orphaned} = !$form->{orphaned}; + + $sth->finish; + $dbh->commit; + +} sub description_translations { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - my $where = "1 = 1"; - my $var; - my $ref; - - for (qw(partnumber description)) { - if ($form->{$_}) { - $var = $dbh->quote($form->like(lc $form->{$_})); - $where .= " AND lower(p.$_) LIKE $var"; - } - } - - $where .= " AND p.obsolete = '0'"; - $where .= " AND p.id = ".$dbh->quote($form->{id}) if $form->{id}; - - - my %ordinal = ( 'partnumber' => 2, 'description' => 3 ); - - my @a = qw(partnumber description); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + my $where = "1 = 1"; + my $var; + my $ref; + + for (qw(partnumber description)) { + if ( $form->{$_} ) { + $var = $dbh->quote( $form->like( lc $form->{$_} ) ); + $where .= " AND lower(p.$_) LIKE $var"; + } + } + + $where .= " AND p.obsolete = '0'"; + $where .= " AND p.id = " . $dbh->quote( $form->{id} ) if $form->{id}; + + my %ordinal = ( 'partnumber' => 2, 'description' => 3 ); + + my @a = qw(partnumber description); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $query = qq| SELECT l.description AS language, t.description AS translation, l.code FROM translation t JOIN language l ON (l.code = t.language_code) WHERE trans_id = ? ORDER BY 1|; - my $tth = $dbh->prepare($query); - - $query = qq| + my $tth = $dbh->prepare($query); + + $query = qq| SELECT p.id, p.partnumber, p.description FROM parts p WHERE $where ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $tra; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{translations} }, $ref; + my $tra; - # get translations for description - $tth->execute($ref->{id}) || $form->dberror; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{translations} }, $ref; - while ($tra = $tth->fetchrow_hashref(NAME_lc)) { - $form->{trans_id} = $ref->{id}; - $tra->{id} = $ref->{id}; - push @{ $form->{translations} }, $tra; - } - $tth->finish; + # get translations for description + $tth->execute( $ref->{id} ) || $form->dberror; - } - $sth->finish; + while ( $tra = $tth->fetchrow_hashref(NAME_lc) ) { + $form->{trans_id} = $ref->{id}; + $tra->{id} = $ref->{id}; + push @{ $form->{translations} }, $tra; + } + $tth->finish; - &get_language("", $dbh, $form) if $form->{id}; + } + $sth->finish; - $dbh->commit; + &get_language( "", $dbh, $form ) if $form->{id}; -} + $dbh->commit; +} sub partsgroup_translations { - my ($self, $myconfig, $form) = @_; - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; + my $dbh = $form->{dbh}; - my $where = "1 = 1"; - my $ref; - my $var; + my $where = "1 = 1"; + my $ref; + my $var; - if ($form->{description}) { - $var = $dbh->quote($form->like(lc $form->{description})); - $where .= " AND lower(p.partsgroup) LIKE $var"; - } - $where .= " AND p.id = ".$dbh->quote($form->{id}) if $form->{id}; - + if ( $form->{description} ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= " AND lower(p.partsgroup) LIKE $var"; + } + $where .= " AND p.id = " . $dbh->quote( $form->{id} ) if $form->{id}; - my $query = qq| + my $query = qq| SELECT l.description AS language, t.description AS translation, l.code FROM translation t JOIN language l ON (l.code = t.language_code) WHERE trans_id = ? ORDER BY 1|; - my $tth = $dbh->prepare($query); - - $form->sort_order(); - - $query = qq| + my $tth = $dbh->prepare($query); + + $form->sort_order(); + + $query = qq| SELECT p.id, p.partsgroup AS description FROM partsgroup p WHERE $where ORDER BY 2 $form->{direction}|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $tra; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{translations} }, $ref; + my $tra; - # get translations for partsgroup - $tth->execute($ref->{id}) || $form->dberror; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{translations} }, $ref; - while ($tra = $tth->fetchrow_hashref(NAME_lc)) { - $form->{trans_id} = $ref->{id}; - push @{ $form->{translations} }, $tra; - } - $tth->finish; + # get translations for partsgroup + $tth->execute( $ref->{id} ) || $form->dberror; - } - $sth->finish; + while ( $tra = $tth->fetchrow_hashref(NAME_lc) ) { + $form->{trans_id} = $ref->{id}; + push @{ $form->{translations} }, $tra; + } + $tth->finish; - &get_language("", $dbh, $form) if $form->{id}; + } + $sth->finish; - $dbh->commit; + &get_language( "", $dbh, $form ) if $form->{id}; -} + $dbh->commit; +} sub project_translations { - my ($self, $myconfig, $form) = @_; - my $dbh = $form->{dbh}; - - my $where = "1 = 1"; - my $var; - my $ref; - - for (qw(projectnumber description)) { - if ($form->{$_}) { - $var = $dbh->quote($form->like(lc $form->{$_})); - $where .= " AND lower(p.$_) LIKE $var"; - } - } - - $where .= " AND p.id = ".$dbh->quote($form->{id}) if $form->{id}; - - - my %ordinal = ( 'projectnumber' => 2, 'description' => 3 ); - - my @a = qw(projectnumber description); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + my $dbh = $form->{dbh}; + + my $where = "1 = 1"; + my $var; + my $ref; + + for (qw(projectnumber description)) { + if ( $form->{$_} ) { + $var = $dbh->quote( $form->like( lc $form->{$_} ) ); + $where .= " AND lower(p.$_) LIKE $var"; + } + } + + $where .= " AND p.id = " . $dbh->quote( $form->{id} ) if $form->{id}; + + my %ordinal = ( 'projectnumber' => 2, 'description' => 3 ); + + my @a = qw(projectnumber description); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $query = qq| SELECT l.description AS language, t.description AS translation, l.code FROM translation t JOIN language l ON (l.code = t.language_code) WHERE trans_id = ? ORDER BY 1|; - my $tth = $dbh->prepare($query); - - $query = qq| + my $tth = $dbh->prepare($query); + + $query = qq| SELECT p.id, p.projectnumber, p.description FROM project p WHERE $where ORDER BY $sortorder|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - my $tra; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{translations} }, $ref; + my $tra; - # get translations for description - $tth->execute($ref->{id}) || $form->dberror; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{translations} }, $ref; - while ($tra = $tth->fetchrow_hashref(NAME_lc)) { - $form->{trans_id} = $ref->{id}; - $tra->{id} = $ref->{id}; - push @{ $form->{translations} }, $tra; - } - $tth->finish; + # get translations for description + $tth->execute( $ref->{id} ) || $form->dberror; - } - $sth->finish; + while ( $tra = $tth->fetchrow_hashref(NAME_lc) ) { + $form->{trans_id} = $ref->{id}; + $tra->{id} = $ref->{id}; + push @{ $form->{translations} }, $tra; + } + $tth->finish; - &get_language("", $dbh, $form) if $form->{id}; + } + $sth->finish; - $dbh->commit; + &get_language( "", $dbh, $form ) if $form->{id}; -} + $dbh->commit; +} sub get_language { - my ($self, $dbh, $form) = @_; - - my $query = qq|SELECT * FROM language ORDER BY 2|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my ( $self, $dbh, $form ) = @_; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_language} }, $ref; - } - $sth->finish; + my $query = qq|SELECT * FROM language ORDER BY 2|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); -} + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_language} }, $ref; + } + $sth->finish; +} sub save_translation { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq|DELETE FROM translation WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id})|| $form->dberror($query); + my $query = qq|DELETE FROM translation WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); - $query = qq| + $query = qq| INSERT INTO translation (trans_id, language_code, description) VALUES (?, ?, ?)|; - my $sth = $dbh->prepare($query) || $form->dberror($query); - - foreach my $i (1 .. $form->{translation_rows}) { - if ($form->{"language_code_$i"} ne "") { - $sth->execute($form->{id}, $form->{"language_code_$i"}, - $form->{"translation_$i"}); - $sth->finish; - } - } - $dbh->commit; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + foreach my $i ( 1 .. $form->{translation_rows} ) { + if ( $form->{"language_code_$i"} ne "" ) { + $sth->execute( + $form->{id}, + $form->{"language_code_$i"}, + $form->{"translation_$i"} + ); + $sth->finish; + } + } + $dbh->commit; } - sub delete_translation { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $query = qq|DELETE FROM translation WHERE trans_id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{id})|| $form->dberror($query); + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; - $dbh->commit; + my $query = qq|DELETE FROM translation WHERE trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{id} ) || $form->dberror($query); + + $dbh->commit; } sub timecard_get_currency { - my $self = shift @_; - my $form = shift @_; - my $dbh = $form->{dbh}; - my $query = qq|SELECT curr FROM customer WHERE id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{customer_id}); - my ($curr) = $sth->fetchrow_array; - $form->{currency} = $curr; + my $self = shift @_; + my $form = shift @_; + my $dbh = $form->{dbh}; + my $query = qq|SELECT curr FROM customer WHERE id = ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{customer_id} ); + my ($curr) = $sth->fetchrow_array; + $form->{currency} = $curr; } - sub project_sales_order { - my ($self, $myconfig, $form) = @_; - - # connect to database - my $dbh = $form->{dbh}; - - my $query = qq|SELECT current_date|; - my ($transdate) = $dbh->selectrow_array($query); - - $form->all_years($myconfig, $dbh); - - $form->all_projects($myconfig, $dbh, $transdate); - - $form->all_employees($myconfig, $dbh, $transdate); - - $dbh->commit; + my ( $self, $myconfig, $form ) = @_; -} + # connect to database + my $dbh = $form->{dbh}; + + my $query = qq|SELECT current_date|; + my ($transdate) = $dbh->selectrow_array($query); + + $form->all_years( $myconfig, $dbh ); + $form->all_projects( $myconfig, $dbh, $transdate ); + + $form->all_employees( $myconfig, $dbh, $transdate ); + + $dbh->commit; + +} sub get_jcitems { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $null; - my $var; - my $where; - - if ($form->{projectnumber}) { - ($null, $var) = split /--/, $form->{projectnumber}; - $var = $dbh->quote($var); - $where .= " AND j.project_id = $var"; - } - - if ($form->{employee}) { - ($null, $var) = split /--/, $form->{employee}; - $var = $dbh->quote($var); - $where .= " AND j.employee_id = $var"; - } - - ($form->{transdatefrom}, $form->{transdateto}) - = $form->from_to( - $form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - if ($form->{transdatefrom}) { - $where .= " AND j.checkedin >= ". - $dbh->quote($form->{transdatefrom}); - } - if ($form->{transdateto}) { - $where .= " AND j.checkedout <= (date ". - $dbh->quote($form->{transdateto}) . - " + interval '1 days')"; - } - - my $query; - my $ref; - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $null; + my $var; + my $where; + + if ( $form->{projectnumber} ) { + ( $null, $var ) = split /--/, $form->{projectnumber}; + $var = $dbh->quote($var); + $where .= " AND j.project_id = $var"; + } + + if ( $form->{employee} ) { + ( $null, $var ) = split /--/, $form->{employee}; + $var = $dbh->quote($var); + $where .= " AND j.employee_id = $var"; + } + + ( $form->{transdatefrom}, $form->{transdateto} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + if ( $form->{transdatefrom} ) { + $where .= + " AND j.checkedin >= " . $dbh->quote( $form->{transdatefrom} ); + } + if ( $form->{transdateto} ) { + $where .= + " AND j.checkedout <= (date " + . $dbh->quote( $form->{transdateto} ) + . " + interval '1 days')"; + } + + my $query; + my $ref; + + $query = qq| SELECT j.id, j.description, j.qty - j.allocated AS qty, j.sellprice, j.parts_id, pr.$form->{vc}_id, j.project_id, j.checkedin::date AS transdate, @@ -1517,83 +1493,80 @@ sub get_jcitems { AND j.allocated != j.qty $where ORDER BY pr.projectnumber, c.name, j.checkedin::date|; - if ($form->{summary}) { - $query =~ s/j\.description/p\.description/; - $query =~ s/c\.name,/c\.name, j\.parts_id, /; - } - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + if ( $form->{summary} ) { + $query =~ s/j\.description/p\.description/; + $query =~ s/c\.name,/c\.name, j\.parts_id, /; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - # tax accounts - $query = qq| + # tax accounts + $query = qq| SELECT c.accno FROM chart c JOIN partstax pt ON (pt.chart_id = c.id) WHERE pt.parts_id = ?|; - my $tth = $dbh->prepare($query) || $form->dberror($query); - my $ptref; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - - $tth->execute($ref->{parts_id}); - $ref->{taxaccounts} = ""; - while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { - $ref->{taxaccounts} .= "$ptref->{accno} "; - } - $tth->finish; - chop $ref->{taxaccounts}; - - $ref->{amount} = $ref->{sellprice} * $ref->{qty}; - - push @{ $form->{jcitems} }, $ref; - } - - $sth->finish; - - $query = qq|SELECT value FROM defaults WHERE setting_key = 'curr'|; - ($form->{currency}) = $dbh->selectrow_array($query); - $form->{currency} =~ s/:.*//; - $form->{defaultcurrency} = $form->{currency}; - - $query = qq| + my $tth = $dbh->prepare($query) || $form->dberror($query); + my $ptref; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + $tth->execute( $ref->{parts_id} ); + $ref->{taxaccounts} = ""; + while ( $ptref = $tth->fetchrow_hashref(NAME_lc) ) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + } + $tth->finish; + chop $ref->{taxaccounts}; + + $ref->{amount} = $ref->{sellprice} * $ref->{qty}; + + push @{ $form->{jcitems} }, $ref; + } + + $sth->finish; + + $query = qq|SELECT value FROM defaults WHERE setting_key = 'curr'|; + ( $form->{currency} ) = $dbh->selectrow_array($query); + $form->{currency} =~ s/:.*//; + $form->{defaultcurrency} = $form->{currency}; + + $query = qq| SELECT c.accno, t.rate FROM tax t JOIN chart c ON (c.id = t.chart_id)|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $form->{taxaccounts} .= "$ref->{accno} "; - $form->{"$ref->{accno}_rate"} = $ref->{rate}; - } - chop $form->{taxaccounts}; - $sth->finish; - - $dbh->commit; - -} + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{taxaccounts} .= "$ref->{accno} "; + $form->{"$ref->{accno}_rate"} = $ref->{rate}; + } + chop $form->{taxaccounts}; + $sth->finish; + $dbh->commit; -sub allocate_projectitems { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - for my $i (1 .. $form->{rowcount}) { - for (split / /, $form->{"jcitems_$i"}) { - my ($id, $qty) = split /:/, $_; - $form->update_balance( - $dbh, 'jcitems', 'allocated', "id = $id", - $qty); - } - } - - $rc = $dbh->commit; - - $rc; - } +sub allocate_projectitems { + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + for my $i ( 1 .. $form->{rowcount} ) { + for ( split / /, $form->{"jcitems_$i"} ) { + my ( $id, $qty ) = split /:/, $_; + $form->update_balance( $dbh, 'jcitems', 'allocated', "id = $id", + $qty ); + } + } + + $rc = $dbh->commit; + + $rc; + +} 1; diff --git a/LedgerSMB/PriceMatrix.pm b/LedgerSMB/PriceMatrix.pm index c604e982..68fa5b12 100644 --- a/LedgerSMB/PriceMatrix.pm +++ b/LedgerSMB/PriceMatrix.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -14,7 +14,7 @@ # maintainers, and copyright holders, see the CONTRIBUTORS file. # # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): -# Copyright (C) 2001 +# Copyright (C) 2001 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.org @@ -23,30 +23,29 @@ # #====================================================================== # -# This file has undergone whitespace cleanup -# +# This file has undergone whitespace cleanup +# #====================================================================== # # Price Matrix module -# +# # #====================================================================== package PriceMatrix; sub price_matrix_query { - my ($dbh, $form) = @_; + my ( $dbh, $form ) = @_; - my $query; - my $sth; + my $query; + my $sth; - my @queryargs; + my @queryargs; - if ($form->{customer_id}) { - my $defaultcurrency = $form->{dbh}->quote( - $form->{defaultcurrency}); - my $customer_id = $form->{dbh}->quote($form->{customer_id}); - $query = qq| + if ( $form->{customer_id} ) { + my $defaultcurrency = $form->{dbh}->quote( $form->{defaultcurrency} ); + my $customer_id = $form->{dbh}->quote( $form->{customer_id} ); + $query = qq| SELECT p.id AS parts_id, 0 AS customer_id, 0 AS pricegroup_id, 0 AS pricebreak, p.sellprice, NULL AS validfrom, NULL AS validto, @@ -91,122 +90,129 @@ sub price_matrix_query { ORDER BY customer_id DESC, pricegroup_id DESC, pricebreak |; - $sth = $dbh->prepare($query) || $form->dberror($query); - } elsif ($form->{vendor_id}) { - my $vendor_id = $form->{dbh}->quote($form->{vendor_id}); - # price matrix and vendor's partnumber - $query = qq| + $sth = $dbh->prepare($query) || $form->dberror($query); + } + elsif ( $form->{vendor_id} ) { + my $vendor_id = $form->{dbh}->quote( $form->{vendor_id} ); + + # price matrix and vendor's partnumber + $query = qq| SELECT partnumber FROM partsvendor WHERE parts_id = ? AND vendor_id = $vendor_id|; - $sth = $dbh->prepare($query) || $form->dberror($query); - } - - $sth; -} + $sth = $dbh->prepare($query) || $form->dberror($query); + } + $sth; +} sub price_matrix { - my ($pmh, $ref, $transdate, $decimalplaces, $form, $myconfig) = @_; - $ref->{pricematrix} = ""; - my $customerprice; - my $pricegroupprice; - my $sellprice; - my $mref; - my %p = (); - - # depends if this is a customer or vendor - if ($form->{customer_id}) { - $pmh->execute($ref->{id}, $ref->{id}, $ref->{id}, $ref->{id}); - - while ($mref = $pmh->fetchrow_hashref(NAME_lc)) { - - # check date - if ($mref->{validfrom}) { - next if $transdate < $form->datetonum( - $myconfig, $mref->{validfrom}); - } - if ($mref->{validto}) { - next if $transdate > $form->datetonum( - $myconfig, $mref->{validto}); - } - - # convert price - $sellprice = $form->round_amount($mref->{sellprice} - * $form->{$mref->{curr}}, $decimalplaces); - - if ($mref->{customer_id}) { - $ref->{sellprice} = $sellprice - if !$mref->{pricebreak}; - $p{$mref->{pricebreak}} = $sellprice; - $customerprice = 1; - } - - if ($mref->{pricegroup_id}) { - if (! $customerprice) { - $ref->{sellprice} = $sellprice - if !$mref->{pricebreak}; - $p{$mref->{pricebreak}} = $sellprice; - } - $pricegroupprice = 1; - } - - if (!$customerprice && !$pricegroupprice) { - $p{$mref->{pricebreak}} = $sellprice; - } - - } - $pmh->finish; - - if (%p) { - if ($ref->{sellprice}) { - $p{0} = $ref->{sellprice}; - } - for (sort { $a <=> $b } keys %p) { - $ref->{pricematrix} .= "${_}:$p{$_} "; - } - } else { - if ($init) { - $ref->{sellprice} = $form->round_amount( - $ref->{sellprice}, $decimalplaces); - } else { - $ref->{sellprice} = $form->round_amount( - $ref->{sellprice} * - (1 - $form->{tradediscount}), - $decimalplaces); - } - $ref->{pricematrix} = "0:$ref->{sellprice} " - if $ref->{sellprice}; - } - chop $ref->{pricematrix}; - - } - - - if ($form->{vendor_id}) { - $pmh->execute($ref->{id}); - - $mref = $pmh->fetchrow_hashref(NAME_lc); - - if ($mref->{partnumber} ne "") { - $ref->{partnumber} = $mref->{partnumber}; - } - - if ($mref->{lastcost}) { - # do a conversion - $ref->{sellprice} = $form->round_amount( - $mref->{lastcost} * $form->{$mref->{curr}}, - $decimalplaces); - } - $pmh->finish; - - $ref->{sellprice} *= 1; - - # add 0:price to matrix - $ref->{pricematrix} = "0:$ref->{sellprice}"; - - } + my ( $pmh, $ref, $transdate, $decimalplaces, $form, $myconfig ) = @_; + $ref->{pricematrix} = ""; + my $customerprice; + my $pricegroupprice; + my $sellprice; + my $mref; + my %p = (); + + # depends if this is a customer or vendor + if ( $form->{customer_id} ) { + $pmh->execute( $ref->{id}, $ref->{id}, $ref->{id}, $ref->{id} ); + + while ( $mref = $pmh->fetchrow_hashref(NAME_lc) ) { + + # check date + if ( $mref->{validfrom} ) { + next + if $transdate < + $form->datetonum( $myconfig, $mref->{validfrom} ); + } + if ( $mref->{validto} ) { + next + if $transdate > + $form->datetonum( $myconfig, $mref->{validto} ); + } + + # convert price + $sellprice = + $form->round_amount( + $mref->{sellprice} * $form->{ $mref->{curr} }, + $decimalplaces ); + + if ( $mref->{customer_id} ) { + $ref->{sellprice} = $sellprice + if !$mref->{pricebreak}; + $p{ $mref->{pricebreak} } = $sellprice; + $customerprice = 1; + } + + if ( $mref->{pricegroup_id} ) { + if ( !$customerprice ) { + $ref->{sellprice} = $sellprice + if !$mref->{pricebreak}; + $p{ $mref->{pricebreak} } = $sellprice; + } + $pricegroupprice = 1; + } + + if ( !$customerprice && !$pricegroupprice ) { + $p{ $mref->{pricebreak} } = $sellprice; + } + + } + $pmh->finish; + + if (%p) { + if ( $ref->{sellprice} ) { + $p{0} = $ref->{sellprice}; + } + for ( sort { $a <=> $b } keys %p ) { + $ref->{pricematrix} .= "${_}:$p{$_} "; + } + } + else { + if ($init) { + $ref->{sellprice} = + $form->round_amount( $ref->{sellprice}, $decimalplaces ); + } + else { + $ref->{sellprice} = + $form->round_amount( + $ref->{sellprice} * ( 1 - $form->{tradediscount} ), + $decimalplaces ); + } + $ref->{pricematrix} = "0:$ref->{sellprice} " + if $ref->{sellprice}; + } + chop $ref->{pricematrix}; + + } + + if ( $form->{vendor_id} ) { + $pmh->execute( $ref->{id} ); + + $mref = $pmh->fetchrow_hashref(NAME_lc); + + if ( $mref->{partnumber} ne "" ) { + $ref->{partnumber} = $mref->{partnumber}; + } + + if ( $mref->{lastcost} ) { + + # do a conversion + $ref->{sellprice} = + $form->round_amount( $mref->{lastcost} * $form->{ $mref->{curr} }, + $decimalplaces ); + } + $pmh->finish; + + $ref->{sellprice} *= 1; + + # add 0:price to matrix + $ref->{pricematrix} = "0:$ref->{sellprice}"; + + } } 1; diff --git a/LedgerSMB/RC.pm b/LedgerSMB/RC.pm index 48f184cd..a7aa1d1f 100644 --- a/LedgerSMB/RC.pm +++ b/LedgerSMB/RC.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -33,261 +33,256 @@ package RC; - -sub getposlines{ - my ($self, $myconfig, $form) = @_; - %pos_config = %{$form->{pos_config}}; - %pos_sources = %{$form->{pos_sources}}; - my $sources = ''; - foreach $key (keys %pos_sources){ - $sources .= ", '$key'"; - } - $sources =~ s/^,\s*//; - my $dbh = $form->{dbh}; - - my $query = qq| +sub getposlines { + my ( $self, $myconfig, $form ) = @_; + %pos_config = %{ $form->{pos_config} }; + %pos_sources = %{ $form->{pos_sources} }; + my $sources = ''; + foreach $key ( keys %pos_sources ) { + $sources .= ", '$key'"; + } + $sources =~ s/^,\s*//; + my $dbh = $form->{dbh}; + + my $query = qq| SELECT sum(amount) AS amount, source FROM acc_trans WHERE chart_id = (SELECT id FROM chart WHERE accno = ?) AND transdate = date 'NOW' AND cleared IS NOT TRUE GROUP BY source|; - my $sth = $dbh->prepare($query); - $sth->execute($pos_config{till_accno}) || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{$form->{TB}}, $ref; - } - $sth->finish; - my $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute( $pos_config{till_accno} ) || $form->dberror($query); + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{TB} }, $ref; + } + $sth->finish; + my $query = qq| SELECT sum(amount) AS sum FROM acc_trans WHERE chart_id = (SELECT id FROM chart WHERE accno = ?) AND transdate = date 'NOW' AND cleared IS NOT TRUE|; - my $sth = $dbh->prepare($query); - $sth->execute($pos_config{till_accno}) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - $form->{sum} = $ref->{sum}; - $sth->finish; + my $sth = $dbh->prepare($query); + $sth->execute( $pos_config{till_accno} ) || $form->dberror($query); + my $ref = $sth->fetchrow_hashref(NAME_lc); + $form->{sum} = $ref->{sum}; + $sth->finish; } sub clear_till { - my ($self, $myconfig, $form) = @_; - %pos_config = %{$form->{pos_config}}; - %pos_sources = %{$form->{pos_sources}}; - my $sources = ''; - foreach $key (keys %pos_sources){ - $sources .= ", '$key'"; - } - $sources =~ s/^,\s//; - my $dbh = $form->{dbh}; - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + %pos_config = %{ $form->{pos_config} }; + %pos_sources = %{ $form->{pos_sources} }; + my $sources = ''; + foreach $key ( keys %pos_sources ) { + $sources .= ", '$key'"; + } + $sources =~ s/^,\s//; + my $dbh = $form->{dbh}; + my $query = qq| UPDATE acc_trans SET cleared = TRUE WHERE chart_id = (SELECT id FROM chart WHERE accno = ?) AND transdate = date 'NOW'|; - my $sth = $dbh->prepare($query); - $sth->execute($pos_config{till_accno}) || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute( $pos_config{till_accno} ) || $form->dberror($query); } -sub getbalance{ - my ($self, $myconfig, $form) = @_; - my $dbh = $form->{dbh}; +sub getbalance { + my ( $self, $myconfig, $form ) = @_; + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT sum(amount) AS balance FROM acc_trans WHERE chart_id = (SELECT id FROM chart WHERE accno = ?)|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{accno}) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - $form->{balance} = $ref->{balance}; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ) || $form->dberror($query); + my $ref = $sth->fetchrow_hashref(NAME_lc); + $form->{balance} = $ref->{balance}; } - sub paymentaccounts { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT accno, description FROM chart WHERE link LIKE '%_paid%' AND (category = 'A' OR category = 'L') ORDER BY accno|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{PR} }, $ref; - } - $sth->finish; + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{PR} }, $ref; + } + $sth->finish; - $form->all_years($myconfig, $dbh); + $form->all_years( $myconfig, $dbh ); } - sub payment_transactions { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $query; - my $sth; - - $query = qq|SELECT category FROM chart WHERE accno = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}); - ($form->{category}) = $sth->fetchrow_array(); - - my $cleared; - - ($form->{fromdate}, $form->{todate}) - = $form->from_to( - $form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - my $transdate = qq| AND ac.transdate < date |. - $dbh->quote($form->{fromdate}); - - if (! $form->{fromdate}) { - $cleared = qq| AND ac.cleared = '1'|; - $transdate = ""; - } - - # get beginning balance - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $query; + my $sth; + + $query = qq|SELECT category FROM chart WHERE accno = ?|; + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ); + ( $form->{category} ) = $sth->fetchrow_array(); + + my $cleared; + + ( $form->{fromdate}, $form->{todate} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + my $transdate = + qq| AND ac.transdate < date | . $dbh->quote( $form->{fromdate} ); + + if ( !$form->{fromdate} ) { + $cleared = qq| AND ac.cleared = '1'|; + $transdate = ""; + } + + # get beginning balance + $query = qq| SELECT sum(ac.amount) FROM acc_trans ac JOIN chart ch ON (ch.id = ac.chart_id) WHERE ch.accno = ? $transdate $cleared |; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}); - ($form->{beginningbalance}) = $sth->fetchrow_array(); + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ); + ( $form->{beginningbalance} ) = $sth->fetchrow_array(); - $query = qq| + $query = qq| SELECT sum(ac.amount) FROM acc_trans ac JOIN chart ch ON (ch.id = ac.chart_id) WHERE ch.accno = ? AND ac.fx_transaction = '1' $transdate $cleared|; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}); - ($form->{fx_balance}) = $sth->fetchrow_array(); - - - $transdate = ""; - if ($form->{todate}) { - $transdate = qq| AND ac.transdate <= date |. - $dbh->quote($form->{todate}); - } - - # get statement balance - $query = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ); + ( $form->{fx_balance} ) = $sth->fetchrow_array(); + + $transdate = ""; + if ( $form->{todate} ) { + $transdate = + qq| AND ac.transdate <= date | . $dbh->quote( $form->{todate} ); + } + + # get statement balance + $query = qq| SELECT sum(ac.amount) FROM acc_trans ac JOIN chart ch ON (ch.id = ac.chart_id) WHERE ch.accno = ? $transdate|; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}); - ($form->{endingbalance}) = $sth->fetchrow_array(); + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ); + ( $form->{endingbalance} ) = $sth->fetchrow_array(); - # fx balance - $query = qq| + # fx balance + $query = qq| SELECT sum(ac.amount) FROM acc_trans ac JOIN chart ch ON (ch.id = ac.chart_id) WHERE ch.accno = ? AND ac.fx_transaction = '1' $transdate |; - $sth = $dbh->prepare($query); - $sth->execute($form->{accno}); - ($form->{fx_endingbalance}) = $sth->fetchrow_array(); - - - $cleared = qq| AND ac.cleared = '0'| unless $form->{fromdate}; - - if ($form->{report}) { - $cleared = qq| AND NOT (ac.cleared = '0' OR ac.cleared = '1')|; - if ($form->{cleared}) { - $cleared = qq| AND ac.cleared = '1'|; - } - if ($form->{outstanding}) { - $cleared = - ($form->{cleared}) - ? "" - : qq| AND ac.cleared = '0'|; - } - if (! $form->{fromdate}) { - $form->{beginningbalance} = 0; - $form->{fx_balance} = 0; - } - } - - my $fx_transaction; - if ($form->{fx_transaction}) { - $fx_transaction = qq| + $sth = $dbh->prepare($query); + $sth->execute( $form->{accno} ); + ( $form->{fx_endingbalance} ) = $sth->fetchrow_array(); + + $cleared = qq| AND ac.cleared = '0'| unless $form->{fromdate}; + + if ( $form->{report} ) { + $cleared = qq| AND NOT (ac.cleared = '0' OR ac.cleared = '1')|; + if ( $form->{cleared} ) { + $cleared = qq| AND ac.cleared = '1'|; + } + if ( $form->{outstanding} ) { + $cleared = + ( $form->{cleared} ) + ? "" + : qq| AND ac.cleared = '0'|; + } + if ( !$form->{fromdate} ) { + $form->{beginningbalance} = 0; + $form->{fx_balance} = 0; + } + } + + my $fx_transaction; + if ( $form->{fx_transaction} ) { + $fx_transaction = qq| AND NOT (ac.chart_id IN (SELECT value FROM defaults WHERE setting_key = 'fxgain_accno_id' UNION SELECT value FROM defaults WHERE setting_key = 'fxloss_accno_id'))|; - } else { - $fx_transaction = qq| + } + else { + $fx_transaction = qq| AND ac.fx_transaction = '0'|; - } - - - if ($form->{summary}) { - $query = qq| + } + + if ( $form->{summary} ) { + $query = qq| SELECT ac.transdate, ac.source, sum(ac.amount) AS amount, ac.cleared FROM acc_trans ac JOIN chart ch ON (ac.chart_id = ch.id) - WHERE ch.accno = |.$dbh->quote($form->{accno}).qq| + WHERE ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND ac.amount >= 0 $fx_transaction $cleared|; - $query .= " AND ac.transdate >= ".$dbh->quote($form->{fromdate}) - if $form->{fromdate}; - $query .= " AND ac.transdate <= ".$dbh->quote($form->{todate}) - if $form->{todate}; - $query .= " GROUP BY ac.source, ac.transdate, ac.cleared"; - $query .= qq| + $query .= " AND ac.transdate >= " . $dbh->quote( $form->{fromdate} ) + if $form->{fromdate}; + $query .= " AND ac.transdate <= " . $dbh->quote( $form->{todate} ) + if $form->{todate}; + $query .= " GROUP BY ac.source, ac.transdate, ac.cleared"; + $query .= qq| UNION ALL SELECT ac.transdate, ac.source, sum(ac.amount) AS amount, ac.cleared FROM acc_trans ac JOIN chart ch ON (ac.chart_id = ch.id) - WHERE ch.accno = |.$dbh->quote($form->{accno}).qq| + WHERE ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND ac.amount < 0 $fx_transaction $cleared|; - $query .= " AND ac.transdate >= ".$dbh->quote($form->{fromdate}) - if $form->{fromdate}; - $query .= " AND ac.transdate <= ".$dbh->quote($form->{todate}) - if $form->{todate}; - $query .= " GROUP BY ac.source, ac.transdate, ac.cleared"; - - $query .= " ORDER BY 1,2"; - - } else { - - $query = qq| + $query .= " AND ac.transdate >= " . $dbh->quote( $form->{fromdate} ) + if $form->{fromdate}; + $query .= " AND ac.transdate <= " . $dbh->quote( $form->{todate} ) + if $form->{todate}; + $query .= " GROUP BY ac.source, ac.transdate, ac.cleared"; + + $query .= " ORDER BY 1,2"; + + } + else { + + $query = qq| SELECT ac.transdate, ac.source, ac.fx_transaction, ac.amount, ac.cleared, g.id, g.description FROM acc_trans ac JOIN chart ch ON (ac.chart_id = ch.id) JOIN gl g ON (g.id = ac.trans_id) - WHERE ch.accno = |.$dbh->quote($form->{accno}).qq| + WHERE ch.accno = | . $dbh->quote( $form->{accno} ) . qq| $fx_transaction $cleared|; - $query .= " AND ac.transdate >= ".$dbh->quote($form->{fromdate}) - if $form->{fromdate}; - $query .= " AND ac.transdate <= ".$dbh->quote($form->{todate}) - if $form->{todate}; - $query .= qq| + $query .= " AND ac.transdate >= " . $dbh->quote( $form->{fromdate} ) + if $form->{fromdate}; + $query .= " AND ac.transdate <= " . $dbh->quote( $form->{todate} ) + if $form->{todate}; + $query .= qq| UNION ALL SELECT ac.transdate, ac.source, ac.fx_transaction, ac.amount, ac.cleared, a.id, n.name @@ -295,13 +290,13 @@ sub payment_transactions { JOIN chart ch ON (ac.chart_id = ch.id) JOIN ar a ON (a.id = ac.trans_id) JOIN customer n ON (n.id = a.customer_id) - WHERE ch.accno = |.$dbh->quote($form->{accno}).qq| + WHERE ch.accno = | . $dbh->quote( $form->{accno} ) . qq| $fx_transaction $cleared|; - $query .= " AND ac.transdate >= ".$dbh->quote($form->{fromdate}) - if $form->{fromdate}; - $query .= " AND ac.transdate <= ".$dbh->quote($form->{todate}) - if $form->{todate}; - $query .= qq| + $query .= " AND ac.transdate >= " . $dbh->quote( $form->{fromdate} ) + if $form->{fromdate}; + $query .= " AND ac.transdate <= " . $dbh->quote( $form->{todate} ) + if $form->{todate}; + $query .= qq| UNION ALL SELECT ac.transdate, ac.source, ac.fx_transaction, ac.amount, ac.cleared, a.id, n.name @@ -309,31 +304,31 @@ sub payment_transactions { JOIN chart ch ON (ac.chart_id = ch.id) JOIN ap a ON (a.id = ac.trans_id) JOIN vendor n ON (n.id = a.vendor_id) - WHERE ch.accno = |.$dbh->quote($form->{accno}).qq| + WHERE ch.accno = | . $dbh->quote( $form->{accno} ) . qq| $fx_transaction $cleared|; - $query .= " AND ac.transdate >= ".$dbh->quote($form->{fromdate}) - if $form->{fromdate}; - $query .= " AND ac.transdate <= ".$dbh->quote($form->{todate}) - if $form->{todate}; - - $query .= " ORDER BY 1,2,3"; - } - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - my $dr; - my $cr; - - if ($form->{summary}) { - $query = qq| + $query .= " AND ac.transdate >= " . $dbh->quote( $form->{fromdate} ) + if $form->{fromdate}; + $query .= " AND ac.transdate <= " . $dbh->quote( $form->{todate} ) + if $form->{todate}; + + $query .= " ORDER BY 1,2,3"; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $dr; + my $cr; + + if ( $form->{summary} ) { + $query = qq| SELECT c.name FROM customer c JOIN ar a ON (c.id = a.customer_id) JOIN acc_trans ac ON (a.id = ac.trans_id) JOIN chart ch ON (ac.chart_id = ch.id) WHERE ac.transdate = ? - AND ch.accno = |.$dbh->quote($form->{accno}).qq| + AND ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND (ac.source = ? OR ac.source IS NULL) AND ac.amount >= 0 $cleared UNION @@ -343,7 +338,7 @@ sub payment_transactions { JOIN acc_trans ac ON (a.id = ac.trans_id) JOIN chart ch ON (ac.chart_id = ch.id) WHERE ac.transdate = ? - AND ch.accno = |.$dbh->quote($form->{accno}).qq| + AND ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND (ac.source = ? OR ac.source IS NULL) AND ac.amount > 0 $cleared UNION @@ -352,21 +347,21 @@ sub payment_transactions { JOIN acc_trans ac ON (g.id = ac.trans_id) JOIN chart ch ON (ac.chart_id = ch.id) WHERE ac.transdate = ? - AND ch.accno = |.$dbh->quote($form->{accno}).qq| + AND ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND (ac.source = ? OR ac.source IS NULL) AND ac.amount >= 0 $cleared|; - - $query .= " ORDER BY 1"; - $dr = $dbh->prepare($query); - $query = qq| + $query .= " ORDER BY 1"; + $dr = $dbh->prepare($query); + + $query = qq| SELECT c.name FROM customer c JOIN ar a ON (c.id = a.customer_id) JOIN acc_trans ac ON (a.id = ac.trans_id) JOIN chart ch ON (ac.chart_id = ch.id) WHERE ac.transdate = ? - AND ch.accno = |.$dbh->quote($form->{accno}).qq| + AND ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND (ac.source = ? OR ac.source IS NULL) AND ac.amount < 0 $cleared UNION @@ -376,7 +371,7 @@ sub payment_transactions { JOIN acc_trans ac ON (a.id = ac.trans_id) JOIN chart ch ON (ac.chart_id = ch.id) WHERE ac.transdate = ? - AND ch.accno = |.$dbh->quote($form->{accno}).qq| + AND ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND (ac.source = ? OR ac.source IS NULL) AND ac.amount < 0 $cleared UNION @@ -385,119 +380,115 @@ sub payment_transactions { JOIN acc_trans ac ON (g.id = ac.trans_id) JOIN chart ch ON (ac.chart_id = ch.id) WHERE ac.transdate = ? - AND ch.accno = |.$dbh->quote($form->{accno}).qq| + AND ch.accno = | . $dbh->quote( $form->{accno} ) . qq| AND (ac.source = ? OR ac.source IS NULL) AND ac.amount < 0 $cleared|; - - $query .= " ORDER BY 1"; - $cr = $dbh->prepare($query); - } - - my $name; - my $ref; - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - - if ($form->{summary}) { - - if ($ref->{amount} > 0) { - $dr->execute( - $ref->{transdate}, $ref->{source}, - $ref->{transdate}, $ref->{source}, - $ref->{transdate}, $ref->{source}); - $ref->{oldcleared} = $ref->{cleared}; - $ref->{name} = (); - - while (($name) = $dr->fetchrow_array) { - push @{ $ref->{name} }, $name; - } - $dr->finish; - } else { - - $cr->execute( - $ref->{transdate}, $ref->{source}, - $ref->{transdate}, $ref->{source}, - $ref->{transdate}, $ref->{source}); - $ref->{oldcleared} = $ref->{cleared}; - $ref->{name} = (); - while (($name) = $cr->fetchrow_array) { - push @{ $ref->{name} }, $name; - } - $cr->finish; - - } - - } else { - push @{ $ref->{name} }, $ref->{description}; - } - - push @{ $form->{PR} }, $ref; - - } - $sth->finish; - - $dbh->commit; - -} + $query .= " ORDER BY 1"; + $cr = $dbh->prepare($query); + } + + my $name; + my $ref; + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + if ( $form->{summary} ) { + + if ( $ref->{amount} > 0 ) { + $dr->execute( + $ref->{transdate}, $ref->{source}, $ref->{transdate}, + $ref->{source}, $ref->{transdate}, $ref->{source} + ); + $ref->{oldcleared} = $ref->{cleared}; + $ref->{name} = (); + + while ( ($name) = $dr->fetchrow_array ) { + push @{ $ref->{name} }, $name; + } + $dr->finish; + } + else { + + $cr->execute( + $ref->{transdate}, $ref->{source}, $ref->{transdate}, + $ref->{source}, $ref->{transdate}, $ref->{source} + ); + $ref->{oldcleared} = $ref->{cleared}; + $ref->{name} = (); + while ( ($name) = $cr->fetchrow_array ) { + push @{ $ref->{name} }, $name; + } + $cr->finish; + + } + + } + else { + push @{ $ref->{name} }, $ref->{description}; + } + + push @{ $form->{PR} }, $ref; + + } + $sth->finish; + + $dbh->commit; + +} sub reconcile { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq|SELECT id FROM chart + my $query = qq|SELECT id FROM chart WHERE accno = '$form->{accno}'|; - my ($chart_id) = $dbh->selectrow_array($query); - $chart_id *= 1; - - $query = qq| + my ($chart_id) = $dbh->selectrow_array($query); + $chart_id *= 1; + + $query = qq| SELECT trans_id FROM acc_trans WHERE (source = ? OR source IS NULL) AND transdate = ? AND cleared = '0' - AND chart_id = |.$dbh->quote($chart_id); - my $sth = $dbh->prepare($query) || $form->dberror($query); - - my $i; - my $trans_id; + AND chart_id = | . $dbh->quote($chart_id); + my $sth = $dbh->prepare($query) || $form->dberror($query); - $query = qq| + my $i; + my $trans_id; + + $query = qq| UPDATE acc_trans SET cleared = '1' WHERE cleared = '0' AND trans_id = ? AND transdate = ? - AND chart_id = |.$dbh->quote($chart_id); - my $tth = $dbh->prepare($query) || $form->dberror($query); - - # clear flags - for $i (1 .. $form->{rowcount}) { - if ($form->{"cleared_$i"} && ! $form->{"oldcleared_$i"}) { - if ($form->{summary}) { - $sth->execute( - $form->{"source_$i"}, - $form->{"transdate_$i"} - ) || $form->dberror; - - while (($trans_id) = $sth->fetchrow_array) { - $tth->execute( - $trans_id, - $form->{"transdate_$i"} - ) || $form->dberror; - $tth->finish; - } - $sth->finish; - - } else { - - $tth->execute( - $form->{"id_$i"}, - $form->{"transdate_$i"} - ) || $form->dberror; - $tth->finish; - } - } - } - - $dbh->commit; + AND chart_id = | . $dbh->quote($chart_id); + my $tth = $dbh->prepare($query) || $form->dberror($query); + + # clear flags + for $i ( 1 .. $form->{rowcount} ) { + if ( $form->{"cleared_$i"} && !$form->{"oldcleared_$i"} ) { + if ( $form->{summary} ) { + $sth->execute( $form->{"source_$i"}, $form->{"transdate_$i"} ) + || $form->dberror; + + while ( ($trans_id) = $sth->fetchrow_array ) { + $tth->execute( $trans_id, $form->{"transdate_$i"} ) + || $form->dberror; + $tth->finish; + } + $sth->finish; + + } + else { + + $tth->execute( $form->{"id_$i"}, $form->{"transdate_$i"} ) + || $form->dberror; + $tth->finish; + } + } + } + + $dbh->commit; } diff --git a/LedgerSMB/RESTXML/Document/Base.pm b/LedgerSMB/RESTXML/Document/Base.pm index e8feaa96..986b4148 100644 --- a/LedgerSMB/RESTXML/Document/Base.pm +++ b/LedgerSMB/RESTXML/Document/Base.pm @@ -5,26 +5,27 @@ use XML::Twig; use LedgerSMB::Log; use Carp; -sub handle_post { - my ($self, $args) = @_; +sub handle_post { + my ( $self, $args ) = @_; - return $args->{handler}->unsupported('the POST method is not implemented.'); + return $args->{handler}->unsupported('the POST method is not implemented.'); } -sub handle_put { - my ($self, $args) = @_; - return $self->{handler}->unsupported('the PUT method is not implemented.'); +sub handle_put { + my ( $self, $args ) = @_; + return $self->{handler}->unsupported('the PUT method is not implemented.'); } sub handle_delete { - my ($self, $args) = @_; - return $self->{handler}->unsupported('the DELETE method is not implemented.'); + my ( $self, $args ) = @_; + return $self->{handler} + ->unsupported('the DELETE method is not implemented.'); } sub handle_get { - my ($self, $args) = @_; + my ( $self, $args ) = @_; - return $self->{handler}->unsupported('the GET method is not implemented.'); + return $self->{handler}->unsupported('the GET method is not implemented.'); } =head3 hash_to_twig @@ -45,18 +46,25 @@ nodes at once. =cut -sub hash_to_twig { - my ($self, $args) = @_; - - my $hash = $args->{hash} || croak "Need a hash to convert to use hash_to_twig"; - my $name = $args->{name} || croak "Need a root element name to use hash_to_twig"; - my @keyorder = keys %$hash; - - @keyorder = sort @keyorder unless defined($args->{sort}) and $args->{sort} == 0; - - return XML::Twig::Elt->new($name,$args->{root_attr}||{}, map { - XML::Twig::Elt->new($_, {'#CDATA'=>1}, $hash->{$_}) - } @keyorder ); +sub hash_to_twig { + my ( $self, $args ) = @_; + + my $hash = $args->{hash} + || croak "Need a hash to convert to use hash_to_twig"; + my $name = $args->{name} + || croak "Need a root element name to use hash_to_twig"; + my @keyorder = keys %$hash; + + @keyorder = sort @keyorder + unless defined( $args->{sort} ) + and $args->{sort} == 0; + + return XML::Twig::Elt->new( + $name, + $args->{root_attr} || {}, + map { XML::Twig::Elt->new( $_, { '#CDATA' => 1 }, $hash->{$_} ) } + @keyorder + ); } 1; diff --git a/LedgerSMB/RESTXML/Document/Customer.pm b/LedgerSMB/RESTXML/Document/Customer.pm index 3a494965..b2e19753 100644 --- a/LedgerSMB/RESTXML/Document/Customer.pm +++ b/LedgerSMB/RESTXML/Document/Customer.pm @@ -3,21 +3,22 @@ use strict; use warnings; use base qw(LedgerSMB::RESTXML::Document::Base); +sub handle_get { + my ( $self, $args ) = @_; + my $user = $args->{user}; + my $dbh = $args->{dbh}; + my $handler = $args->{handler}; -sub handle_get { - my ($self, $args) = @_; - my $user = $args->{user}; - my $dbh = $args->{dbh}; - my $handler = $args->{handler}; + my $res = $dbh->selectrow_hashref( q{SELECT * from customer where id = ?}, + undef, $args->{args}[0] ); - my $res = $dbh->selectrow_hashref(q{SELECT * from customer where id = ?}, undef, $args->{args}[0]); - - if(!$res) { - $handler->not_found("No customer with the id $args->{args}[0] found"); - } else { - $handler->respond($self->hash_to_twig({name=>'Customer',hash=>$res})); - } + if ( !$res ) { + $handler->not_found("No customer with the id $args->{args}[0] found"); + } + else { + $handler->respond( + $self->hash_to_twig( { name => 'Customer', hash => $res } ) ); + } } - 1; diff --git a/LedgerSMB/RESTXML/Document/Customer_Search.pm b/LedgerSMB/RESTXML/Document/Customer_Search.pm index 7456f9d3..9f2fb3d6 100644 --- a/LedgerSMB/RESTXML/Document/Customer_Search.pm +++ b/LedgerSMB/RESTXML/Document/Customer_Search.pm @@ -4,43 +4,58 @@ use warnings; use base qw(LedgerSMB::RESTXML::Document::Base); use LedgerSMB::Log; -sub handle_get { - my ($self, $args) = @_; - my $user = $args->{user}; - my $dbh = $args->{dbh}; - my $handler = $args->{handler}; - - my $query = $handler->read_query(); - - my %terms; - - for my $field ($query->param()) { - # TODO: BIG GAPING HOLE HERE. - $terms{$field} = $query->param($field); - } - - if($terms{_keyword}) { - %terms = ( - name=>$terms{_keyword}, - customernumber=>$terms{_keyword}, - contact=>$terms{_keyword} - ); - } - my $sql = 'SELECT id,name,phone,customernumber FROM customer WHERE '.join(' OR ',map { "$_ like ?" } sort keys %terms); - - - my $res = $dbh->prepare($sql); - - $res->execute(map { "$terms{$_}\%" } sort keys %terms) or return $handler->error($dbh->errstr); - - my @rows; - my $row; - push @rows, $row while $row = $res->fetchrow_hashref(); - - $res->finish(); - - $handler->respond(XML::Twig::Elt->new('Customer_Search_Response',{'xmlns:xlink'=>"http://www.w3.org/1999/xlink"},map { - $self->hash_to_twig({name=>'Customer',root_attr=>{'xlink:href'=>"Customer/$_->{id}"}, hash=>$_}); - } @rows)); +sub handle_get { + my ( $self, $args ) = @_; + my $user = $args->{user}; + my $dbh = $args->{dbh}; + my $handler = $args->{handler}; + + my $query = $handler->read_query(); + + my %terms; + + for my $field ( $query->param() ) { + + # TODO: BIG GAPING HOLE HERE. + $terms{$field} = $query->param($field); + } + + if ( $terms{_keyword} ) { + %terms = ( + name => $terms{_keyword}, + customernumber => $terms{_keyword}, + contact => $terms{_keyword} + ); + } + my $sql = + 'SELECT id,name,phone,customernumber FROM customer WHERE ' + . join( ' OR ', map { "$_ like ?" } sort keys %terms ); + + my $res = $dbh->prepare($sql); + + $res->execute( map { "$terms{$_}\%" } sort keys %terms ) + or return $handler->error( $dbh->errstr ); + + my @rows; + my $row; + push @rows, $row while $row = $res->fetchrow_hashref(); + + $res->finish(); + + $handler->respond( + XML::Twig::Elt->new( + 'Customer_Search_Response', + { 'xmlns:xlink' => "http://www.w3.org/1999/xlink" }, + map { + $self->hash_to_twig( + { + name => 'Customer', + root_attr => { 'xlink:href' => "Customer/$_->{id}" }, + hash => $_ + } + ); + } @rows + ) + ); } 1; diff --git a/LedgerSMB/RESTXML/Document/Part.pm b/LedgerSMB/RESTXML/Document/Part.pm index 072f9b80..97394494 100644 --- a/LedgerSMB/RESTXML/Document/Part.pm +++ b/LedgerSMB/RESTXML/Document/Part.pm @@ -3,21 +3,22 @@ use strict; use warnings; use base qw(LedgerSMB::RESTXML::Document::Base); +sub handle_get { + my ( $self, $args ) = @_; + my $user = $args->{user}; + my $dbh = $args->{dbh}; + my $handler = $args->{handler}; -sub handle_get { - my ($self, $args) = @_; - my $user = $args->{user}; - my $dbh = $args->{dbh}; - my $handler = $args->{handler}; + my $res = $dbh->selectrow_hashref( q{SELECT * from part where id = ?}, + undef, $args->{args}[0] ); - my $res = $dbh->selectrow_hashref(q{SELECT * from part where id = ?}, undef, $args->{args}[0]); - - if(!$res) { - $handler->not_found("No part with the id $args->{args}[0] found"); - } else { - $handler->respond($self->hash_to_twig({name=>'Customer',hash=>$res})); - } + if ( !$res ) { + $handler->not_found("No part with the id $args->{args}[0] found"); + } + else { + $handler->respond( + $self->hash_to_twig( { name => 'Customer', hash => $res } ) ); + } } - 1; diff --git a/LedgerSMB/RESTXML/Document/Part_Search.pm b/LedgerSMB/RESTXML/Document/Part_Search.pm index 927c67c0..9339dcc2 100644 --- a/LedgerSMB/RESTXML/Document/Part_Search.pm +++ b/LedgerSMB/RESTXML/Document/Part_Search.pm @@ -4,42 +4,57 @@ use warnings; use base qw(LedgerSMB::RESTXML::Document::Base); use LedgerSMB::Log; -sub handle_get { - my ($self, $args) = @_; - my $user = $args->{user}; - my $dbh = $args->{dbh}; - my $handler = $args->{handler}; - - my $query = $handler->read_query(); - - my %terms; - - for my $field ($query->param()) { - # TODO: BIG GAPING HOLE HERE. - $terms{$field} = $query->param($field); - } - - if($terms{_keyword}) { - %terms = ( - description=>$terms{_keyword}, - partnumber=>$terms{_keyword}, - ); - } - my $sql = 'SELECT id,description,partnumber FROM parts WHERE '.join(' OR ',map { "$_ like ?" } sort keys %terms); - - - my $res = $dbh->prepare($sql); - - $res->execute(map { "$terms{$_}\%" } sort keys %terms) or return $handler->error($dbh->errstr); - - my @rows; - my $row; - push @rows, $row while $row = $res->fetchrow_hashref(); - - $res->finish(); - - $handler->respond(XML::Twig::Elt->new('Part_Search_Response',{'xmlns:xlink'=>"http://www.w3.org/1999/xlink"},map { - $self->hash_to_twig({name=>'Part',root_attr=>{'xlink:href'=>"Part/$_->{id}"}, hash=>$_}); - } @rows)); +sub handle_get { + my ( $self, $args ) = @_; + my $user = $args->{user}; + my $dbh = $args->{dbh}; + my $handler = $args->{handler}; + + my $query = $handler->read_query(); + + my %terms; + + for my $field ( $query->param() ) { + + # TODO: BIG GAPING HOLE HERE. + $terms{$field} = $query->param($field); + } + + if ( $terms{_keyword} ) { + %terms = ( + description => $terms{_keyword}, + partnumber => $terms{_keyword}, + ); + } + my $sql = + 'SELECT id,description,partnumber FROM parts WHERE ' + . join( ' OR ', map { "$_ like ?" } sort keys %terms ); + + my $res = $dbh->prepare($sql); + + $res->execute( map { "$terms{$_}\%" } sort keys %terms ) + or return $handler->error( $dbh->errstr ); + + my @rows; + my $row; + push @rows, $row while $row = $res->fetchrow_hashref(); + + $res->finish(); + + $handler->respond( + XML::Twig::Elt->new( + 'Part_Search_Response', + { 'xmlns:xlink' => "http://www.w3.org/1999/xlink" }, + map { + $self->hash_to_twig( + { + name => 'Part', + root_attr => { 'xlink:href' => "Part/$_->{id}" }, + hash => $_ + } + ); + } @rows + ) + ); } 1; diff --git a/LedgerSMB/RESTXML/Document/SalesOrder.pm b/LedgerSMB/RESTXML/Document/SalesOrder.pm index acb4d5aa..b2f96256 100644 --- a/LedgerSMB/RESTXML/Document/SalesOrder.pm +++ b/LedgerSMB/RESTXML/Document/SalesOrder.pm @@ -3,15 +3,12 @@ use strict; use warnings; use base qw(LedgerSMB::RESTXML::Document::Base); +sub handle_get { + my ( $self, $args ) = @_; - -sub handle_get { - my ($self, $args) = @_; - - print "Content-type: text/html\n\n"; - print "It still works"; + print "Content-type: text/html\n\n"; + print "It still works"; } - 1; diff --git a/LedgerSMB/RESTXML/Document/Session.pm b/LedgerSMB/RESTXML/Document/Session.pm index 1db36502..ed99b06b 100644 --- a/LedgerSMB/RESTXML/Document/Session.pm +++ b/LedgerSMB/RESTXML/Document/Session.pm @@ -16,18 +16,15 @@ use strict; use warnings; use base qw(LedgerSMB::RESTXML::Document::Base); - -sub handle_get { - my ($self, $args) = @_; - +sub handle_get { + my ( $self, $args ) = @_; } -sub handle_post { - my ($self, $args) = @_; - print "Content-type: text/html\n\nhi"; - -} +sub handle_post { + my ( $self, $args ) = @_; + print "Content-type: text/html\n\nhi"; +} 1; diff --git a/LedgerSMB/RESTXML/Handler.pm b/LedgerSMB/RESTXML/Handler.pm index 006c2ead..0939da7f 100644 --- a/LedgerSMB/RESTXML/Handler.pm +++ b/LedgerSMB/RESTXML/Handler.pm @@ -17,61 +17,73 @@ CGI_handle is the gateway for the RESTful lsmb API. =cut -sub cgi_handle { - my $self = shift; - - my $method = $ENV{REQUEST_METHOD}; - my $pathinfo = $ENV{PATH_INFO}; - - #pull off the leading slash, we need it in the form document/arguments/foo - $pathinfo =~ s#^/##; - - - my $function = 'handle_'.lc($method); - my ($user, $module, @args) = split '/',$pathinfo; - $user = LedgerSMB::User->fetch_config($user); - - my $dbh = $self->connect_db($user); - - # non-word characters are forbidden, usually a sign of someone being sneaky. - $module =~ s#\W##; - - my $document_module = $self->try_to_load($module); - - if($document_module) { - if($document_module->can($function)) { - my $returnValue = $document_module->$function({dbh=>$dbh, args=>\@args, handler=>$self, user=>$user}); - - #return $self->return_serialized_response($returnValue); - - } else { - return $self->unsupported("$module cannot handle method $method"); - } - } else { - return $self->not_found("Could not find a handler for document type $module: <pre>$@</pre>"); - } +sub cgi_handle { + my $self = shift; + + my $method = $ENV{REQUEST_METHOD}; + my $pathinfo = $ENV{PATH_INFO}; + + #pull off the leading slash, we need it in the form document/arguments/foo + $pathinfo =~ s#^/##; + + my $function = 'handle_' . lc($method); + my ( $user, $module, @args ) = split '/', $pathinfo; + $user = LedgerSMB::User->fetch_config($user); + + my $dbh = $self->connect_db($user); + + # non-word characters are forbidden, usually a sign of someone being sneaky. + $module =~ s#\W##; + + my $document_module = $self->try_to_load($module); + + if ($document_module) { + if ( $document_module->can($function) ) { + my $returnValue = $document_module->$function( + { + dbh => $dbh, + args => \@args, + handler => $self, + user => $user + } + ); + + #return $self->return_serialized_response($returnValue); + + } + else { + return $self->unsupported("$module cannot handle method $method"); + } + } + else { + return $self->not_found( + "Could not find a handler for document type $module: <pre>$@</pre>" + ); + } } -sub cgi_report_error { - my $self = shift; - my $message = shift; - my $code = shift||500; - - print "Status: $code\n"; - print "Content-Type: text/html\n\n"; - print "<html><body>\n"; - print "<h1>REST API error</h1>"; - print "<blockquote>$message</blockquote>"; - print "</body></html>"; +sub cgi_report_error { + my $self = shift; + my $message = shift; + my $code = shift || 500; + + print "Status: $code\n"; + print "Content-Type: text/html\n\n"; + print "<html><body>\n"; + print "<h1>REST API error</h1>"; + print "<blockquote>$message</blockquote>"; + print "</body></html>"; } -sub cgi_read_query { - my $self = shift; - - use CGI; - my $cgi = CGI->new(); - return $cgi; +sub cgi_read_query { + my $self = shift; + + use CGI; + my $cgi = CGI->new(); + + return $cgi; } + # ------------------------------------------------------------------------------------------------------------------------ =head3 try_to_load @@ -83,20 +95,21 @@ document to try to load. returns a blessed anonymous hashref if the module =cut -sub try_to_load { - my $self = shift; - my $module = shift; +sub try_to_load { + my $self = shift; + my $module = shift; - eval qq{ + eval qq{ use LedgerSMB::RESTXML::Document::$module; }; - if($@) { - warn "Cannot load $module: $@" unless $@ =~ /Can't locate LedgerSMB\//i; - - return undef; - } else { - return bless {}, "LedgerSMB::RESTXML::Document::$module"; - } + if ($@) { + warn "Cannot load $module: $@" unless $@ =~ /Can't locate LedgerSMB\//i; + + return undef; + } + else { + return bless {}, "LedgerSMB::RESTXML::Document::$module"; + } } =head3 connect_db @@ -105,67 +118,71 @@ Given a user's config, returns a database connection handle. =cut -sub connect_db { - my ($self, $myconfig) = @_; +sub connect_db { + my ( $self, $myconfig ) = @_; - my $dbh = DBI->connect( - $myconfig->{dbconnect}, $myconfig->{dbuser}, - $myconfig->{dbpasswd}) - or carp "Error connecting to the db :$DBI::errstr"; + my $dbh = DBI->connect( $myconfig->{dbconnect}, + $myconfig->{dbuser}, $myconfig->{dbpasswd} ) + or carp "Error connecting to the db :$DBI::errstr"; - return $dbh; + return $dbh; } # lets see how far XML::Simple can take us. use XML::Simple; use Scalar::Util qw(blessed); -sub return_serialized_response { - my ($self, $response) = @_; +sub return_serialized_response { + my ( $self, $response ) = @_; - print "Content-type: text/xml\n\n"; + print "Content-type: text/xml\n\n"; - if(blessed $response && $response->isa('XML::Twig::Elt')) { - print qq{<?xml version="1.0"?>\n}; - print $response->sprint(); - } else { - my $xs = XML::Simple->new(NoAttr=>1,RootName=>'LedgerSMBResponse',XMLDecl=>1); + if ( blessed $response && $response->isa('XML::Twig::Elt') ) { + print qq{<?xml version="1.0"?>\n}; + print $response->sprint(); + } + else { + my $xs = XML::Simple->new( + NoAttr => 1, + RootName => 'LedgerSMBResponse', + XMLDecl => 1 + ); - print $xs->XMLout($response); - } + print $xs->XMLout($response); + } - return; + return; } -sub read_query { - my ($self) = @_; +sub read_query { + my ($self) = @_; - # for now. - return $self->cgi_read_query(); + # for now. + return $self->cgi_read_query(); } # =------------------------- POSSIBLE WAYS FOR MODULES TO RESPOND. -sub respond { - my ($self, $data) = @_; +sub respond { + my ( $self, $data ) = @_; - return $self->return_serialized_response($data); + return $self->return_serialized_response($data); } -sub not_found { - my ($self, $message) = @_; +sub not_found { + my ( $self, $message ) = @_; - $self->cgi_report_error($message,404); + $self->cgi_report_error( $message, 404 ); } -sub unsupported { - my ($self, $message) = @_; - $self->cgi_report_error($message, 501) +sub unsupported { + my ( $self, $message ) = @_; + $self->cgi_report_error( $message, 501 ); } -sub error { - my ($self, $message) = @_; +sub error { + my ( $self, $message ) = @_; - $self->cgi_report_error($message,500); + $self->cgi_report_error( $message, 500 ); } 1; diff --git a/LedgerSMB/RP.pm b/LedgerSMB/RP.pm index f778ae67..797488d0 100644 --- a/LedgerSMB/RP.pm +++ b/LedgerSMB/RP.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -34,39 +34,41 @@ package RP; sub inventory_activity { - my ($self, $myconfig, $form) = @_; - ($form->{fromdate}, $form->{todate}) = - $form->from_to($form->{fromyear}, $form->{frommonth}, - $form->{interval}) - if $form->{fromyear} && $form->{frommonth}; - - my $dbh = $form->{dbh}; - - unless ($form->{sort_col}){ - $form->{sort_col} = 'partnumber'; - } - - - my $where = ''; - if ($form->{fromdate}){ - $where .= "AND coalesce(ar.duedate, ap.duedate) >= ". - $dbh->quote($form->{fromdate}); - } - if ($form->{todate}){ - $where .= "AND coalesce(ar.duedate, ap.duedate) < ". - $dbh->quote($form->{todate}). " "; - } - if ($form->{partnumber}){ - $where .= qq| AND p.partnumber ILIKE |. - $dbh->quote('%'."$form->{partnumber}%"); - } - if ($form->{description}){ - $where .= q| AND p.description ILIKE | - .$dbh->quote('%'."$form->{description}%"); - } - $where =~ s/^\s?AND/WHERE/; - - my $query = qq| + my ( $self, $myconfig, $form ) = @_; + ( $form->{fromdate}, $form->{todate} ) = + $form->from_to( $form->{fromyear}, $form->{frommonth}, $form->{interval} ) + if $form->{fromyear} && $form->{frommonth}; + + my $dbh = $form->{dbh}; + + unless ( $form->{sort_col} ) { + $form->{sort_col} = 'partnumber'; + } + + my $where = ''; + if ( $form->{fromdate} ) { + $where .= + "AND coalesce(ar.duedate, ap.duedate) >= " + . $dbh->quote( $form->{fromdate} ); + } + if ( $form->{todate} ) { + $where .= + "AND coalesce(ar.duedate, ap.duedate) < " + . $dbh->quote( $form->{todate} ) . " "; + } + if ( $form->{partnumber} ) { + $where .= + qq| AND p.partnumber ILIKE | + . $dbh->quote( '%' . "$form->{partnumber}%" ); + } + if ( $form->{description} ) { + $where .= + q| AND p.description ILIKE | + . $dbh->quote( '%' . "$form->{description}%" ); + } + $where =~ s/^\s?AND/WHERE/; + + my $query = qq| SELECT min(p.description) AS description, min(p.partnumber) AS partnumber, sum( CASE WHEN i.qty > 0 THEN i.qty ELSE 0 END) AS sold, @@ -85,671 +87,828 @@ sub inventory_activity { $where GROUP BY i.parts_id ORDER BY $form->{sort_col}|; - my $sth = $dbh->prepare($query) || $form->dberror($query); - $sth->execute() || $form->dberror($query); - @cols = qw(description sold revenue partnumber received expense); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{net_income} = $ref->{revenue} - $ref->{expense}; - map {$ref->{$_} =~ s/^\s*//} @cols; - map {$ref->{$_} =~ s/\s*$//} @cols; - push @{$form->{TB}}, $ref; - } - $sth->finish; - $dbh->commit; - -} - + my $sth = $dbh->prepare($query) || $form->dberror($query); + $sth->execute() || $form->dberror($query); + @cols = qw(description sold revenue partnumber received expense); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{net_income} = $ref->{revenue} - $ref->{expense}; + map { $ref->{$_} =~ s/^\s*// } @cols; + map { $ref->{$_} =~ s/\s*$// } @cols; + push @{ $form->{TB} }, $ref; + } + $sth->finish; + $dbh->commit; +} sub yearend_statement { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + # if todate < existing yearends, delete GL and yearends + my $query = qq|SELECT trans_id FROM yearend WHERE transdate >= ?|; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{todate} ) || $form->dberror($query); + + my @trans_id = (); + my $id; + while ( ($id) = $sth->fetchrow_array ) { + push @trans_id, $id; + } + $sth->finish; + + $query = qq|DELETE FROM gl WHERE id = ?|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; + my $ath = $dbh->prepare($query) || $form->dberror($query); + + foreach $id (@trans_id) { + $sth->execute($id); + $ath->execute($id); + + $sth->finish; + $ath->finish; + } + + my $last_period = 0; + my @categories = qw(I E); + my $category; + + $form->{decimalplaces} *= 1; + + &get_accounts( $dbh, 0, $form->{fromdate}, $form->{todate}, $form, + \@categories ); + + $dbh->commit; + + # now we got $form->{I}{accno}{ } + # and $form->{E}{accno}{ } + + my %account = ( + 'I' => { + 'label' => 'income', + 'labels' => 'income', + 'ml' => 1 + }, + 'E' => { + 'label' => 'expense', + 'labels' => 'expenses', + 'ml' => -1 + } + ); + + foreach $category (@categories) { + foreach $key ( sort keys %{ $form->{$category} } ) { + if ( $form->{$category}{$key}{charttype} eq 'A' ) { + $form->{"total_$account{$category}{labels}_this_period"} += + $form->{$category}{$key}{this} * $account{$category}{ml}; + } + } + } + + # totals for income and expenses + $form->{total_income_this_period} = + $form->round_amount( $form->{total_income_this_period}, + $form->{decimalplaces} ); + $form->{total_expenses_this_period} = + $form->round_amount( $form->{total_expenses_this_period}, + $form->{decimalplaces} ); + + # total for income/loss + $form->{total_this_period} = + $form->{total_income_this_period} - $form->{total_expenses_this_period}; - # if todate < existing yearends, delete GL and yearends - my $query = qq|SELECT trans_id FROM yearend WHERE transdate >= ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{todate}) || $form->dberror($query); - - my @trans_id = (); - my $id; - while (($id) = $sth->fetchrow_array) { - push @trans_id, $id; - } - $sth->finish; - - $query = qq|DELETE FROM gl WHERE id = ?|; - $sth = $dbh->prepare($query) || $form->dberror($query); - - $query = qq|DELETE FROM acc_trans WHERE trans_id = ?|; - my $ath = $dbh->prepare($query) || $form->dberror($query); - - foreach $id (@trans_id) { - $sth->execute($id); - $ath->execute($id); - - $sth->finish; - $ath->finish; - } - - - my $last_period = 0; - my @categories = qw(I E); - my $category; - - $form->{decimalplaces} *= 1; - - &get_accounts($dbh, 0, $form->{fromdate}, $form->{todate}, $form, \@categories); - - $dbh->commit; - - - # now we got $form->{I}{accno}{ } - # and $form->{E}{accno}{ } - - my %account = ( - 'I' => { - 'label' => 'income', - 'labels' => 'income', - 'ml' => 1 }, - 'E' => { - 'label' => 'expense', - 'labels' => 'expenses', - 'ml' => -1 } - ); - - foreach $category (@categories) { - foreach $key (sort keys %{ $form->{$category} }) { - if ($form->{$category}{$key}{charttype} eq 'A') { - $form->{"total_$account{$category}{labels}_this_period"} - += $form->{$category}{$key}{this} - * $account{$category}{ml}; - } - } - } - - - # totals for income and expenses - $form->{total_income_this_period} = $form->round_amount( - $form->{total_income_this_period}, $form->{decimalplaces}); - $form->{total_expenses_this_period} = $form->round_amount( - $form->{total_expenses_this_period}, $form->{decimalplaces}); - - # total for income/loss - $form->{total_this_period} - = $form->{total_income_this_period} - - $form->{total_expenses_this_period}; - } - sub income_statement { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $last_period = 0; - my @categories = qw(I E); - my $category; - - $form->{decimalplaces} *= 1; - - if (! ($form->{fromdate} || $form->{todate})) { - if ($form->{fromyear} && $form->{frommonth}) { - ($form->{fromdate}, $form->{todate}) - = $form->from_to( - $form->{fromyear}, - $form->{frommonth}, $form->{interval}); - } - } - - &get_accounts( - $dbh, $last_period, $form->{fromdate}, $form->{todate}, - $form, \@categories, 1); - - if (! ($form->{comparefromdate} || $form->{comparetodate})) { - if ($form->{compareyear} && $form->{comparemonth}) { - ($form->{comparefromdate}, $form->{comparetodate}) - = $form->from_to( - $form->{compareyear}, - $form->{comparemonth}, - $form->{interval}); - } - } - - # if there are any compare dates - if ($form->{comparefromdate} || $form->{comparetodate}) { - $last_period = 1; - - &get_accounts( - $dbh, $last_period, $form->{comparefromdate}, - $form->{comparetodate}, $form, \@categories, 1); - } - - - $dbh->commit; - - - # now we got $form->{I}{accno}{ } - # and $form->{E}{accno}{ } - - my %account = ( - 'I' => { - 'label' => 'income', - 'labels' => 'income', - 'ml' => 1 }, - 'E' => { - 'label' => 'expense', - 'labels' => 'expenses', - 'ml' => -1 } - ); - - my $str; - - foreach $category (@categories) { - - foreach $key (sort keys %{ $form->{$category} }) { - # push description onto array - - $str = ($form->{l_heading}) ? $form->{padding} : ""; - - if ($form->{$category}{$key}{charttype} eq "A") { - $str .= - ($form->{l_accno}) - ? "$form->{$category}{$key}{accno} - $form->{$category}{$key}{description}" - : "$form->{$category}{$key}{description}"; - } - if ($form->{$category}{$key}{charttype} eq "H") { - if ($account{$category}{subtotal} - && $form->{l_subtotal}) { - - $dash = "- "; - push(@{$form->{"$account{$category}{label}_account"}}, - "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); - - push(@{$form->{"$account{$category}{labels}_this_period"}}, - $form->format_amount( - $myconfig, - $account{$category}{subthis} - * $account{$category}{ml}, - $form->{decimalplaces}, - $dash)); - - if ($last_period) { - # Chris T: Giving up on - # Formatting this one :-( - push(@{$form->{"$account{$category}{labels}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - } - - } - - $str = "$form->{br}$form->{bold}$form->{$category}{$key}{description}$form->{endbold}"; - - $account{$category}{subthis} - = $form->{$category}{$key}{this}; - $account{$category}{sublast} - = $form->{$category}{$key}{last}; - $account{$category}{subdescription} - = $form->{$category}{$key}{description}; - $account{$category}{subtotal} = 1; - - $form->{$category}{$key}{this} = 0; - $form->{$category}{$key}{last} = 0; - - next unless $form->{l_heading}; - - $dash = " "; - } - - push(@{$form->{"$account{$category}{label}_account"}}, - $str); - - if ($form->{$category}{$key}{charttype} eq 'A') { - $form->{"total_$account{$category}{labels}_this_period"} += $form->{$category}{$key}{this} * $account{$category}{ml}; - - $dash = "- "; - } - - push(@{$form->{"$account{$category}{labels}_this_period"}}, $form->format_amount($myconfig, $form->{$category}{$key}{this} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - - # add amount or - for last period - if ($last_period) { - $form->{"total_$account{$category}{labels}_last_period"} += $form->{$category}{$key}{last} * $account{$category}{ml}; - - push(@{$form->{"$account{$category}{labels}_last_period"}}, $form->format_amount($myconfig,$form->{$category}{$key}{last} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - } - } - - $str = ($form->{l_heading}) ? $form->{padding} : ""; - if ($account{$category}{subtotal} && $form->{l_subtotal}) { - push(@{$form->{"$account{$category}{label}_account"}}, "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); - push(@{$form->{"$account{$category}{labels}_this_period"}}, $form->format_amount($myconfig, $account{$category}{subthis} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - - if ($last_period) { - push(@{$form->{"$account{$category}{labels}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - } - } - - } - - - # totals for income and expenses - $form->{total_income_this_period} = $form->round_amount($form->{total_income_this_period}, $form->{decimalplaces}); - $form->{total_expenses_this_period} = $form->round_amount($form->{total_expenses_this_period}, $form->{decimalplaces}); - - # total for income/loss - $form->{total_this_period} = $form->{total_income_this_period} - $form->{total_expenses_this_period}; - - if ($last_period) { - # total for income/loss - $form->{total_last_period} = $form->format_amount($myconfig, $form->{total_income_last_period} - $form->{total_expenses_last_period}, $form->{decimalplaces}, "- "); - - # totals for income and expenses for last_period - $form->{total_income_last_period} = $form->format_amount($myconfig, $form->{total_income_last_period}, $form->{decimalplaces}, "- "); - $form->{total_expenses_last_period} = $form->format_amount($myconfig, $form->{total_expenses_last_period}, $form->{decimalplaces}, "- "); - - } - - - $form->{total_income_this_period} = $form->format_amount($myconfig,$form->{total_income_this_period}, $form->{decimalplaces}, "- "); - $form->{total_expenses_this_period} = $form->format_amount($myconfig,$form->{total_expenses_this_period}, $form->{decimalplaces}, "- "); - $form->{total_this_period} = $form->format_amount($myconfig,$form->{total_this_period}, $form->{decimalplaces}, "- "); + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $last_period = 0; + my @categories = qw(I E); + my $category; + + $form->{decimalplaces} *= 1; + + if ( !( $form->{fromdate} || $form->{todate} ) ) { + if ( $form->{fromyear} && $form->{frommonth} ) { + ( $form->{fromdate}, $form->{todate} ) = + $form->from_to( $form->{fromyear}, $form->{frommonth}, + $form->{interval} ); + } + } + + &get_accounts( $dbh, $last_period, $form->{fromdate}, $form->{todate}, + $form, \@categories, 1 ); + + if ( !( $form->{comparefromdate} || $form->{comparetodate} ) ) { + if ( $form->{compareyear} && $form->{comparemonth} ) { + ( $form->{comparefromdate}, $form->{comparetodate} ) = + $form->from_to( $form->{compareyear}, $form->{comparemonth}, + $form->{interval} ); + } + } + + # if there are any compare dates + if ( $form->{comparefromdate} || $form->{comparetodate} ) { + $last_period = 1; + + &get_accounts( + $dbh, $last_period, + $form->{comparefromdate}, + $form->{comparetodate}, + $form, \@categories, 1 + ); + } + + $dbh->commit; + + # now we got $form->{I}{accno}{ } + # and $form->{E}{accno}{ } + + my %account = ( + 'I' => { + 'label' => 'income', + 'labels' => 'income', + 'ml' => 1 + }, + 'E' => { + 'label' => 'expense', + 'labels' => 'expenses', + 'ml' => -1 + } + ); + + my $str; + + foreach $category (@categories) { + + foreach $key ( sort keys %{ $form->{$category} } ) { + + # push description onto array + + $str = ( $form->{l_heading} ) ? $form->{padding} : ""; + + if ( $form->{$category}{$key}{charttype} eq "A" ) { + $str .= + ( $form->{l_accno} ) + ? "$form->{$category}{$key}{accno} - $form->{$category}{$key}{description}" + : "$form->{$category}{$key}{description}"; + } + if ( $form->{$category}{$key}{charttype} eq "H" ) { + if ( $account{$category}{subtotal} + && $form->{l_subtotal} ) + { + + $dash = "- "; + push( + @{ $form->{"$account{$category}{label}_account"} }, +"$str$form->{bold}$account{$category}{subdescription}$form->{endbold}" + ); + + push( + @{ + $form->{"$account{$category}{labels}_this_period"} + }, + $form->format_amount( + $myconfig, + $account{$category}{subthis} * + $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + + if ($last_period) { + + # Chris T: Giving up on + # Formatting this one :-( + push( + @{ + $form->{ + "$account{$category}{labels}_last_period"} + }, + $form->format_amount( + $myconfig, + $account{$category}{sublast} * + $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + } + + } + + $str = +"$form->{br}$form->{bold}$form->{$category}{$key}{description}$form->{endbold}"; + + $account{$category}{subthis} = $form->{$category}{$key}{this}; + $account{$category}{sublast} = $form->{$category}{$key}{last}; + $account{$category}{subdescription} = + $form->{$category}{$key}{description}; + $account{$category}{subtotal} = 1; + + $form->{$category}{$key}{this} = 0; + $form->{$category}{$key}{last} = 0; + + next unless $form->{l_heading}; + + $dash = " "; + } + + push( @{ $form->{"$account{$category}{label}_account"} }, $str ); + + if ( $form->{$category}{$key}{charttype} eq 'A' ) { + $form->{"total_$account{$category}{labels}_this_period"} += + $form->{$category}{$key}{this} * $account{$category}{ml}; + + $dash = "- "; + } + + push( + @{ $form->{"$account{$category}{labels}_this_period"} }, + $form->format_amount( + $myconfig, + $form->{$category}{$key}{this} * $account{$category}{ml}, + $form->{decimalplaces}, $dash + ) + ); + + # add amount or - for last period + if ($last_period) { + $form->{"total_$account{$category}{labels}_last_period"} += + $form->{$category}{$key}{last} * $account{$category}{ml}; + + push( + @{ $form->{"$account{$category}{labels}_last_period"} }, + $form->format_amount( + $myconfig, + $form->{$category}{$key}{last} * + $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + } + } + + $str = ( $form->{l_heading} ) ? $form->{padding} : ""; + if ( $account{$category}{subtotal} && $form->{l_subtotal} ) { + push( + @{ $form->{"$account{$category}{label}_account"} }, +"$str$form->{bold}$account{$category}{subdescription}$form->{endbold}" + ); + push( + @{ $form->{"$account{$category}{labels}_this_period"} }, + $form->format_amount( + $myconfig, + $account{$category}{subthis} * $account{$category}{ml}, + $form->{decimalplaces}, $dash + ) + ); + + if ($last_period) { + push( + @{ $form->{"$account{$category}{labels}_last_period"} }, + $form->format_amount( + $myconfig, + $account{$category}{sublast} * $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + } + } + + } + + # totals for income and expenses + $form->{total_income_this_period} = + $form->round_amount( $form->{total_income_this_period}, + $form->{decimalplaces} ); + $form->{total_expenses_this_period} = + $form->round_amount( $form->{total_expenses_this_period}, + $form->{decimalplaces} ); + + # total for income/loss + $form->{total_this_period} = + $form->{total_income_this_period} - $form->{total_expenses_this_period}; + + if ($last_period) { + + # total for income/loss + $form->{total_last_period} = $form->format_amount( + $myconfig, + $form->{total_income_last_period} - + $form->{total_expenses_last_period}, + $form->{decimalplaces}, + "- " + ); + + # totals for income and expenses for last_period + $form->{total_income_last_period} = $form->format_amount( + $myconfig, + $form->{total_income_last_period}, + $form->{decimalplaces}, "- " + ); + $form->{total_expenses_last_period} = $form->format_amount( + $myconfig, + $form->{total_expenses_last_period}, + $form->{decimalplaces}, "- " + ); + + } + + $form->{total_income_this_period} = $form->format_amount( + $myconfig, + $form->{total_income_this_period}, + $form->{decimalplaces}, "- " + ); + $form->{total_expenses_this_period} = $form->format_amount( + $myconfig, + $form->{total_expenses_this_period}, + $form->{decimalplaces}, "- " + ); + $form->{total_this_period} = $form->format_amount( + $myconfig, + $form->{total_this_period}, + $form->{decimalplaces}, "- " + ); } - sub balance_sheet { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $last_period = 0; - my @categories = qw(A L Q); - - my $null; - - if ($form->{asofdate}) { - if ($form->{asofyear} && $form->{asofmonth}) { - if ($form->{asofdate} !~ /\W/) { - $form->{asofdate} - = "$form->{asofyear}$form->{asofmonth}$form->{asofdate}"; - } - } - } else { - if ($form->{asofyear} && $form->{asofmonth}) { - ($null, $form->{asofdate}) - = $form->from_to( - $form->{asofyear}, $form->{asofmonth}); - } - } - - # if there are any dates construct a where - if ($form->{asofdate}) { - - $form->{this_period} = "$form->{asofdate}"; - $form->{period} = "$form->{asofdate}"; - - } - - $form->{decimalplaces} *= 1; - - &get_accounts( - $dbh, $last_period, "", $form->{asofdate}, $form, - \@categories, 1); - - if ($form->{compareasofdate}) { - if ($form->{compareasofyear} && $form->{compareasofmonth}) { - if ($form->{compareasofdate} !~ /\W/) { - $form->{compareasofdate} = "$form->{compareasofyear}$form->{compareasofmonth}$form->{compareasofdate}"; - } - } - } else { - if ($form->{compareasofyear} && $form->{compareasofmonth}) { - ($null, $form->{compareasofdate}) = $form->from_to( - $form->{compareasofyear}, - $form->{compareasofmonth}); - } - } - - # if there are any compare dates - if ($form->{compareasofdate}) { - - $last_period = 1; - &get_accounts( - $dbh, $last_period, "", $form->{compareasofdate}, - $form, \@categories, 1); - - $form->{last_period} = "$form->{compareasofdate}"; - - } - - - $dbh->commit; - - - # now we got $form->{A}{accno}{ } assets - # and $form->{L}{accno}{ } liabilities - # and $form->{Q}{accno}{ } equity - # build asset accounts - - my $str; - my $key; - - my %account = ( - 'A' => { - 'label' => 'asset', - 'labels' => 'assets', - 'ml' => -1 }, - 'L' => { - 'label' => 'liability', - 'labels' => 'liabilities', - 'ml' => 1 }, - 'Q' => { - 'label' => 'equity', - 'labels' => 'equity', - 'ml' => 1 } - ); - - - foreach $category (@categories) { - - foreach $key (sort keys %{ $form->{$category} }) { - - $str = ($form->{l_heading}) ? $form->{padding} : ""; - - if ($form->{$category}{$key}{charttype} eq "A") { - $str .= - ($form->{l_accno}) - ? "$form->{$category}{$key}{accno} - $form->{$category}{$key}{description}" - : "$form->{$category}{$key}{description}"; - } - if ($form->{$category}{$key}{charttype} eq "H") { - if ($account{$category}{subtotal} - && $form->{l_subtotal}) { - - $dash = "- "; - push(@{$form->{"$account{$category}{label}_account"}}, "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); - push(@{$form->{"$account{$category}{label}_this_period"}}, $form->format_amount($myconfig, $account{$category}{subthis} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - - if ($last_period) { - push(@{$form->{"$account{$category}{label}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - } - } - - $str = "$form->{bold}$form->{$category}{$key}{description}$form->{endbold}"; - - $account{$category}{subthis} = $form->{$category}{$key}{this}; - $account{$category}{sublast} = $form->{$category}{$key}{last}; - $account{$category}{subdescription} = $form->{$category}{$key}{description}; - $account{$category}{subtotal} = 1; - - $form->{$category}{$key}{this} = 0; - $form->{$category}{$key}{last} = 0; - - next unless $form->{l_heading}; - - $dash = " "; - } - - # push description onto array - push(@{$form->{"$account{$category}{label}_account"}}, - $str); - - if ($form->{$category}{$key}{charttype} eq 'A') { - $form->{"total_$account{$category}{labels}_this_period"} += $form->{$category}{$key}{this} * $account{$category}{ml}; - $dash = "- "; - } - - push(@{$form->{"$account{$category}{label}_this_period"}}, $form->format_amount($myconfig, $form->{$category}{$key}{this} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - - if ($last_period) { - $form->{"total_$account{$category}{labels}_last_period"} += $form->{$category}{$key}{last} * $account{$category}{ml}; - - push(@{$form->{"$account{$category}{label}_last_period"}}, $form->format_amount($myconfig, $form->{$category}{$key}{last} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - } - } - - $str = ($form->{l_heading}) ? $form->{padding} : ""; - if ($account{$category}{subtotal} && $form->{l_subtotal}) { - push(@{$form->{"$account{$category}{label}_account"}}, "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); - push(@{$form->{"$account{$category}{label}_this_period"}}, $form->format_amount($myconfig, $account{$category}{subthis} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - - if ($last_period) { - push(@{$form->{"$account{$category}{label}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); - } - } - - } - - - # totals for assets, liabilities - $form->{total_assets_this_period} = $form->round_amount( - $form->{total_assets_this_period}, $form->{decimalplaces}); - $form->{total_liabilities_this_period} = $form->round_amount( - $form->{total_liabilities_this_period}, - $form->{decimalplaces}); - $form->{total_equity_this_period} = $form->round_amount( - $form->{total_equity_this_period}, $form->{decimalplaces}); - - # calculate earnings - $form->{earnings_this_period} = $form->{total_assets_this_period} - - $form->{total_liabilities_this_period} - - $form->{total_equity_this_period}; - - push(@{$form->{equity_this_period}}, - $form->format_amount( - $myconfig, $form->{earnings_this_period}, - $form->{decimalplaces}, "- ")); - - $form->{total_equity_this_period} = $form->round_amount( - $form->{total_equity_this_period} - + $form->{earnings_this_period}, - $form->{decimalplaces}); - - # add liability + equity - $form->{total_this_period} = $form->format_amount( - $myconfig, - $form->{total_liabilities_this_period} - + $form->{total_equity_this_period}, - $form->{decimalplaces}, "- "); - - - if ($last_period) { - # totals for assets, liabilities - $form->{total_assets_last_period} = $form->round_amount( - $form->{total_assets_last_period}, - $form->{decimalplaces}); - $form->{total_liabilities_last_period} = $form->round_amount( - $form->{total_liabilities_last_period}, - $form->{decimalplaces}); - $form->{total_equity_last_period} = $form->round_amount( - $form->{total_equity_last_period}, - $form->{decimalplaces}); - - # calculate retained earnings - $form->{earnings_last_period} - = $form->{total_assets_last_period} - - $form->{total_liabilities_last_period} - - $form->{total_equity_last_period}; - - push(@{$form->{equity_last_period}}, - $form->format_amount( - $myconfig,$form->{earnings_last_period}, - $form->{decimalplaces}, "- ")); - - $form->{total_equity_last_period} = $form->round_amount( - $form->{total_equity_last_period} - + $form->{earnings_last_period}, - $form->{decimalplaces}); - - # add liability + equity - $form->{total_last_period} = $form->format_amount( - $myconfig, - $form->{total_liabilities_last_period} - + $form->{total_equity_last_period}, - $form->{decimalplaces}, "- "); - - } - - - $form->{total_liabilities_last_period} = $form->format_amount( - $myconfig, $form->{total_liabilities_last_period}, - $form->{decimalplaces}, "- ") - if ($form->{total_liabilities_last_period}); - - $form->{total_equity_last_period} = $form->format_amount( - $myconfig, $form->{total_equity_last_period}, - $form->{decimalplaces}, "- ") - if ($form->{total_equity_last_period}); - - $form->{total_assets_last_period} = $form->format_amount( - $myconfig, $form->{total_assets_last_period}, - $form->{decimalplaces}, "- ") - if ($form->{total_assets_last_period}); - - $form->{total_assets_this_period} = $form->format_amount( - $myconfig, $form->{total_assets_this_period}, - $form->{decimalplaces}, "- "); - - $form->{total_liabilities_this_period} = $form->format_amount( - $myconfig, $form->{total_liabilities_this_period}, - $form->{decimalplaces}, "- "); - - $form->{total_equity_this_period} = $form->format_amount( - $myconfig, $form->{total_equity_this_period}, - $form->{decimalplaces}, "- "); + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $last_period = 0; + my @categories = qw(A L Q); + + my $null; + + if ( $form->{asofdate} ) { + if ( $form->{asofyear} && $form->{asofmonth} ) { + if ( $form->{asofdate} !~ /\W/ ) { + $form->{asofdate} = + "$form->{asofyear}$form->{asofmonth}$form->{asofdate}"; + } + } + } + else { + if ( $form->{asofyear} && $form->{asofmonth} ) { + ( $null, $form->{asofdate} ) = + $form->from_to( $form->{asofyear}, $form->{asofmonth} ); + } + } + + # if there are any dates construct a where + if ( $form->{asofdate} ) { + + $form->{this_period} = "$form->{asofdate}"; + $form->{period} = "$form->{asofdate}"; + + } + + $form->{decimalplaces} *= 1; + + &get_accounts( $dbh, $last_period, "", $form->{asofdate}, $form, + \@categories, 1 ); + + if ( $form->{compareasofdate} ) { + if ( $form->{compareasofyear} && $form->{compareasofmonth} ) { + if ( $form->{compareasofdate} !~ /\W/ ) { + $form->{compareasofdate} = +"$form->{compareasofyear}$form->{compareasofmonth}$form->{compareasofdate}"; + } + } + } + else { + if ( $form->{compareasofyear} && $form->{compareasofmonth} ) { + ( $null, $form->{compareasofdate} ) = + $form->from_to( $form->{compareasofyear}, + $form->{compareasofmonth} ); + } + } + + # if there are any compare dates + if ( $form->{compareasofdate} ) { + + $last_period = 1; + &get_accounts( $dbh, $last_period, "", $form->{compareasofdate}, + $form, \@categories, 1 ); + + $form->{last_period} = "$form->{compareasofdate}"; + + } + + $dbh->commit; + + # now we got $form->{A}{accno}{ } assets + # and $form->{L}{accno}{ } liabilities + # and $form->{Q}{accno}{ } equity + # build asset accounts + + my $str; + my $key; + + my %account = ( + 'A' => { + 'label' => 'asset', + 'labels' => 'assets', + 'ml' => -1 + }, + 'L' => { + 'label' => 'liability', + 'labels' => 'liabilities', + 'ml' => 1 + }, + 'Q' => { + 'label' => 'equity', + 'labels' => 'equity', + 'ml' => 1 + } + ); + + foreach $category (@categories) { + + foreach $key ( sort keys %{ $form->{$category} } ) { + + $str = ( $form->{l_heading} ) ? $form->{padding} : ""; + + if ( $form->{$category}{$key}{charttype} eq "A" ) { + $str .= + ( $form->{l_accno} ) + ? "$form->{$category}{$key}{accno} - $form->{$category}{$key}{description}" + : "$form->{$category}{$key}{description}"; + } + if ( $form->{$category}{$key}{charttype} eq "H" ) { + if ( $account{$category}{subtotal} + && $form->{l_subtotal} ) + { + + $dash = "- "; + push( + @{ $form->{"$account{$category}{label}_account"} }, +"$str$form->{bold}$account{$category}{subdescription}$form->{endbold}" + ); + push( + @{ $form->{"$account{$category}{label}_this_period"} }, + $form->format_amount( + $myconfig, + $account{$category}{subthis} * + $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + + if ($last_period) { + push( + @{ + $form->{ + "$account{$category}{label}_last_period"} + }, + $form->format_amount( + $myconfig, + $account{$category}{sublast} * + $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + } + } + + $str = +"$form->{bold}$form->{$category}{$key}{description}$form->{endbold}"; + + $account{$category}{subthis} = $form->{$category}{$key}{this}; + $account{$category}{sublast} = $form->{$category}{$key}{last}; + $account{$category}{subdescription} = + $form->{$category}{$key}{description}; + $account{$category}{subtotal} = 1; + + $form->{$category}{$key}{this} = 0; + $form->{$category}{$key}{last} = 0; + + next unless $form->{l_heading}; + + $dash = " "; + } + + # push description onto array + push( @{ $form->{"$account{$category}{label}_account"} }, $str ); + + if ( $form->{$category}{$key}{charttype} eq 'A' ) { + $form->{"total_$account{$category}{labels}_this_period"} += + $form->{$category}{$key}{this} * $account{$category}{ml}; + $dash = "- "; + } + + push( + @{ $form->{"$account{$category}{label}_this_period"} }, + $form->format_amount( + $myconfig, + $form->{$category}{$key}{this} * $account{$category}{ml}, + $form->{decimalplaces}, $dash + ) + ); + + if ($last_period) { + $form->{"total_$account{$category}{labels}_last_period"} += + $form->{$category}{$key}{last} * $account{$category}{ml}; + + push( + @{ $form->{"$account{$category}{label}_last_period"} }, + $form->format_amount( + $myconfig, + $form->{$category}{$key}{last} * + $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + } + } + + $str = ( $form->{l_heading} ) ? $form->{padding} : ""; + if ( $account{$category}{subtotal} && $form->{l_subtotal} ) { + push( + @{ $form->{"$account{$category}{label}_account"} }, +"$str$form->{bold}$account{$category}{subdescription}$form->{endbold}" + ); + push( + @{ $form->{"$account{$category}{label}_this_period"} }, + $form->format_amount( + $myconfig, + $account{$category}{subthis} * $account{$category}{ml}, + $form->{decimalplaces}, $dash + ) + ); + + if ($last_period) { + push( + @{ $form->{"$account{$category}{label}_last_period"} }, + $form->format_amount( + $myconfig, + $account{$category}{sublast} * $account{$category}{ml}, + $form->{decimalplaces}, + $dash + ) + ); + } + } + + } + + # totals for assets, liabilities + $form->{total_assets_this_period} = + $form->round_amount( $form->{total_assets_this_period}, + $form->{decimalplaces} ); + $form->{total_liabilities_this_period} = + $form->round_amount( $form->{total_liabilities_this_period}, + $form->{decimalplaces} ); + $form->{total_equity_this_period} = + $form->round_amount( $form->{total_equity_this_period}, + $form->{decimalplaces} ); + + # calculate earnings + $form->{earnings_this_period} = + $form->{total_assets_this_period} - + $form->{total_liabilities_this_period} - + $form->{total_equity_this_period}; + + push( + @{ $form->{equity_this_period} }, + $form->format_amount( + $myconfig, $form->{earnings_this_period}, + $form->{decimalplaces}, "- " + ) + ); + + $form->{total_equity_this_period} = + $form->round_amount( + $form->{total_equity_this_period} + $form->{earnings_this_period}, + $form->{decimalplaces} ); + + # add liability + equity + $form->{total_this_period} = $form->format_amount( + $myconfig, + $form->{total_liabilities_this_period} + + $form->{total_equity_this_period}, + $form->{decimalplaces}, + "- " + ); + + if ($last_period) { + + # totals for assets, liabilities + $form->{total_assets_last_period} = + $form->round_amount( $form->{total_assets_last_period}, + $form->{decimalplaces} ); + $form->{total_liabilities_last_period} = + $form->round_amount( $form->{total_liabilities_last_period}, + $form->{decimalplaces} ); + $form->{total_equity_last_period} = + $form->round_amount( $form->{total_equity_last_period}, + $form->{decimalplaces} ); + + # calculate retained earnings + $form->{earnings_last_period} = + $form->{total_assets_last_period} - + $form->{total_liabilities_last_period} - + $form->{total_equity_last_period}; + + push( + @{ $form->{equity_last_period} }, + $form->format_amount( + $myconfig, $form->{earnings_last_period}, + $form->{decimalplaces}, "- " + ) + ); + + $form->{total_equity_last_period} = + $form->round_amount( + $form->{total_equity_last_period} + $form->{earnings_last_period}, + $form->{decimalplaces} ); + + # add liability + equity + $form->{total_last_period} = $form->format_amount( + $myconfig, + $form->{total_liabilities_last_period} + + $form->{total_equity_last_period}, + $form->{decimalplaces}, + "- " + ); + + } + + $form->{total_liabilities_last_period} = $form->format_amount( + $myconfig, + $form->{total_liabilities_last_period}, + $form->{decimalplaces}, "- " + ) if ( $form->{total_liabilities_last_period} ); + + $form->{total_equity_last_period} = $form->format_amount( + $myconfig, + $form->{total_equity_last_period}, + $form->{decimalplaces}, "- " + ) if ( $form->{total_equity_last_period} ); + + $form->{total_assets_last_period} = $form->format_amount( + $myconfig, + $form->{total_assets_last_period}, + $form->{decimalplaces}, "- " + ) if ( $form->{total_assets_last_period} ); + + $form->{total_assets_this_period} = $form->format_amount( + $myconfig, + $form->{total_assets_this_period}, + $form->{decimalplaces}, "- " + ); + + $form->{total_liabilities_this_period} = $form->format_amount( + $myconfig, + $form->{total_liabilities_this_period}, + $form->{decimalplaces}, "- " + ); + + $form->{total_equity_this_period} = $form->format_amount( + $myconfig, + $form->{total_equity_this_period}, + $form->{decimalplaces}, "- " + ); } - sub get_accounts { - my ($dbh, $last_period, $fromdate, $todate, $form, $categories, - $excludeyearend) = @_; - - my $department_id; - my $project_id; - - ($null, $department_id) = split /--/, $form->{department}; - ($null, $project_id) = split /--/, $form->{projectnumber}; - - my $query; - my $dpt_where; - my $dpt_join; - my $project; - my $where = "1 = 1"; - my $glwhere = ""; - my $subwhere = ""; - my $yearendwhere = "1 = 1"; - my $item; - - my $category = "AND ("; - foreach $item (@{ $categories }) { - $category .= qq|c.category = |.$dbh->quote($item).qq| OR |; - } - $category =~ s/OR $/\)/; - - - # get headings - $query = qq| + my ( $dbh, $last_period, $fromdate, $todate, $form, $categories, + $excludeyearend ) + = @_; + + my $department_id; + my $project_id; + + ( $null, $department_id ) = split /--/, $form->{department}; + ( $null, $project_id ) = split /--/, $form->{projectnumber}; + + my $query; + my $dpt_where; + my $dpt_join; + my $project; + my $where = "1 = 1"; + my $glwhere = ""; + my $subwhere = ""; + my $yearendwhere = "1 = 1"; + my $item; + + my $category = "AND ("; + foreach $item ( @{$categories} ) { + $category .= qq|c.category = | . $dbh->quote($item) . qq| OR |; + } + $category =~ s/OR $/\)/; + + # get headings + $query = qq| SELECT accno, description, category FROM chart c WHERE c.charttype = 'H' $category ORDER BY c.accno|; - if ($form->{accounttype} eq 'gifi'){ - $query = qq| + if ( $form->{accounttype} eq 'gifi' ) { + $query = qq| SELECT g.accno, g.description, c.category FROM gifi g JOIN chart c ON (c.gifi_accno = g.accno) WHERE c.charttype = 'H' $category ORDER BY g.accno|; - } - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - my @headingaccounts = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)){ - $form->{$ref->{category}}{$ref->{accno}}{description} - = "$ref->{description}"; - - $form->{$ref->{category}}{$ref->{accno}}{charttype} = "H"; - $form->{$ref->{category}}{$ref->{accno}}{accno} = $ref->{accno}; - - push @headingaccounts, $ref->{accno}; - } - - $sth->finish; - - if ($form->{method} eq 'cash' && !$todate) { - ($todate) = $dbh->selectrow_array(qq|SELECT current_date|); - } - - if ($fromdate) { - if ($form->{method} eq 'cash') { - $subwhere .= " AND transdate >= ". - $dbh->quote($fromdate); - $glwhere = " AND ac.transdate >= ". - $dbh->quote($fromdate); - } else { - $where .= " AND ac.transdate >= ". - $dbh->quote($fromdate); - } - } - - if ($todate) { - $where .= " AND ac.transdate <= ".$dbh->quote($todate); - $subwhere .= " AND transdate <= ".$dbh->quote($todate); - $yearendwhere = "ac.transdate < ".$dbh->quote($todate); - } - - if ($excludeyearend) { - $ywhere = " + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my @headingaccounts = (); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $form->{ $ref->{category} }{ $ref->{accno} }{description} = + "$ref->{description}"; + + $form->{ $ref->{category} }{ $ref->{accno} }{charttype} = "H"; + $form->{ $ref->{category} }{ $ref->{accno} }{accno} = $ref->{accno}; + + push @headingaccounts, $ref->{accno}; + } + + $sth->finish; + + if ( $form->{method} eq 'cash' && !$todate ) { + ($todate) = $dbh->selectrow_array(qq|SELECT current_date|); + } + + if ($fromdate) { + if ( $form->{method} eq 'cash' ) { + $subwhere .= " AND transdate >= " . $dbh->quote($fromdate); + $glwhere = " AND ac.transdate >= " . $dbh->quote($fromdate); + } + else { + $where .= " AND ac.transdate >= " . $dbh->quote($fromdate); + } + } + + if ($todate) { + $where .= " AND ac.transdate <= " . $dbh->quote($todate); + $subwhere .= " AND transdate <= " . $dbh->quote($todate); + $yearendwhere = "ac.transdate < " . $dbh->quote($todate); + } + + if ($excludeyearend) { + $ywhere = " AND ac.trans_id NOT IN (SELECT trans_id FROM yearend)"; - - if ($todate) { - $ywhere = " + + if ($todate) { + $ywhere = " AND ac.trans_id NOT IN (SELECT trans_id FROM yearend - WHERE transdate <= ".$dbh->quote($todate).")"; - } - - if ($fromdate) { - $ywhere = " + WHERE transdate <= " . $dbh->quote($todate) . ")"; + } + + if ($fromdate) { + $ywhere = " AND ac.trans_id NOT IN (SELECT trans_id FROM yearend - WHERE transdate >= ".$dbh->quote($fromdate). - ")"; - if ($todate) { - $ywhere = " + WHERE transdate >= " . $dbh->quote($fromdate) . ")"; + if ($todate) { + $ywhere = " AND ac.trans_id NOT IN (SELECT trans_id FROM yearend WHERE transdate >= " - .$dbh->quote($fromdate)." - AND transdate <= ". - $dbh->quote($todate).")"; - } - } - } - - if ($department_id) { - $dpt_join = qq| + . $dbh->quote($fromdate) . " + AND transdate <= " . $dbh->quote($todate) . ")"; + } + } + } + + if ($department_id) { + $dpt_join = qq| JOIN department t ON (a.department_id = t.id)|; - $dpt_where = qq| + $dpt_where = qq| AND t.id = $department_id|; - } + } - if ($project_id) { - $project = qq| + if ($project_id) { + $project = qq| AND ac.project_id = $project_id|; - } + } + if ( $form->{accounttype} eq 'gifi' ) { - if ($form->{accounttype} eq 'gifi') { - - if ($form->{method} eq 'cash') { + if ( $form->{method} eq 'cash' ) { - $query = qq| + $query = qq| SELECT g.accno, sum(ac.amount) AS amount, g.description, c.category FROM acc_trans ac @@ -848,10 +1007,9 @@ sub get_accounts { $project GROUP BY c.category|; - if ($excludeyearend) { - + if ($excludeyearend) { - $query .= qq| + $query .= qq| UNION ALL @@ -872,20 +1030,20 @@ sub get_accounts { $dpt_where $project GROUP BY g.accno, g.description, c.category|; - } + } - } else { + } + else { - if ($department_id) { - $dpt_join = qq| + if ($department_id) { + $dpt_join = qq| JOIN dpt_trans t ON (t.trans_id = ac.trans_id)|; - $dpt_where = qq| - AND t.department_id = |. - $dbh->quote($department_id); - } + $dpt_where = qq| + AND t.department_id = | . $dbh->quote($department_id); + } - $query = qq| + $query = qq| SELECT g.accno, SUM(ac.amount) AS amount, g.description, c.category FROM acc_trans ac @@ -907,9 +1065,9 @@ sub get_accounts { AND c.gifi_accno = '' $project GROUP BY c.category|; - if ($excludeyearend) { + if ($excludeyearend) { - $query .= qq| + $query .= qq| UNION ALL @@ -937,14 +1095,15 @@ sub get_accounts { GROUP BY g.accno, g.description, c.category|; - } - } - - } else { # standard account + } + } + + } + else { # standard account - if ($form->{method} eq 'cash') { + if ( $form->{method} eq 'cash' ) { - $query = qq| + $query = qq| SELECT c.accno, sum(ac.amount) AS amount, c.description, c.category FROM acc_trans ac @@ -985,11 +1144,11 @@ sub get_accounts { $project GROUP BY c.accno, c.description, c.category|; - if ($excludeyearend) { + if ($excludeyearend) { - # this is for the yearend - - $query .= qq| + # this is for the yearend + + $query .= qq| UNION ALL @@ -1008,20 +1167,20 @@ sub get_accounts { $project GROUP BY c.accno, c.description, c.category|; - } + } - } else { - - if ($department_id) { - $dpt_join = qq| + } + else { + + if ($department_id) { + $dpt_join = qq| JOIN dpt_trans t ON (t.trans_id = ac.trans_id)|; - $dpt_where = qq| AND t.department_id = |. - $dbh->quote($department_id); - } + $dpt_where = + qq| AND t.department_id = | . $dbh->quote($department_id); + } - - $query = qq| + $query = qq| SELECT c.accno, sum(ac.amount) AS amount, c.description, c.category FROM acc_trans ac @@ -1031,9 +1190,9 @@ sub get_accounts { $project GROUP BY c.accno, c.description, c.category|; - if ($excludeyearend) { + if ($excludeyearend) { - $query .= qq| + $query .= qq| UNION ALL @@ -1052,115 +1211,109 @@ sub get_accounts { $project GROUP BY c.accno, c.description, c.category|; - } - } - } - - my @accno; - my $accno; - my $ref; - - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - - # get last heading account - @accno = grep { $_ le "$ref->{accno}" } @headingaccounts; - $accno = pop @accno; - if ($accno && ($accno ne $ref->{accno}) ) { - if ($last_period) { - $form->{$ref->{category}}{$accno}{last} - += $ref->{amount}; - } else { - $form->{$ref->{category}}{$accno}{this} - += $ref->{amount}; - } - } - - $form->{$ref->{category}}{$ref->{accno}}{accno} - = $ref->{accno}; - $form->{$ref->{category}}{$ref->{accno}}{description} - = $ref->{description}; - $form->{$ref->{category}}{$ref->{accno}}{charttype} = "A"; - - if ($last_period) { - $form->{$ref->{category}}{$ref->{accno}}{last} - += $ref->{amount}; - } else { - $form->{$ref->{category}}{$ref->{accno}}{this} - += $ref->{amount}; - } - } - $sth->finish; - - - # remove accounts with zero balance - foreach $category (@{ $categories }) { - foreach $accno (keys %{ $form->{$category} }) { - $form->{$category}{$accno}{last} = $form->round_amount( - $form->{$category}{$accno}{last}, - $form->{decimalplaces}); - $form->{$category}{$accno}{this} = $form->round_amount( - $form->{$category}{$accno}{this}, - $form->{decimalplaces}); - - delete $form->{$category}{$accno} - if ($form->{$category}{$accno}{this} == 0 - && $form->{$category}{$accno}{last} - == 0); - } - } + } + } + } + + my @accno; + my $accno; + my $ref; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + + # get last heading account + @accno = grep { $_ le "$ref->{accno}" } @headingaccounts; + $accno = pop @accno; + if ( $accno && ( $accno ne $ref->{accno} ) ) { + if ($last_period) { + $form->{ $ref->{category} }{$accno}{last} += $ref->{amount}; + } + else { + $form->{ $ref->{category} }{$accno}{this} += $ref->{amount}; + } + } + + $form->{ $ref->{category} }{ $ref->{accno} }{accno} = $ref->{accno}; + $form->{ $ref->{category} }{ $ref->{accno} }{description} = + $ref->{description}; + $form->{ $ref->{category} }{ $ref->{accno} }{charttype} = "A"; + + if ($last_period) { + $form->{ $ref->{category} }{ $ref->{accno} }{last} += + $ref->{amount}; + } + else { + $form->{ $ref->{category} }{ $ref->{accno} }{this} += + $ref->{amount}; + } + } + $sth->finish; + + # remove accounts with zero balance + foreach $category ( @{$categories} ) { + foreach $accno ( keys %{ $form->{$category} } ) { + $form->{$category}{$accno}{last} = + $form->round_amount( $form->{$category}{$accno}{last}, + $form->{decimalplaces} ); + $form->{$category}{$accno}{this} = + $form->round_amount( $form->{$category}{$accno}{this}, + $form->{decimalplaces} ); + + delete $form->{$category}{$accno} + if ( $form->{$category}{$accno}{this} == 0 + && $form->{$category}{$accno}{last} == 0 ); + } + } } +sub trial_balance { + my ( $self, $myconfig, $form ) = @_; + my $dbh = $form->{dbh}; -sub trial_balance { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my ($query, $sth, $ref); - my %balance = (); - my %trb = (); - my $null; - my $department_id; - my $project_id; - my @headingaccounts = (); - my $dpt_where; - my $dpt_join; - my $project; - - my $where = "1 = 1"; - my $invwhere = $where; - - ($null, $department_id) = split /--/, $form->{department}; - ($null, $project_id) = split /--/, $form->{projectnumber}; - - if ($department_id) { - $dpt_join = qq| + my ( $query, $sth, $ref ); + my %balance = (); + my %trb = (); + my $null; + my $department_id; + my $project_id; + my @headingaccounts = (); + my $dpt_where; + my $dpt_join; + my $project; + + my $where = "1 = 1"; + my $invwhere = $where; + + ( $null, $department_id ) = split /--/, $form->{department}; + ( $null, $project_id ) = split /--/, $form->{projectnumber}; + + if ($department_id) { + $dpt_join = qq| JOIN dpt_trans t ON (ac.trans_id = t.trans_id)|; - $dpt_where = qq| - AND t.department_id = |.$dbh->quote($department_id); - } - - - if ($project_id) { - $project = qq| - AND ac.project_id = |.$dbh->quote($project_id); - } - - ($form->{fromdate}, $form->{todate}) = $form->from_to( - $form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - # get beginning balances - if ($form->{fromdate}) { - - if ($form->{accounttype} eq 'gifi') { - - $query = qq| + $dpt_where = qq| + AND t.department_id = | . $dbh->quote($department_id); + } + + if ($project_id) { + $project = qq| + AND ac.project_id = | . $dbh->quote($project_id); + } + + ( $form->{fromdate}, $form->{todate} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + # get beginning balances + if ( $form->{fromdate} ) { + + if ( $form->{accounttype} eq 'gifi' ) { + + $query = qq| SELECT g.accno, c.category, SUM(ac.amount) AS amount, g.description, c.contra @@ -1172,10 +1325,11 @@ sub trial_balance { $dpt_where $project GROUP BY g.accno, c.category, g.description, c.contra|; - - } else { - - $query = qq| + + } + else { + + $query = qq| SELECT c.accno, c.category, SUM(ac.amount) AS amount, c.description, c.contra @@ -1186,83 +1340,74 @@ sub trial_balance { $dpt_where $project GROUP BY c.accno, c.category, c.description, c.contra|; - - } - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{amount} = $form->round_amount($ref->{amount}, - 2); - $balance{$ref->{accno}} = $ref->{amount}; - - if ($form->{all_accounts}) { - $trb{$ref->{accno}}{description} - = $ref->{description}; - $trb{$ref->{accno}}{charttype} - = 'A'; - $trb{$ref->{accno}}{category} - = $ref->{category}; - $trb{$ref->{accno}}{contra} - = $ref->{contra}; - } - - } - $sth->finish; - - } - - - # get headings - $query = qq| + + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{amount} = $form->round_amount( $ref->{amount}, 2 ); + $balance{ $ref->{accno} } = $ref->{amount}; + + if ( $form->{all_accounts} ) { + $trb{ $ref->{accno} }{description} = $ref->{description}; + $trb{ $ref->{accno} }{charttype} = 'A'; + $trb{ $ref->{accno} }{category} = $ref->{category}; + $trb{ $ref->{accno} }{contra} = $ref->{contra}; + } + + } + $sth->finish; + + } + + # get headings + $query = qq| SELECT c.accno, c.description, c.category FROM chart c WHERE c.charttype = 'H' ORDER by c.accno|; - if ($form->{accounttype} eq 'gifi'){ - $query = qq| + if ( $form->{accounttype} eq 'gifi' ) { + $query = qq| SELECT g.accno, g.description, c.category, c.contra FROM gifi g JOIN chart c ON (c.gifi_accno = g.accno) WHERE c.charttype = 'H' ORDER BY g.accno|; - } - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $trb{$ref->{accno}}{description} = $ref->{description}; - $trb{$ref->{accno}}{charttype} = 'H'; - $trb{$ref->{accno}}{category} = $ref->{category}; - $trb{$ref->{accno}}{contra} = $ref->{contra}; - - push @headingaccounts, $ref->{accno}; - } - - $sth->finish; - - - if ($form->{fromdate} || $form->{todate}) { - if ($form->{fromdate}) { - $where .= " AND ac.transdate >= " - .$dbh->quote($form->{fromdate}); - $invwhere .= " AND a.transdate >= ". - $dbh->quote($form->{fromdate}); - } - if ($form->{todate}) { - $where .= " AND ac.transdate <= ". - $dbh->quote($form->{todate}); - $invwhere .= " AND a.transdate <= " - .$dbh->quote($form->{todate}); - } - } - - - if ($form->{accounttype} eq 'gifi') { - - $query = qq| + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $trb{ $ref->{accno} }{description} = $ref->{description}; + $trb{ $ref->{accno} }{charttype} = 'H'; + $trb{ $ref->{accno} }{category} = $ref->{category}; + $trb{ $ref->{accno} }{contra} = $ref->{contra}; + + push @headingaccounts, $ref->{accno}; + } + + $sth->finish; + + if ( $form->{fromdate} || $form->{todate} ) { + if ( $form->{fromdate} ) { + $where .= + " AND ac.transdate >= " . $dbh->quote( $form->{fromdate} ); + $invwhere .= + " AND a.transdate >= " . $dbh->quote( $form->{fromdate} ); + } + if ( $form->{todate} ) { + $where .= " AND ac.transdate <= " . $dbh->quote( $form->{todate} ); + $invwhere .= + " AND a.transdate <= " . $dbh->quote( $form->{todate} ); + } + } + + if ( $form->{accounttype} eq 'gifi' ) { + + $query = qq| SELECT g.accno, g.description, c.category, SUM(ac.amount) AS amount, c.contra FROM acc_trans ac @@ -1272,10 +1417,11 @@ sub trial_balance { WHERE $where $dpt_where $project GROUP BY g.accno, g.description, c.category, c.contra ORDER BY accno|; - - } else { - $query = qq| + } + else { + + $query = qq| SELECT c.accno, c.description, c.category, SUM(ac.amount) AS amount, c.contra FROM acc_trans ac @@ -1285,13 +1431,13 @@ sub trial_balance { GROUP BY c.accno, c.description, c.category, c.contra ORDER BY accno|; - } + } - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - # prepare query for each account - $query = qq| + # prepare query for each account + $query = qq| SELECT (SELECT SUM(ac.amount) * -1 FROM acc_trans ac JOIN chart c ON (c.id = ac.chart_id) $dpt_join @@ -1303,9 +1449,9 @@ sub trial_balance { WHERE $where $dpt_where $project AND ac.amount > 0 AND c.accno = ?) AS credit |; - if ($form->{accounttype} eq 'gifi') { + if ( $form->{accounttype} eq 'gifi' ) { - $query = qq| + $query = qq| SELECT (SELECT SUM(ac.amount) * -1 FROM acc_trans ac JOIN chart c ON (c.id = ac.chart_id) @@ -1319,187 +1465,176 @@ sub trial_balance { $dpt_join WHERE $where $dpt_where $project AND ac.amount > 0 AND c.gifi_accno = ?) AS credit|; - - } - - $drcr = $dbh->prepare($query); - - # calculate debit and credit for the period - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - $trb{$ref->{accno}}{description} = $ref->{description}; - $trb{$ref->{accno}}{charttype} = 'A'; - $trb{$ref->{accno}}{category} = $ref->{category}; - $trb{$ref->{accno}}{contra} = $ref->{contra}; - $trb{$ref->{accno}}{amount} += $ref->{amount}; - } - $sth->finish; - - my ($debit, $credit); - - foreach my $accno (sort keys %trb) { - $ref = (); - - $ref->{accno} = $accno; - for (qw(description category contra charttype amount)) { - $ref->{$_} = $trb{$accno}{$_}; - } - - $ref->{balance} = $balance{$ref->{accno}}; - if ($trb{$accno}{charttype} eq 'A') { - if ($project_id) { - - if ($ref->{amount} < 0) { - $ref->{debit} = $ref->{amount} * -1; - } else { - $ref->{credit} = $ref->{amount}; - } - next if $form->round_amount( - $ref->{amount}, 2) == 0; - - } else { - - # get DR/CR - $drcr->execute($ref->{accno}, $ref->{accno}) - || $form->dberror($query); - - ($debit, $credit) = (0,0); - while (($debit, $credit) - = $drcr->fetchrow_array) { - $ref->{debit} += $debit; - $ref->{credit} += $credit; - } - $drcr->finish; - - } - - $ref->{debit} = $form->round_amount($ref->{debit}, 2); - $ref->{credit} - = $form->round_amount($ref->{credit}, 2); - - if (!$form->{all_accounts}) { - next - if $form->round_amount( - $ref->{debit} + $ref->{credit}, - 2) - == 0; - } - } - - # add subtotal - @accno = grep { $_ le "$ref->{accno}" } @headingaccounts; - $accno = pop @accno; - if ($accno) { - $trb{$accno}{debit} += $ref->{debit}; - $trb{$accno}{credit} += $ref->{credit}; - } - - push @{ $form->{TB} }, $ref; - - } - - $dbh->commit; - - # debits and credits for headings - foreach $accno (@headingaccounts) { - foreach $ref (@{ $form->{TB} }) { - if ($accno eq $ref->{accno}) { - $ref->{debit} = $trb{$accno}{debit}; - $ref->{credit} = $trb{$accno}{credit}; - } - } - } + } + + $drcr = $dbh->prepare($query); + + # calculate debit and credit for the period + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $trb{ $ref->{accno} }{description} = $ref->{description}; + $trb{ $ref->{accno} }{charttype} = 'A'; + $trb{ $ref->{accno} }{category} = $ref->{category}; + $trb{ $ref->{accno} }{contra} = $ref->{contra}; + $trb{ $ref->{accno} }{amount} += $ref->{amount}; + } + $sth->finish; + + my ( $debit, $credit ); + + foreach my $accno ( sort keys %trb ) { + $ref = (); + + $ref->{accno} = $accno; + for (qw(description category contra charttype amount)) { + $ref->{$_} = $trb{$accno}{$_}; + } + + $ref->{balance} = $balance{ $ref->{accno} }; + + if ( $trb{$accno}{charttype} eq 'A' ) { + if ($project_id) { + + if ( $ref->{amount} < 0 ) { + $ref->{debit} = $ref->{amount} * -1; + } + else { + $ref->{credit} = $ref->{amount}; + } + next if $form->round_amount( $ref->{amount}, 2 ) == 0; + + } + else { + + # get DR/CR + $drcr->execute( $ref->{accno}, $ref->{accno} ) + || $form->dberror($query); + + ( $debit, $credit ) = ( 0, 0 ); + while ( ( $debit, $credit ) = $drcr->fetchrow_array ) { + $ref->{debit} += $debit; + $ref->{credit} += $credit; + } + $drcr->finish; + + } + + $ref->{debit} = $form->round_amount( $ref->{debit}, 2 ); + $ref->{credit} = $form->round_amount( $ref->{credit}, 2 ); + + if ( !$form->{all_accounts} ) { + next + if $form->round_amount( $ref->{debit} + $ref->{credit}, 2 ) == + 0; + } + } + + # add subtotal + @accno = grep { $_ le "$ref->{accno}" } @headingaccounts; + $accno = pop @accno; + if ($accno) { + $trb{$accno}{debit} += $ref->{debit}; + $trb{$accno}{credit} += $ref->{credit}; + } + + push @{ $form->{TB} }, $ref; + + } + + $dbh->commit; + + # debits and credits for headings + foreach $accno (@headingaccounts) { + foreach $ref ( @{ $form->{TB} } ) { + if ( $accno eq $ref->{accno} ) { + $ref->{debit} = $trb{$accno}{debit}; + $ref->{credit} = $trb{$accno}{credit}; + } + } + } } - sub aging { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - my $invoice = ($form->{arap} eq 'ar') ? 'is' : 'ir'; - - my $query = qq|SELECT value FROM defaults WHERE setting_key = 'curr'|; - ($form->{currencies}) = $dbh->selectrow_array($query); - - ($null, $form->{todate}) - = $form->from_to($form->{year}, $form->{month}) - if $form->{year} && $form->{month}; - - if (! $form->{todate}) { - $query = qq|SELECT current_date|; - ($form->{todate}) = $dbh->selectrow_array($query); - } - - my $where = "1 = 1"; - my $name; - my $null; - my $ref; - my $transdate = ($form->{overdue}) ? "duedate" : "transdate"; - - if ($form->{"$form->{ct}_id"}) { - $where .= qq| AND ct.id = |. - $dbh->quote($form->{"$form->{ct}_id"}); - } else { - if ($form->{$form->{ct}} ne "") { - $name = $dbh->quote($form->like( - lc $form->{$form->{ct}})); - $where .= qq| AND lower(ct.name) LIKE $name| - if $form->{$form->{ct}}; - } - } - - if ($form->{department}) { - ($null, $department_id) = split /--/, $form->{department}; - $where .= qq| AND a.department_id = |. - $dbh->quote($department_id); - } - - # select outstanding vendors or customers, depends on $ct - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + my $invoice = ( $form->{arap} eq 'ar' ) ? 'is' : 'ir'; + + my $query = qq|SELECT value FROM defaults WHERE setting_key = 'curr'|; + ( $form->{currencies} ) = $dbh->selectrow_array($query); + + ( $null, $form->{todate} ) = $form->from_to( $form->{year}, $form->{month} ) + if $form->{year} && $form->{month}; + + if ( !$form->{todate} ) { + $query = qq|SELECT current_date|; + ( $form->{todate} ) = $dbh->selectrow_array($query); + } + + my $where = "1 = 1"; + my $name; + my $null; + my $ref; + my $transdate = ( $form->{overdue} ) ? "duedate" : "transdate"; + + if ( $form->{"$form->{ct}_id"} ) { + $where .= qq| AND ct.id = | . $dbh->quote( $form->{"$form->{ct}_id"} ); + } + else { + if ( $form->{ $form->{ct} } ne "" ) { + $name = $dbh->quote( $form->like( lc $form->{ $form->{ct} } ) ); + $where .= qq| AND lower(ct.name) LIKE $name| + if $form->{ $form->{ct} }; + } + } + + if ( $form->{department} ) { + ( $null, $department_id ) = split /--/, $form->{department}; + $where .= qq| AND a.department_id = | . $dbh->quote($department_id); + } + + # select outstanding vendors or customers, depends on $ct + $query = qq| SELECT DISTINCT ct.id, ct.name, ct.language_code FROM $form->{ct} ct JOIN $form->{arap} a ON (a.$form->{ct}_id = ct.id) WHERE $where AND a.paid != a.amount AND (a.$transdate <= ?) ORDER BY ct.name|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{todate}) || $form->dberror; - - my @ot = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @ot, $ref; - } - $sth->finish; - - my $buysell = ($form->{arap} eq 'ar') ? 'buy' : 'sell'; - - my $todate = $dbh->quote($form->{todate}); - my %interval = ( - 'c0' => "(date $todate - interval '0 days')", - 'c30' => "(date $todate - interval '30 days')", - 'c60' => "(date $todate - interval '60 days')", - 'c90' => "(date $todate - interval '90 days')" - ); - - - - # for each company that has some stuff outstanding - $form->{currencies} ||= ":"; - - - $where = qq|a.paid != a.amount AND c.id = ? AND a.curr = ?|; - - if ($department_id) { - $where .= qq| AND a.department_id = |. - $dbh->quote($department_id); - } - - $query = ""; - my $union = ""; - - if ($form->{c0}) { - $query .= qq| + my $sth = $dbh->prepare($query); + $sth->execute( $form->{todate} ) || $form->dberror; + + my @ot = (); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @ot, $ref; + } + $sth->finish; + + my $buysell = ( $form->{arap} eq 'ar' ) ? 'buy' : 'sell'; + + my $todate = $dbh->quote( $form->{todate} ); + my %interval = ( + 'c0' => "(date $todate - interval '0 days')", + 'c30' => "(date $todate - interval '30 days')", + 'c60' => "(date $todate - interval '60 days')", + 'c90' => "(date $todate - interval '90 days')" + ); + + # for each company that has some stuff outstanding + $form->{currencies} ||= ":"; + + $where = qq|a.paid != a.amount AND c.id = ? AND a.curr = ?|; + + if ($department_id) { + $where .= qq| AND a.department_id = | . $dbh->quote($department_id); + } + + $query = ""; + my $union = ""; + + if ( $form->{c0} ) { + $query .= qq| SELECT c.id AS ctid, c.$form->{ct}number, c.name, c.address1, c.address2, c.city, c.state, c.zipcode, c.country, c.contact, c.email, @@ -1520,13 +1655,13 @@ sub aging { WHERE $where AND ( a.$transdate <= $interval{c0} AND a.$transdate >= $interval{c30} )|; - $union = qq|UNION|; + $union = qq|UNION|; - } - - if ($form->{c30}) { + } - $query .= qq| + if ( $form->{c30} ) { + + $query .= qq| $union @@ -1549,13 +1684,13 @@ sub aging { WHERE $where AND (a.$transdate < $interval{c30} AND a.$transdate >= $interval{c60})|; - $union = qq|UNION|; + $union = qq|UNION|; - } + } - if ($form->{c60}) { + if ( $form->{c60} ) { - $query .= qq| + $query .= qq| $union SELECT c.id AS ctid, c.$form->{ct}number, c.name, @@ -1577,13 +1712,13 @@ sub aging { WHERE $where AND (a.$transdate < $interval{c60} AND a.$transdate >= $interval{c90})|; - $union = qq|UNION|; + $union = qq|UNION|; - } + } - if ($form->{c90}) { + if ( $form->{c90} ) { - $query .= qq| + $query .= qq| $union SELECT c.id AS ctid, c.$form->{ct}number, c.name, c.address1, c.address2, c.city, c.state, @@ -1603,210 +1738,203 @@ sub aging { JOIN $form->{ct} c ON (a.$form->{ct}_id = c.id) WHERE $where AND a.$transdate < $interval{c90}|; - } - $query .= qq| ORDER BY ctid, $transdate, invnumber|; - $sth = $dbh->prepare($query) || $form->dberror($query); - - my @var = (); - - if ($form->{c0} + $form->{c30} + $form->{c60} + $form->{c90}) { - foreach $curr (split /:/, $form->{currencies}) { - - foreach $item (@ot) { - - @var = (); - for (qw(c0 c30 c60 c90)) { - push @var, ($item->{id}, $curr) - if $form->{$_} } - - $sth->execute(@var); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)){ - $ref->{module} = - ($ref->{invoice}) - ? $invoice - : $form->{arap}; - $ref->{module} = 'ps' if $ref->{till}; - $ref->{exchangerate} = 1 - unless $ref->{exchangerate}; - $ref->{language_code} - = $item->{language_code}; - push @{ $form->{AG} }, $ref; - } - $sth->finish; - - } - } - } - - # get language - my $query = qq|SELECT * FROM language ORDER BY 2|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{all_language} }, $ref; - } - $sth->finish; - - $dbh->commit; + } + $query .= qq| ORDER BY ctid, $transdate, invnumber|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + my @var = (); + + if ( $form->{c0} + $form->{c30} + $form->{c60} + $form->{c90} ) { + foreach $curr ( split /:/, $form->{currencies} ) { + + foreach $item (@ot) { + + @var = (); + for (qw(c0 c30 c60 c90)) { + push @var, ( $item->{id}, $curr ) + if $form->{$_}; + } + + $sth->execute(@var); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{module} = + ( $ref->{invoice} ) + ? $invoice + : $form->{arap}; + $ref->{module} = 'ps' if $ref->{till}; + $ref->{exchangerate} = 1 + unless $ref->{exchangerate}; + $ref->{language_code} = $item->{language_code}; + push @{ $form->{AG} }, $ref; + } + $sth->finish; + + } + } + } + + # get language + my $query = qq|SELECT * FROM language ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{all_language} }, $ref; + } + $sth->finish; + + $dbh->commit; } - sub get_customer { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; - my $dbh = $form->{dbh}; + my $dbh = $form->{dbh}; - my $query = qq| + my $query = qq| SELECT name, email, cc, bcc FROM $form->{ct} ct WHERE ct.id = ?|; - $sth = $dbh->prepare($query); - $sth->execute($form->{"$form->{ct}_id"}); - ($form->{$form->{ct}}, $form->{email}, $form->{cc}, $form->{bcc}) - = $sth->fetchrow_array(); - - $dbh->commit; + $sth = $dbh->prepare($query); + $sth->execute( $form->{"$form->{ct}_id"} ); + ( $form->{ $form->{ct} }, $form->{email}, $form->{cc}, $form->{bcc} ) = + $sth->fetchrow_array(); -} + $dbh->commit; +} sub get_taxaccounts { - my ($self, $myconfig, $form) = @_; + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + my $ARAP = uc $form->{db}; - my $dbh = $form->{dbh}; - my $ARAP = uc $form->{db}; - - # get tax accounts - my $query = qq| + # get tax accounts + my $query = qq| SELECT DISTINCT c.accno, c.description FROM chart c JOIN tax t ON (c.id = t.chart_id) WHERE c.link LIKE '%${ARAP}_tax%' ORDER BY c.accno|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror; - my $ref = (); - while ($ref = $sth->fetchrow_hashref(NAME_lc) ) { - push @{ $form->{taxaccounts} }, $ref; - } - $sth->finish; + my $ref = (); + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{taxaccounts} }, $ref; + } + $sth->finish; - # get gifi tax accounts - my $query = qq| + # get gifi tax accounts + my $query = qq| SELECT DISTINCT g.accno, g.description FROM gifi g JOIN chart c ON (c.gifi_accno= g.accno) JOIN tax t ON (c.id = t.chart_id) WHERE c.link LIKE '%${ARAP}_tax%' ORDER BY accno|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror; - while ($ref = $sth->fetchrow_hashref(NAME_lc) ) { - push @{ $form->{gifi_taxaccounts} }, $ref; - } - $sth->finish; + while ( $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{gifi_taxaccounts} }, $ref; + } + $sth->finish; - $dbh->commit; + $dbh->commit; } - - sub tax_report { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my ($null, $department_id) = split /--/, $form->{department}; - - # build WHERE - my $where = "1 = 1"; - my $cashwhere = ""; - - if ($department_id) { - $where .= qq|AND a.department_id = |. - $dbh->quote($department_id); - } - - my $query; - my $sth; - my $accno; - - if ($form->{accno}) { - if ($form->{accno} =~ /^gifi_/) { - ($null, $accno) = split /_/, $form->{accno}; - $accno = $dbh->quote($accno); - $accno = qq| AND ch.gifi_accno = $accno|; - } else { - $accno = $dbh->quote($form->{accno}); - $accno = qq| AND ch.accno = $accno|; - } - } - - my $table; - my $ARAP; - - if ($form->{db} eq 'ar') { - $table = "customer"; - $ARAP = "AR"; - } - if ($form->{db} eq 'ap') { - $table = "vendor"; - $ARAP = "AP"; - } - - my $transdate = "a.transdate"; - - ($form->{fromdate}, $form->{todate}) = - $form->from_to($form->{year},$form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - # if there are any dates construct a where - if ($form->{fromdate} || $form->{todate}) { - if ($form->{fromdate}) { - $where .= " AND $transdate >= '$form->{fromdate}'"; - } - if ($form->{todate}) { - $where .= " AND $transdate <= '$form->{todate}'"; - } - } - - - if ($form->{method} eq 'cash') { - $transdate = "a.datepaid"; - - my $todate = $form->{todate}; - if (! $todate) { - ($todate) = $dbh->selectrow_array( - qq|SELECT current_date|); - } - - $cashwhere = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my ( $null, $department_id ) = split /--/, $form->{department}; + + # build WHERE + my $where = "1 = 1"; + my $cashwhere = ""; + + if ($department_id) { + $where .= qq|AND a.department_id = | . $dbh->quote($department_id); + } + + my $query; + my $sth; + my $accno; + + if ( $form->{accno} ) { + if ( $form->{accno} =~ /^gifi_/ ) { + ( $null, $accno ) = split /_/, $form->{accno}; + $accno = $dbh->quote($accno); + $accno = qq| AND ch.gifi_accno = $accno|; + } + else { + $accno = $dbh->quote( $form->{accno} ); + $accno = qq| AND ch.accno = $accno|; + } + } + + my $table; + my $ARAP; + + if ( $form->{db} eq 'ar' ) { + $table = "customer"; + $ARAP = "AR"; + } + if ( $form->{db} eq 'ap' ) { + $table = "vendor"; + $ARAP = "AP"; + } + + my $transdate = "a.transdate"; + + ( $form->{fromdate}, $form->{todate} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + # if there are any dates construct a where + if ( $form->{fromdate} || $form->{todate} ) { + if ( $form->{fromdate} ) { + $where .= " AND $transdate >= '$form->{fromdate}'"; + } + if ( $form->{todate} ) { + $where .= " AND $transdate <= '$form->{todate}'"; + } + } + + if ( $form->{method} eq 'cash' ) { + $transdate = "a.datepaid"; + + my $todate = $form->{todate}; + if ( !$todate ) { + ($todate) = $dbh->selectrow_array(qq|SELECT current_date|); + } + + $cashwhere = qq| AND ac.trans_id IN ( SELECT trans_id FROM acc_trans JOIN chart ON (chart_id = chart.id) WHERE link LIKE '%${ARAP}_paid%' - AND $transdate <= |.$dbh->quote($todate).qq| + AND $transdate <= | . $dbh->quote($todate) . qq| AND a.paid = a.amount)|; - } + } - - my $ml = ($form->{db} eq 'ar') ? 1 : -1; - - my %ordinal = ( 'transdate' => 3, 'invnumber' => 4, 'name' => 5 ); - - my @a = qw(transdate invnumber name); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - if ($form->{summary}) { - - $query = qq| + my $ml = ( $form->{db} eq 'ar' ) ? 1 : -1; + + my %ordinal = ( 'transdate' => 3, 'invnumber' => 4, 'name' => 5 ); + + my @a = qw(transdate invnumber name); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + if ( $form->{summary} ) { + + $query = qq| SELECT a.id, a.invoice, $transdate AS transdate, a.invnumber, n.name, a.netamount, ac.amount * $ml AS tax, a.till @@ -1816,10 +1944,11 @@ sub tax_report { JOIN $table n ON (n.id = a.${table}_id) WHERE $where $accno $cashwhere |; - if ($form->{fromdate}) { - # include open transactions from previous period - if ($cashwhere) { - $query .= qq| + if ( $form->{fromdate} ) { + + # include open transactions from previous period + if ($cashwhere) { + $query .= qq| UNION SELECT a.id, a.invoice, @@ -1832,13 +1961,13 @@ sub tax_report { JOIN $table n ON (n.id = a.${table}_id) WHERE a.datepaid >= '$form->{fromdate}' $accno $cashwhere|; - } - } - - - } else { + } + } - $query = qq| + } + else { + + $query = qq| SELECT a.id, '0' AS invoice, $transdate AS transdate, a.invnumber, n.name, a.netamount, ac.amount * $ml AS tax, a.notes AS description, @@ -1873,9 +2002,9 @@ sub tax_report { AND pt.chart_id = ch.id) WHERE $where $accno AND a.invoice = '1' $cashwhere|; - if ($form->{fromdate}) { - if ($cashwhere) { - $query .= qq| + if ( $form->{fromdate} ) { + if ($cashwhere) { + $query .= qq| UNION SELECT a.id, '0' AS invoice, @@ -1924,16 +2053,16 @@ sub tax_report { WHERE a.datepaid >= '$form->{fromdate}' $accno AND a.invoice = '1' $cashwhere|; - } - } - } + } + } + } + if ( $form->{report} =~ /nontaxable/ ) { - if ($form->{report} =~ /nontaxable/) { - - if ($form->{summary}) { - # only gather up non-taxable transactions - $query = qq| + if ( $form->{summary} ) { + + # only gather up non-taxable transactions + $query = qq| SELECT DISTINCT a.id, a.invoice, $transdate AS transdate, a.invnumber, n.name, a.netamount, a.till @@ -1943,9 +2072,9 @@ sub tax_report { WHERE $where AND a.netamount = a.amount $cashwhere|; - if ($form->{fromdate}) { - if ($cashwhere) { - $query .= qq| + if ( $form->{fromdate} ) { + if ($cashwhere) { + $query .= qq| UNION SELECT DISTINCT a.id, a.invoice, @@ -1962,13 +2091,14 @@ sub tax_report { AND a.netamount = a.amount $cashwhere|; - } - } - - } else { + } + } + + } + else { - # gather up details for non-taxable transactions - $query = qq| + # gather up details for non-taxable transactions + $query = qq| SELECT a.id, '0' AS invoice, $transdate AS transdate, a.invnumber, n.name, a.netamount, @@ -2001,9 +2131,9 @@ sub tax_report { GROUP BY a.id, a.invnumber, $transdate, n.name, ac.description, a.till|; - if ($form->{fromdate}) { - if ($cashwhere) { - $query .= qq| + if ( $form->{fromdate} ) { + if ($cashwhere) { + $query .= qq| UNION SELECT a.id, '0' AS invoice, $transdate AS transdate, @@ -2055,145 +2185,141 @@ sub tax_report { GROUP BY a.id, a.invnumber, $transdate, n.name, ac.description, a.till|; - } - } + } + } - } - } + } + } - - $query .= qq| ORDER by $sortorder|; + $query .= qq| ORDER by $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while ( my $ref = $sth->fetchrow_hashref(NAME_lc)) { - $ref->{tax} = $form->round_amount($ref->{tax}, 2); - if ($form->{report} =~ /nontaxable/) { - push @{ $form->{TR} }, $ref if $ref->{netamount}; - } else { - push @{ $form->{TR} }, $ref if $ref->{tax}; - } - } + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + $ref->{tax} = $form->round_amount( $ref->{tax}, 2 ); + if ( $form->{report} =~ /nontaxable/ ) { + push @{ $form->{TR} }, $ref if $ref->{netamount}; + } + else { + push @{ $form->{TR} }, $ref if $ref->{tax}; + } + } - $sth->finish; - $dbh->commit; + $sth->finish; + $dbh->commit; } - sub paymentaccounts { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; + my ( $self, $myconfig, $form ) = @_; - my $ARAP = uc $form->{db}; - - # get A(R|P)_paid accounts - my $query = qq| + my $dbh = $form->{dbh}; + + my $ARAP = uc $form->{db}; + + # get A(R|P)_paid accounts + my $query = qq| SELECT accno, description FROM chart WHERE link LIKE '%${ARAP}_paid%' ORDER BY accno|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{PR} }, $ref; - } - $sth->finish; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{PR} }, $ref; + } + $sth->finish; - $form->all_years($myconfig, $dbh); - - $dbh->{dbh}; + $form->all_years( $myconfig, $dbh ); + + $dbh->{dbh}; } - sub payments { - my ($self, $myconfig, $form) = @_; - - my $dbh = $form->{dbh}; - - my $ml = 1; - if ($form->{db} eq 'ar') { - $table = 'customer'; - $ml = -1; - } - if ($form->{db} eq 'ap') { - $table = 'vendor'; - } - - - my $query; - my $sth; - my $dpt_join; - my $where; - my $var; - - if ($form->{department_id}) { - $dpt_join = qq| JOIN dpt_trans t ON (t.trans_id = ac.trans_id)|; - - $where = qq| AND t.department_id = |. - $dbh->quote($form->{department_id}); - } - - ($form->{fromdate}, $form->{todate}) = $form->from_to( - $form->{year}, $form->{month}, $form->{interval}) - if $form->{year} && $form->{month}; - - if ($form->{fromdate}) { - $where .= " AND ac.transdate >= " - .$dbh->quote($form->{fromdate}); - } - if ($form->{todate}) { - $where .= " AND ac.transdate <= ".$dbh->quote($form->{todate}); - } - if (!$form->{fx_transaction}) { - $where .= " AND ac.fx_transaction = '0'"; - } - - if ($form->{description} ne "") { - $var = $dbh->quote($form->like(lc $form->{description})); - $where .= " AND lower(c.name) LIKE $var"; - } - if ($form->{source} ne "") { - $var = $dbh->quote($form->like(lc $form->{source})); - $where .= " AND lower(ac.source) LIKE $var"; - } - if ($form->{memo} ne "") { - $var = $dbh->quote($form->like(lc $form->{memo})); - $where .= " AND lower(ac.memo) LIKE $var"; - } - - my %ordinal = ( - 'name' => 1, - 'transdate' => 2, - 'source' => 4, - 'employee' => 6, - 'till' => 7 - ); - - my @a = qw(name transdate employee); - my $sortorder = $form->sort_order(\@a, \%ordinal); - - my $glwhere = $where; - $glwhere =~ s/\(c.name\)/\(g.description\)/; - - # cycle through each id - foreach my $accno (split(/ /, $form->{paymentaccounts})) { - - $query = qq| + my ( $self, $myconfig, $form ) = @_; + + my $dbh = $form->{dbh}; + + my $ml = 1; + if ( $form->{db} eq 'ar' ) { + $table = 'customer'; + $ml = -1; + } + if ( $form->{db} eq 'ap' ) { + $table = 'vendor'; + } + + my $query; + my $sth; + my $dpt_join; + my $where; + my $var; + + if ( $form->{department_id} ) { + $dpt_join = qq| JOIN dpt_trans t ON (t.trans_id = ac.trans_id)|; + + $where = + qq| AND t.department_id = | . $dbh->quote( $form->{department_id} ); + } + + ( $form->{fromdate}, $form->{todate} ) = + $form->from_to( $form->{year}, $form->{month}, $form->{interval} ) + if $form->{year} && $form->{month}; + + if ( $form->{fromdate} ) { + $where .= " AND ac.transdate >= " . $dbh->quote( $form->{fromdate} ); + } + if ( $form->{todate} ) { + $where .= " AND ac.transdate <= " . $dbh->quote( $form->{todate} ); + } + if ( !$form->{fx_transaction} ) { + $where .= " AND ac.fx_transaction = '0'"; + } + + if ( $form->{description} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{description} ) ); + $where .= " AND lower(c.name) LIKE $var"; + } + if ( $form->{source} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{source} ) ); + $where .= " AND lower(ac.source) LIKE $var"; + } + if ( $form->{memo} ne "" ) { + $var = $dbh->quote( $form->like( lc $form->{memo} ) ); + $where .= " AND lower(ac.memo) LIKE $var"; + } + + my %ordinal = ( + 'name' => 1, + 'transdate' => 2, + 'source' => 4, + 'employee' => 6, + 'till' => 7 + ); + + my @a = qw(name transdate employee); + my $sortorder = $form->sort_order( \@a, \%ordinal ); + + my $glwhere = $where; + $glwhere =~ s/\(c.name\)/\(g.description\)/; + + # cycle through each id + foreach my $accno ( split( / /, $form->{paymentaccounts} ) ) { + + $query = qq| SELECT id, accno, description FROM chart WHERE accno = ?|; - $sth = $dbh->prepare($query); - $sth->execute($accno) || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute($accno) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref(NAME_lc); - push @{ $form->{PR} }, $ref; - $sth->finish; + my $ref = $sth->fetchrow_hashref(NAME_lc); + push @{ $form->{PR} }, $ref; + $sth->finish; - $query = qq| + $query = qq| SELECT c.name, ac.transdate, sum(ac.amount) * $ml AS paid, ac.source, ac.memo, e.name AS employee, a.till, a.curr @@ -2204,21 +2330,21 @@ sub payments { $dpt_join WHERE ac.chart_id = $ref->{id} $where|; - if ($form->{till} ne "") { - $query .= " AND a.invoice = '1' AND NOT a.till IS NULL"; - - if ($myconfig->{role} eq 'user') { - $query .= " AND e.login = '$form->{login}'"; - } - } + if ( $form->{till} ne "" ) { + $query .= " AND a.invoice = '1' AND NOT a.till IS NULL"; + + if ( $myconfig->{role} eq 'user' ) { + $query .= " AND e.login = '$form->{login}'"; + } + } - $query .= qq| + $query .= qq| GROUP BY c.name, ac.transdate, ac.source, ac.memo, e.name, a.till, a.curr|; - - if ($form->{till} eq "") { - - $query .= qq| + + if ( $form->{till} eq "" ) { + + $query .= qq| UNION SELECT g.description, ac.transdate, sum(ac.amount) * $ml AS paid, ac.source, @@ -2234,25 +2360,23 @@ sub payments { GROUP BY g.description, ac.transdate, ac.source, ac.memo, e.name|; - } + } - $query .= qq| ORDER BY $sortorder|; + $query .= qq| ORDER BY $sortorder|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - while (my $pr = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $form->{$ref->{id}} }, $pr; - } - $sth->finish; + while ( my $pr = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{ $ref->{id} } }, $pr; + } + $sth->finish; - } - - $dbh->commit; - -} + } + $dbh->commit; -1; +} +1; diff --git a/LedgerSMB/Report.pm b/LedgerSMB/Report.pm index 66d19d5a..4fcc0201 100644 --- a/LedgerSMB/Report.pm +++ b/LedgerSMB/Report.pm @@ -1,7 +1,9 @@ + =head1: LedgerSMB::Report: Stub function for custom reports. =head1: Copyright (c) 2007. LedgerSMB Core Team =cut + package LedgerSMB::Report; use base qw(LedgerSMB::DBObject); use strict; diff --git a/LedgerSMB/Session.pm b/LedgerSMB/Session.pm index 76ed27ce..dbc2d1c3 100644 --- a/LedgerSMB/Session.pm +++ b/LedgerSMB/Session.pm @@ -1,13 +1,13 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # This is a simple abstraction layer allowing other session handling mechanisms @@ -16,8 +16,8 @@ package Session; use LedgerSMB::Sysconfig; -if (!${LedgerSMB::Sysconfig::session}){ - ${LedgerSMB::Sysconfig::session} = 'DB'; +if ( !${LedgerSMB::Sysconfig::session} ) { + ${LedgerSMB::Sysconfig::session} = 'DB'; } -require "LedgerSMB/Session/".${LedgerSMB::Sysconfig::session}.".pm"; +require "LedgerSMB/Session/" . ${LedgerSMB::Sysconfig::session} . ".pm"; diff --git a/LedgerSMB/Session/DB.pm b/LedgerSMB/Session/DB.pm index eb550c62..592d0922 100755 --- a/LedgerSMB/Session/DB.pm +++ b/LedgerSMB/Session/DB.pm @@ -1,13 +1,13 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # # @@ -24,248 +24,285 @@ # # destroy - destroys session # -# password_check - compares the password with the stored cryted password +# password_check - compares the password with the stored cryted password # (ver. < 1.2) and the md5 one (ver. >= 1.2) #==================================================================== package Session; sub session_check { - use Time::HiRes qw(gettimeofday); + use Time::HiRes qw(gettimeofday); - my ($cookie, $form) = @_; - my ($sessionID, $transactionID, $token) = split /:/, $cookie; + my ( $cookie, $form ) = @_; + my ( $sessionID, $transactionID, $token ) = split /:/, $cookie; - # use the central database handle - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; + # use the central database handle + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - my $checkQuery = $dbh->prepare("SELECT u.username, s.transaction_id + my $checkQuery = $dbh->prepare( + "SELECT u.username, s.transaction_id FROM session as s, users as u WHERE s.session_id = ? AND s.token = ? AND s.users_id = u.id - AND s.last_used > now() - ?::interval"); + AND s.last_used > now() - ?::interval" + ); - my $updateAge = $dbh->prepare("UPDATE session + my $updateAge = $dbh->prepare( + "UPDATE session SET last_used = now(), transaction_id = ? - WHERE session_id = ?;"); - - #must be an integer - $sessionID =~ s/[^0-9]//g; - $sessionID = int $sessionID; + WHERE session_id = ?;" + ); - $transactionID =~ s/[^0-9]//g; - $transactionID = int $transactionID; + #must be an integer + $sessionID =~ s/[^0-9]//g; + $sessionID = int $sessionID; - #must be 32 chars long and contain hex chars - $token =~ s/[^0-9a-f]//g; - $token = substr($token, 0, 32); + $transactionID =~ s/[^0-9]//g; + $transactionID = int $transactionID; - if (!$myconfig{timeout}){ - $timeout = "1 day"; - } else { - $timeout = "$myconfig{timeout} seconds"; - } + #must be 32 chars long and contain hex chars + $token =~ s/[^0-9a-f]//g; + $token = substr( $token, 0, 32 ); - $checkQuery->execute($sessionID, $token, $timeout) - || $form->dberror(__FILE__.':'.__LINE__.': Looking for session: '); - my $sessionValid = $checkQuery->rows; + if ( !$myconfig{timeout} ) { + $timeout = "1 day"; + } + else { + $timeout = "$myconfig{timeout} seconds"; + } - if($sessionValid){ + $checkQuery->execute( $sessionID, $token, $timeout ) + || $form->dberror( + __FILE__ . ':' . __LINE__ . ': Looking for session: ' ); + my $sessionValid = $checkQuery->rows; - #user has a valid session cookie, now check the user - my ($sessionLogin, $sessionTransaction) = $checkQuery->fetchrow_array; + if ($sessionValid) { - my $login = $form->{login}; - $login =~ s/[^a-zA-Z0-9._+@'-]//g; + #user has a valid session cookie, now check the user + my ( $sessionLogin, $sessionTransaction ) = $checkQuery->fetchrow_array; - if(($sessionLogin eq $login) and ($sessionTransaction eq $transactionID)){ + my $login = $form->{login}; + $login =~ s/[^a-zA-Z0-9._+@'-]//g; - #microseconds are more than random enough for transaction_id - my ($ignore, $newTransactionID) = gettimeofday(); + if ( ( $sessionLogin eq $login ) + and ( $sessionTransaction eq $transactionID ) ) + { - $newTransactionID = int $newTransactionID; - - $updateAge->execute($newTransactionID, $sessionID) - || $form->dberror(__FILE__.':'.__LINE__.': Updating session age: '); + #microseconds are more than random enough for transaction_id + my ( $ignore, $newTransactionID ) = gettimeofday(); - $newCookieValue = $sessionID . ':'.$newTransactionID.':' . $token; + $newTransactionID = int $newTransactionID; - #now update the cookie in the browser - print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|; - return 1; + $updateAge->execute( $newTransactionID, $sessionID ) + || $form->dberror( + __FILE__ . ':' . __LINE__ . ': Updating session age: ' ); - } else { - #something's wrong, they have the cookie, but wrong user or the wrong transaction id. Hijack attempt? - #destroy the session - my $sessionDestroy = $dbh->prepare(""); + $newCookieValue = + $sessionID . ':' . $newTransactionID . ':' . $token; - #delete the cookie in the browser - print qq|Set-Cookie: LedgerSMB=; path=/;\n|; - return 0; - } - - } else { - #cookie is not valid - #delete the cookie in the browser - print qq|Set-Cookie: LedgerSMB=; path=/;\n|; - return 0; - } -} + #now update the cookie in the browser + print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|; + return 1; -sub session_create { + } + else { - use Time::HiRes qw(gettimeofday); +#something's wrong, they have the cookie, but wrong user or the wrong transaction id. Hijack attempt? +#destroy the session + my $sessionDestroy = $dbh->prepare(""); - #microseconds are more than random enough for transaction_id - my ($ignore, $newTransactionID) = gettimeofday(); - $newTransactionID = int $newTransactionID; + #delete the cookie in the browser + print qq|Set-Cookie: LedgerSMB=; path=/;\n|; + return 0; + } - my ($form) = @_; + } + else { - if (! $ENV{HTTP_HOST}){ - #don't create cookies or sessions for CLI use - return 1; - } - - # use the central database handle - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - - # TODO Change this to use %myconfig - my $deleteExisting = $dbh->prepare( - "DELETE - FROM session - WHERE session.users_id = (select id from users where username = ?) - AND age(last_used) > ?::interval"); - - my $seedRandom = $dbh->prepare("SELECT setseed(?);"); + #cookie is not valid + #delete the cookie in the browser + print qq|Set-Cookie: LedgerSMB=; path=/;\n|; + return 0; + } +} - my $fetchSequence = $dbh->prepare("SELECT nextval('session_session_id_seq'), md5(random());"); - - my $createNew = $dbh->prepare("INSERT INTO session (session_id, users_id, token, transaction_id) - VALUES(?, (SELECT id - FROM users - WHERE username = ?), ?, ?);"); +sub session_create { + use Time::HiRes qw(gettimeofday); - # this is assuming that $form->{login} is safe, which might be a bad assumption - # so, I'm going to remove some chars, which might make previously valid logins invalid - my $login = $form->{login}; - $login =~ s/[^a-zA-Z0-9._+@'-]//g; + #microseconds are more than random enough for transaction_id + my ( $ignore, $newTransactionID ) = gettimeofday(); + $newTransactionID = int $newTransactionID; - #delete any existing stale sessions with this login if they exist - if (!$myconfig{timeout}){ - $myconfig{timeout} = 86400; - } + my ($form) = @_; - $deleteExisting->execute($login, "$myconfig{timeout} seconds") - || $form->dberror(__FILE__.':'.__LINE__.': Delete from session: '); + if ( !$ENV{HTTP_HOST} ) { - #doing the random stuff in the db so that LedgerSMB won't - #require a good random generator - maybe this should be reviewed, pgsql's isn't great either - $fetchSequence->execute() || $form->dberror(__FILE__.':'.__LINE__.': Fetch sequence id: '); - my ($newSessionID, $newToken) = $fetchSequence->fetchrow_array; + #don't create cookies or sessions for CLI use + return 1; + } - #create a new session - $createNew->execute($newSessionID, $login, $newToken, $newTransactionID) - || $form->dberror(__FILE__.':'.__LINE__.': Create new session: '); + # use the central database handle + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - #reseed the random number generator - my $randomSeed = 1.0 * ('0.'. (time() ^ ($$ + ($$ <<15)))); + # TODO Change this to use %myconfig + my $deleteExisting = $dbh->prepare( + "DELETE + FROM session + WHERE session.users_id = (select id from users where username = ?) + AND age(last_used) > ?::interval" + ); - $seedRandom->execute($randomSeed) - || $form->dberror(__FILE__.':'.__LINE__.': Reseed random generator: '); + my $seedRandom = $dbh->prepare("SELECT setseed(?);"); - $newCookieValue = $newSessionID . ':'.$newTransactionID.':' . $newToken; + my $fetchSequence = + $dbh->prepare("SELECT nextval('session_session_id_seq'), md5(random());"); - #now set the cookie in the browser - #TODO set domain from ENV, also set path to install path - print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|; - $form->{LedgerSMB} = $newCookieValue; + my $createNew = $dbh->prepare( + "INSERT INTO session (session_id, users_id, token, transaction_id) + VALUES(?, (SELECT id + FROM users + WHERE username = ?), ?, ?);" + ); + +# this is assuming that $form->{login} is safe, which might be a bad assumption +# so, I'm going to remove some chars, which might make previously valid logins invalid + my $login = $form->{login}; + $login =~ s/[^a-zA-Z0-9._+@'-]//g; + + #delete any existing stale sessions with this login if they exist + if ( !$myconfig{timeout} ) { + $myconfig{timeout} = 86400; + } + + $deleteExisting->execute( $login, "$myconfig{timeout} seconds" ) + || $form->dberror( + __FILE__ . ':' . __LINE__ . ': Delete from session: ' ); + +#doing the random stuff in the db so that LedgerSMB won't +#require a good random generator - maybe this should be reviewed, pgsql's isn't great either + $fetchSequence->execute() + || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetch sequence id: ' ); + my ( $newSessionID, $newToken ) = $fetchSequence->fetchrow_array; + + #create a new session + $createNew->execute( $newSessionID, $login, $newToken, $newTransactionID ) + || $form->dberror( __FILE__ . ':' . __LINE__ . ': Create new session: ' ); + + #reseed the random number generator + my $randomSeed = 1.0 * ( '0.' . ( time() ^ ( $$ + ( $$ << 15 ) ) ) ); + + $seedRandom->execute($randomSeed) + || $form->dberror( + __FILE__ . ':' . __LINE__ . ': Reseed random generator: ' ); + + $newCookieValue = $newSessionID . ':' . $newTransactionID . ':' . $newToken; + + #now set the cookie in the browser + #TODO set domain from ENV, also set path to install path + print qq|Set-Cookie: LedgerSMB=$newCookieValue; path=/;\n|; + $form->{LedgerSMB} = $newCookieValue; } sub session_destroy { - my ($form) = @_; + my ($form) = @_; - my $login = $form->{login}; - $login =~ s/[^a-zA-Z0-9._+@'-]//g; + my $login = $form->{login}; + $login =~ s/[^a-zA-Z0-9._+@'-]//g; - # use the central database handle - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; + # use the central database handle + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - my $deleteExisting = $dbh->prepare(" + my $deleteExisting = $dbh->prepare( " DELETE FROM session WHERE users_id = (select id from users where username = ?) - "); + " ); - $deleteExisting->execute($login) - || $form->dberror(__FILE__.':'.__LINE__.': Delete from session: '); + $deleteExisting->execute($login) + || $form->dberror( + __FILE__ . ':' . __LINE__ . ': Delete from session: ' ); - #delete the cookie in the browser - print qq|Set-Cookie: LedgerSMB=; path=/;\n|; + #delete the cookie in the browser + print qq|Set-Cookie: LedgerSMB=; path=/;\n|; } sub password_check { - use Digest::MD5; + use Digest::MD5; - my ($form, $username, $password) = @_; + my ( $form, $username, $password ) = @_; - $username =~ s/[^a-zA-Z0-9._+@'-]//g; + $username =~ s/[^a-zA-Z0-9._+@'-]//g; - # use the central database handle - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; + # use the central database handle + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - my $fetchPassword = $dbh->prepare("SELECT u.username, uc.password, uc.crypted_password + my $fetchPassword = $dbh->prepare( + "SELECT u.username, uc.password, uc.crypted_password FROM users as u, users_conf as uc WHERE u.username = ? - AND u.id = uc.id;"); + AND u.id = uc.id;" + ); - $fetchPassword->execute($username) || $form->dberror(__FILE__.':'.__LINE__.': Fetching password : '); + $fetchPassword->execute($username) + || $form->dberror( __FILE__ . ':' . __LINE__ . ': Fetching password : ' ); - my ($dbusername, $md5Password, $cryptPassword) = $fetchPassword->fetchrow_array; + my ( $dbusername, $md5Password, $cryptPassword ) = + $fetchPassword->fetchrow_array; - if ($dbusername ne $username) { - # User data retrieved from db not for the requested user - return 0; - } elsif ($cryptPassword){ - #First time login from old system, check crypted password + if ( $dbusername ne $username ) { - if ((crypt $password, substr($username, 0, 2)) eq $cryptPassword) { + # User data retrieved from db not for the requested user + return 0; + } + elsif ($cryptPassword) { - #password was good, convert to md5 password and null crypted - my $updatePassword = $dbh->prepare("UPDATE users_conf + #First time login from old system, check crypted password + + if ( ( crypt $password, substr( $username, 0, 2 ) ) eq $cryptPassword ) + { + + #password was good, convert to md5 password and null crypted + my $updatePassword = $dbh->prepare( + "UPDATE users_conf SET password = md5(?), crypted_password = null FROM users WHERE users_conf.id = users.id - AND users.username = ?;"); - - $updatePassword->execute($password, $username) - || $form->dberror(__FILE__.':'.__LINE__.': Converting password : '); - - return 1; - - } else { - return 0; #password failed - } - - } elsif ($md5Password){ - - if ($md5Password ne (Digest::MD5::md5_hex $password) ) { - return 0; - } - else { - return 1; - } - - } else { - #both the md5Password and cryptPasswords were blank - return 0; - } + AND users.username = ?;" + ); + + $updatePassword->execute( $password, $username ) + || $form->dberror( + __FILE__ . ':' . __LINE__ . ': Converting password : ' ); + + return 1; + + } + else { + return 0; #password failed + } + + } + elsif ($md5Password) { + + if ( $md5Password ne ( Digest::MD5::md5_hex $password) ) { + return 0; + } + else { + return 1; + } + + } + else { + + #both the md5Password and cryptPasswords were blank + return 0; + } } 1; diff --git a/LedgerSMB/Setting.pm b/LedgerSMB/Setting.pm index 2f439610..282bfd8e 100644 --- a/LedgerSMB/Setting.pm +++ b/LedgerSMB/Setting.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::Setting - LedgerSMB class for managing Business Locations @@ -44,107 +45,118 @@ our $VERSION = '1.0.0'; our @ISA = qw(LedgerSMB::DBObject); sub AUTOLOAD { - my $self = shift; - my $AUTOLOAD = $LedgerSMB::Setting::AUTOLOAD; - $AUTOLOAD =~ s/^.*:://; - $self->exec_method(procname => "setting_$AUTOLOAD", args =>\@_); + my $self = shift; + my $AUTOLOAD = $LedgerSMB::Setting::AUTOLOAD; + $AUTOLOAD =~ s/^.*:://; + $self->exec_method( procname => "setting_$AUTOLOAD", args => \@_ ); } sub get { - my $self = shift; - my $hashref = shift @{$self->exec_method(procname => 'setting_get')}; - $self->merge($hashref, 'value'); + my $self = shift; + my $hashref = shift @{ $self->exec_method( procname => 'setting_get' ) }; + $self->merge( $hashref, 'value' ); } sub parse_increment { - my $self = shift; - my $myconfig = shift; - - # Long-run, we may want to run this via Parse::RecDescent, but this is - # at least a start for here. Chris T. - - # Replaces Form::UpdateDefaults - - $_ = $self->incriment; - # check for and replace - # <?lsmb DATE ?>, <?lsmb YYMMDD ?>, <?lsmb YEAR ?>, <?lsmb MONTH ?>, <?lsmb DAY ?> or variations of - # <?lsmb NAME 1 1 3 ?>, <?lsmb BUSINESS ?>, <?lsmb BUSINESS 10 ?>, <?lsmb CURR... ?> - # <?lsmb DESCRIPTION 1 1 3 ?>, <?lsmb ITEM 1 1 3 ?>, <?lsmb PARTSGROUP 1 1 3 ?> only for parts - # <?lsmb PHONE ?> for customer and vendors - - my $dbvar = $_; - my $var = $_; - my $str; - my $param; - - if (/<\?lsmb /) { - - while (/<\?lsmb /) { - - s/<\?lsmb .*? \?>//; - last unless $&; - $param = $&; - $str = ""; - - if ($param =~ /<\?lsmb date \?>/i) { - $str = ($self->split_date($myconfig->{dateformat}, $self->{transdate}))[0]; - $var =~ s/$param/$str/; - } - - if ($param =~ /<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i) { - - my $fld = lc $&; - $fld =~ s/<\?lsmb //; - - if ($fld =~ /name/) { - if ($self->{type}) { - $fld = $self->{vc}; - } - } - - my $p = $param; - $p =~ s/(<|>|%)//g; - my @p = split / /, $p; - my @n = split / /, uc $self->{$fld}; - - if ($#p > 0) { - - for (my $i = 1; $i <= $#p; $i++) { - $str .= substr($n[$i-1], 0, $p[$i]); - } - - } else { - ($str) = split /--/, $self->{$fld}; - } - - $var =~ s/$param/$str/; - $var =~ s/\W//g if $fld eq 'phone'; - } - - if ($param =~ /<\?lsmb (yy|mm|dd)/i) { - - my $p = $param; - $p =~ s/(<|>|%)//g; - my $spc = $p; - $spc =~ s/\w//g; - $spc = substr($spc, 0, 1); - my %d = ( yy => 1, mm => 2, dd => 3 ); - my @p = (); - - my @a = $self->split_date($myconfig->{dateformat}, $self->{transdate}); - for (sort keys %d) { push @p, $a[$d{$_}] if ($p =~ /$_/) } - $str = join $spc, @p; - $var =~ s/$param/$str/; - } - - if ($param =~ /<\?lsmb curr/i) { - $var =~ s/$param/$self->{currency}/; - } - } - } - - $self->{value} = $var; - $var; + my $self = shift; + my $myconfig = shift; + + # Long-run, we may want to run this via Parse::RecDescent, but this is + # at least a start for here. Chris T. + + # Replaces Form::UpdateDefaults + + $_ = $self->incriment; + +# check for and replace +# <?lsmb DATE ?>, <?lsmb YYMMDD ?>, <?lsmb YEAR ?>, <?lsmb MONTH ?>, <?lsmb DAY ?> or variations of +# <?lsmb NAME 1 1 3 ?>, <?lsmb BUSINESS ?>, <?lsmb BUSINESS 10 ?>, <?lsmb CURR... ?> +# <?lsmb DESCRIPTION 1 1 3 ?>, <?lsmb ITEM 1 1 3 ?>, <?lsmb PARTSGROUP 1 1 3 ?> only for parts +# <?lsmb PHONE ?> for customer and vendors + + my $dbvar = $_; + my $var = $_; + my $str; + my $param; + + if (/<\?lsmb /) { + + while (/<\?lsmb /) { + + s/<\?lsmb .*? \?>//; + last unless $&; + $param = $&; + $str = ""; + + if ( $param =~ /<\?lsmb date \?>/i ) { + $str = ( + $self->split_date( + $myconfig->{dateformat}, + $self->{transdate} + ) + )[0]; + $var =~ s/$param/$str/; + } + + if ( $param =~ +/<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i + ) + { + + my $fld = lc $&; + $fld =~ s/<\?lsmb //; + + if ( $fld =~ /name/ ) { + if ( $self->{type} ) { + $fld = $self->{vc}; + } + } + + my $p = $param; + $p =~ s/(<|>|%)//g; + my @p = split / /, $p; + my @n = split / /, uc $self->{$fld}; + + if ( $#p > 0 ) { + + for ( my $i = 1 ; $i <= $#p ; $i++ ) { + $str .= substr( $n[ $i - 1 ], 0, $p[$i] ); + } + + } + else { + ($str) = split /--/, $self->{$fld}; + } + + $var =~ s/$param/$str/; + $var =~ s/\W//g if $fld eq 'phone'; + } + + if ( $param =~ /<\?lsmb (yy|mm|dd)/i ) { + + my $p = $param; + $p =~ s/(<|>|%)//g; + my $spc = $p; + $spc =~ s/\w//g; + $spc = substr( $spc, 0, 1 ); + my %d = ( yy => 1, mm => 2, dd => 3 ); + my @p = (); + + my @a = $self->split_date( $myconfig->{dateformat}, + $self->{transdate} ); + for ( sort keys %d ) { push @p, $a[ $d{$_} ] if ( $p =~ /$_/ ) } + $str = join $spc, @p; + $var =~ s/$param/$str/; + } + + if ( $param =~ /<\?lsmb curr/i ) { + $var =~ s/$param/$self->{currency}/; + } + } + } + + $self->{value} = $var; + $var; } diff --git a/LedgerSMB/Sysconfig.pm b/LedgerSMB/Sysconfig.pm index bfb9c890..361f3c6b 100644 --- a/LedgerSMB/Sysconfig.pm +++ b/LedgerSMB/Sysconfig.pm @@ -1,4 +1,4 @@ -# This is the new configuration file for LedgerSMB. Eventually all system +# This is the new configuration file for LedgerSMB. Eventually all system # configuration directives will go here, This will probably not fully replace # the ledger-smb.conf until 1.3, however. @@ -6,23 +6,28 @@ package LedgerSMB::Sysconfig; use LedgerSMB::Form; use Config::Std; -use DBI qw(:sql_types); +use DBI qw(:sql_types); binmode STDOUT, ':utf8'; # For Win32, change $pathsep to ';'; -$pathsep=':'; +$pathsep = ':'; -$session='DB'; -$logging=0; # No logging on by default +$session = 'DB'; +$logging = 0; # No logging on by default @io_lineitem_columns = qw(unit onhand sellprice discount linetotal); # Whitelist for redirect destination -@scripts = ('aa.pl', 'admin.pl', 'am.pl', 'ap.pl', 'ar.pl', 'arap.pl', - 'arapprn.pl', 'bp.pl', 'ca.pl', 'cp.pl', 'ct.pl', 'gl.pl', 'hr.pl', - 'ic.pl', 'io.pl', 'ir.pl', 'is.pl', 'jc.pl', 'login.pl', 'menu.pl', - 'oe.pl', 'pe.pl', 'pos.pl', 'ps.pl', 'pw.pl', 'rc.pl', 'rp.pl'); +@scripts = ( + 'aa.pl', 'admin.pl', 'am.pl', 'ap.pl', + 'ar.pl', 'arap.pl', 'arapprn.pl', 'bp.pl', + 'ca.pl', 'cp.pl', 'ct.pl', 'gl.pl', + 'hr.pl', 'ic.pl', 'io.pl', 'ir.pl', + 'is.pl', 'jc.pl', 'login.pl', 'menu.pl', + 'oe.pl', 'pe.pl', 'pos.pl', 'ps.pl', + 'pw.pl', 'rc.pl', 'rp.pl' +); # if you have latex installed set to 1 $latex = 1; @@ -46,7 +51,7 @@ $memberfile = "users/members"; $sendmail = "/usr/sbin/sendmail -t"; # SMTP settings -$smtphost = ''; +$smtphost = ''; $smtptimout = 60; # set language for login and admin @@ -62,64 +67,68 @@ $gzip = "gzip -S .gz"; $localepath = 'locale/po'; # available printers -%printer = ( Laser => 'lpr -Plaser', - Epson => 'lpr -PEpson', - ); +%printer = ( + Laser => 'lpr -Plaser', + Epson => 'lpr -PEpson', +); my %config; -read_config('ledgersmb.conf' => %config) or die; +read_config( 'ledgersmb.conf' => %config ) or die; # Root variables -for $var (qw(pathsep logging check_max_invoices language session latex - db_autoupdate)){ +for $var ( + qw(pathsep logging check_max_invoices language session latex + db_autoupdate) + ) +{ ${$var} = $config{''}{$var} if $config{''}{$var}; } -%printer = %{$config{printers}} if $config{printers}; +%printer = %{ $config{printers} } if $config{printers}; # ENV Paths -for $var (qw(PATH PERL5LIB)){ -$ENV{$var} .= $pathsep.(join $pathsep, @{$config{environment}{$var}}) if - $config{environment}{$var}; +for $var (qw(PATH PERL5LIB)) { + $ENV{$var} .= $pathsep . ( join $pathsep, @{ $config{environment}{$var} } ) + if $config{environment}{$var}; } # Application-specific paths -for $var (qw(localepath spool templates images)){ - ${$var} = $config{paths}{$var} if $config{paths}{$var}; +for $var (qw(localepath spool templates images)) { + ${$var} = $config{paths}{$var} if $config{paths}{$var}; } # Programs -for $var (qw(gzip)){ - ${$var} = $config{programs}{$var} if $config{programs}{$var}; +for $var (qw(gzip)) { + ${$var} = $config{programs}{$var} if $config{programs}{$var}; } # mail configuration -for $var (qw(sendmail smpthost smtptimeout)){ - ${$var} = $config{mail}{$var} if $config{mail}{$var}; +for $var (qw(sendmail smpthost smtptimeout)) { + ${$var} = $config{mail}{$var} if $config{mail}{$var}; } - # We used to have a global dbconnect but have moved to single entries -for $var (qw(DBhost DBport DBname DBUserName DBPassword)){ - ${"global".$var} = $config{globaldb}{$var} if $config{globaldb}{$var}; +for $var (qw(DBhost DBport DBname DBUserName DBPassword)) { + ${ "global" . $var } = $config{globaldb}{$var} if $config{globaldb}{$var}; } #putting this in an if clause for now so not to break other devel users -if ($config{globaldb}{DBname}){ - my $dbconnect = "dbi:Pg:dbname=$globalDBname host=$globalDBhost +if ( $config{globaldb}{DBname} ) { + my $dbconnect = "dbi:Pg:dbname=$globalDBname host=$globalDBhost port=$globalDBport user=$globalDBUserName - password=$globalDBPassword"; # for easier debugging - $GLOBALDBH = DBI->connect($dbconnect); - if (!$GLOBALDBH){ - $form = new Form; - $form->error("No GlobalDBH Configured or Could not Connect"); - } + password=$globalDBPassword"; # for easier debugging + $GLOBALDBH = DBI->connect($dbconnect); + if ( !$GLOBALDBH ) { + $form = new Form; + $form->error("No GlobalDBH Configured or Could not Connect"); + } } -# These lines prevent other apps in mod_perl from seeing the global db + +# These lines prevent other apps in mod_perl from seeing the global db # connection info my $globalDBConnect = undef; -my $globalUserName = undef; -my $globalPassword = undef; +my $globalUserName = undef; +my $globalPassword = undef; 1; diff --git a/LedgerSMB/Tax.pm b/LedgerSMB/Tax.pm index 6d4c7956..edf3bccc 100644 --- a/LedgerSMB/Tax.pm +++ b/LedgerSMB/Tax.pm @@ -4,15 +4,15 @@ # LedgerSMB::Tax # Default simple tax application # -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # # @@ -30,71 +30,74 @@ package Tax; use Math::BigFloat; sub init_taxes { - my ($form, $taxaccounts) = @_; - my $dbh = $form->{dbh}; - @taxes = (); - my @accounts = split / /, $taxaccounts; - my $query = qq|SELECT t.taxnumber, c.description, + my ( $form, $taxaccounts ) = @_; + my $dbh = $form->{dbh}; + @taxes = (); + my @accounts = split / /, $taxaccounts; + my $query = qq|SELECT t.taxnumber, c.description, t.rate, t.chart_id, t.pass, m.taxmodulename FROM tax t INNER JOIN chart c ON (t.chart_id = c.id) INNER JOIN taxmodule m ON (t.taxmodule_id = m.taxmodule_id) WHERE c.accno = ?|; - my $sth = $dbh->prepare($query); - foreach $taxaccount (@accounts) { - $sth->execute($taxaccount) || $form->dberror($query); - my $ref = $sth->fetchrow_hashref; + my $sth = $dbh->prepare($query); + foreach $taxaccount (@accounts) { + $sth->execute($taxaccount) || $form->dberror($query); + my $ref = $sth->fetchrow_hashref; - my $module = $ref->{'taxmodulename'}; - require "LedgerSMB/Taxes/${module}.pm"; - $module =~ s/\//::/g; - my $tax = (eval 'Taxes::'.$module)->new(); + my $module = $ref->{'taxmodulename'}; + require "LedgerSMB/Taxes/${module}.pm"; + $module =~ s/\//::/g; + my $tax = ( eval 'Taxes::' . $module )->new(); - $tax->pass($ref->{'pass'}); - $tax->account($taxaccount); - $tax->rate(Math::BigFloat->new($ref->{'rate'})); - $tax->taxnumber($ref->{'taxnumber'}); - $tax->chart($ref->{'chart'}); - $tax->description($ref->{'description'}); - $tax->value(Math::BigFloat->bzero()); + $tax->pass( $ref->{'pass'} ); + $tax->account($taxaccount); + $tax->rate( Math::BigFloat->new( $ref->{'rate'} ) ); + $tax->taxnumber( $ref->{'taxnumber'} ); + $tax->chart( $ref->{'chart'} ); + $tax->description( $ref->{'description'} ); + $tax->value( Math::BigFloat->bzero() ); - push @taxes, $tax; - $sth->finish; - } - return @taxes; + push @taxes, $tax; + $sth->finish; + } + return @taxes; } sub calculate_taxes { - my ($taxes, $form, $subtotal, $extract) = @_; - my $total = Math::BigFloat->bzero(); - my %passes; - foreach my $tax (@taxes) { - push @{$passes{$tax->pass}}, $tax; - } - my @passkeys = sort keys %passes; - @passkeys = reverse @passkeys if $extract; - foreach my $pass (@passkeys) { - my $passrate = Math::BigFloat->bzero(); - my $passtotal = Math::BigFloat->bzero(); - foreach my $tax (@{$passes{$pass}}) { - $passrate += $tax->rate; - } - foreach my $tax (@{$passes{$pass}}) { - $passtotal += $tax->apply_tax($form, $subtotal + $total) if not $extract; - $passtotal += $tax->extract_tax($form, $subtotal - $total, $passrate) if $extract; - } - $total += $passtotal; - } - return $total; + my ( $taxes, $form, $subtotal, $extract ) = @_; + my $total = Math::BigFloat->bzero(); + my %passes; + foreach my $tax (@taxes) { + push @{ $passes{ $tax->pass } }, $tax; + } + my @passkeys = sort keys %passes; + @passkeys = reverse @passkeys if $extract; + foreach my $pass (@passkeys) { + my $passrate = Math::BigFloat->bzero(); + my $passtotal = Math::BigFloat->bzero(); + foreach my $tax ( @{ $passes{$pass} } ) { + $passrate += $tax->rate; + } + foreach my $tax ( @{ $passes{$pass} } ) { + $passtotal += $tax->apply_tax( $form, $subtotal + $total ) + if not $extract; + $passtotal += + $tax->extract_tax( $form, $subtotal - $total, $passrate ) + if $extract; + } + $total += $passtotal; + } + return $total; } sub apply_taxes { - my ($taxes, $form, $subtotal) = @_; - return $subtotal + calculate_taxes($taxes, $form, $subtotal, 0); + my ( $taxes, $form, $subtotal ) = @_; + return $subtotal + calculate_taxes( $taxes, $form, $subtotal, 0 ); } sub extract_taxes { - my ($taxes, $form, $subtotal) = @_; - return $subtotal - calculate_taxes($taxes, $form, $subtotal, 1); + my ( $taxes, $form, $subtotal ) = @_; + return $subtotal - calculate_taxes( $taxes, $form, $subtotal, 1 ); } 1; diff --git a/LedgerSMB/Taxes/Simple.pm b/LedgerSMB/Taxes/Simple.pm index 57777be4..bbcf539b 100755 --- a/LedgerSMB/Taxes/Simple.pm +++ b/LedgerSMB/Taxes/Simple.pm @@ -4,15 +4,15 @@ # Taxes::Simple # Default simple tax application # -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # # @@ -30,35 +30,35 @@ use Class::Struct; use Math::BigFloat; struct Taxes::Simple => { - taxnumber => '$', - description => '$', - rate => 'Math::BigFloat', - chart => '$', - account => '$', - value => 'Math::BigFloat', - pass => '$' + taxnumber => '$', + description => '$', + rate => 'Math::BigFloat', + chart => '$', + account => '$', + value => 'Math::BigFloat', + pass => '$' }; sub calculate_tax { - my ($self, $form, $subtotal, $extract, $passrate) = @_; - my $rate = $self->rate; - my $tax = $subtotal * $rate / (Math::BigFloat->bone() + $passrate); - $tax = $subtotal * $rate if not $extract; - return $tax; + my ( $self, $form, $subtotal, $extract, $passrate ) = @_; + my $rate = $self->rate; + my $tax = $subtotal * $rate / ( Math::BigFloat->bone() + $passrate ); + $tax = $subtotal * $rate if not $extract; + return $tax; } sub apply_tax { - my ($self, $form, $subtotal) = @_; - my $tax = $self->calculate_tax($form, $subtotal, 0); - $self->value($tax); - return $tax; + my ( $self, $form, $subtotal ) = @_; + my $tax = $self->calculate_tax( $form, $subtotal, 0 ); + $self->value($tax); + return $tax; } sub extract_tax { - my ($self, $form, $subtotal, $passrate) = @_; - my $tax = $self->calculate_tax($form, $subtotal, 1, $passrate); - $self->value($tax); - return $tax; + my ( $self, $form, $subtotal, $passrate ) = @_; + my $tax = $self->calculate_tax( $form, $subtotal, 1, $passrate ); + $self->value($tax); + return $tax; } 1; diff --git a/LedgerSMB/Template.pm b/LedgerSMB/Template.pm index 2c1a9d8f..93254df1 100755 --- a/LedgerSMB/Template.pm +++ b/LedgerSMB/Template.pm @@ -3,15 +3,15 @@ # Template support module for LedgerSMB # LedgerSMB::Template # -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2007 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # # @@ -27,61 +27,77 @@ use LedgerSMB::Sysconfig; package LedgerSMB::Template; sub new { - my $class = shift; - my $self = {}; - $self->{myconfig} = shift; - $self->{template} = shift; - $self->{format} = shift; - $self->{language} = shift; - $self->{output} = ''; - bless $self, $class; - return $self; + my $class = shift; + my $self = {}; + $self->{myconfig} = shift; + $self->{template} = shift; + $self->{format} = shift; + $self->{language} = shift; + $self->{output} = ''; + bless $self, $class; + return $self; } sub valid_language { - my $self = shift; - # XXX Actually perform validity checks - return 1; + my $self = shift; + + # XXX Actually perform validity checks + return 1; } sub render { - my $self = shift; - my $vars = shift; - my $template; + my $self = shift; + my $vars = shift; + my $template; - if (not defined $self->{language}) { - $template = Template->new({ - INCLUDE_PATH => $self->{'myconfig'}->{'templates'}, - START_TAG => quotemeta('<?lsmb'), - END_TAG => quotemeta('?>'), - DELIMITER => ';', - }) || throw Error::Simple Template->error(); - } elsif ($self->valid_language()) { - $template = Template->new({ - INCLUDE_PATH => "$self->{'myconfig'}->{'templates'}/$self->{language};$self->{'myconfig'}->{'templates'}", - START_TAG => quotemeta('<?lsmb'), - END_TAG => quotemeta('?>'), - DELIMITER => ';', - }) || throw Error::Simple Template->error(); - } else { - throw Error::Simple 'Invalid language'; - } + if ( not defined $self->{language} ) { + $template = Template->new( + { + INCLUDE_PATH => $self->{'myconfig'}->{'templates'}, + START_TAG => quotemeta('<?lsmb'), + END_TAG => quotemeta('?>'), + DELIMITER => ';', + } + ) || throw Error::Simple Template->error(); + } + elsif ( $self->valid_language() ) { + $template = Template->new( + { + INCLUDE_PATH => +"$self->{'myconfig'}->{'templates'}/$self->{language};$self->{'myconfig'}->{'templates'}", + START_TAG => quotemeta('<?lsmb'), + END_TAG => quotemeta('?>'), + DELIMITER => ';', + } + ) || throw Error::Simple Template->error(); + } + else { + throw Error::Simple 'Invalid language'; + } - eval "require LedgerSMB::Template::$self->{format}"; - if ($@) { - throw Error::Simple $@; - } + eval "require LedgerSMB::Template::$self->{format}"; + if ($@) { + throw Error::Simple $@; + } - my $cleanvars = &{"LedgerSMB::Template::$self->{format}::preprocess"}($vars); - if (not $template->process( - &{"LedgerSMB::Template::$self->{format}::get_template"}($self->{template}), - $cleanvars, \$self->{output}, binmode => ':utf8')) { - throw Error::Simple $template->error(); - } + my $cleanvars = + &{"LedgerSMB::Template::$self->{format}::preprocess"}($vars); + if ( + not $template->process( + &{"LedgerSMB::Template::$self->{format}::get_template"}( + $self->{template} ), + $cleanvars, + \$self->{output}, + binmode => ':utf8' + ) + ) + { + throw Error::Simple $template->error(); + } - &{"LedgerSMB::Template::$self->{format}::postprocess"}($self); + &{"LedgerSMB::Template::$self->{format}::postprocess"}($self); - return $self->{output}; + return $self->{output}; } 1; diff --git a/LedgerSMB/Template/HTML.pm b/LedgerSMB/Template/HTML.pm index 8e610e26..62834f70 100755 --- a/LedgerSMB/Template/HTML.pm +++ b/LedgerSMB/Template/HTML.pm @@ -1,3 +1,4 @@ + =head1 NAME LedgerSMB::Template::HTML Template support module for LedgerSMB @@ -29,29 +30,31 @@ use CGI; package LedgerSMB::Template::HTML; sub get_template { - my $name = shift; - return "${name}.html"; + my $name = shift; + return "${name}.html"; } sub preprocess { - my $rawvars = shift; - my $vars; - my $type = ref $rawvars; - -#XXX fix escaping function - if ($type eq 'ARRAY') { - } elsif ($type eq 'HASH') { - for (keys %{$rawvars}) { - $vars->{$_} = preprocess($rawvars[$_]); - } - } else { - return CGI::escapeHTML($rawvars); - } + my $rawvars = shift; + my $vars; + my $type = ref $rawvars; + + #XXX fix escaping function + if ( $type eq 'ARRAY' ) { + } + elsif ( $type eq 'HASH' ) { + for ( keys %{$rawvars} ) { + $vars->{$_} = preprocess( $rawvars[$_] ); + } + } + else { + return CGI::escapeHTML($rawvars); + } } sub postprocess { - my $parent = shift; - return; + my $parent = shift; + return; } 1; diff --git a/LedgerSMB/User.pm b/LedgerSMB/User.pm index 71199a1a..914bdfb9 100644 --- a/LedgerSMB/User.pm +++ b/LedgerSMB/User.pm @@ -1,8 +1,8 @@ #===================================================================== -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used # with permission. @@ -18,7 +18,7 @@ # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.org -# +# # Contributors: Jim Rawlings <jim@your-dba.com> # #====================================================================== @@ -34,20 +34,21 @@ package LedgerSMB::User; use LedgerSMB::Sysconfig; use LedgerSMB::Session; -use Data::Dumper; +use Data::Dumper; sub new { - - my ($type, $login) = @_; - my $self = {}; - if ($login ne "") { + my ( $type, $login ) = @_; + my $self = {}; + + if ( $login ne "" ) { + + # use central db + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - # use central db - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - - # for now, this is querying the table directly... ugly - my $fetchUserPrefs = $dbh->prepare("SELECT acs, address, businessnumber, + # for now, this is querying the table directly... ugly + my $fetchUserPrefs = $dbh->prepare( + "SELECT acs, address, businessnumber, company, countrycode, currency, dateformat, dbdriver, dbhost, dbname, dboptions, dbpasswd, dbport, dbuser, @@ -57,68 +58,77 @@ sub new { timeout, vclimit, u.username FROM users_conf as uc, users as u WHERE u.username = ? - AND u.id = uc.id;"); + AND u.id = uc.id;" + ); - $fetchUserPrefs->execute($login); + $fetchUserPrefs->execute($login); - my $userHashRef = $fetchUserPrefs->fetchrow_hashref; + my $userHashRef = $fetchUserPrefs->fetchrow_hashref; - while ( my ($key, $value) = each(%{$userHashRef}) ) { - $self->{$key} = $value; - } + while ( my ( $key, $value ) = each( %{$userHashRef} ) ) { + $self->{$key} = $value; + } + + chomp( $self->{dbport} ); + chomp( $self->{dbname} ); + chomp( $self->{dbhost} ); - chomp($self->{dbport}); - chomp($self->{dbname}); - chomp($self->{dbhost}); + $self->{dbconnect} = + 'dbi:Pg:dbname=' + . $self->{dbname} + . ';host=' + . $self->{dbhost} + . ';port=' + . $self->{dbport}; - $self->{dbconnect} = 'dbi:Pg:dbname='.$self->{dbname}.';host='.$self->{dbhost}.';port='.$self->{dbport}; + if ( $self->{username} ) { + $self->{login} = $login; + } + } - if($self->{username}){ - $self->{login} = $login; - } - } - - bless $self, $type; + bless $self, $type; } sub country_codes { - use Locale::Country; - use Locale::Language; + use Locale::Country; + use Locale::Language; + + my %cc = (); - my %cc = (); - - # scan the locale directory and read in the LANGUAGE files - opendir DIR, "${LedgerSMB::Sysconfig::localepath}"; + # scan the locale directory and read in the LANGUAGE files + opendir DIR, "${LedgerSMB::Sysconfig::localepath}"; - my @dir = grep !/^\..*$/, readdir DIR; + my @dir = grep !/^\..*$/, readdir DIR; - foreach my $dir (@dir) { - $dir = substr($dir, 0, -3); - $cc{$dir} = code2language(substr($dir, 0, 2)); - $cc{$dir} .= ("/" . code2country(substr($dir, 3, 2))) - if length($dir) > 2; - $cc{$dir} .= (" " . substr($dir, 6)) if length($dir) > 5; - } + foreach my $dir (@dir) { + $dir = substr( $dir, 0, -3 ); + $cc{$dir} = code2language( substr( $dir, 0, 2 ) ); + $cc{$dir} .= ( "/" . code2country( substr( $dir, 3, 2 ) ) ) + if length($dir) > 2; + $cc{$dir} .= ( " " . substr( $dir, 6 ) ) if length($dir) > 5; + } - closedir(DIR); + closedir(DIR); - %cc; + %cc; } sub fetch_config { -#I'm hoping that this function will go and is a temporary bridge -#until we get rid of %myconfig elsewhere in the code - - my ($self, $login) = @_; - - if ($login ne "") { - - # use central db - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - - # for now, this is querying the table directly... ugly - my $fetchUserPrefs = $dbh->prepare("SELECT acs, address, businessnumber, + + #I'm hoping that this function will go and is a temporary bridge + #until we get rid of %myconfig elsewhere in the code + + my ( $self, $login ) = @_; + + if ( $login ne "" ) { + + # use central db + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; + + # for now, this is querying the table directly... ugly + my $fetchUserPrefs = $dbh->prepare( + "SELECT acs, address, businessnumber, company, countrycode, currency, dateformat, dbdriver, dbhost, dbname, dboptions, dbpasswd, dbport, dbuser, @@ -128,607 +138,608 @@ sub fetch_config { timeout, vclimit, u.username FROM users_conf as uc, users as u WHERE u.username = ? - AND u.id = uc.id;"); - - $fetchUserPrefs->execute($login); + AND u.id = uc.id;" + ); - my $userHashRef = $fetchUserPrefs->fetchrow_hashref; + $fetchUserPrefs->execute($login); - while ( my ($key, $value) = each(%{$userHashRef}) ) { - $myconfig{$key} = $value; - } + my $userHashRef = $fetchUserPrefs->fetchrow_hashref; - chomp($myconfig{'dbport'}); - chomp($myconfig{'dbname'}); - chomp($myconfig{'dbhost'}); + while ( my ( $key, $value ) = each( %{$userHashRef} ) ) { + $myconfig{$key} = $value; + } - $myconfig{'login'} = $login; - $myconfig{'dbconnect'} = 'dbi:Pg:dbname='.$myconfig{'dbname'}.';host='.$myconfig{'dbhost'}.';port='.$myconfig{'dbport'}; - } - - return \%myconfig; + chomp( $myconfig{'dbport'} ); + chomp( $myconfig{'dbname'} ); + chomp( $myconfig{'dbhost'} ); + + $myconfig{'login'} = $login; + $myconfig{'dbconnect'} = + 'dbi:Pg:dbname=' + . $myconfig{'dbname'} + . ';host=' + . $myconfig{'dbhost'} + . ';port=' + . $myconfig{'dbport'}; + } + + return \%myconfig; } sub login { - my ($self, $form) = @_; + my ( $self, $form ) = @_; - my $rc = -1; - - if ($self->{login} ne "") { - if (! Session::password_check($form, $form->{login}, $form->{password})) { - return -1; - } + my $rc = -1; - #this is really dumb, but %myconfig will have to stay until 1.3 - while ( my ($key, $value) = each(%{$self}) ) { - $myconfig{$key} = $value; - } + if ( $self->{login} ne "" ) { + if ( + !Session::password_check( + $form, $form->{login}, $form->{password} + ) + ) + { + return -1; + } + + #this is really dumb, but %myconfig will have to stay until 1.3 + while ( my ( $key, $value ) = each( %{$self} ) ) { + $myconfig{$key} = $value; + } - # check if database is down - my $dbh = DBI->connect( - $myconfig{dbconnect}, $myconfig{dbuser}, - $myconfig{dbpasswd}) - or $self->error(__FILE__.':'.__LINE__.': '.$DBI::errstr); + # check if database is down + my $dbh = + DBI->connect( $myconfig{dbconnect}, $myconfig{dbuser}, + $myconfig{dbpasswd} ) + or $self->error( __FILE__ . ':' . __LINE__ . ': ' . $DBI::errstr ); - # we got a connection, check the version - my $query = qq| + # we got a connection, check the version + my $query = qq| SELECT value FROM defaults WHERE setting_key = 'version'|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror(__FILE__.':'.__LINE__.$query); - - my ($dbversion) = $sth->fetchrow_array; - $sth->finish; - - # add login to employee table if it does not exist - # no error check for employee table, ignore if it does not exist - my $login = $self->{login}; - $login =~ s/@.*//; - $query = qq|SELECT id FROM employees WHERE login = ?|; - $sth = $dbh->prepare($query); - $sth->execute($login); - - my ($id) = $sth->fetchrow_array; - $sth->finish; - - if (! $id) { - my ($employeenumber) = - $form->update_defaults( - \%myconfig, "employeenumber", $dbh); - - $query = qq| + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . $query ); + + my ($dbversion) = $sth->fetchrow_array; + $sth->finish; + + # add login to employee table if it does not exist + # no error check for employee table, ignore if it does not exist + my $login = $self->{login}; + $login =~ s/@.*//; + $query = qq|SELECT id FROM employees WHERE login = ?|; + $sth = $dbh->prepare($query); + $sth->execute($login); + + my ($id) = $sth->fetchrow_array; + $sth->finish; + + if ( !$id ) { + my ($employeenumber) = + $form->update_defaults( \%myconfig, "employeenumber", $dbh ); + + $query = qq| INSERT INTO employees (login, employeenumber, name, workphone, role) VALUES (?, ?, ?, ?, ?)|; - $sth = $dbh->prepare($query); - $sth->execute( - $login, $employeenumber, $myconfig{name}, - $myconfig{tel}, $myconfig{role}); - } - $dbh->disconnect; - - $rc = 0; - - - if ($form->{dbversion} ne $dbversion) { - $rc = -3; - $dbupdate = (calc_version($dbversion) - < calc_version($form->{dbversion})); - } - - if ($dbupdate) { - $rc = -4; - - # if DB2 bale out - if ($myconfig{dbdriver} eq 'DB2') { - $rc = -2; - } - } - } - - $rc; - -} + $sth = $dbh->prepare($query); + $sth->execute( + $login, $employeenumber, $myconfig{name}, + $myconfig{tel}, $myconfig{role} + ); + } + $dbh->disconnect; + $rc = 0; + + if ( $form->{dbversion} ne $dbversion ) { + $rc = -3; + $dbupdate = + ( calc_version($dbversion) < calc_version( $form->{dbversion} ) ); + } + + if ($dbupdate) { + $rc = -4; + + # if DB2 bale out + if ( $myconfig{dbdriver} eq 'DB2' ) { + $rc = -2; + } + } + } + + $rc; + +} sub check_recurring { - my ($self, $form) = @_; + my ( $self, $form ) = @_; - my $dbh = DBI->connect( - $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); + my $dbh = + DBI->connect( $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); - my $query = qq| + my $query = qq| SELECT count(*) FROM recurring WHERE enddate >= current_date AND nextdate <= current_date|; - ($_) = $dbh->selectrow_array($query); - - $dbh->disconnect; + ($_) = $dbh->selectrow_array($query); - $_; + $dbh->disconnect; -} + $_; +} sub dbconnect_vars { - my ($form, $db) = @_; - - my %dboptions = ( - 'Pg' => { - 'yy-mm-dd' => 'set DateStyle to \'ISO\'', - 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'', - 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'', - 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'', - 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'', - 'dd.mm.yy' => 'set DateStyle to \'GERMAN\'' - } - ); - - - $form->{dboptions} = $dboptions{$form->{dbdriver}}{$form->{dateformat}}; - - $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db"; - $form->{dbconnect} .= ";host=$form->{dbhost}"; - $form->{dbconnect} .= ";port=$form->{dbport}"; - -} + my ( $form, $db ) = @_; + + my %dboptions = ( + 'Pg' => { + 'yy-mm-dd' => 'set DateStyle to \'ISO\'', + 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'', + 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'', + 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'', + 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'', + 'dd.mm.yy' => 'set DateStyle to \'GERMAN\'' + } + ); + + $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} }; + $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db"; + $form->{dbconnect} .= ";host=$form->{dbhost}"; + $form->{dbconnect} .= ";port=$form->{dbport}"; + +} sub dbdrivers { - my @drivers = DBI->available_drivers(); + my @drivers = DBI->available_drivers(); - # return (grep { /(Pg|Oracle|DB2)/ } @drivers); - return (grep { /Pg$/ } @drivers); + # return (grep { /(Pg|Oracle|DB2)/ } @drivers); + return ( grep { /Pg$/ } @drivers ); } - sub dbsources { - my ($self, $form) = @_; + my ( $self, $form ) = @_; + + my @dbsources = (); + my ( $sth, $query ); - my @dbsources = (); - my ($sth, $query); - - $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault}; - $form->{sid} = $form->{dbdefault}; - &dbconnect_vars($form, $form->{dbdefault}); + $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault}; + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars( $form, $form->{dbdefault} ); - my $dbh = DBI->connect( - $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); + my $dbh = + DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); + if ( $form->{dbdriver} eq 'Pg' ) { - if ($form->{dbdriver} eq 'Pg') { + $query = qq|SELECT datname FROM pg_database|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror( __FILE__ . ':' . __LINE__ . $query ); - $query = qq|SELECT datname FROM pg_database|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror(__FILE__.':'.__LINE__.$query); - - while (my ($db) = $sth->fetchrow_array) { + while ( my ($db) = $sth->fetchrow_array ) { - if ($form->{only_acc_db}) { + if ( $form->{only_acc_db} ) { - next if ($db =~ /^template/); + next if ( $db =~ /^template/ ); - &dbconnect_vars($form, $db); - my $dbh = DBI->connect( - $form->{dbconnect}, $form->{dbuser}, - $form->{dbpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); + &dbconnect_vars( $form, $db ); + my $dbh = + DBI->connect( $form->{dbconnect}, $form->{dbuser}, + $form->{dbpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); - $query = qq| + $query = qq| SELECT tablename FROM pg_tables WHERE tablename = 'defaults' AND tableowner = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{dbuser}) - || $form->dberror(__FILE__.':'.__LINE__.$query); - - if ($sth->fetchrow_array) { - push @dbsources, $db; - } - $sth->finish; - $dbh->disconnect; - next; - } - push @dbsources, $db; - } - } - - $sth->finish; - $dbh->disconnect; - - return @dbsources; + my $sth = $dbh->prepare($query); + $sth->execute( $form->{dbuser} ) + || $form->dberror( __FILE__ . ':' . __LINE__ . $query ); + + if ( $sth->fetchrow_array ) { + push @dbsources, $db; + } + $sth->finish; + $dbh->disconnect; + next; + } + push @dbsources, $db; + } + } -} + $sth->finish; + $dbh->disconnect; - -sub dbcreate { - my ($self, $form) = @_; - - my %dbcreate = ( 'Pg' => qq|CREATE DATABASE "$form->{db}" WITH ENCODING = 'UNICODE'| ); - - $form->{sid} = $form->{dbdefault}; - &dbconnect_vars($form, $form->{dbdefault}); - # The below line connects to Template1 or another template file in order - # to create the db. One must disconnect and reconnect later. - if ($form->{dbsuperuser}){ - my $superdbh = DBI->connect( - $form->{dbconnect}, - $form->{dbsuperuser}, - $form->{dbsuperpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); - my $query = qq|$dbcreate{$form->{dbdriver}}|; - $superdbh->do($query) || $form->dberror(__FILE__.':'.__LINE__.$query); - - $superdbh->disconnect; - } - #Reassign for the work below - - &dbconnect_vars($form, $form->{db}); - - my $dbh = DBI->connect( - $form->{dbconnect}, - $form->{dbuser}, - $form->{dbpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); - if ($form->{dbsuperuser}){ - my $superdbh = DBI->connect( - $form->{dbconnect}, - $form->{dbsuperuser}, - $form->{dbsuperpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); - # JD: We need to check for plpgsql, - # if it isn't there create it, if we can't error - # Good chance I will have to do this twice as I get - # used to the way the code is structured - - my %langcreate = ( 'Pg' => qq|CREATE LANGUAGE plpgsql|); - my $query = qq|$langcreate{$form->{dbdriver}}|; - $superdbh->do($query); - $superdbh->disconnect; - } - # create the tables - my $dbdriver = - ($form->{dbdriver} =~ /Pg/) - ? 'Pg' - : $form->{dbdriver}; - - my $filename = qq|sql/Pg-database.sql|; - $self->process_query($form, $dbh, $filename); - - # load gifi - ($filename) = split /_/, $form->{chart}; - $filename =~ s/_//; - $self->process_query($form, $dbh, "sql/${filename}-gifi.sql"); - - # load chart of accounts - $filename = qq|sql/$form->{chart}-chart.sql|; - $self->process_query($form, $dbh, $filename); - - - # create custom tables and functions - my $item; - foreach $item (qw(tables functions)) { - $filename = "sql/${dbdriver}-custom_${item}.sql"; - if (-f "$filename") { - $self->process_query($form, $dbh, $filename); - } - } - - $dbh->disconnect; + return @dbsources; } +sub dbcreate { + my ( $self, $form ) = @_; + + my %dbcreate = + ( 'Pg' => qq|CREATE DATABASE "$form->{db}" WITH ENCODING = 'UNICODE'| ); + + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars( $form, $form->{dbdefault} ); + + # The below line connects to Template1 or another template file in order + # to create the db. One must disconnect and reconnect later. + if ( $form->{dbsuperuser} ) { + my $superdbh = + DBI->connect( $form->{dbconnect}, $form->{dbsuperuser}, + $form->{dbsuperpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); + my $query = qq|$dbcreate{$form->{dbdriver}}|; + $superdbh->do($query) + || $form->dberror( __FILE__ . ':' . __LINE__ . $query ); + + $superdbh->disconnect; + } + + #Reassign for the work below + + &dbconnect_vars( $form, $form->{db} ); + + my $dbh = + DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); + if ( $form->{dbsuperuser} ) { + my $superdbh = + DBI->connect( $form->{dbconnect}, $form->{dbsuperuser}, + $form->{dbsuperpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); + + # JD: We need to check for plpgsql, + # if it isn't there create it, if we can't error + # Good chance I will have to do this twice as I get + # used to the way the code is structured + + my %langcreate = ( 'Pg' => qq|CREATE LANGUAGE plpgsql| ); + my $query = qq|$langcreate{$form->{dbdriver}}|; + $superdbh->do($query); + $superdbh->disconnect; + } + + # create the tables + my $dbdriver = + ( $form->{dbdriver} =~ /Pg/ ) + ? 'Pg' + : $form->{dbdriver}; + + my $filename = qq|sql/Pg-database.sql|; + $self->process_query( $form, $dbh, $filename ); + + # load gifi + ($filename) = split /_/, $form->{chart}; + $filename =~ s/_//; + $self->process_query( $form, $dbh, "sql/${filename}-gifi.sql" ); + + # load chart of accounts + $filename = qq|sql/$form->{chart}-chart.sql|; + $self->process_query( $form, $dbh, $filename ); + + # create custom tables and functions + my $item; + foreach $item (qw(tables functions)) { + $filename = "sql/${dbdriver}-custom_${item}.sql"; + if ( -f "$filename" ) { + $self->process_query( $form, $dbh, $filename ); + } + } + $dbh->disconnect; -sub process_query { - my ($self, $form, $dbh, $filename) = @_; - - return unless (-f $filename); - - $ENV{PGPASSWORD} = $form->{dbpasswd}; - $ENV{PGUSER} = $form->{dbuser}; - $ENV{PGDATABASE} = $form->{db}; - $ENV{PGHOST} = $form->{dbhost}; - $ENV{PGPORT} = $form->{pgport}; - - $results = `psql -f $filename 2>&1`; - if ($?){ - $form->error($!); - } - elsif ($results =~ /error/i){ - $form->error($results); - } } - +sub process_query { + my ( $self, $form, $dbh, $filename ) = @_; + + return unless ( -f $filename ); + + $ENV{PGPASSWORD} = $form->{dbpasswd}; + $ENV{PGUSER} = $form->{dbuser}; + $ENV{PGDATABASE} = $form->{db}; + $ENV{PGHOST} = $form->{dbhost}; + $ENV{PGPORT} = $form->{pgport}; + + $results = `psql -f $filename 2>&1`; + if ($?) { + $form->error($!); + } + elsif ( $results =~ /error/i ) { + $form->error($results); + } +} sub dbdelete { - my ($self, $form) = @_; + my ( $self, $form ) = @_; - $form->{sid} = $form->{dbdefault}; - &dbconnect_vars($form, $form->{dbdefault}); - my $dbh = DBI->connect( - $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); - my $query = qq|DROP DATABASE "$form->{db}"|; - $dbh->do($query) || $form->dberror(__FILE__.':'.__LINE__.$query); + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars( $form, $form->{dbdefault} ); + my $dbh = + DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); + my $query = qq|DROP DATABASE "$form->{db}"|; + $dbh->do($query) || $form->dberror( __FILE__ . ':' . __LINE__ . $query ); - $dbh->disconnect; + $dbh->disconnect; } - - sub dbsources_unused { - my ($self, $form, $memfile) = @_; + my ( $self, $form, $memfile ) = @_; - my @dbexcl = (); - my @dbsources = (); - - $form->error(__FILE__.':'.__LINE__.": $memfile locked!") if (-f "${memfile}.LCK"); - - # open members file - open(FH, '<', "$memfile") or $form->error(__FILE__.':'.__LINE__.": $memfile : $!"); + my @dbexcl = (); + my @dbsources = (); - while (<FH>) { - if (/^dbname=/) { - my ($null,$item) = split /=/; - push @dbexcl, $item; - } - } + $form->error( __FILE__ . ':' . __LINE__ . ": $memfile locked!" ) + if ( -f "${memfile}.LCK" ); - close FH; + # open members file + open( FH, '<', "$memfile" ) + or $form->error( __FILE__ . ':' . __LINE__ . ": $memfile : $!" ); - $form->{only_acc_db} = 1; - my @db = &dbsources("", $form); + while (<FH>) { + if (/^dbname=/) { + my ( $null, $item ) = split /=/; + push @dbexcl, $item; + } + } - push @dbexcl, $form->{dbdefault}; + close FH; - foreach $item (@db) { - unless (grep /$item$/, @dbexcl) { - push @dbsources, $item; - } - } + $form->{only_acc_db} = 1; + my @db = &dbsources( "", $form ); - return @dbsources; + push @dbexcl, $form->{dbdefault}; -} + foreach $item (@db) { + unless ( grep /$item$/, @dbexcl ) { + push @dbsources, $item; + } + } + return @dbsources; + +} sub dbneedsupdate { - my ($self, $form) = @_; + my ( $self, $form ) = @_; + + my %dbsources = (); + my $query; - my %dbsources = (); - my $query; - - $form->{sid} = $form->{dbdefault}; - &dbconnect_vars($form, $form->{dbdefault}); + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars( $form, $form->{dbdefault} ); - my $dbh = DBI->connect( - $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); + my $dbh = + DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); - if ($form->{dbdriver} =~ /Pg/) { + if ( $form->{dbdriver} =~ /Pg/ ) { - $query = qq| + $query = qq| SELECT d.datname FROM pg_database d, pg_user u WHERE d.datdba = u.usesysid AND u.usename = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($form->{dbuser}) || $form->dberror(__FILE__.':'.__LINE__.$query); - - while (my ($db) = $sth->fetchrow_array) { + my $sth = $dbh->prepare($query); + $sth->execute( $form->{dbuser} ) + || $form->dberror( __FILE__ . ':' . __LINE__ . $query ); + + while ( my ($db) = $sth->fetchrow_array ) { - next if ($db =~ /^template/); + next if ( $db =~ /^template/ ); - &dbconnect_vars($form, $db); - - my $dbh = DBI->connect( - $form->{dbconnect}, $form->{dbuser}, - $form->{dbpasswd}) - or $form->dberror(__FILE__.':'.__LINE__); + &dbconnect_vars( $form, $db ); - $query = qq| + my $dbh = + DBI->connect( $form->{dbconnect}, $form->{dbuser}, + $form->{dbpasswd} ) + or $form->dberror( __FILE__ . ':' . __LINE__ ); + + $query = qq| SELECT tablename FROM pg_tables WHERE tablename = 'defaults'|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror(__FILE__.':'.__LINE__.$query); + my $sth = $dbh->prepare($query); + $sth->execute + || $form->dberror( __FILE__ . ':' . __LINE__ . $query ); - if ($sth->fetchrow_array) { - $query = qq| + if ( $sth->fetchrow_array ) { + $query = qq| SELECT value FROM defaults WHERE setting_key = 'version'|; - my $sth = $dbh->prepare($query); - $sth->execute; - - if (my ($version) = $sth->fetchrow_array) { - $dbsources{$db} = $version; - } - $sth->finish; - } - $sth->finish; - $dbh->disconnect; - } - $sth->finish; - } - - - - $dbh->disconnect; - - %dbsources; + my $sth = $dbh->prepare($query); + $sth->execute; + + if ( my ($version) = $sth->fetchrow_array ) { + $dbsources{$db} = $version; + } + $sth->finish; + } + $sth->finish; + $dbh->disconnect; + } + $sth->finish; + } -} + $dbh->disconnect; + + %dbsources; +} sub dbupdate { - my ($self, $form) = @_; - - $form->{sid} = $form->{dbdefault}; - - my @upgradescripts = (); - my $query; - my $rc = -2; - - if ($form->{dbupdate}) { - # read update scripts into memory - opendir SQLDIR, "sql/." or $form->error(__FILE__.':'.__LINE__.': '.$!); - @upgradescripts = - sort script_version - grep /$form->{dbdriver}-upgrade-.*?\.sql$/, - readdir SQLDIR; - closedir SQLDIR; - } - - - foreach my $db (split / /, $form->{dbupdate}) { - - next unless $form->{$db}; - - # strip db from dataset - $db =~ s/^db//; - &dbconnect_vars($form, $db); - - my $dbh = DBI->connect( - $form->{dbconnect}, $form->{dbuser}, - $form->{dbpasswd}, {AutoCommit => 0}) - or $form->dberror(__FILE__.':'.__LINE__); - - # check version - $query = qq| + my ( $self, $form ) = @_; + + $form->{sid} = $form->{dbdefault}; + + my @upgradescripts = (); + my $query; + my $rc = -2; + + if ( $form->{dbupdate} ) { + + # read update scripts into memory + opendir SQLDIR, "sql/." + or $form->error( __FILE__ . ':' . __LINE__ . ': ' . $! ); + @upgradescripts = + sort script_version grep /$form->{dbdriver}-upgrade-.*?\.sql$/, + readdir SQLDIR; + closedir SQLDIR; + } + + foreach my $db ( split / /, $form->{dbupdate} ) { + + next unless $form->{$db}; + + # strip db from dataset + $db =~ s/^db//; + &dbconnect_vars( $form, $db ); + + my $dbh = DBI->connect( + $form->{dbconnect}, $form->{dbuser}, + $form->{dbpasswd}, { AutoCommit => 0 } + ) or $form->dberror( __FILE__ . ':' . __LINE__ ); + + # check version + $query = qq| SELECT value FROM defaults WHERE setting_key = 'version'|; - my $sth = $dbh->prepare($query); - # no error check, let it fall through - $sth->execute; - - my $version = $sth->fetchrow_array; - $sth->finish; - - next unless $version; - - $version = calc_version($version); - my $dbversion = calc_version($form->{dbversion}); - - foreach my $upgradescript (@upgradescripts) { - my $a = $upgradescript; - $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g; - - my ($mindb, $maxdb) = split /-/, $a; - $mindb = calc_version($mindb); - $maxdb = calc_version($maxdb); - - next if ($version >= $maxdb); - - # exit if there is no upgrade script or version == mindb - last if ($version < $mindb || $version >= $dbversion); - - # apply upgrade - $self->process_query($form, $dbh, "sql/$upgradescript"); - $dbh->commit; - $version = $maxdb; - - } - - $rc = 0; - $dbh->disconnect; - - } - - $rc; + my $sth = $dbh->prepare($query); + + # no error check, let it fall through + $sth->execute; + + my $version = $sth->fetchrow_array; + $sth->finish; + + next unless $version; + + $version = calc_version($version); + my $dbversion = calc_version( $form->{dbversion} ); + + foreach my $upgradescript (@upgradescripts) { + my $a = $upgradescript; + $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g; + + my ( $mindb, $maxdb ) = split /-/, $a; + $mindb = calc_version($mindb); + $maxdb = calc_version($maxdb); + + next if ( $version >= $maxdb ); + + # exit if there is no upgrade script or version == mindb + last if ( $version < $mindb || $version >= $dbversion ); + + # apply upgrade + $self->process_query( $form, $dbh, "sql/$upgradescript" ); + $dbh->commit; + $version = $maxdb; + + } + + $rc = 0; + $dbh->disconnect; + + } + + $rc; } - sub calc_version { - - my @v = split /\./, $_[0]; - my $version = 0; - my $i; - - for ($i = 0; $i <= $#v; $i++) { - $version *= 1000; - $version += $v[$i]; - } - - return $version; - + + my @v = split /\./, $_[0]; + my $version = 0; + my $i; + + for ( $i = 0 ; $i <= $#v ; $i++ ) { + $version *= 1000; + $version += $v[$i]; + } + + return $version; + } - sub script_version { - my ($my_a, $my_b) = ($a, $b); - - my ($a_from, $a_to, $b_from, $b_to); - my ($res_a, $res_b, $i); - - $my_a =~ s/.*-upgrade-//; - $my_a =~ s/.sql$//; - $my_b =~ s/.*-upgrade-//; - $my_b =~ s/.sql$//; - ($a_from, $a_to) = split(/-/, $my_a); - ($b_from, $b_to) = split(/-/, $my_b); - - $res_a = calc_version($a_from); - $res_b = calc_version($b_from); - - if ($res_a == $res_b) { - $res_a = calc_version($a_to); - $res_b = calc_version($b_to); - } - - return $res_a <=> $res_b; - + my ( $my_a, $my_b ) = ( $a, $b ); + + my ( $a_from, $a_to, $b_from, $b_to ); + my ( $res_a, $res_b, $i ); + + $my_a =~ s/.*-upgrade-//; + $my_a =~ s/.sql$//; + $my_b =~ s/.*-upgrade-//; + $my_b =~ s/.sql$//; + ( $a_from, $a_to ) = split( /-/, $my_a ); + ( $b_from, $b_to ) = split( /-/, $my_b ); + + $res_a = calc_version($a_from); + $res_b = calc_version($b_from); + + if ( $res_a == $res_b ) { + $res_a = calc_version($a_to); + $res_b = calc_version($b_to); + } + + return $res_a <=> $res_b; + } sub save_member { - my ($self) = @_; + my ($self) = @_; - # replace \r\n with \n - for (qw(address signature)) { $self->{$_} =~ s/\r?\n/\\n/g } + # replace \r\n with \n + for (qw(address signature)) { $self->{$_} =~ s/\r?\n/\\n/g } - # use central db - my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; + # use central db + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - #check to see if the user exists already - my $userCheck = $dbh->prepare("SELECT id FROM users WHERE username = ?"); - $userCheck->execute($self->{login}); - my ($userID) = $userCheck->fetchrow_array; + #check to see if the user exists already + my $userCheck = $dbh->prepare("SELECT id FROM users WHERE username = ?"); + $userCheck->execute( $self->{login} ); + my ($userID) = $userCheck->fetchrow_array; - if (! $self->{dbhost}) { - $self->{dbhost} = 'localhost'; - } - if (! $self->{dbport}) { - $self->{dbport} = '5432'; - } + if ( !$self->{dbhost} ) { + $self->{dbhost} = 'localhost'; + } + if ( !$self->{dbport} ) { + $self->{dbport} = '5432'; + } + + my $userConfExists = 0; - my $userConfExists = 0; + if ($userID) { - if($userID){ - #got an id, check to see if it's in the users_conf table - my $userConfCheck = $dbh->prepare("SELECT password, 1 FROM users_conf WHERE id = ?"); - $userConfCheck->execute($userID); + #got an id, check to see if it's in the users_conf table + my $userConfCheck = + $dbh->prepare("SELECT password, 1 FROM users_conf WHERE id = ?"); + $userConfCheck->execute($userID); - ($oldPassword, $userConfExists) = $userConfCheck->fetchrow_array; - } - else{ - my $userConfAdd = $dbh->prepare("SELECT create_user(?);"); - $userConfAdd->execute($self->{login}); - ($userID) = $userConfAdd->fetchrow_array; - } + ( $oldPassword, $userConfExists ) = $userConfCheck->fetchrow_array; + } + else { + my $userConfAdd = $dbh->prepare("SELECT create_user(?);"); + $userConfAdd->execute( $self->{login} ); + ($userID) = $userConfAdd->fetchrow_array; + } - if($userConfExists){ + if ($userConfExists) { - # for now, this is updating the table directly... ugly - my $userConfUpdate = $dbh->prepare("UPDATE users_conf + # for now, this is updating the table directly... ugly + my $userConfUpdate = $dbh->prepare( + "UPDATE users_conf SET acs = ?, address = ?, businessnumber = ?, company = ?, countrycode = ?, currency = ?, dateformat = ?, dbdriver = ?, @@ -740,37 +751,47 @@ sub save_member { sid = ?, signature = ?, stylesheet = ?, tel = ?, templates = ?, timeout = ?, vclimit = ? - WHERE id = ?;"); - - $userConfUpdate->execute($self->{acs}, $self->{address}, $self->{businessnumber}, - $self->{company}, $self->{countrycode}, $self->{currency}, - $self->{dateformat}, $self->{dbdriver}, - $self->{dbhost}, $self->{dbname}, $self->{dboptions}, - $self->{dbpasswd}, $self->{dbport}, $self->{dbuser}, - $self->{email}, $self->{fax}, $self->{menuwidth}, - $self->{name}, $self->{numberformat}, - $self->{print}, $self->{printer}, $self->{role}, - $self->{sid}, $self->{signature}, $self->{stylesheet}, - $self->{tel}, $self->{templates}, $self->{timeout}, - $self->{vclimit}, $userID); - - - if($oldPassword ne $self->{password}){ - # if they're supplying a 32 char password that matches their old password - # assume they don't want to change passwords - - $userConfUpdate = $dbh->prepare("UPDATE users_conf + WHERE id = ?;" + ); + + $userConfUpdate->execute( + $self->{acs}, $self->{address}, + $self->{businessnumber}, $self->{company}, + $self->{countrycode}, $self->{currency}, + $self->{dateformat}, $self->{dbdriver}, + $self->{dbhost}, $self->{dbname}, + $self->{dboptions}, $self->{dbpasswd}, + $self->{dbport}, $self->{dbuser}, + $self->{email}, $self->{fax}, + $self->{menuwidth}, $self->{name}, + $self->{numberformat}, $self->{print}, + $self->{printer}, $self->{role}, + $self->{sid}, $self->{signature}, + $self->{stylesheet}, $self->{tel}, + $self->{templates}, $self->{timeout}, + $self->{vclimit}, $userID + ); + + if ( $oldPassword ne $self->{password} ) { + + # if they're supplying a 32 char password that matches their old password + # assume they don't want to change passwords + + $userConfUpdate = $dbh->prepare( + "UPDATE users_conf SET password = md5(?) - WHERE id = ?"); + WHERE id = ?" + ); - $userConfUpdate->execute($self->{password}, $userID); + $userConfUpdate->execute( $self->{password}, $userID ); - } + } - } - else{ + } + else { - my $userConfInsert = $dbh->prepare("INSERT INTO users_conf(acs, address, businessnumber, + my $userConfInsert = $dbh->prepare( + "INSERT INTO users_conf(acs, address, businessnumber, company, countrycode, currency, dateformat, dbdriver, dbhost, dbname, dboptions, dbpasswd, @@ -780,138 +801,145 @@ sub save_member { timeout, vclimit, id, password) VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, - ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, md5(?));"); - - $userConfInsert->execute($self->{acs}, $self->{address}, $self->{businessnumber}, - $self->{company}, $self->{countrycode}, $self->{currency}, - $self->{dateformat}, $self->{dbdriver}, - $self->{dbhost}, $self->{dbname}, $self->{dboptions}, - $self->{dbpasswd}, $self->{dbport}, $self->{dbuser}, - $self->{email}, $self->{fax}, $self->{menuwidth}, - $self->{name}, $self->{numberformat}, - $self->{print}, $self->{printer}, $self->{role}, - $self->{sid}, $self->{signature}, $self->{stylesheet}, - $self->{tel}, $self->{templates}, $self->{timeout}, - $self->{vclimit}, $userID, $self->{password}); - - } - - if (! $self->{'admin'}) { - - $self->{dbpasswd} =~ s/\\'/'/g; - $self->{dbpasswd} =~ s/\\\\/\\/g; - - # format dbconnect and dboptions string - &dbconnect_vars($self, $self->{dbname}); - - # check if login is in database - my $dbh = DBI->connect( - $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}, - {AutoCommit => 0}) - or $self->error($DBI::errstr); - - # add login to employees table if it does not exist - my $login = $self->{login}; - $login =~ s/@.*//; - my $sth = $dbh->prepare("SELECT id FROM employees WHERE login = ?;"); - $sth->execute($login); - - my ($id) = $sth->fetchrow_array; - $sth->finish; - my $employeenumber; - my @values; - if ($id) { - - $query = qq|UPDATE employees SET + ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, md5(?));" + ); + + $userConfInsert->execute( + $self->{acs}, $self->{address}, + $self->{businessnumber}, $self->{company}, + $self->{countrycode}, $self->{currency}, + $self->{dateformat}, $self->{dbdriver}, + $self->{dbhost}, $self->{dbname}, + $self->{dboptions}, $self->{dbpasswd}, + $self->{dbport}, $self->{dbuser}, + $self->{email}, $self->{fax}, + $self->{menuwidth}, $self->{name}, + $self->{numberformat}, $self->{print}, + $self->{printer}, $self->{role}, + $self->{sid}, $self->{signature}, + $self->{stylesheet}, $self->{tel}, + $self->{templates}, $self->{timeout}, + $self->{vclimit}, $userID, + $self->{password} + ); + + } + + if ( !$self->{'admin'} ) { + + $self->{dbpasswd} =~ s/\\'/'/g; + $self->{dbpasswd} =~ s/\\\\/\\/g; + + # format dbconnect and dboptions string + &dbconnect_vars( $self, $self->{dbname} ); + + # check if login is in database + my $dbh = DBI->connect( + $self->{dbconnect}, $self->{dbuser}, + $self->{dbpasswd}, { AutoCommit => 0 } + ) or $self->error($DBI::errstr); + + # add login to employees table if it does not exist + my $login = $self->{login}; + $login =~ s/@.*//; + my $sth = $dbh->prepare("SELECT id FROM employees WHERE login = ?;"); + $sth->execute($login); + + my ($id) = $sth->fetchrow_array; + $sth->finish; + my $employeenumber; + my @values; + if ($id) { + + $query = qq|UPDATE employees SET role = ?, email = ?, name = ? WHERE login = ?|; - @values = ($self->{role}, $self->{email}, $self->{name}, $login); + @values = ( $self->{role}, $self->{email}, $self->{name}, $login ); - } else { + } + else { - my ($employeenumber) = Form::update_defaults( - "", \%$self, "employeenumber", $dbh); - $query = qq| + my ($employeenumber) = + Form::update_defaults( "", \%$self, "employeenumber", $dbh ); + $query = qq| INSERT INTO employees (login, employeenumber, name, workphone, role, email, sales) VALUES (?, ?, ?, ?, ?, ?, '1')|; - - @values = ($login, $employeenumber, $self->{name}, $self->{tel}, - $self->{role}, $self->{email}) - } - $sth = $dbh->prepare($query); - $sth->execute(@values); - $dbh->commit; - $dbh->disconnect; + @values = ( + $login, $employeenumber, $self->{name}, + $self->{tel}, $self->{role}, $self->{email} + ); + } - } -} + $sth = $dbh->prepare($query); + $sth->execute(@values); + $dbh->commit; + $dbh->disconnect; + } +} sub delete_login { - my ($self, $form) = @_; - - my $dbh = DBI->connect( - $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, - {AutoCommit => 0}) - or $form->dberror(__FILE__.':'.__LINE__); - - my $login = $form->{login}; - $login =~ s/@.*//; - my $query = qq|SELECT id FROM employees WHERE login = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($login) || $form->dberror(__FILE__.':'.__LINE__.': '.$query); - - my ($id) = $sth->fetchrow_array; - $sth->finish; - - my $query = qq| + my ( $self, $form ) = @_; + + my $dbh = DBI->connect( + $form->{dbconnect}, $form->{dbuser}, + $form->{dbpasswd}, { AutoCommit => 0 } + ) or $form->dberror( __FILE__ . ':' . __LINE__ ); + + my $login = $form->{login}; + $login =~ s/@.*//; + my $query = qq|SELECT id FROM employees WHERE login = ?|; + my $sth = $dbh->prepare($query); + $sth->execute($login) + || $form->dberror( __FILE__ . ':' . __LINE__ . ': ' . $query ); + + my ($id) = $sth->fetchrow_array; + $sth->finish; + + my $query = qq| UPDATE employees SET login = NULL, enddate = current_date WHERE login = ?|; - $sth = $dbh->prepare($query); - $sth->execute($login); - $dbh->commit; - $dbh->disconnect; + $sth = $dbh->prepare($query); + $sth->execute($login); + $dbh->commit; + $dbh->disconnect; } - sub config_vars { - - my @conf = - qw(acs address businessnumber company countrycode - currency dateformat dbconnect dbdriver dbhost dbname dboptions - dbpasswd dbport dbuser email fax menuwidth name numberformat - password printer role sid signature stylesheet tel templates - timeout vclimit); - @conf; + my @conf = qw(acs address businessnumber company countrycode + currency dateformat dbconnect dbdriver dbhost dbname dboptions + dbpasswd dbport dbuser email fax menuwidth name numberformat + password printer role sid signature stylesheet tel templates + timeout vclimit); -} + @conf; +} sub error { - my ($self, $msg) = @_; - - if ($ENV{GATEWAY_INTERFACE}) { - print qq|Content-Type: text/html\n\n|. - qq|<body bgcolor=ffffff>\n\n|. - qq|<h2><font color=red>Error!</font></h2>\n|. - qq|<p><b>$msg</b>|; - - } - - die "Error: $msg\n"; - -} + my ( $self, $msg ) = @_; + + if ( $ENV{GATEWAY_INTERFACE} ) { + print qq|Content-Type: text/html\n\n| + . qq|<body bgcolor=ffffff>\n\n| + . qq|<h2><font color=red>Error!</font></h2>\n| + . qq|<p><b>$msg</b>|; + } + + die "Error: $msg\n"; + +} 1; diff --git a/LedgerSMB/locales.pl b/LedgerSMB/locales.pl index 0bfc2503..e4ade0d0 100755 --- a/LedgerSMB/locales.pl +++ b/LedgerSMB/locales.pl @@ -8,26 +8,30 @@ use FileHandle; use Getopt::Long; Getopt::Long::Configure('bundling'); -$basedir = "../.."; -$bindir = "$basedir/bin"; +$basedir = "../.."; +$bindir = "$basedir/bin"; $customdir = "$bindir/custom"; -$menufile = "menu.ini"; +$menufile = "menu.ini"; my $excludeCustom = 0; -my $buildAll = 0; -my $noMissing = 0; -my $goodOpt = 0; -$goodOpt = GetOptions ( - 'n' => \$excludeCustom, 'no-custom' => \$excludeCustom, - 'a' => \$buildAll, 'build-all' => \$buildAll, - 'm' => \$noMissing, 'no-missing' => \$noMissing); - -if (!$goodOpt) { - printf "Invalid options\n"; - exit 1; +my $buildAll = 0; +my $noMissing = 0; +my $goodOpt = 0; +$goodOpt = GetOptions( + 'n' => \$excludeCustom, + 'no-custom' => \$excludeCustom, + 'a' => \$buildAll, + 'build-all' => \$buildAll, + 'm' => \$noMissing, + 'no-missing' => \$noMissing +); + +if ( !$goodOpt ) { + printf "Invalid options\n"; + exit 1; } -open(FH, "LANGUAGE"); +open( FH, "LANGUAGE" ); $language = <FH>; close(FH); chomp $language; @@ -44,325 +48,338 @@ closedir DIR; @customfiles = () if ($excludeCustom); if ($excludeCustom) { - @menufiles = ($menufile); -} else { - opendir DIR, "$bindir" or die "$!"; - @menufiles = grep { /.*?_$menufile$/ } readdir DIR; - closedir DIR; + @menufiles = ($menufile); +} +else { + opendir DIR, "$bindir" or die "$!"; + @menufiles = grep { /.*?_$menufile$/ } readdir DIR; + closedir DIR; ## unshift @menufiles, $menufile; ## opendir DIR, "$customdir" or die "$!"; ## @menufiles = grep { /^$menufile$/ } readdir DIR; ## closedir DIR; - unshift @menufiles, $menufile; + unshift @menufiles, $menufile; } -if (-f "all") { - eval { require "all"; }; - %all = %{$self{texts}}; - %{$self{texts}} = (); -} else { - # build %all file from individual files - foreach $file (@progfiles) { - &scanfile("$bindir/$file"); - } +if ( -f "all" ) { + eval { require "all"; }; + %all = %{ $self{texts} }; + %{ $self{texts} } = (); } - +else { + + # build %all file from individual files + foreach $file (@progfiles) { + &scanfile("$bindir/$file"); + } +} + # remove the old missing file -if (-f 'missing') { - unlink "missing"; +if ( -f 'missing' ) { + unlink "missing"; } - + foreach $file (@progfiles) { - - next if -d "$bindir/$file"; - %locale = (); - %submit = (); - %subrt = (); - @missing = (); - %missing = (); - - &scanfile("$bindir/$file"); - - # scan custom_{module}.pl or {login}_{module}.pl files - foreach $customfile (@customfiles) { - if ($customfile =~ /_$file/) { - if (-f "$bindir/$customfile") { - &scanfile("$bindir/$customfile"); - } + + next if -d "$bindir/$file"; + %locale = (); + %submit = (); + %subrt = (); + @missing = (); + %missing = (); + + &scanfile("$bindir/$file"); + + # scan custom_{module}.pl or {login}_{module}.pl files + foreach $customfile (@customfiles) { + if ( $customfile =~ /_$file/ ) { + if ( -f "$bindir/$customfile" ) { + &scanfile("$bindir/$customfile"); + } + } } - } - - # if this is the menu.pl file - if ($file eq 'menu.pl') { - foreach $item (@menufiles) { - &scanmenu("$basedir/$item"); + + # if this is the menu.pl file + if ( $file eq 'menu.pl' ) { + foreach $item (@menufiles) { + &scanmenu("$basedir/$item"); + } } - } - - $file =~ s/\.pl//; - - if (-f "$file.missing") { - eval { require "$file.missing"; }; - unlink "$file.missing"; - - for (keys %$missing) { - $self{texts}{$_} ||= $missing->{$_}; + + $file =~ s/\.pl//; + + if ( -f "$file.missing" ) { + eval { require "$file.missing"; }; + unlink "$file.missing"; + + for ( keys %$missing ) { + $self{texts}{$_} ||= $missing->{$_}; + } } - } - open FH, '>', "$file" or die "$! : $file"; + open FH, '>', "$file" or die "$! : $file"; - if ($charset) { - print FH qq|\$self{charset} = '$charset';\n\n|; - } + if ($charset) { + print FH qq|\$self{charset} = '$charset';\n\n|; + } - print FH q|$self{texts} = { + print FH q|$self{texts} = { |; - foreach $key (sort keys %locale) { - $text = ($self{texts}{$key}) ? $self{texts}{$key} : $all{$key}; - $count++; - - $text =~ s/'/\\'/g; - $text =~ s/\\$/\\\\/; - - $keytext = $key; - $keytext =~ s/'/\\'/g; - $keytext =~ s/\\$/\\\\/; - - if (!$text) { - $notext++; - push @missing, $keytext; - next; + foreach $key ( sort keys %locale ) { + $text = ( $self{texts}{$key} ) ? $self{texts}{$key} : $all{$key}; + $count++; + + $text =~ s/'/\\'/g; + $text =~ s/\\$/\\\\/; + + $keytext = $key; + $keytext =~ s/'/\\'/g; + $keytext =~ s/\\$/\\\\/; + + if ( !$text ) { + $notext++; + push @missing, $keytext; + next; + } + + print FH qq| '$keytext'| + . ( ' ' x ( 27 - length($keytext) ) ) + . qq| => '$text',\n|; } - - print FH qq| '$keytext'|.(' ' x (27-length($keytext))).qq| => '$text',\n|; - } - print FH q|}; + print FH q|}; $self{subs} = { |; - - foreach $key (sort keys %subrt) { - $text = $key; - $text =~ s/'/\\'/g; - $text =~ s/\\$/\\\\/; - print FH qq| '$text'|.(' ' x (27-length($text))).qq| => '$text',\n|; - } - - foreach $key (sort keys %submit) { - $text = ($self{texts}{$key}) ? $self{texts}{$key} : $all{$key}; - next unless $text; - - $text =~ s/'/\\'/g; - $text =~ s/\\$/\\\\/; - - $english_sub = $key; - $english_sub =~ s/'/\\'/g; - $english_sub =~ s/\\$/\\\\/; - $english_sub = lc $key; - - $translated_sub = lc $text; - $english_sub =~ s/( |-|,|\/|\.$)/_/g; - $translated_sub =~ s/( |-|,|\/|\.$)/_/g; - print FH qq| '$translated_sub'|.(' ' x (27-length($translated_sub))).qq| => '$english_sub',\n|; - } - - print FH q|}; + + foreach $key ( sort keys %subrt ) { + $text = $key; + $text =~ s/'/\\'/g; + $text =~ s/\\$/\\\\/; + print FH qq| '$text'| + . ( ' ' x ( 27 - length($text) ) ) + . qq| => '$text',\n|; + } + + foreach $key ( sort keys %submit ) { + $text = ( $self{texts}{$key} ) ? $self{texts}{$key} : $all{$key}; + next unless $text; + + $text =~ s/'/\\'/g; + $text =~ s/\\$/\\\\/; + + $english_sub = $key; + $english_sub =~ s/'/\\'/g; + $english_sub =~ s/\\$/\\\\/; + $english_sub = lc $key; + + $translated_sub = lc $text; + $english_sub =~ s/( |-|,|\/|\.$)/_/g; + $translated_sub =~ s/( |-|,|\/|\.$)/_/g; + print FH qq| '$translated_sub'| + . ( ' ' x ( 27 - length($translated_sub) ) ) + . qq| => '$english_sub',\n|; + } + + print FH q|}; 1; |; - close FH; + close FH; - if (!$noMissing) { - if (@missing) { - open FH, '>', "$file.missing" or die "$! : missing"; + if ( !$noMissing ) { + if (@missing) { + open FH, '>', "$file.missing" or die "$! : missing"; - print FH qq|# module $file + print FH qq|# module $file # add the missing texts and run locales.pl to rebuild \$missing = { |; - foreach $text (@missing) { - $text =~ s/'/\\'/g; - $text =~ s/\\$/\\\\/; - print FH qq| '$text'|.(' ' x (27-length($text))).qq| => '',\n|; - } + foreach $text (@missing) { + $text =~ s/'/\\'/g; + $text =~ s/\\$/\\\\/; + print FH qq| '$text'| + . ( ' ' x ( 27 - length($text) ) ) + . qq| => '',\n|; + } - print FH q|}; + print FH q|}; 1; |; - close FH; - + close FH; + + } } - } - - # redo the all file - if ($buildAll) { - open FH, '>', "all" or die "$! : all"; + # redo the all file + if ($buildAll) { + open FH, '>', "all" or die "$! : all"; - print FH q|# These are all the texts to build the translations files. + print FH q|# These are all the texts to build the translations files. # to build unique strings edit the module files instead # this file is just a shortcut to build strings which are the same |; - if ($charset) { - print FH qq|\$self{charset} = '$charset';\n\n|; - } + if ($charset) { + print FH qq|\$self{charset} = '$charset';\n\n|; + } - print FH q| + print FH q| $self{texts} = { |; - foreach $key (sort keys %all) { - $keytext = $key; - $keytext =~ s/'/\\'/g; - $keytext =~ s/\\$/\\\\/; - - $text = $all{$key}; - $text =~ s/'/\\'/g; - $text =~ s/\\$/\\\\/; - print FH qq| '$keytext'|.(' ' x (27-length($keytext))).qq| => '$text',\n|; - } + foreach $key ( sort keys %all ) { + $keytext = $key; + $keytext =~ s/'/\\'/g; + $keytext =~ s/\\$/\\\\/; - print FH q|}; + $text = $all{$key}; + $text =~ s/'/\\'/g; + $text =~ s/\\$/\\\\/; + print FH qq| '$keytext'| + . ( ' ' x ( 27 - length($keytext) ) ) + . qq| => '$text',\n|; + } + + print FH q|}; 1; |; - close FH; - - } + close FH; + + } } -$per = sprintf("%.1f", ($count - $notext) / $count * 100); +$per = sprintf( "%.1f", ( $count - $notext ) / $count * 100 ); print "\n$language - ${per}%\n"; exit; -# eof +# eof sub scanfile { - my ($file, $level) = @_; - - my $fh = new FileHandle; - return unless (-e $file or $file !~ /custom/); - open $fh, '<', "$file" or die "$! : $file"; - - $file =~ s/\.pl//; - $file =~ s/$bindir\///; - - %temp = (); - for (keys %{$self{texts}}) { - $temp{$_} = $self{texts}{$_}; - } - - # read translation file if it exists - if (-f $file) { - eval { do "$file"; }; - for (keys %{$self{texts}}) { - $all{$_} ||= $self{texts}{$_}; - if ($level) { - $temp{$_} ||= $self{texts}{$_}; - } else { - $temp{$_} = $self{texts}{$_}; - } + my ( $file, $level ) = @_; + + my $fh = new FileHandle; + return unless ( -e $file or $file !~ /custom/ ); + open $fh, '<', "$file" or die "$! : $file"; + + $file =~ s/\.pl//; + $file =~ s/$bindir\///; + + %temp = (); + for ( keys %{ $self{texts} } ) { + $temp{$_} = $self{texts}{$_}; } - } - - %{$self{texts}} = (); - for (sort keys %temp) { - $self{texts}{$_} = $temp{$_}; - } - - - while (<$fh>) { - # is this another file - if (/require\s+\W.*\.pl/) { - my $newfile = $&; - $newfile =~ s/require\s+\W//; - $newfile =~ s/\$form->{path}\///; - &scanfile("$basedir/$newfile", 1) if $newfile !~ /_/; + + # read translation file if it exists + if ( -f $file ) { + eval { do "$file"; }; + for ( keys %{ $self{texts} } ) { + $all{$_} ||= $self{texts}{$_}; + if ($level) { + $temp{$_} ||= $self{texts}{$_}; + } + else { + $temp{$_} = $self{texts}{$_}; + } + } } - - # is this a sub ? - if (/^sub /) { - ($null, $subrt) = split / +/; - $subrt{$subrt} = 1; - next; + + %{ $self{texts} } = (); + for ( sort keys %temp ) { + $self{texts}{$_} = $temp{$_}; } - - my $rc = 1; - - while ($rc) { - if (/Locale/) { - if (!/^use /) { - my ($null, $country) = split /,/; - $country =~ s/^ +["']//; - $country =~ s/["'].*//; - } - } - - if (/\$locale->text.*?\W\)/) { - my $string = $&; - $string =~ s/\$locale->text\(\s*['"(q|qq)]['\/\\\|~]*//; - $string =~ s/\W\)+.*$//; - - # if there is no $ in the string record it - unless ($string =~ /\$\D.*/) { - # this guarantees one instance of string - $locale{$string} = 1; - - # is it a submit button before $locale-> - if (/type="?submit"?/i) { - $submit{$string} = 1; - } - } - } - - # exit loop if there are no more locales on this line - ($rc) = ($' =~ /\$locale->text/); - # strip text - s/^.*?\$locale->text.*?\)//; + + while (<$fh>) { + + # is this another file + if (/require\s+\W.*\.pl/) { + my $newfile = $&; + $newfile =~ s/require\s+\W//; + $newfile =~ s/\$form->{path}\///; + &scanfile( "$basedir/$newfile", 1 ) if $newfile !~ /_/; + } + + # is this a sub ? + if (/^sub /) { + ( $null, $subrt ) = split / +/; + $subrt{$subrt} = 1; + next; + } + + my $rc = 1; + + while ($rc) { + if (/Locale/) { + if ( !/^use / ) { + my ( $null, $country ) = split /,/; + $country =~ s/^ +["']//; + $country =~ s/["'].*//; + } + } + + if (/\$locale->text.*?\W\)/) { + my $string = $&; + $string =~ s/\$locale->text\(\s*['"(q|qq)]['\/\\\|~]*//; + $string =~ s/\W\)+.*$//; + + # if there is no $ in the string record it + unless ( $string =~ /\$\D.*/ ) { + + # this guarantees one instance of string + $locale{$string} = 1; + + # is it a submit button before $locale-> + if (/type="?submit"?/i) { + $submit{$string} = 1; + } + } + } + + # exit loop if there are no more locales on this line + ($rc) = ( $' =~ /\$locale->text/ ); + + # strip text + s/^.*?\$locale->text.*?\)//; + } } - } - close($fh); + close($fh); } - sub scanmenu { - my $file = shift; - - my $fh = new FileHandle; - open $fh, '<', "$file" or die "$! : $file"; - - my @a = grep /^\[/, <$fh>; - close($fh); - - # strip [] - grep { s/(\[|\])//g } @a; - - foreach my $item (@a) { - $item =~ s/ *$//; - @b = split /--/, $item; - foreach $string (@b) { - chomp $string; - if ($string !~ /^\s*$/) { - $locale{$string} = 1; - } + my $file = shift; + + my $fh = new FileHandle; + open $fh, '<', "$file" or die "$! : $file"; + + my @a = grep /^\[/, <$fh>; + close($fh); + + # strip [] + grep { s/(\[|\])//g } @a; + + foreach my $item (@a) { + $item =~ s/ *$//; + @b = split /--/, $item; + foreach $string (@b) { + chomp $string; + if ( $string !~ /^\s*$/ ) { + $locale{$string} = 1; + } + } } - } - -} +} |