Unexpected warnings in log file.

[krisahoch]

Fellow Monks,

I have a small Whiteboard application for my company's installation of PerlDesk. PerlDesk is an application for Support Tracking.

Recently, I was asked to add filtering capability to this Whiteboard. The filtering is simple and not a tough thing to do. Later I was asked to provide a mechanism for resetting every filter to its default. This is especially important of filters have been applied multiple times in one session.

I thought the best way to do this would be to 'CGI::Pretty::delete_all()' (I was required to make the html source easy to read, or I would have just used CGI) if a checkbox called 'Reset' was defined. This gives the desirec results. Everything is set to defaults.

Here is the problem. Anytime the checkbox is checked, and then the form is submitted, I receive a warning in my Apache logs that looks like this.

Use of uninitialized value in concatenation (.) at (eval 13) line 29 (
+#1)
    
    (W uninitialized) An undefined value was used as if it were alread
+y defined.  It was
    interpreted as a "" or a 0, but maybe it was a mistake.  To suppre
+ss this
    warning assign a defined value to your variables.

This seems simple and straight forward right? I thought so. I could not find any reason why this problem would be at line 29 of the code, so I added more code to the beginning of the file...33 lines of operational code. It still gives the same message. The message will always state (eval 13) line 29 (#1).

I am truly perplexed. Would someone please give me an idea of where else to look? I will be posting the code below, but before I do, here are somethings to remember,

• I would rather use the GET method with this form, but management didn't like seeing the ENV name/value pairs
• I removed sensitive data (hrefs and @INC entries)

Thank you again, Kristofer

---

#!/bin/perl -wT
use diagnostics;
use strict;
use warnings;
use CGI::Pretty;

my $Path = 'SENSITIVE_DATA_EDITTED_OUT';
push @INC, $Path;

my $WebPage = new CGI::Pretty;

if(defined $WebPage->param('Reset')) { $WebPage->delete_all ;}

my $NextNumber = 0;

require "PerlDesk.pl";
my $dbh = &_databaseConnect();
my $Tickets  = &databaseEntrys('select id,category,time,status,ownersh
+ip,username from perldesk.calls', 'id');
my $Customer = &databaseEntrys('select username,name,company from perl
+desk.users', 'username');
my $INTStaff = &databaseEntrys('select username,name from perldesk.sta
+ff', 'username');
$dbh->disconnect;

################################################################
sub databaseEntrys
{
my ($QUERY, $ORDER) = ($_[0], $_[1]);

  if ((!(defined($QUERY))) || (!(defined($ORDER)))) { return; }

  my $self = {};

  my $sth = $dbh->prepare("$QUERY");
  $sth->execute;

  while (my $rows = $sth->fetchrow_hashref)
  {
    $self->{$rows->{$ORDER}} = $rows;
  }

  $sth->finish;

return $self;
}

#######################################################
sub UniqueList
{
  my ($Hashish, $Section) = ($_[0], $_[1]);

  my @List = ();
   foreach my $entry (keys %{$Hashish})
  {

    if ($entry eq 0)
    {
      push @List, '--ALL--';
      next;
    }
    #Trim out duplicates
    my $Entry = $Hashish->{$entry}->{$Section};
    my $check = 'passed';
    foreach my $i (@List)
    {
      if ($i eq $Entry) { $check = 'failed'; }
    }

    push @List, $Entry unless($check eq 'failed');
    $check = 'passed';
  }

  @List = sort (@List);
  return
  $WebPage->popup_menu
    (
      -values   => \@List,
      -name => $Hashish->{0}->{$Section},
      -default => '--ALL--'
    );
}
#######################################################
sub table_header
{
  my ($Hashish) = $_[0];
  return join
  ( '',
    $WebPage->Tr
    (
      $WebPage->td
      (
        { -class => $Hashish->{0}->{7} },
        [
          $Hashish->{0}->{1},
          $Hashish->{0}->{2},
          $Hashish->{0}->{3},
          $Hashish->{0}->{4},
          $Hashish->{0}->{5},
          $Hashish->{0}->{6},
          $Hashish->{0}->{7}
        ]
      )
    ),

    $WebPage->Tr
    (
      $WebPage->td
      (
        { -class => 'OPEN'  },
        [
          '',
          &UniqueList($Hashish,2),
          &UniqueList($Hashish,3),
          &UniqueList($Hashish,4),
          &UniqueList($Hashish,5),
          &UniqueList($Hashish,6),
          &UniqueList($Hashish,7)
        ],
      )
    )
  );
}

######################################################################
+#########
sub WebPageParameter
{
  my ($VALUE, $PARAM) = ($_[0],$_[1]);

  if (!defined($WebPage->param($PARAM))) { return 1; }

  if ( ($WebPage->param($PARAM) ne $VALUE ) &&
       ($WebPage->param($PARAM) ne '--ALL--')
     )
     { return undef; }

return 1;
}

######################################################################
+########
sub Filtered
{
  my ($Hash, $Entry) = ($_[0], $_[1]);

  return undef unless defined(WebPageParameter($Hash->{$Entry}->{2}, $
+Hash->{0}->{2}));
  return undef unless defined(WebPageParameter($Hash->{$Entry}->{3}, $
+Hash->{0}->{3}));
  return undef unless defined(WebPageParameter($Hash->{$Entry}->{4}, $
+Hash->{0}->{4}));
  return undef unless defined(WebPageParameter($Hash->{$Entry}->{5}, $
+Hash->{0}->{5}));
  return undef unless defined(WebPageParameter($Hash->{$Entry}->{6}, $
+Hash->{0}->{6}));
  return undef unless defined(WebPageParameter($Hash->{$Entry}->{7}, $
+Hash->{0}->{7}));
  return 1;
}

######################################################################
+#########
sub table_entry
{
  my ($Hashish, $StartEntry, $FinishEntry) = ($_[0], $_[1], $_[2]);

  my $RETURN = '';

  for (my $i = $StartEntry; $i <= $FinishEntry; $i++)
  {
    next unless defined(Filtered($Hashish, $i));

    my $OTHER = $WebPage->Tr
    (
      $WebPage->td
      (
        { -class => $Hashish->{$i}->{7} },
        [
          $Hashish->{$i}->{1},
          $Hashish->{$i}->{2},
          $Hashish->{$i}->{3},
          $Hashish->{$i}->{4},
          $Hashish->{$i}->{5},
          $Hashish->{$i}->{6},
          $Hashish->{$i}->{7}
        ]
      )
    );

    $RETURN = join (' ', $RETURN, $OTHER);
  }

return $RETURN;
}
######################################################################
+#########
sub processData
{
my $self = {};

  $self->{0}->{1} = 'Ticket';
  $self->{0}->{2} = 'Product';
  $self->{0}->{3} = 'Assignee';
  $self->{0}->{4} = 'Customer';
  $self->{0}->{5} = 'Company';
  $self->{0}->{6} = 'Opened';
  $self->{0}->{7} = 'Status';

  foreach my $Entry ( keys %{$Tickets} )
  {
    $NextNumber++;
    my $Number = $Tickets->{$Entry}->{id};

    $Tickets->{$Entry}->{time} = reverse join('-', (split('-', $Ticket
+s->{$Entry}->{time}))[0..2]);
    $self->{$Number}->{TicketNumber} = $Tickets->{$Entry}->{id};
    $self->{$Number}->{0} = "{$Entry}->{id}\" />";
    $self->{$Number}->{1} =
      $WebPage->a
      (
        {
          -href  => "cgi-bin/staff.cgi?do=ticket&cid=$Tickets->{$Entry
+}->{id}",
          -class => "$Tickets->{$Entry}->{status}",
          -target=> '_new'
        },
        "$Tickets->{$Entry}->{id}"
      );

    $self->{$Number}->{2} = $Tickets->{$Entry}->{category};
    $self->{$Number}->{3} = $INTStaff->{$Tickets->{$Entry}->{ownership
+}}->{name};
    $self->{$Number}->{4} = $Customer->{$Tickets->{$Entry}->{username}
+}->{name};
    $self->{$Number}->{5} = $Customer->{$Tickets->{$Entry}->{username}
+}->{company};
    $self->{$Number}->{6} = $Tickets->{$Entry}->{time};
    $self->{$Number}->{7} = $Tickets->{$Entry}->{status};
        }
return $self;
}

sub resetForm
{
  $WebPage->delete_all;
  print displayWebPage();
}
######################################################################
+#####
sub displayWebPage
{
return $WebPage->header,
  $WebPage->start_html
  (
    -title => 'Interactive Network Technologies, Inc - PerlDesk',
    -style => { -src => "SupportDesk_Style.css" }
  ),

  $WebPage->startform,
  $WebPage->table
  (
    $WebPage->td
    (
      {-align => 'center'},
      $WebPage->a({-href => 'SENSITIVE_DATA_EDITTED_OUT', -target => '
+_new'}, "[ Attachments ]"),
      $WebPage->a({-href => 'SENSITIVE_DATA_EDITTED_OUT', -target => '
+_new'}, "[ Admin ]"),
      $WebPage->a({-href => 'SENSITIVE_DATA_EDITTED_OUT', -target => '
+_new'}, "[ Staff ]"),
      $WebPage->a({-href => 'SENSITIVE_DATA_EDITTED_OUT', -target => '
+_new'}, "[ Users ]"),
      $WebPage->a({-href => 'SENSITIVE_DATA_EDITTED_OUT', -target => '
+_new'}, "[ Customer_Database ]")
    )
  ),

  $WebPage->table
  (
    $WebPage->td
    (
      $WebPage->textfield
      (
        -name     => 'StartingNumber',
        -default  => 1,
        -size     => 5,
        -maxlength=> 5
      ),
      $WebPage->b("Show from Ticket"),
      $WebPage->br,

      $WebPage->textfield
      (
        -name     => 'EndingNumber',
        -default  => $NextNumber,
        -size     => 5,
        -maxlength=> 5
      ),
      $WebPage->b("To Ticket"),
      "(last number: $NextNumber)"
    ),

    $WebPage->td
    (
      $WebPage->submit (value => 'Activate Filter'),
      $WebPage->checkbox
      (
        -name => 'Reset',
        -label => 'Check here, and Activate Filter to reset defaults'
      ),
    )
  ),

  $WebPage->table ({-border => 'solid'}, @_ ),
  $WebPage->end_form,
  $WebPage->end_html;
return;
}
#####################################################################

  my $Entities = &processData();
  my $start = 0;
  my $final = $NextNumber;

  $start = $WebPage->param('StartingNumber') if (defined ($WebPage->pa
+ram('StartingNumber')));
  $final = $WebPage->param('EndingNumber')   if (defined ($WebPage->pa
+ram('EndingNumber')));

  if ($start le 0) { $start = 1; }
  if (($final < $start) || ($final > $NextNumber)) { $final = $NextNum
+ber; }

  $WebPage->param('EndingNumber', $final);
  $WebPage->param('StartingNumber', $start);

  print displayWebPage(table_header($Entities),table_entry($Entities,$
+start, $final));
1;

[sauoq]

#!/bin/perl -wT

Take out that pesky w on your shebang line. . .

:-)

-sauoq
"My two cents aren't worth a dime.";

[TexasTess]

Can't be the -w after the shebang, the system log would not change the case of the character..and it specifically references a "W" not a "w".

This is a long shot..but are you writing this code in a windows environment then moving it to a *unix server? The following line might be your culprit because of the carriage return after the "return"...


return
  $WebPage->popup_menu
    (
      -values   =>

Try it this way:

return $WebPage->popup_menu
    (
      -values   =>

There are instances where carriage returns are translated into "." thus the concatonation reference in the warning...I'd like it if you tried taking it out just to humor me...

TexasTess
"Great Spirits Often Encounter Violent Opposition From Mediocre Minds" --Albert Einstein

[krisahoch]

No. I am writing it on a Linux server. I use Kate as my editor. I was also given to understand that perl doesn't care about whitespace in this type of instance.