This is from the original email...
Architecturally, Its Apache 2.2, Mason 1.33, mod_perl 2.0.2. Like all good coders should I put the non-display code in reasonably OO PMs and 'use' it in the mason template. I set up test scripts for each sub and test they as best I can. In fact, once I started having issues with this object, I set it up to run a million times and had no failures from the script on several attempts.
The object is pretty simple. It takes a path as an argument and returns either a list of directories or file names as urls. Departments use ftp to upload documents and reports to the directory structure and then this web app allows others to read them. The base URL is hardcoded in the PM and there are regexes to avoid spoofing, it seems pretty rock solid. the issue is that the longer the server is up, the more often it falsely returns an object with no URLs. Dumping the document, I see that some of the fields are not defaults, but prints at various points in the method don't print. This is where I noticed that it appears to be caching... I noticed some things in the dumped object are from earlier iterations of the object.
If anyone has a good idea why this is happening or suggestions on how to debug it, I would sure appreciate this.
The code is below
JimB
#! /usr/local/perl
package Dir;
use strict;
Dir.pm:
sub get_list
{
my $self = ();
shift;
$self->{base} = "/usr/local/www/uploads/SS7";
$self->{URI} = shift;
$self->{path} = "";
$self->{title} = "";
$self->{leaf} = "false";
$self->{names} = ();
$self->{urls} = ();
bless($self);
$self->{title} = $self->{URI};
$self->{path} = $self->{base} . $self->{URI} . "/";
opendir DH, $self->{path};
my @save_files;
while (my $line = readdir(DH))
{
my $path = $self->{path} . $line;
if ((-d $path) && ($line !~ /\.$/))
{
$self->{names}{$line} = $line;
$self->{names}{$line} =~ tr/_/ /d;
$self->{urls}{$line} = $line;
}
else
{
push (@save_files, $line);
}
}
my $count = scalar (keys %{$self->{names}});
if ($count == 0)
{
foreach my $line (@save_files)
{
next if (-d $line);
$self->{names}{$line} = $line;
$self->{names}{$line} =~ tr/_/ /d;
$self->{names}{$line} =~ tr/.xls//d;
$self->{urls}{$line} = $line;
}
$self->{leaf} = "true";
}
return($self);
}
1;
Reports.cgi:
% if (defined $rep->{title}) {
% $rep->{title} =~ tr/_/ /;
% $rep->{title} =~ tr/\// /;
<h3><& SELF:title &><font size="-1"> <% $rep->{title} %></font></h3>
% } else {
<h3><& SELF:title &> </h3>
% }
<ul class="menulist">
% if ($rep->{leaf} eq "true") {
% my %tmp_names = ();
% my %tmp_urls = ();
% foreach $iter (sort {$b cmp $a} keys %{$rep->{urls}}) {
% if ($rep->{names}->{$iter} =~/(\d\d)(\d\d)(\d\d)/) {
% $tmp_names{"$3$1$2"} = $mos[$1] . " $2, 20$3";
% $tmp_urls{"$3$1$2"} = $rep->{urls}->{$iter};
% }
% } foreach $iter (sort {$b <=> $a} keys %tmp_names) {
<li> <a href="/files/SS7/<% $rep->{URI} %>/<% $tmp_urls{$iter} %>"> <
+% $tmp_names{$iter} %></a>
% } } else {
% foreach $iter (sort {$b cmp $a} keys %{$rep->{urls}}) {
<li> <a href="<% $r->uri %>?rep=<% $rep->{URI} . "/" . $rep->{urls}->
+{$iter} %>&app=SS7/Reports"> <% $rep->{names}->{$iter} %></a>
% }
% }
</ul>
</div>
<%method title>
SS7:
</%method>
<%once>
use Apps::SS7::Dir;
use Data::Dumper;
</%once>
<%init>
my @mos = ("","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sept","
+Oct","Nov","Dec");
my $item;
my $iter;
my $rep = Dir->get_list($ARGS{rep});
</%init>
Here is the httpd.conf section:
DocumentRoot "/usr/local/www/docs"
#
# Each directory to which Apache has access can be configured with res
+pect
# to which services and features are allowed and/or disabled in that
# directory (and its subdirectories).
#
# First, we configure the "default" to be a very restrictive set of
# features.
#
<Directory />
Options FollowSymLinks
AllowOverride None
Order deny,allow
Deny from all
</Directory>
#
# Note that from this point forward you must specifically allow
# particular features to be enabled - so if something's not working as
# you might expect, make sure that you have specifically enabled it
# below.
#
#
# This should be changed to whatever you set DocumentRoot to.
#
PerlRequire /usr/local/www/lib/uses.pl
PerlSwitches -wT
PerlSetVar MasonCompRoot /usr/local/www/docs
PerlAddVar MasonDataDir /usr/local/httpd/mason
PerlAddVar MasonAllowGlobals $AuthDBH
PerlAddVar MasonAllowGlobals $RepDBH
PerlAddVar MasonAllowGlobals $SysDBH
PerlAddVar MasonAllowGlobals $User
PerlModule HTML::Mason::ApacheHandler
PerlModule Apache::DBI
PerlModule Apache2::Cookie
PerlModule CGI
PerlModule Apache2::Const
<FilesMatch "(\.html|\.css)$">
SetHandler perl-script
PerlHandler HTML::Mason::ApacheHandler
</FilesMatch>
# <FilesMatch "(\.cgi)$">
# SetHandler perl-script
# PerlHandler "sub { return Apache2::Const::NOT_FOUND }"
# </FilesMatch>
<Directory "/usr/local/www/docs">
#
# Possible values for the Options directive are "None", "All",
# or any combination of:
# Indexes Includes FollowSymLinks SymLinksifOwnerMatch ExecCGI M
+ultiViews
#
# Note that "MultiViews" must be named *explicitly* --- "Options A
+ll"
# doesn't give it to you.
#
# The Options directive is both complicated and important. Please
+ see
# http://httpd.apache.org/docs/2.2/mod/core.html#options
# for more information.
#
Options Indexes FollowSymLinks
#
# AllowOverride controls what directives may be placed in .htacces
+s files.
# It can be "All", "None", or any combination of the keywords:
# Options FileInfo AuthConfig Limit
#
AllowOverride None
#
# Controls who can get stuff from this server.
#
Order allow,deny
Allow from all
</Directory>
--Jimbus aka Jim Babcock
Wireless Data Engineer and Geek Wannabe
jim-dot-babcock-at-usa-dot-com
| 