dpath2o has asked for the wisdom of the Perl Monks concerning the following question:
Hello Monks I am trying to write a simple CGI script using CGI::Application that shows the latest files on a remote server. I can do this via the command line with the following code:
use DBI; use Net::SFTP::Foreign; use Data::Dumper qw(Dumper); my $dbh = DBI->connect('dbi:mysql:database=realtime;host=localhost','r +oot','xxxxxxx'); my $sql = "select id,codename,full_name from stations"; my $sth = $dbh->prepare($sql); $sth->execute(); my $rs = $sth->fetchrow_hashref(); $rs = $sth->fetchall_arrayref( { id => 1, full_name => 1, codename => 1 } ); my ($sc,$mn,$hr,$md,$mo,$yr,$wd,$yd,$id) = localtime(time); $yr += 190 +0; my $hostname = 'xxx.xxx.xxx.xxx'; my $username = 'xxxxx'; my $Dbase_search = '/data/archive/real-time/staging/radial'; my @latestfiles; print "\nOPENING SFTP connection to $hostname as user $username ...\n\ +n"; my $sftp = Net::SFTP::Foreign->new( $hostname , user=>$username ); foreach my $station ( @{$rs} ) { my $Dsearch = $Dbase_search.'/'.$station->{codename}.'/'.$yr; print "Searching $Dsearch for files modified in the last 24 hours +... \n"; my @files = $sftp->find( $Dsearch , wanted => sub{ use Fcntl qw(S_ISREG); my $now = time(); my $yesterday = $now-(24*3600); my (undef, $entry) = @_; ( ($entry->{a}->mtime < $now) and ($e +ntry->{a}->mtime > $yesterday) and S_ISREG($entry->{a}->perm) ) } ); push @latestfiles, $_->{filename} for $files[-1]; print "Latest $station->{full_name} file: $_->{filename}\n" for $f +iles[-1]; } print "\nCLOSING SFTP connection\n\n"; $sftp->disconnect;
HOWEVER, when I try implementing this in CGI::Application I get the following message: There has been an error: Modification of non-creatable array value attempted, subscript -1 at /users/xxx/sites/simple_secure/realtime/simple_realtime.pm line 164. I'm not quite sure how to proceed ... Here's the relevant chunk of code in simple_realtime.pm that's failing on me:
my $self = shift; my $stations = shift; my @latestfiles = []; # remote host my $hostname = 'xxx.xxx.xxx.xxx'; my $username = 'xxxx'; my $password = 'xxxxxxxx'; my $Dbase = '/data/archive/real-time/staging/radial'; # time my ($sc,$mn,$hr,$md,$mo,$yr,$wd,$yd,$id) = localtime(time); $yr += + 1900; $mo += 1; my $now = sprintf('%4d-%02d-%02d %02d:%02d:%02d',$yr,$mo,$md,$hr,$ +mn,$sc); # connect use Net::SFTP::Foreign; my $sftp = Net::SFTP::Foreign->new( $hostname , user => $username +, password => $password ) or fatal_error($!); # search foreach my $station ( @{$stations} ) { my $Dsearch = $Dbase.'/'. $station->{codename}.'/'.$yr; my @files = $sftp->find( $Dsearch , wanted => sub{ use Fcntl qw(S_ISREG); my $now = time(); my $yesterday = $now-(24*3 +600); my (undef, $entry) = @_; ( ($entry->{a}->mtime < $now) a +nd ($entry->{a}->mtime > $yesterday) and S_ISREG($entry->{a}->perm) ) } ); push @latestfiles, $_->{filename} for $files[-1]; } $stations->{flatest} = \@latestfiles; my $template = $self->load_tmpl('show_radial_file_status.tmpl'); $template->param( title => "Latest Files on Simple Server", now => $now, hostname => $hostname, stations => $stations, ); $sftp->disconnect; return $template->output(); #return @latestfiles;
Further to this I don't in fact know if $stations->{flatest}=\@latestfiles; will work the way I'm intending it to -- i.e. put the latest files into stations hash when stations is created by:
sub _retrieve_station_list { my $self = shift; my $sql = "select id,codename,full_name from stations"; $self->dbh->{PrintError} = 0; $self->dbh->{RaiseError} = 1; my $sth = $self->dbh->prepare($sql); $sth->execute(); my $rs = $sth->fetchrow_hashref(); $rs = $sth->fetchall_arrayref( { id => 1, full_name => 1, codename => 1 } ); return $rs; }
Any insight you might have I'm sure I'd benefit from. Thanks
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: CGI Dynamic Query
by dpath2o (Acolyte) on Jan 10, 2014 at 02:22 UTC | |
by dpath2o (Acolyte) on Jan 10, 2014 at 03:04 UTC | |
by tangent (Parson) on Jan 10, 2014 at 03:12 UTC |