Bugfix in SL/Menu und weitere stricts.

diff --git a/SL/AP.pm b/SL/AP.pm
index ed0fe98c6e883073ea5ca6440f7751269025aceb..d4fe48428f8e7e658319e9fd6e11f77c53ebac50 100644 (file)
--- a/SL/AP.pm
+++ b/SL/AP.pm
@@ -37,6 +37,8 @@ package AP;
 use SL::DBUtils;
 use SL::MoreCommon;
 
 use SL::DBUtils;
 use SL::MoreCommon;
 

+use strict;
+

 sub post_transaction {
   $main::lxdebug->enter_sub();
 
 sub post_transaction {
   $main::lxdebug->enter_sub();
 

diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm
index f2e99a8e398794f98df950241f63b218ff13bb9c..000bc1bdbe8ebfb3ac474af4453f8a81c064f07c 100644 (file)
--- a/SL/DBUtils.pm
+++ b/SL/DBUtils.pm
@@ -1,9 +1,9 @@
 package SL::DBUtils;
 
 require Exporter;
 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
              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);
 
 
   my ($form, $dbh, $query) = splice(@_, 0, 3);
 

-  dump_query(LXDebug::QUERY, '', $query, @_);
+  dump_query(LXDebug->QUERY(), '', $query, @_);

 
   my $result;
   if (0 == scalar(@_)) {
 
   my $result;
   if (0 == scalar(@_)) {


@@ -57,7 +57,7 @@ sub do_statement {
 
   my ($form, $sth, $query) = splice(@_, 0, 3);
 
 
   my ($form, $sth, $query) = splice(@_, 0, 3);
 

-  dump_query(LXDebug::QUERY, '', $query, @_);
+  dump_query(LXDebug->QUERY(), '', $query, @_);

 
   my $result;
   if (0 == scalar(@_)) {
 
   my $result;
   if (0 == scalar(@_)) {


@@ -74,8 +74,9 @@ sub do_statement {
 sub dump_query {
   my ($level, $msg, $query) = splice(@_, 0, 3);
 
 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++;
   }
   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);
 
 
   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);
 
 
   my $sth = $dbh->prepare($query) || $form->dberror($query);
 


@@ -125,7 +126,7 @@ sub prepare_execute_query {
 
   my ($form, $dbh, $query) = splice(@_, 0, 3);
 
 
   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) {
 
   my $sth = $dbh->prepare($query) || $form->dberror($query);
   if (scalar(@_) != 0) {

diff --git a/SL/DN.pm b/SL/DN.pm
index a325766cd1a4f3a2012aae55c7ab0c38f896016b..e1a634202946aedf4503031fb5abdbcaffdf5642 100644 (file)
--- a/SL/DN.pm
+++ b/SL/DN.pm
@@ -41,6 +41,8 @@ use SL::Mailer;
 use SL::MoreCommon;
 use SL::Template;
 
 use SL::MoreCommon;
 use SL::Template;
 

+use strict;
+

 sub get_config {
   $main::lxdebug->enter_sub();
 
 sub get_config {
   $main::lxdebug->enter_sub();
 

diff --git a/SL/GenericTranslations.pm b/SL/GenericTranslations.pm
index 5592af2b0fbcb3897dace91454978de750105874..a509212a3f7422ff68687dcca1103651bea8593a 100644 (file)
--- a/SL/GenericTranslations.pm
+++ b/SL/GenericTranslations.pm
@@ -2,6 +2,8 @@ package GenericTranslations;
 
 use SL::DBUtils;
 
 
 use SL::DBUtils;
 

+use strict;
+

 sub get {
   $main::lxdebug->enter_sub();
 
 sub get {
   $main::lxdebug->enter_sub();
 

diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm
index 047d2b0b611e6000442fb9192f355c263fd8cb84..3dbd14fe0ac45cbf640b632b7590f464ebfef71d 100644 (file)
--- a/SL/LXDebug.pm
+++ b/SL/LXDebug.pm
@@ -17,6 +17,8 @@ use POSIX qw(strftime);
 
 use YAML;
 
 
 use YAML;
 

+use strict;
+

 my $data_dumper_available;
 
 our $global_level;
 my $data_dumper_available;
 
 our $global_level;

diff --git a/SL/Menu.pm b/SL/Menu.pm
index adac1b00689eca9d18fc18e534dcbe7fa7853e67..9fcf15374eb3babffd34ac5d408db0b7d28b4269 100644 (file)
--- a/SL/Menu.pm
+++ b/SL/Menu.pm
@@ -400,7 +400,10 @@ sub set_access {
 
   $self->{ORDER} = [ grep { $self->{$_}->{VISIBLE} } @{ $self->{ORDER} } ];
 
 
   $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 };
   map { delete @{$self->{$_}}{qw(GRANTED IS_MENU NUM_VISIBLE_CHILDREN VISIBLE ACCESS)} if ($_ ne 'ORDER') } keys %{ $self };

+  }

 }
 
 sub dump_visible {
 }
 
 sub dump_visible {