From ed944ca355b3446d4e6c3fc22f748f77b64d58db Mon Sep 17 00:00:00 2001 From: =?utf8?q?Sven=20Sch=C3=B6ling?= Date: Tue, 20 Oct 2009 11:11:56 +0200 Subject: [PATCH] Bugfix in SL/Menu und weitere stricts. --- SL/AP.pm | 2 ++ SL/DBUtils.pm | 17 +++++++++-------- SL/DN.pm | 2 ++ SL/GenericTranslations.pm | 2 ++ SL/LXDebug.pm | 2 ++ SL/Menu.pm | 3 +++ 6 files changed, 20 insertions(+), 8 deletions(-) diff --git a/SL/AP.pm b/SL/AP.pm index ed0fe98c6..d4fe48428 100644 --- a/SL/AP.pm +++ b/SL/AP.pm @@ -37,6 +37,8 @@ package AP; use SL::DBUtils; use SL::MoreCommon; +use strict; + sub post_transaction { $main::lxdebug->enter_sub(); diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm index f2e99a8e3..000bc1bdb 100644 --- a/SL/DBUtils.pm +++ b/SL/DBUtils.pm @@ -1,9 +1,9 @@ package SL::DBUtils; require Exporter; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); -@EXPORT = qw(conv_i conv_date conv_dateq do_query selectrow_query do_statement +our @EXPORT = qw(conv_i conv_date conv_dateq do_query selectrow_query do_statement dump_query quote_db_date selectfirst_hashref_query selectfirst_array_query selectall_hashref_query selectall_array_query @@ -36,7 +36,7 @@ sub do_query { my ($form, $dbh, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); my $result; if (0 == scalar(@_)) { @@ -57,7 +57,7 @@ sub do_statement { my ($form, $sth, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); my $result; if (0 == scalar(@_)) { @@ -74,8 +74,9 @@ sub do_statement { sub dump_query { my ($level, $msg, $query) = splice(@_, 0, 3); - my $filename = $self_filename = 'SL/DBUtils.pm'; - my $caller_level; + my $self_filename = 'SL/DBUtils.pm'; + my $filename = $self_filename; + my ($caller_level, $line, $subroutine); while ($filename eq $self_filename) { (undef, $filename, $line, $subroutine) = caller $caller_level++; } @@ -111,7 +112,7 @@ sub prepare_query { my ($form, $dbh, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); my $sth = $dbh->prepare($query) || $form->dberror($query); @@ -125,7 +126,7 @@ sub prepare_execute_query { my ($form, $dbh, $query) = splice(@_, 0, 3); - dump_query(LXDebug::QUERY, '', $query, @_); + dump_query(LXDebug->QUERY(), '', $query, @_); my $sth = $dbh->prepare($query) || $form->dberror($query); if (scalar(@_) != 0) { diff --git a/SL/DN.pm b/SL/DN.pm index a325766cd..e1a634202 100644 --- a/SL/DN.pm +++ b/SL/DN.pm @@ -41,6 +41,8 @@ use SL::Mailer; use SL::MoreCommon; use SL::Template; +use strict; + sub get_config { $main::lxdebug->enter_sub(); diff --git a/SL/GenericTranslations.pm b/SL/GenericTranslations.pm index 5592af2b0..a509212a3 100644 --- a/SL/GenericTranslations.pm +++ b/SL/GenericTranslations.pm @@ -2,6 +2,8 @@ package GenericTranslations; use SL::DBUtils; +use strict; + sub get { $main::lxdebug->enter_sub(); diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm index 047d2b0b6..3dbd14fe0 100644 --- a/SL/LXDebug.pm +++ b/SL/LXDebug.pm @@ -17,6 +17,8 @@ use POSIX qw(strftime); use YAML; +use strict; + my $data_dumper_available; our $global_level; diff --git a/SL/Menu.pm b/SL/Menu.pm index adac1b006..9fcf15374 100644 --- a/SL/Menu.pm +++ b/SL/Menu.pm @@ -400,7 +400,10 @@ sub set_access { $self->{ORDER} = [ grep { $self->{$_}->{VISIBLE} } @{ $self->{ORDER} } ]; + { no strict 'refs'; + # ToDO: fix this. nuke and pave algorithm without type checking screams for problems. map { delete @{$self->{$_}}{qw(GRANTED IS_MENU NUM_VISIBLE_CHILDREN VISIBLE ACCESS)} if ($_ ne 'ORDER') } keys %{ $self }; + } } sub dump_visible { -- 2.20.1