Perl 'if' statement - perl

Right now, I have the following Perl code
my $tmpl1="download1_video.html"
if $file->{file_name}=~/\.(avi|divx|mkv|flv|mp4|wmv)$/i;
$tmpl1||="download1.html";
so it's checking to see if the file is a video, and if so it directs it to the certain page. Although I'm just wondering how I can add another if statement in there to check if the extension is .mp3, and if so direct it to download1_audio.html.

if ( $file->{file_name} =~ m/\.(avi|divx|mkv|flv|mp4|wmv)$/i ){
## Download video
}
elsif($file->{file_name} =~ m/\.(mp3)$/i){
## Download Audio
}
Is this what you needed ?

if ($file->{file_name} =~ /\.(avi|divx|mkv|flv|mp4|mp3|wmv)$/i )
{
if ($1 eq "mp3")
{
# mp3 stuff
}
elsif ($1 eq "mp4")
{
# mp4 stuff
}
else
{
# all other file types
}
}
else
{
# It didn't match
}
A fancier way would be to create a hash keyed by your file types in advance with the info you needed for your next page; the filename I guess?
my %pageHash = ( "mp3" => "mp3Page.html", "divx" => "divxPage.html", ... );
...
$file->{file_name} =~ /\.(.*)$/i;
if (exists $pageHash{$1})
{
$page = $pageHash{$1};
}
else
{
# unknown file extension
}

Having just been burnt by this, I must advise you against declaring a variable with a conditional modifier. If the condition does not hold true, it runs no part of the other clause, which means that you are not declaring $tmpl1, but since it's already passed strict, it allows you to assign to an undefined position in memory.
There is a safer way to do what your predecessor is doing here, that can yet illustrate a solution.
my $tmpl1
= $file->{file_name} =~ /\.(avi|divx|mkv|flv|mp4|wmv)$/i
? 'download1_video.html'
: $file->{file_name} =~ m/\.mp3$/i
? 'download1_audio.html'
: 'download1.html'
;
Thus,
$tmpl1 is always declared
$tmpl1 is always assigned a value

Related

Get blob uploaded data with pure Perl

In Javascript, I am sending a blob using XHR by the following code:
var v=new FormData();
v.append("EFD",new Blob([...Uint8Array...]));
var h=new XMLHttpRequest();
h.setRequestHeader("Content-type","multipart/form-data; charset=utf-8");
h.open("POST","...url...");
h.send(v);
In the server, I have created in Perl the following function, that suppose to implement CGI->param and CGI->upload:
# QS (Query String) receive in argument string for single parameter or array of many required parameters.
# If string been supplied: Return the value of the parameter or undef if missing.
# If array been supplied, a hash will be returned with keys for param names and their corresponding values.
# If the first argument is undef, then return hash with ALL available parameters.
sub QS {
my $b=$ENV{'QUERY_STRING'};
if($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$b,$ENV{'CONTENT_LENGTH'}) or die "E100";
}
my $e=$_[0]; my $t=&AT($e); my $r={}; my #q=split(/&/,$b);
my %p=(); if($t eq "A") { %p=map { $_=>1 } #{$e}; }
foreach my $i(#q) {
my ($k,$s)=split(/=/,$i); $s=~tr/+//; $s=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if($t eq "") { $r->{$k}=$s; }
elsif($t eq "A") { if($p{$k}) { $r->{$k}=$s; } }
elsif($k eq $_[0]) { return $s; }
}
return $r;
}
# AT is a function for determining type of an object, and also a quck way to distinguish between just a string and a number.
sub AT {
if(!defined $_[0]) { return ""; } my $v=ref($_[0]);
if($v eq "") { return ($_[0]*1 eq $_[0])?"N":"S"; }
my $k={"ARRAY"=>"A","HASH"=>"H"};
return $k->{$v}||$_[0]->{_obt}||$v;
}
So in the main program it will be called as:
my $EFD=&FW::QS("EFD"); # FW = The module name where QS and AT are.
When I issuing the POST from the client, the script in the server does not pop-up any errors, and does not terminates - it continues to run and run and run.... Endlessly.... Consuming 100% CPU time and 100% memory - without any explanation.
I have these in the beginning of the script, though:
use strict;
use warnings;
use diagnostics;
but it still behave in such a way that I need to kill the script in order to terminate it...
Anyone know what I did wrong...? No infinite loop here, as far as I know... If I change the Blob to regular classic way of "...url...?EFD=dhglkhserkhgoi" then it works just fine, but I want a Blob....
Thanks a lot
This QS function is only usable for POSTs with an application/x-www-urlencoded body, which yours isn't.

Use Archive::Zip to determine if a member is a text file or not

I'm working on a script that will grep the contents of members of zip archives when the member name matches a pattern, using a given search string.
I have the following sub that processes a single archive (the script can take more than one archive on the command line):
sub processArchive($$$$) {
my ($zip, $searchstr, $match, $zipName) = #_;
print "zip[$zip] searchstr[$searchstr] match[$match] zipName[$zipName]\n";
my #matchingList = $zip->membersMatching($match);
my $len = #matchingList;
if ($len > 0) {
print $zipName . ":\n";
for my $member (#matchingList) {
print "member[$member]\n";
print "textfile[" . $member->isTextFile() . "] contents[" . $member->contents() . "]\n";
if ($member->isTextFile()) {
print "Is a text file.\n";
}
else {
print "Is not a text file.\n";
}
my #matchingLines = grep /$searchstr/, $member->contents();
my $len = #matchingLines;
if ($len > 0) {
print #matchingLines;
}
}
}
}
The logic isn't even complete yet. I'm first experimenting with calling "isTextFile()" to see what it does. I must be doing something wrong, because I get "Is not a text file" for at least one member that is clearly a text file.
I also note that when I print the value of the return from "isTextFile()", it's always an empty string. Is that what I should expect from printing a "true" or "false" value, or is something else wrong here?
The "text file" status is read from a flag in the ZIP file. Many archiving tools do not set this flag properly, as it is rarely used and has no impact on normal use.
If you actually need to check whether a file contains text, you will need to extract it and see for yourself.

How come Catalyst::Controller::WrapCGI doesn't get any post data?

Whenever I POST something to a page with Catalyst::Controller::WrapCGI I notice that my old CGI script doesn't get any POST data.. Data inside the body of the HTTP request. What am I doing wrong and how do I fix this?
In my case, this was because I was using Catalyst::Controller::WrapCGI v0.35 and Catalyst::Controller::REST. This created a problem.. My configuration looked like this,
package MyApp::Controller::REST;
__PACKAGE__->config(namespace => '');
BEGIN { extends 'Catalyst::Controller::REST' }
and
package MyApp::Controller::Root;
__PACKAGE__->config(namespace => '');
BEGIN { extends 'Catalyst::Controller::WrapCGI' }
However, Catalyst::Controller::REST installs a begin action on line 298
sub begin : ActionClass('Deserialize') { }
And, that -- in my case -- was delegating to Catalyst::Action::Deserialize::JSON which is smart enough to seek($body,0,0) but too dumb and inconsiderate to do that for the next guy down the chain.... Code below from here
if(openhandle $body) {
seek($body, 0, 0); # in case something has already read from it
while ( defined( my $line = <$body> ) ) {
$rbody .= $line;
}
}
And, to make matters even worse, the next guy down the chain in this example is Catalyst::Controller::WrapCGI which not just fails to clean up for the next guy, but fails to set it up for itself (code from here),
if ($body) { # Slurp from body filehandle
local $/; $body_content = <$body>;
}
That should look like (at the very least)
if ($body) { # Slurp from body filehandle
local $/;
seek($body,0,0);
$body_content = <$body>;
}
That's why we can't have nice things... I opened a bug in C:C:WrapCGI to get this resolved.

Perl Read a file into a variable and add suffix to each lines

I'm very new to Perl and I'm having a hard time find out what I want.
I have a text file containing something like
text 2015-02-02:
- blabla1
- blabla2
text2 2014-12-12:
- blabla
- ...
I'm trying to read the file, put it in var, add to end of each line (of my var) and use it to send it to a web page.
This is what I have for the moment. It works except for the part.
if (open (IN, "CHANGELOG.OLD")) {
local $/;
$oldchangelog = <IN>'</br>';
close (IN);
$tmplhtml{'CHANGELOG'} = $oldchangelog;
} else {
# changelog not available
$tmplhtml{'CHANGELOG'} = "Changelog not available";
}
thanks for the help!
As someone comments - this looks like YAML, so parsing as YAML is probably more appropriate.
However to address your scenario:
3 argument file opens are good.
you're using local $/; which means you're reading the whole file into a string. This is not suitable for line by line processing.
Looks like you're putting everything into one element of a hash. Is there any particular reason you're doing this?
Anyway:
if ( open ( my $input, "<", "CHANGELOG.OLD" ) ) {
while ( my $line = <$input> ) {
$tmplhtml{'CHANGELOG'} .= $line . " <BR/>\n";
}
}
else {
$tmplhtml{'CHANGELOG'} = "Changelog not available";
}
As an alternative - you can render text 'neatly' to HTML using <PRE> tags.

What does this perl crash means?

Can someone tell me what this means?
if (not defined $config{'crontab'}) {
die "no crontab defined!";
}
I want to open a file crontab.txt but the perl script crashes at this line and I don't really know any perl.
EDIT 1
It goes like this:
sub main()
{
my %config = %{getCommandLineOptions()};
my $programdir = File::Spec->canonpath ( (fileparse ( Win32::GetFullPathName($PROGRAM_NAME) ))[1] );
my $logdir = File::Spec->catdir ($programdir, 'logs');
$logfile = File::Spec->catfile ($logdir, 'cronw.log');
configureLogger($logfile);
$log = get_logger("cronw::cronService-pl");
# if --exec option supplied, we are being invoked to execute a job
if ($config{exec}) {
execJob(decodeArgs($config{exec}), decodeArgs($config{args}));
return;
}
my $cronfile = $config{'crontab'};
$log->info('starting service');
$log->debug('programdir: '.$programdir);
$log->debug('logfile: '.$logfile);
if (not defined $config{'crontab'}) {
$log->error("no crontab defined!\n");
die "no crontab defined!";
# fixme: crontab detection?
}
$log->debug('crontab: '.$config{'crontab'});
And I'm trying to load this 'crontab.txt' file...
sub getCommandLineOptions()
{
my $clParser = new Getopt::Long::Parser config => ["gnu_getopt", "pass_through"];
my %config = ();
my #parameter = ( 'crontab|cronfile=s',
'exec=s',
'args=s',
'v|verbose'
);
$clParser->getoptions (\%config, #parameter);
if (scalar (#ARGV) != 0) { $config{'unknownParameter'} = $true; }
return \%config;
}
Probably I have to give the script an argument
Probably I have to give the script an argument
I would say so.
$ script --cronfile=somefile
That code looks to see whether there is a key 'crontab' in the hash %config. If not, then it calls die and terminates.
If that's not what you expect to happen, then somewhere else in your script there should be something that is setting $config{'crontab'}, but there is not currently enough information in your question to determine what that might be.
Probably the file path of crontab.txt is expected in %config hash, pointed by the 'crontab' key, but isn't there! If so, a DIRTY solution CAN BE:
$config{'crontab'}='FULLPATH/crontab.txt';
#if (not defined $config{'crontab'}) {
# die "no crontab defined!";
#}
but this may not work because there is something like $config{'prefix'} and what you will try to open is the path represented by the concatenation of both, or just because in $config{'crontab'} is expected any other value than full path!