I study the High Order Perl book and have an issue with iterators in the Chapter 4.3.4.
The code:
main_script.pl
#!/perl
use strict;
use warnings;
use FindBin qw($Bin);
use lib $Bin;
use Iterator_Utils qw(:all);
use FlatDB;
my $db = FlatDB->new("$Bin/db.csv") or die "$!";
my $q = $db->query('STATE', 'NY');
while (my $rec = NEXTVAL($q) )
{
print $rec;
}
Iterator_Utils.pm
#!/perl
use strict;
use warnings;
package Iterator_Utils;
use Exporter 'import';;
our #EXPORT_OK = qw(NEXTVAL Iterator
append imap igrep
iterate_function filehandle_iterator list_iterator);
our %EXPORT_TAGS = ('all' => \#EXPORT_OK);
sub NEXTVAL { $_[0]->() }
sub Iterator (&) { return $_[0] }
FlatDB.pm
#!/perl
use strict;
use warnings;
package FlatDB;
my $FIELDSEP = qr/:/;
sub new
{
my $class = shift;
my $file = shift;
open my $fh, "<", $file or return;
chomp(my $schema = <$fh>);
my #field = split $FIELDSEP, $schema;
my %fieldnum = map { uc $field[$_] => $_ } (0..$#field);
bless
{
FH => $fh,
FIELDS => \#field,
FIELDNUM => \%fieldnum,
FIELDSEP => $FIELDSEP
} => $class;
}
use Fcntl ':seek';
sub query
{
my $self = shift;
my ($field, $value) = #_;
my $fieldnum = $self->{FIELDNUM}{uc $field};
return unless defined $fieldnum;
my $fh = $self->{FH};
seek $fh, 0, SEEK_SET;
<$fh>; # discard schema line
return Iterator
{
local $_;
while (<$fh>)
{
chomp;
my #fields = split $self->{FIELDSEP}, $_, -1;
my $fieldval = $fields[$fieldnum];
return $_ if $fieldval eq $value;
}
return;
};
}
db.csv
LASTNAME:FIRSTNAME:CITY:STATE:OWES
Adler:David:New York:NY:157.00
Ashton:Elaine:Boston:MA:0.00
Dominus:Mark:Philadelphia:PA:0.00
Orwant:Jon:Cambridge:MA:26.30
Schwern:Michael:New York:NY:149658.23
Wall:Larry:Mountain View:CA:-372.14
Just as in the book so far, right? However I do not get the output (the strings with Adler and Schwern should occur). The error message is:
Can't use string ("Adler:David:New York:NY:157.00") as a subroutine ref while
"strict refs" in use at N:/Perle/Learn/Iterators/Iterator_Utils.pm line 12, <$fh>
line 3.
What am I doing wrong?
Thanks in advance!
FlatDB calls Iterator, which is defined in Iterator_Utils, so it needs to import that function from Iterator_Utils. If you add
use Iterator_Utils qw(Iterator);
after package FlatDB, the program will work.
Thanks very much for finding this error. I will add this to the errata on the web site. If you would like to be credited by name, please email me your name.
Related
I'm writing a tool that must import a number of other perl config files. The files are not wrapped w/packages and may have similar or conflicting variables/functions. I don't have the ability to change the format of these files, so I must work around what they are. What I was thinking to do was import each into a unique name space, but I've not found a way to do that using do, require, or use. If I don't use dynamic names, just a hardcoded name, I can do it.
Want something like this:
sub sourceTheFile {
my ($namespace, $file) = #_;
package $namespace;
do $file;
1;
return;
}
That doesn't work because the package command requires a constant for the name. So then I try something like this:
sub sourceTheFile {
my ($namespace, $file) = #_;
eval "package $namespace;do $file;1;"
return;
}
But the contents of the file read by do are placed in the main:: scope not the one I want. The target scope is created, just not populated by the
do. (I tried require, and just a straight cat $file inside the eval as well.)
I'm using Devel::Symdump to verify that the namespaces are built correctly or not.
example input file:
my $xyz = "some var";
%all_have_this = ( common=>"stuff" );
ADDITIONAL CHALLENGE
Using the answer that does the temp file build and do call, I can make this work dynamically as I require. BUT, big but, how do I now reference the data inside this new namespace? Perl doesn't seem to have the lose ability to build a variable name from a string and use that as the variable.
I am not sure why the eval did not work. Maybe a bug? Here is a workaround using a temp file. This works for me:
use strict;
use warnings;
use Devel::Symdump;
use File::Temp;
my $file = './test.pl';
my $namespace = 'TEST';
{
my $fh = File::Temp->new();
print $fh "package $namespace;\n";
print $fh "do '$file';\n";
print $fh "1;\n";
close $fh;
do $fh->filename;
}
Perl's use and require facilities make use of any hooks you might have installed in #INC. You can simply install a hook which looks in a specific location to load modules with a prefix you choose:
package MyIncHook;
use strict;
use warnings;
use autouse Carp => qw( croak );
use File::Spec::Functions qw( catfile );
sub import {
my ($class, $prefix, $location) = #_;
unshift #INC, _loader_for($prefix, $location);
return;
}
sub _loader_for {
my $prefix = shift;
my $location = shift;
$prefix =~ s{::}{/}g;
return sub {
my $self = shift;
my $wanted = shift;
return unless $wanted =~ /^\Q$prefix/;
my $path = catfile($location, $wanted);
my ($is_done);
open my $fh, '<', $path
or croak "Failed to open '$path' for reading: $!";
my $loader = sub {
if ($is_done) {
close $fh
or croak "Failed to close '$path': $!";
return 0;
}
if (defined (my $line = <$fh>)) {
$_ = $line;
return 1;
}
else {
$_ = "1\n";
$is_done = 1;
return 1;
}
};
(my $package = $wanted) =~ s{/}{::}g;
$package =~ s/[.]pm\z//;
my #ret = (\"package $package;", $loader);
return #ret;
}
}
__PACKAGE__;
__END__
Obviously, modify the construction of $path according to your requirements.
You can use it like this:
#!/usr/bin/env perl
use strict;
use warnings;
use MyIncHook ('My::Namespace', "$ENV{TEMP}/1");
use My::Namespace::Rand;
print $My::Namespace::Rand::settings{WARNING_LEVEL}, "\n";
where $ENV{TEMP}/1/My/Namespace/Rand.pm contains:
%settings = (
WARNING_LEVEL => 'critical',
);
Output:
C:\Temp> perl t.pl
critical
You can, obviously, define your own mapping from made up module names to file names.
I want to make a configuration file which hold some objects, like this (where of course none of the paramaters can be considered as a primary key)
param1=abc
param2=ghj
param1=bcd
param2=hjk
; always the sames parameters
This file could be read, lets say with Config::IniFiles, because it has a direct transcription into ini file, like this
[0]
param1=abc
param2=ghj
[1]
param1=bcd
param2=hjk
with, for example, something like
perl -pe 'if (m/^\s*$/ || !$section ) print "[", ($section++ || 0) , "]"'
And finish with
open my $fh, '<', "/path/to/config_file.ini" or die $!;
$cfg = Config::IniFiles->new( -file => $fh );
(...parse here the sections starting with 0.)
But, I here ask me some question about the thing becoming quite complex....
(A) Is There a way to transform the $fh, so that it is not required to execute the perl one-liner BEFORE reading the file sequentially? So, to transform the file during perl is actually reading it.
or
(B) Is there a module to read my wonderfull flat database? Or something approching? I let myslef said, that Gnu coreutils does this kind of flat file reading, but I cannot remember how.
You can create a simple subclass of Config::INI::Reader:
package MyReader;
use strict;
use warnings;
use base 'Config::INI::Reader';
sub new {
my $class = shift;
my $self = $class->SUPER::new( #_ );
$self->{section} = 0;
return $self;
}
sub starting_section { 0 };
sub can_ignore { 0 };
sub parse_section_header {
my ( $self, $line ) = #_;
return $line =~ /^\s*$/ ? ++$self->{section} : undef ;
}
1;
With your input this gives:
% perl -MMyReader -MData::Dumper -e 'print Dumper( MyReader->read_file("cfg") )'
$VAR1 = {
'1' => {
'param2' => 'hjk',
'param1' => 'bcd'
},
'0' => {
'param2' => 'ghj',
'param1' => 'abc'
}
};
You can use a variable reference instead of a file name to create a filehandle that reads from it:
use strict;
use warnings;
use autodie;
my $config = "/path/to/config_file.ini";
my $content = do {
local $/;
open my $fh, "<", $config;
"\n". <$fh>;
};
# one liner replacement
my $section = 0;
$content =~ s/^\s*$/ "\n[". $section++ ."]" /mge;
open my $fh, '<', \$content;
my $cfg = Config::IniFiles->new( -file => $fh );
# ...
You can store the modified data in a real file or a string variable, but I suggest that you use paragraph mode by setting the input record separator $/ to the empty string. Like this
use strict;
use warnings;
{
local $/ = ''; # Read file in "paragraphs"
my $section = 0;
while (<DATA>) {
printf "[%d]\n", $section++;
print;
}
}
__DATA__
param1=abc
param2=ghj
param1=bcd
param2=hjk
output
[0]
param1=abc
param2=ghj
[1]
param1=bcd
param2=hjk
Update
If you read the file into a string, adding section identifiers as above, then you can read the result directly into a Config::IniFiles object using a string reference, for instance
my $config = Config::IniFiles->new(-file => \$modified_contents)
This example shows the tie interface, which results in a Perl hash that contains the configuration information. I have used Data::Dump only to show the structure of the resultant hash.
use strict;
use warnings;
use Config::IniFiles;
my $config;
{
open my $fh, '<', 'config_file.ini' or die "Couldn't open config file: $!";
my $section = 0;
local $/ = '';
while (<$fh>) {
$config .= sprintf "[%d]\n", $section++;
$config .= $_;
}
};
tie my %config, 'Config::IniFiles', -file => \$config;
use Data::Dump;
dd \%config;
output
{
# tied Config::IniFiles
"0" => {
# tied Config::IniFiles::_section
param1 => "abc",
param2 => "ghj",
},
"1" => {
# tied Config::IniFiles::_section
param1 => "bcd",
param2 => "hjk",
},
}
You may want to perform operations on a flux of objects (as Powershell) instead of a flux of text, so
use strict;
use warnings;
use English;
sub operation {
# do something with objects
...
}
{
local $INPUT_RECORD_SEPARATOR = '';
# object are separated with empty lines
while (<STDIN>) {
# key value
my %object = ( m/^ ([^=]+) = ([[:print:]]*) $ /xmsg );
# key cannot have = included, which is the delimiter
# value are printable characters (one line only)
operation ( \%object )
}
A like also other answers.
I have Perl and CSV file with something like:
"Name","Lastname"
"Homer","Simpsons"
"Ned","Flanders"
In this CSV file I have header in the first line and in other lines there are
data.
I want to convert this CSV file to such Perl data:
[
{
Lastname => "Simpsons",
Name => "Homer",
},
{
Lastname => "Flanders",
Name => "Ned",
},
]
I've written the function that users Text::CSV and doing what I need.
Here is the sample script:
#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
use 5.010;
use utf8;
use open qw(:std :utf8);
use Text::CSV;
sub read_csv {
my ($filename) = #_;
my #first_line;
my $result;
my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1 });
open my $fh, "<:encoding(utf8)", $filename or die "$filename: $!";
while (my $row = $csv->getline ($fh)) {
if (not #first_line) {
#first_line = #{$row};
} else {
push #{$result}, { map { $first_line[$_] => $row->[$_] } 0..$#first_line };
}
}
close $fh;
return $result;
}
my $data = read_csv('sample.csv');
This works fine but this function I want to use in several scripts. I'm
greatly suprised that Text::CSV doesn't have this feature.
My question. What should I do to simplify solving such tasks in the future for
me and others?
Should I use some Perl module from CPAN, should I try to add this function to
Text::CSV, or something else?
Huh? Why so complicated? First, we fetch the header outside of the loop:
my $headers = $csv->getline($fh) or die "no header";
Assign these to be the column names:
$csv->column_names(#$headers);
Then, each call to getline_hr will provide a hashref:
while (my $hashref = $csv->getline_hr($fh)) {
push #$result, $hashref;
}
We can also use getline_hr_all:
$result = $csv->getline_hr_all($fh);
In other words, it ain't complex, most pieces are already provided by Text::CSV, and it can be done in very few lines.
Also, a module like this seems to already exist: Text::CSV::Slurp. (note: reverse dependency search through metacpan is awesome)
It's probably not a standard feature because different people will want their CSV files parsed into different data structures.
Why not create your own module that wraps this function?
package CSVRead;
use strict;
use warnings;
use 5.010;
use open qw(:std :utf8);
use Text::CSV;
require Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw(read_csv);
sub read_csv {
my ($filename) = #_;
my #first_line;
my $result;
my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1 });
open my $fh, "<:encoding(utf8)", $filename or die "$filename: $!";
while (my $row = $csv->getline ($fh)) {
if (not #first_line) {
#first_line = #{$row};
} else {
push #{$result}, { map { $first_line[$_] => $row->[$_] } 0..$#first_line };
}
}
close $fh;
return $result;
}
Then, use it like this:
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Data::Dumper;
use CSVRead;
my $data = read_csv('sample.csv');
say Dumper $data;
I wrote a script, where i slurp in UTF-8 encoded HTML-file and then parse it to tree with HTML::Tree. Problem is that after parsing the strings are not marked as UTF-8 anymore.
As _utf8_on() is not recommended way to set flag on, i am looking for proper way.
My simplified code-example:
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use utf8::all;
use autodie;
use HTML::Tree;
use Encode qw/is_utf8/;
my $file = shift;
my $tree;
if ($file) {
my $content = slurp_in( 'file' => $file );
$tree = html_tree('content' => $content);
} else {
die "no file";
}
my $title = $tree->look_down(_tag => 'title');
$title = $title->as_HTML('');
if ( is_utf8( $title ) ) {
say "OK: $title";
} else {
say "NOT OK: $title";
}
## SUBS
##
sub slurp_in {
my %v = #_;
open(my $fh, "<:utf8", $v{file}) || die "no $v{file}: $!";
local $/;
my $content = (<$fh>);
close $fh;
if ($content) {
return $content;
} else {
die "no content in $v{file} !";
}
}
sub html_tree {
my %v = #_;
my $tree = HTML::Tree->new();
$tree->utf8_mode(1); ## wrong call here, no such method, but no warnings on it!
$tree->parse( $v{content} );
if ($tree) {
return $tree;
} else {
die "no tree here";
}
}
Your code is overcomplicated, and you employ utf8::all and decode manually and call that strange method all at once. Rhetorically asking, what do you expect to achieve that way? I do not have the patience to find out the details what goes wrong and where, especially since you did not post any input with which your program fails to do the expected, so I drastically reduce it to a much simpler one. This works:
#!/usr/bin/env perl
use 5.010;
use strict;
use warnings FATAL => ':all';
use File::Slurp qw(read_file); # autodies on error
use HTML::Tree qw();
my $file = shift;
die 'no file' unless $file;
my $tree = HTML::Tree->new_from_content(
read_file($file, binmode => ':encoding(UTF-8)')
);
my $title = $tree->look_down(_tag => 'title');
$title->as_HTML(''); # returns a Perl string
I like to use the nifty perl feature where reading from the empty angle operator <> magically gives your program UNIX filter semantics, but I'd like to be able to access this feature through an actual filehandle (or IO::Handle object, or similar), so that I can do things like pass it into subroutines and such. Is there any way to do this?
This question is particularly hard to google, because searching for "angle operator" and "filehandle" just tells me how to read from filehandles using the angle operator.
From perldoc perlvar:
ARGV
The special filehandle that iterates over command-line filenames in #ARGV. Usually written as the null filehandle in the angle operator <>. Note that currently ARGV only has its magical effect within the <> operator; elsewhere it is just a plain filehandle corresponding to the last file opened by <>. In particular, passing \*ARGV as a parameter to a function that expects a filehandle may not cause your function to automatically read the contents of all the files in #ARGV.
I believe that answers all aspects of your question in that "Hate to say it but it won't do what you want" kind of way. What you could do is make functions that take a list of filenames to open, and do this:
sub takes_filenames (#) {
local #ARGV = #_;
// do stuff with <>
}
But that's probably the best you'll be able to manage.
Expanding on Chris Lutz's idea, here is a very rudimentary implementation:
#!/usr/bin/perl
package My::ARGV::Reader;
use strict; use warnings;
use autodie;
use IO::Handle;
use overload
'<>' => \&reader,
'""' => \&argv,
'0+' => \&input_line_number,
;
sub new {
my $class = shift;
my $self = {
names => [ #_ ],
handles => [],
current_file => 0,
};
bless $self => $class;
}
sub reader {
my $self = shift;
return scalar <STDIN> unless #{ $self->{names}};
my $line;
while ( 1 ) {
my $current = $self->{current_file};
return if $current >= #{ $self->{names} };
my $fh = $self->{handles}->[$current];
unless ( $fh ) {
$self->{handles}->[$current] = $fh = $self->open_file;
}
if( eof $fh ) {
close $fh;
$self->{current_file} = $current + 1;
next;
}
$line = <$fh>;
last;
}
return $line;
}
sub open_file {
my $self = shift;
my $name = $self->{names}->[ $self->{current_file} ];
open my $fh, '<', $name;
return $fh;
}
sub argv {
my $self = shift;
my $name = #{$self->{names}}
? $self->{names}->[ $self->{current_file} ]
: '-'
;
return $name;
}
sub input_line_number {
my $self = shift;
my $fh = #{$self->{names}}
? $self->{handles}->[$self->{current_file}]
: \*STDIN
;
return $fh->input_line_number;
}
which can be used as:
package main;
use strict; use warnings;
my $it = My::ARGV::Reader->new(#ARGV);
echo($it);
sub echo {
my ($it) = #_;
printf "[%s:%d]:%s", $it, +$it, $_ while <$it>;
}
Output:
[file1:1]:bye bye
[file1:2]:hello
[file1:3]:thank you
[file1:4]:no translation
[file1:5]:
[file2:1]:chao
[file2:2]:hola
[file2:3]:gracias
[file2:4]:
It looks like this has already been implemented as Iterator::Diamond. Iterator::Diamond also disables the 2-argument-open magic that perl uses when reading <ARGV>. Even better, it supports reading '-' as STDIN, without enabling all the other magic. In fact, I might use it for that purpose just on single files.