From 29795499e0623f7ff7ea739ed3b61d66dad0e7c6 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Sven=20Sch=C3=B6ling?= Date: Fri, 12 Oct 2007 15:24:44 +0000 Subject: [PATCH] Verbesserungen am Tag Script. Ausserdem Merge der Revisionen 5239 5259 5340 5341 5342 und 5343. --- SL/AM.pm | 9 ++++----- SL/Form.pm | 33 ++++++++++++++++----------------- SL/IC.pm | 4 +--- SL/IR.pm | 8 ++++---- SL/Template.pm | 2 +- scripts/create_tags_file.pl | 16 +++++++++++++--- 6 files changed, 39 insertions(+), 33 deletions(-) diff --git a/SL/AM.pm b/SL/AM.pm index ec4c3f00c..980226974 100644 --- a/SL/AM.pm +++ b/SL/AM.pm @@ -594,7 +594,6 @@ sub lead { $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - $form->{ALL}; while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { push @{ $form->{ALL} }, $ref; } @@ -690,7 +689,6 @@ sub business { $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - $form->{ALL}; while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { push @{ $form->{ALL} }, $ref; } @@ -962,12 +960,13 @@ sub get_buchungsgruppe { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; + my $query; # connect to database my $dbh = $form->dbconnect($myconfig); if ($form->{id}) { - my $query = + $query = qq|SELECT description, inventory_accno_id, (SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno, income_accno_id_0, @@ -997,7 +996,7 @@ sub get_buchungsgruppe { $sth->finish; - my $query = + $query = qq|SELECT count(id) = 0 AS orphaned FROM parts WHERE buchungsgruppen_id = ?|; @@ -1538,7 +1537,7 @@ sub save_preferences { # save first currency in myconfig $form->{currency} = substr($form->{curr}, 0, 3); - my $myconfig = new User "$memberfile", "$form->{login}"; + $myconfig = new User "$memberfile", "$form->{login}"; foreach my $item (keys %$form) { $myconfig->{$item} = $form->{$item}; diff --git a/SL/Form.pm b/SL/Form.pm index c1b0e2887..2236a94ee 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -49,6 +49,7 @@ use SL::Menu; use SL::User; use SL::Common; use CGI; +use List::Util qw(max min sum); my $standard_dbh; @@ -98,7 +99,8 @@ sub _request_to_hash { if (($line eq $boundary) || ($line eq "$boundary\r")) { $params{$name} =~ s|\r?\n$|| if $name; - undef $name, $filename; + undef $name; + undef $filename; $headers_done = 0; $content_type = "text/plain"; @@ -331,20 +333,17 @@ sub info { $main::lxdebug->leave_sub(); } +# calculates the number of rows in a textarea based on the content and column number +# can be capped with maxrows sub numtextrows { $main::lxdebug->enter_sub(); - my ($self, $str, $cols, $maxrows) = @_; - my $rows = 0; - - map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str; - - $maxrows = $rows unless defined $maxrows; + my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str; + $maxrows ||= $rows; $main::lxdebug->leave_sub(); - - return ($rows > $maxrows) ? $maxrows : $rows; + return min $rows, $maxrows; } sub dberror { @@ -1206,13 +1205,13 @@ sub update_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; - + my ($query); # some sanity check for currency if ($curr eq '') { $main::lxdebug->leave_sub(); return; } - my $query = qq|SELECT curr FROM defaults|; + $query = qq|SELECT curr FROM defaults|; my ($currency) = selectrow_query($self, $dbh, $query); my ($defaultcurrency) = split m/:/, $currency; @@ -1223,7 +1222,7 @@ sub update_exchangerate { return; } - my $query = qq|SELECT e.curr FROM exchangerate e + $query = qq|SELECT e.curr FROM exchangerate e WHERE e.curr = ? AND e.transdate = ? FOR UPDATE|; my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate); @@ -1288,13 +1287,14 @@ sub get_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $fld) = @_; + my ($query); unless ($transdate) { $main::lxdebug->leave_sub(); return 1; } - my $query = qq|SELECT curr FROM defaults|; + $query = qq|SELECT curr FROM defaults|; my ($currency) = selectrow_query($self, $dbh, $query); my ($defaultcurrency) = split m/:/, $currency; @@ -1304,7 +1304,7 @@ sub get_exchangerate { return 1; } - my $query = qq|SELECT e.$fld FROM exchangerate e + $query = qq|SELECT e.$fld FROM exchangerate e WHERE e.curr = ? AND e.transdate = ?|; my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); @@ -2500,8 +2500,7 @@ sub redo_rows { my @ndx = (); - map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } - (1 .. $count); + map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count; my $i = 0; @@ -2587,7 +2586,7 @@ sub save_status { my $formnames = $self->{printed}; my $emailforms = $self->{emailed}; - my $query = qq|DELETE FROM status + $query = qq|DELETE FROM status WHERE (formname = ?) AND (trans_id = ?)|; do_query($self, $dbh, $query, $self->{formname}, $self->{id}); diff --git a/SL/IC.pm b/SL/IC.pm index bc82b0c55..8520f5091 100644 --- a/SL/IC.pm +++ b/SL/IC.pm @@ -839,7 +839,7 @@ sub all_parts { $form->{parts} = +{ }; - my @simple_filters = qw(partnumber ean description partsgroup microfiche drawing); + my @simple_filters = qw(partnumber ean description partsgroup microfiche drawing onhand); my @makemodel_filters = qw(make model); my @invoice_oi_filters = qw(serialnumber soldtotal); my @apoe_filters = qw(transdate); @@ -1395,8 +1395,6 @@ sub update_prices { my $group; my $limit; - my @where_values; - if ($item ne 'make') { foreach my $item (qw(partnumber drawing microfiche make model pg.partsgroup)) { my $column = $item; diff --git a/SL/IR.pm b/SL/IR.pm index f220a1674..3a8c4654c 100644 --- a/SL/IR.pm +++ b/SL/IR.pm @@ -305,7 +305,7 @@ sub post_invoice { $h_item_unit->finish(); - my $project_id = conv_i($form->{"globalproject_id"}); + $project_id = conv_i($form->{"globalproject_id"}); $form->{datepaid} = $form->{invdate}; @@ -637,18 +637,18 @@ sub delete_invoice { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; - + my $query; # connect to database my $dbh = $form->dbconnect_noauto($myconfig); &reverse_invoice($dbh, $form); # delete zero entries - my $query = qq|DELETE FROM acc_trans WHERE amount = 0|; + $query = qq|DELETE FROM acc_trans WHERE amount = 0|; do_query($form, $dbh, $query); # delete AP record - my $query = qq|DELETE FROM ap WHERE id = ?|; + $query = qq|DELETE FROM ap WHERE id = ?|; do_query($form, $dbh, $query, conv_i($form->{id})); my $rc = $dbh->commit; diff --git a/SL/Template.pm b/SL/Template.pm index 297c025fb..f19e67ab0 100644 --- a/SL/Template.pm +++ b/SL/Template.pm @@ -1366,7 +1366,7 @@ sub format_string { foreach my $key (keys(%markup_replace)) { my $value = $markup_replace{$key}; - $variable =~ s|\<${key}\>||gi; + $variable =~ s|\<${key}\>||gi; #" $variable =~ s|\</${key}\>||gi; } diff --git a/scripts/create_tags_file.pl b/scripts/create_tags_file.pl index e27a96ba0..d7cef8e6d 100644 --- a/scripts/create_tags_file.pl +++ b/scripts/create_tags_file.pl @@ -20,11 +20,21 @@ use strict; use warnings FATAL =>'all'; use diagnostics; -my $dir = IO::Dir->new("SL/"); +use Getopt::Long; -my @files = grep {/\.pm$/} $dir->read(); +my $parse_SL = 1; +my $parse_binmozilla = 0; +GetOptions("sl!" => \$parse_SL, + "pm!" => \$parse_SL, + "binmozilla!" => \$parse_binmozilla, + "pl!" => \$parse_binmozilla, + ); -@files = grep { s{^}{SL\/}gxms } @files; +my @files = (); +push @files, grep { /\.pm$/ && s{^}{SL/}gxms } IO::Dir->new("SL/")->read() if $parse_SL; +push @files, grep { /\.pl$/ && s{^}{bin/mozilla/}gxms} IO::Dir->new("bin/mozilla/")->read() if $parse_binmozilla; + +#map { s{^}{SL\/}gxms } @files; #print Dumper(@files); -- 2.20.1