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 $#;
Related
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?
Below is the Perl code in .pm file which is supposed to replace the specified strings (that are in "quotes") with some values. But its not happening. Can anyone explain what is happening in this code?
package SomePackage;
require Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
sub send_request {
my ( $service, $action, $torole ) = #_;
my ( $seller_request_mmd );
my $replace_contents = ();
$replace_contents{"REPLACE_Service"} = $service;
$replace_contents{"REPLACE_RequestAction"} = $action;
$replace_contents{"REPLACE_TradingPartner"} = $torole;
$replace_contents{"REPLACE_Requestxml"} = "Request.xml";
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml" );
}
sub create_mmd_and_transfer {
my $local_replace_contents = shift;
my $input_mmd = shift;
my $local_output_mmd = shift;
my $output_mmd = shift;
update_mmd_file( "$input_mmd", "temp_mmd_file.xml", $local_replace_contents );
}
sub update_mmd_file {
my $input_file = shift;
my $output_file = shift;
my $contents = shift;
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template $input_file \n $input_file not found int the Templates folder \n Please place the same and then run the script ");
open( TEMP_MMD_FILE, ">$output_file" );
while ( <MMD_FILE> ) {
s/^M//g; # Getrid of the ^Ms
foreach my $content ( keys( %$contents ) ) {
my $exact_value = ${%$contents}{$content};
if ( $main::test_scenario =~ /^Invalid Request Action \a\n\d Service/
and ( $content =~ /REPLACE_Service|REPLACE_RequestAction/i ) ) {
}
else {
if ( $exact_value ne "" ) {
s/$content/$exact_value/g;
}
}
}
print TEMP_MMD_FILE;
}
close MMD_FILE;
close TEMP_MMD_FILE;
}
The following will not make your script work, just create the better base for some future questions.
Before you even thinking about posting a perl question here:
1.) add to the top of your script:
use strict;
use warnings;
Posting a code here without these two lines, nobody will bother even trying to read the code.
2.) use perl -c SomePackage.pm for the check. If it will tell you: SomePackage.pm syntax OK - you can start thinking about posting a question here. ;)
Some basic problems with your script:
package SomePackage;
use strict; # see the above
use warnings;
require Exporter;
# these variables are defined outside of this package, so, tell perl this fact. use the `our`
our #ISA = qw(Exporter);
#the use warnings will warn you about the following line
# #EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
#the correct one is without commas
our #EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file); #not saying anything about the #EXPORT rudeness. :)
#my $replace_contents = ();
#the $replace_contents is a scalar. Bellow you using a hash. So,
my %replace_contents;
#or use the scalar but the lines bellow should use the hashref notation, e.g.
# $replace_contents->{"REPLACE_Service"} = $service;
# you decide. :)
# the seller_request_mmd contains undef here.
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml");
# also bellow, in the subroutine definition it wants 4 arguments.
# indicates a problem...
# using 2-arg open is not the best practice.
# Also, you should to use lexical filehandles
# open (MMD_FILE, "<$input_file")
# better
open (my $mmd_file, '<', $input_file)
# of course, you need change every MMD_FILE to $mmd_file
# check the result of the open and die if not successful
# or you can use the
use autodie;
# instead of $exact_value = ${%$contents}{$content};
# you probably want
my $exact_value = $contents->{$content};
Indent your code!
All the above are just about the syntactic problems and not solving anything about the "logic" of your code.
Ps: And me is still an beginner, so, others sure will find much more problems with the above code.
Ok. Here's what I've done to test this.
Firstly, you didn't give us an input file or the code that you use to call the module. So I invented them. I made the simplest possible input file:
REPLACE_Service
REPLACE_RequestAction
REPLACE_TradingPartner
REPLACE_Requestxml
And this driver program:
#!/usr/bin/perl
use strict;
use warnings;
use SomePackage;
send_request('foo', 'bar', 'baz');
sub error_exit {
die #_;
}
The first time, I ran it, I got this error:
Undefined subroutine &main::send_request called at test line 8.
That was because your #EXPORT line was wrong. You had:
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
But the point of qw(...) is that you don't need the commas. So I corrected it to:
#EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file);
Then I re-ran the program and got this error:
Cannot open MMD file template
not found int the Templates folder
Please place the same and then run the script at test line 11.
That looked like there was something missing. I changed the error message, adding indicators of where the variable interpolation was supposed to happen:
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template <$input_file> \n <$input_file> not found int the Templates folder \n Please place the same and then run the script ");
Then the error message looked like this:
Cannot open MMD file template <>
<> not found int the Templates folder
Please place the same and then run the script at test line 11.
So it seems clear that the $input_file variable isn't set in the update_mmd_file() subroutine. Tracing that variable back, we see that this value is originally the $seller_request_mmd variable in send_request(). But in send_request() you declare $seller_request_mmd but you never give it a value. So let's do that:
my ( $seller_request_mmd ) = 'test_input.txt';
Now, when I run your program, it runs to completion without any errors. And I find a new temp_mmd_file.xml is generated. But it is exactly the same as the input file. So more investigation is needed.
Digging into the update_mmd_file() subroutine, we find this interesting line:
my $exact_value = ${%$contents}{$content};
I think you're trying to extract a value from $contents, which is a hash reference. But your syntax is wrong. You were probably aiming at:
my $exact_value = ${$contents}{$content};
But most Perl programmers prefer the arrow notation for working with reference look-ups.
my $exact_value = $contents->{$content};
Making that change and re-running the program, I get an output file that contains:
foo
bar
baz
Request.xml
Which is exactly what I expected. So the program now works.
But there is still a lot of work to do. As you have been told repeatedly, you should always add:
use strict;
use warnings;
to your code. That will find a lot of potential problems in your code - which you should fix.
To be honest, this feels to me like you were trying to run before you could walk. I'd recommend spending some time to work through a good Perl introductory book before taking on my more Perl work.
And there was a lot of useful information missing from your question. It wouldn't have taken as long to get to the solution if you had shown us your driver program and your input data.
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.
I have a Perl program that reads in a bunch of data, munges it, and then outputs several different file formats. I'd like to make Perl be one of those formats (in the form of a .pm package) and allow people to use the munged data within their own Perl scripts.
Printing out the data is easy using Data::Dump::pp.
I'd also like to print some helper functions to the resulting package.
What's an easy way to print a multi-line string without variable substitution?
I'd like to be able to do:
print <<EOL;
sub xyz {
my $var = shift;
}
EOL
But then I'd have to escape all of the $'s.
Is there a simple way to do this? Perhaps I can create an actual sub and have some magic pretty-printer print the contents? The printed code doesn't have to match the input or even be legible.
Enclose the name of the delimiter in single quotes and interpolation will not occur.
print <<'EOL';
sub xyz {
my $var = shift;
}
EOL
You could use a templating package like Template::Toolkit or Text::Template.
Or, you could roll your own primitive templating system that looks something like this:
my %vars = qw( foo 1 bar 2 );
Write_Code(\$vars);
sub Write_Code {
my $vars = shift;
my $code = <<'END';
sub baz {
my $foo = <%foo%>;
my $bar = <%bar%>;
return $foo + $bar;
}
END
while ( my ($key, $value) = each %$vars ) {
$code =~ s/<%$key%>/$value/g;
}
return $code;
}
This looks nice and simple, but there are various traps and tricks waiting for you if you DIY. Did you notice that I failed to use quotemeta on my key names in the substituion?
I recommend that you use a time-tested templating library, like the ones I mentioned above.
You can actually continue a string literal on the next line, like this:
my $mail = "Hello!
Blah blah.";
Personally, I find that more readable than heredocs (the <<<EOL thing mentioned elsewhere).
Double quote " interpolates variables, but you can use '. Note you'll need to escape any ' in your string for this to work.
Perl is actually quite rich in convenient things to make things more readable, e.g. other quote-operations. qq and q correspond to " and ' and you can use whatever delimiter makes sense:
my $greeting = qq/Hello there $name!
Nice to meet you/; # Interpolation
my $url = q|http://perlmonks.org/|; # No need to escape /
(note how the syntax coloring here didn't quite keep up)
Read perldoc perlop (find in page: "Quote and Quote-like Operators") for more information.
Use a data section to store the Perl code:
#!/usr/bin/perl
use strict;
use warnings;
print <DATA>;
#print munged data
__DATA__
package MungedData;
use strict;
use warnings;
sub foo {
print "foo\n";
}
Try writing your code as an actual perl subroutine, then using B::Deparse to get the source code at runtime.
I have a line of code along the lines of:
print $somehash{$var}{fh} "foo";
The hash contains the filehandle a few levels down. The error is:
String found where operator expected at test.pl line 10, near "} "foo""
I can fix it by doing this:
my $fh = $somehash{$var}{fh};
print $fh "foo";
...but is there a one-liner?
see http://perldoc.perl.org/functions/print.html
Note that if you're storing
FILEHANDLEs in an array, or if you're
using any other expression more
complex than a scalar variable to
retrieve it, you will have to use a
block returning the filehandle value
instead: ...
So, in your case, you would use a block like this:
print { $somehash{$var}{fh} } "foo";
If you have anything other than a simple scalar as your filehandle, you need to wrap the reference holding the filehandle in braces so Perl knows how to parse the statement:
print { $somehash{$var}{fh} } $foo;
Part of Perl Best Practices says to always wrap filehandles in braces just for this reason, although I don't get that nutty with it.
The syntax is odd because print is an indirect method on a filehandle object:
method_name Object #arguments;
You might have seen this in old-school CGI.pm. Here are two indirect method calls:
use CGI;
my $cgi_object = new CGI 'cat=Buster&bird=nightengale';
my $value = param $cgi_object 'bird';
print "Indirect value is $value\n";
That almost works fine (see Schwern's answer about the ambiguity) as long as the object is in a simple scalar. However, if I put the $cgi_object in a hash, I get the same syntax error you got with print. I can put the braces around the hash access to make it work out. Continuing with the previous code:
my %hash;
$hash{animals}{cgi} = $cgi_object;
# $value = param $hash{animals}{cgi} 'cat'; # syntax error
$value = param { $hash{animals}{cgi} } 'cat';
print "Braced value is $value\n";
That's all a bit clunky so just use the arrow notation for everything instead:
my $cgi_object = CGI->new( ... );
$cgi_object->param( ... );
$hash{animals}{cgi}->param( ... );
You can do the same with filehandles, although you have to use the IO::Handle module to make it all work out:
use IO::Handle;
STDOUT->print( 'Hello World' );
open my( $fh ), ">", $filename or die ...;
$fh->print( ... );
$hash{animals}{fh} = $fh;
$hash{animals}{fh}->print( ... );
The above answers are all correct. The reason they don't allow a full expression in there is print FH LIST is already pretty weird syntax. To put anything more complicated in there would introduce a ton of ambiguous syntax. The block removed that ambiguity.
To see where this madness leads to, consider the horror that is indirect object syntax.
foo $bar; # Is that foo($bar) or $bar->foo()? Good luck!