I'd like to store file handle to a global hash and read() it in a subroutine without revealing CGI object, but I find that it doesn't work(resulting zero sized output file).
Here is the simplified perl code:
#!/usr/local/bin/perl
use CGI;
use vars qw(%in);
&init_hash;
$fname = &process_uploaded_file if($in{'upfile'});
$fsize = -s $fname;
print "Content-Type: text/plain\r\n\r\n";
print "in{'upfile'}=",$in{'upfile'},"\r\n";
print "in{'desc'}=",$in{'desc'},"\r\n";
print "fname=",$fname,"\r\n";
print "fsize=",$fsize,"\r\n";
sub init_hash{
my $q = new CGI;
$in{'desc'} = $q->param('desc');
$in{'upfile'} = $q->param('upfile');
$in{'upfh'} = $q->upload('upfile') if($in{'upfile'});
}
sub process_uploaded_file{
my $fname = time.'.bin';
open(OUT,'>',$fname) || die('open file failed');
while(my $read = read($in{'upfh'}, my $buff, 4096)){
print OUT $buff;
}
close(OUT);
eval { close($in{'upfh'}); };
return $fname;
}
EDIT: I should provide perl and cgi.pm version.
Perl version: This is perl 5, version 12, subversion 2 (v5.12.2) built for MSWin32-x86-multi-thread
(with 8 registered patches, see perl -V for more detail)
$CGI::VERSION='3.50';
There is so much wrong with your code.
First your problem: you are trying to optimize where optimization isn't due. And the temp files of the CGI object are deleted before you actually access them. Your code should work when you extend the lifetime of the CGI object, e.g. by adding it to the %in hash.
Always use strict; use warnings;. There are no excuses.
Global variables are declared with our. The vars pragma is a historical artifact. But please don't use global variables, as they are unneccessary here.
Don't call functions like &foo unless you can tell me what exactly this does. Until you have this knowledge: foo().
Use the header method of the CGI object to write headers: $q->header('text/plain').
The \n may not be what you think it is. Do a binmode STDOUT to remove the :crlf PerlIO-layer if it is currently applied. Although equivalent to \r\n, It may be clearer to write \015\012 to demonstrate that you care about the actual bytes.
You can interpolate variables into strings, you know. You can also specify a string that is to be appended after each print by setting $\:
{
local $\ = "\015\012";
print "in{'upfile'}=$in{'upfile'}";
print "in{'desc'}=$in{'desc'}";
print "fname=$fname";
print "fsize=$fsize";
}
Don't use bareword filehandles. Instead of open OUT, "<", $fname you should open my $outfh, "<", $fname.
Why did you put one close in an eval? I don't see how this should die.
Related
I am trying to pass arguments from one Perl script to another. Some of the arguments contain spaces.
I am reading in a comma-delimited text file and splitting each line on the comma.
my ($jockey, $racecourse, $racenum, $hnamenum, $trainer, $TDRating, $PRO) = split(/,/, $line);
The data in the comma-delimited text file look as follows:
AARON LYNCH,WARRNAMBOOL,RACE 1,DAREBIN (8),ERIC MUSGROVE,B,1
When I print out each variable, from the parent script, they look fine (as above).
print "$jockey\n";
print "$racecourse\n";
print "$racenum\n";
print "$hnamenum\n";
print "$trainer\n";
print "$TDRating\n";
print "$PRO\n";
AARON LYNCH
WARRNAMBOOL
RACE 1
DAREBIN (8)
ERIC MUSGROVE
B
1
When I pass the arguments to the child script (as follows), the arguments are passed incorrectly.
system("perl \"$bindir\\narrative4.pl\" $jockey $racecourse $racenum $hnamenum $trainer $TDRating $PRO");
AARON
LYNCH
WARRNAMBOOL
RACE
1
DAREBIN
(8)
As you can see, $ARGV[0] becomes AARON, $ARGV[1] becomes LYNCH, $ARGV[2] becomes WARRNAMBOOL, and so on.
I have investigated adding quotes to the arguments using qq, quotemeta and Win32::ShellQuote, unfortunately, even if I pass qq{"$jockey"}, the quotes are still stripped before they reach the child script, so they must be protected in some way.
I not sure if either of the aforementioned solutions is the correct but I'm happy to be corrected.
I'd appreciate any suggestions. Thanks in advance.
Note: I am running this using Strawberry Perl on a Windows 10 PC.
Note2: I purposely left out use strict; & use warnings; in these examples.
Parent Script
use Cwd;
$dir = getcwd;
$bin = "bin"; $bindir = "$dir/$bin";
$infile = "FINAL-SORTED-JOCKEY-RIDES-FILE.list";
open (INFILE, "<$infile") or die "Could not open $infile $!\n";
while (<INFILE>)
{
$line = $_;
chomp($line);
my ($jockey, $racecourse, $racenum, $hnamenum, $trainer, $TDRating, $PRO) = split(/,/, $line);
print "$jockey\n";
print "$racecourse\n";
print "$racenum\n";
print "$hnamenum\n";
print "$trainer\n";
print "$TDRating\n";
print "$PRO\n";
system("perl \"$bindir\\narrative4.pl\" $jockey $racecourse $racenum $hnamenum $trainer $TDRating $PRO");
sleep (1);
}
close INFILE;
exit;
Child Script
$passedjockey = $ARGV[0];
$passedracecourse = $ARGV[1];
$passedracenum = $ARGV[2];
$passedhnamenum = $ARGV[3];
$passedtrainer = $ARGV[4];
$passedTDRating = $ARGV[5];
$passedPRO = $ARGV[6];
print "$passedjockey\n";
print "$passedracecourse\n";
print "$passedracenum\n";
print "$passedhnamenum\n";
print "$passedtrainer\n";
print "$passedTDRating\n";
print "$passedPRO\n\n";
That whole double-quoted string that is passed to system is first evaluated and thus all variables are interpolated -- so the intended multi-word arguments become merely words in a list. So in the end the string has a command to run with individual words as arguments.
Then, even if you figure out how to stick which quotes in there just right, so to keep those multi-word arguments "together," there's still a chance of a shell being invoked, in which case those arguments again get broken up into words before being passed to the program.
Instead of all this use the LIST form of system. The first argument is then the name of the program that will be directly executed without a shell (see docs for some details on that), and the remaining arguments are passed as they are to that program.
parent
use warnings;
use strict;
use feature 'say';
my #args = ('first words', 'another', 'two more', 'final');
my $prog = 'print_args.pl';
system($prog, #args) == 0
or die "Error w/ system($prog, #args): $!";
and the invoked print_args.pl
use warnings;
use strict;
use feature 'say';
say for #ARGV;
The #ARGV contains arguments passed to the program at invocation. There's more that can be done to inspect the error, see docs and links in them.†
By what you show you indeed don't need a shell and the LIST form is generally easy to recommend as a basic way to use system, when the shell isn't needed. If you were to need shell's capabilities for something in that command then you'd have to figure out how to protect those spaces.
† And then there are modules for running external programs that are far better than system & Co. From ease-of-use to features and power:
IPC::System::Simple, Capture::Tiny, IPC::Run3, IPC::Run.
I am pulling out my hair on using the file handle returned by select.
The documentation about select reads:
select
Returns the currently selected filehandle.
I have a piece of code, that prints some data and usually is executed without any re-direction. But there is one use case, where select is used to re-direct the print output to a file.
In this piece of code, I need to use the current selected file handle. I tried the following code fragment:
my $fh = select;
print $fh "test\n";
I wrote a short test program to demonstrate my problem:
#!/usr/bin/perl
use strict;
use warnings;
sub test
{
my $fh=select;
print $fh "#_\n";
}
my $oldfh;
# this works :-)
open my $test1, "> test1.txt";
$oldfh = select $test1;
test("test1");
close select $oldfh if defined $oldfh;
#this doesn't work. :-(
# Can't use string ("main::TEST2") as a symbol ref while "strict refs" in use
open TEST2,">test2.txt";
$oldfh = select TEST2;
test("test2");
close select $oldfh if defined $oldfh;
#this doesn't work, too. :-(
# gives Can't use string ("main::STDOUT") as a symbol ref while "strict refs" in use at
test("test");
It seems, that select is not returning a reference to the file handle but a string containing the name of the file handle.
What do I have to do to always get a usable file handle from select's return value?
P.S. I need to pass this file handle as OutputFile to XML::Simple's XMLout().
Just use
print XMLout(...);
It seems, that select is not returning a reference to the file handle but a string containing the name of the file handle.
It can indeed return a plain ordinary string.
>perl -MDevel::Peek -E"Dump(select())"
SV = PV(0x6cbe38) at 0x260e850
REFCNT = 1
FLAGS = (PADTMP,POK,pPOK)
PV = 0x261ce48 "main::STDOUT"\0
CUR = 12
LEN = 24
But that's perfectly acceptable as a file handle to Perl. There are four things that Perl accepts as file handles:
A reference to an IO object.
>perl -e"my $fh = *STDOUT{IO}; CORE::say($fh 'foo');"
foo
A glob that contains a reference to an IO object.
>perl -e"my $fh = *STDOUT; CORE::say($fh 'foo');"
foo
A reference to a glob that contains a reference to an IO object.
>perl -e"my $fh = \*STDOUT; CORE::say($fh 'foo');"
foo
A "symbolic reference" to a glob that contains a reference to an IO object.
>perl -e"my $fh = 'STDOUT'; CORE::say($fh 'foo');"
foo
This type doesn't work under strict refs, though.
>perl -Mstrict -e"my $fh = 'STDOUT'; CORE::say($fh 'foo');"
Can't use string ("STDOUT") as a symbol ref while "strict refs" in use at -e line 1.
What do I have to do to always get a usable file handle from select's return value?
As demonstrated above, it already returns a perfectly usable file handle. If XMLout doesn't support it, then it's a bug in XMLout. You could work around it as follows:
my $fh = select();
if (!ref($fh) && ref(\$fh) ne 'GLOB') {
no strict qw( refs );
$fh = \*$fh;
}
This can also be used to make the handle usable in a strict environment
As bad as XML::Simple is at reading XML, it's a million times worse at generating it. See Why is XML::Simple Discouraged?.
Consider XML::LibXML or XML::Twig if you're modifying XML.
Consider XML::Writer if you're generating XML.
The point of select is you don't need to specify the handle at all, since it's the default one.
sub test {
print "#_\n";
}
That's also the reason why select isn't recommended: it introduces global state which is hard to track and debug.
First of all, you shouldn't use XML::Simple , because it will need lots of work to make sure that your output will generate consistent XML. At least make sure you're using the appropriate ForceArray parameters.
Instead of doing filehandle shenanigans, why don't you use the simpler
print XMLout($data, %options);
... instead of trying to pass a default filehandle around?
I'm working on a bot in Perl (based on POE) and so far so good, but I can't figure out how can I add a !js or !perl command to evaluate respective code and return one line of output to be printed into the channel. I found App::EvalServer but I don't get how to use it.
Thanks for any help!
The App::EvalServer module comes with a binary to run as a standalone application. You do not put it in your program but rather run it on it's own. It opens a port where you can hand it code as a json string. This does not sound like a good idea to me either.
There is another module you might want to look at called Safe. I suggest you read through the complete documentation as well as the one to Opcode (linked in the doc) before you do anything with this. YOU CAN DO SERIOUS DAMAGE IF YOU EVALUATE ARBITRARY CODE! Never forget that.
UPDATE:
Here's an example of how to capture the output of print or say from your evaled code. You can use open with a variable to make printed output always go to that variable. If you switch back afterwards you can work with the captured output in your var. This is called an in-memory file.
use strict; use warnings;
use feature 'say';
use Safe;
# Put our STDOUT into a variable
my $printBuffer;
open(my $buffer, '>', \$printBuffer);
# Everything we say and print will go into $printBuffer until we change it back
my $stdout = select($buffer);
# Create a new Safe
my $compartment = new Safe;
$compartment->permit(qw(print)); # for testing
# This is where the external code comes in:
my $external_code = qq~print "Hello World!\n"~;
# Execute the code
my $ret = $compartment->reval($external_code, 1);
# Go back to STDOUT
select($stdout);
printf "The return value of the reval is: %d\n", $ret;
say "The reval's output is:";
say $printBuffer;
# Now you can do whatever you want with your output
$printBuffer =~ s/World/Earth/;
say "After I change it:";
say $printBuffer;
Disclaimer: Use this code at your own risk!
Update 2: After a lengthy discussion in chat, here's what we came up with. It implements a kind of timeout to stop the execution if the reval is taking to long, e.g. because of an infinite loop.
#!/usr/bin/perl
use warnings;
use strict;
use Safe;
use Benchmark qw(:hireswallclock);
my ($t0, $t1); # Benchmark
my $timedOut = 0;
my $userError = 0;
my $printBuffer;
open (my $buffer, '>', \$printBuffer);
my $stdout = select($buffer);
my $cpmt = new Safe;
$cpmt->permit_only(qw(:default :base_io sleep));
eval
{
local $SIG{'ALRM'} = sub { $timedOut = 1; die "alarm\n"};
$t0 = Benchmark->new;
alarm 2;
$cpmt->reval('print "bla\n"; die "In the user-code!";');
# $cpmt->reval('print "bla\n"; sleep 50;');
alarm 0;
$t1 = Benchmark->new;
if ($#)
{
$userError = "The user-code died! $#\n";
}
};
select($stdout);
if ($timedOut)
{
print "Timeout!\n";
my $td = timediff($t1, $t0);
print timestr($td), "\n";
print $printBuffer;
}
else
{
print "There was no timeout...\n";
if ($userError)
{
print "There was an error with your code!\n";
print $userError;
print "But here's your output anyway:\n";
print $printBuffer;
}
else
{
print $printBuffer;
}
}
Take a look at perl eval(), you can pass it variables/strings and it will evaluate it as if it's perl code. Likewise in javascript, there's also an eval() function that performs similarly.
However, DO NOT EVALUATE ARBITRARY CODE in either perl or javascript unless you can run it in a completely closed environment (and even then, it's still a bad idea). Lot's of people spend lots of time preventing just this from happening. So that's how you'd do it, but you don't want to do it, really at all.
Some time ago, I ask a question: How do I redefine built in Perl functions?
And the answers have served me well. I have a package that overrides Perl's 'open' function enabling me to log file access.
Now I've come to a case that breaks the functionality of the original code.
use strict;
use warnings;
use Data::Dumper;
sub myopen (*;#) {
my $p;
my $retval = CORE::open($p, $_[1]);
{
no strict;
*{"main::$_[0]"} = $p;
}
return $retval;
}
BEGIN {
*CORE::GLOBAL::open = *myopen;
};
my #a = (1, 2, 3);
open(CHECK, ">dump") or print "UNABLE TO OPEN DUMPER FILE: $!\n";
print CHECK "test\n";
print CHECK Data::Dumper->Dump(\#a);
close CHECK
Now I get this message:
Can't locate object method "CHECK" via package "Data::Dumper"
How do I fix it?
Try using a name other than "CHECK".
"CHECK" is a special function which is called during compile time, and you really shouldn't use it.
$ open CHECK , '<', 'foo.txt';
Took 0.00224494934082031 seconds.
Runtime error: Undefined subroutine &Devel::REPL::Plugin::Packages::DefaultScratchpad::CHECK called at (eval 329) line 5.
$ open CHECKS , '<', 'foo.txt';
Took 0.00155806541442871 seconds.
$
More on 'CHECK'
Why that specific error?
perl -MO=Deparse -e 'print CHECK Data::Dumper 1';
print 'Data::Dumper'->CHECK(1);
Also, you're using global file handles, which are problematic.
use this notation:
open my $fh, '<' , $foo ;
print <$fh>;
close $fh;
These are extra beneficial is they self-close when they go out of scope.
Compare:
> perl -MData::Dumper -e'local*_=*STDOUT;print _ Data::Dumper->Dump([2]);'
Can't locate object method "_" via package "Data::Dumper" at -e line 1.
to
> perl -MData::Dumper -e'local*_=*STDOUT;print _ ( Data::Dumper->Dump([2]) );'
$VAR1 = 2;
I used a different name from "STDOUT" because it seems to only gets the indirect object wrong when it's not a built-in handle.
This will work and without producing the error...
print {*CHECK} Data::Dumper->Dump(\#a);
This stops it being confused has an "Indirect Object Syntax"
However I do recommend steering clear of using CHECK and other special named code blocks in Perl and using lexical variables for filehandles is the preferred method. PBP
Let's say I have a text file created using Data::Dumper, along the lines of:
my $x = [ { foo => 'bar', asdf => undef }, 0, -4, [ [] ] ];
I'd like to read that file back in and get $x back. I tried this:
my $vars;
{
undef $/;
$vars = <FILE>;
}
eval $vars;
But it didn't seem to work -- $x not only isn't defined, when I try to use it I get a warning that
Global symbol $x requires explicit package name.
What's the right way to do this? (And yes, I know it's ugly. It's a quick utility script, not e.g., a life-support system.)
As others have already said, you'd probably be better off storing the data in a better serialisation format:
Storable - this is quick and easy, but fairly Perl-specific (but will satisfy your need for a quick solution in a relatively unimportant script easily)
YAML, using the YAML module, or YAML::Tiny, or YAML::Any as a wrapper to take advantage of whatever JSON module(s) are available on your system
JSON, using the JSON module, or JSON::XS for more speed (or JSON::Any as a wrapper to take advantage of whatever JSON module(s) are available on your system)
XML, using the XML-Simple module, or one of the other XML modules.
Personally, I think I'd aim for YAML or JSON... you can't get much easier than:
my $data = YAML::Any::LoadFile($filename);
Here's a thread that provides a couple different options: Undumper
If you're just looking for data persistence the Storable module might be your best bet.
By default, Data::Dumper output cannot be parsed by eval, especially if the data structure being dumped is circular in some way. However, you can set
$Data::Dumper::Purity = 1;
or
$obj->Purity(1);
where obj is a Data::Dumper object. Either of these will cause Data::Dumper to produce output that can be parsed by eval.
See the Data::Dumper documenatation at CPAN for all the details.
As Rich says, you probably don't want to use Data::Dumper for persistence, but rather something like Storable.
However, to answer the question asked... IIRC, Data::Dumper doesn't declare your variables to be my, so are you doing that yourself somehow?
To be able to eval the data back in, the variable needs to not be my within the eval. If your text file contained this:
$x = [ { foo => 'bar', asdf => undef }, 0, -4, [ [] ] ];
Then this would work:
my $vars;
{
undef $/;
$vars = <FILE>;
}
my $x;
eval $vars;
print $x;
If you want to stay with something easy and human-readable, simply use the Data::Dump module instead of Data::Dumper. Basically, it is Data::Dumper done right -- it produces valid Perl expressions ready for assignment, without creating all those weird $VAR1, $VAR2 etc. variables.
Then, if your code looks like:
my $x = [ { foo => 'bar', asdf => undef }, 0, -4, [ [] ] ];
Save it using:
use Data::Dump "pp";
open F, ">dump.txt";
print F pp($x);
This produces a file dump.txt that looks like (on my PC at least):
[{ asdf => undef, foo => "bar" }, 0, -4, [[]]]
Load it using:
open F, "dump.txt";
my $vars;
{ local $/ = undef; $vars = <F>; }
my $x = eval $vars;
Note that
If you're bothering to put the assignment to $/ in its own block, you should use local to ensure it's value is actually restored at the end of the block; and
The result of eval() needs to be assigned to $x.
Are you sure that file was created by Data::Dumper? There shouldn't be a my in there.
Some other options are Storable, YAML, or DBM::Deep. I go through some examples in the "Persistence" chapter of Mastering Perl.
Good luck, :)
This snippet is short and worked for me (I was reading in an array). It takes the filename from the first script argument.
# Load in the Dumper'ed library data structure and eval it
my $dsname = $ARGV[0];
my #lib = do "$dsname";
I think you want to put
our $x;
into your code before accessing x. That will satisfy the strict error checking.
That being said, I join the other voices in suggesting Storable.
This works fine for me:
Writing out:
open(my $C, qw{>}, $userdatafile) or croak "$userdatafile: $!";
use Data::Dumper;
print $C Data::Dumper->Dump([\%document], [qw(*document)]);
close($C) || croak "$userdatafile: $!";
Reading in:
open(my $C, qw{<}, $userdatafile) or croak "$userdatafile: $!";
local $/ = $/;
my $str = <$C>;
close($C) || croak "$userdatafile: $!";
eval { $str };
croak $# if $#;