Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Devel::Size reports different size after hash access
4 direct replies — Read more / Contribute
by Cristoforo
on Oct 25, 2016 at 15:40
    While working on a problem, I came across something I couldn't explain.

    When asking for the size of a newly created hash, it gave me one size. But after accessing the hash, it gave a size almost 50% larger.

    #!/usr/bin/perl use strict; use warnings; use Devel::Size 'total_size'; my $s = 'AAAAAAAAAAAAAAA'; my %hash = map {$s++ => 1} 1 .. 1000; print total_size(\%hash). ' ' . keys(%hash) . "\n"; open my $fh, '>', 'j1.txt' or die $!; for my $key (keys %hash) { print $fh "$key $hash{$key}\n"; } print total_size(\%hash). ' ' . keys(%hash) . "\n";
    The results of running this code was:
    105248 1000 145288 1000

    I'm using perl version 5.014 and the version of Devel::Size is .08.

If line matches, print column, else print file name
2 direct replies — Read more / Contribute
by Yakup
on Oct 25, 2016 at 14:05

    Hello everyone. I had used Perl a little bit long time ago and now I'm trying to write a little program, but I have got stuck. I would like to check bunch of kickstart files for a '--hostname=' pattern. If it matches I want to get the collumn right after it (actual hostname). Else it should take the name of the file (stripped of '.ks' suffix) and save all of them to the array. Commented lines should not be taken. This is how I have done it in bash + awk

    #!/bin/env bash declare -a hostlist=$(grep -P '(?<!#)--hostname' *.ks | awk -F'=' '{pr +int $2}') declare -a not_predefined_hosts=$(grep -L "\-\-hostname" *.ks | cut -d +\. -f1 ) declare -a commented=$(grep -l ".*#.*\-\-hostname" *.ks | cut -d\. -f1 + ) for host in "${not_predefined_hosts[@]}" do hostlist+="$host" done for host in "${commented[@]}" do hostlist+="$host" done

    This works, but when I want to do it with perl, I get multiple issues.

    #!/usr/bin/env perl use strict; use warnings; use File::Basename; my $lab_root = dirname $0; opendir( DH, $lab_root) or die "Cannot open $lab_root: $!\n"; my @kickstarts = grep ( /\.ks$/, readdir(DH)); my @bsname ; my $hostname; for my $kickstart (@kickstarts) { my $name = (split /\./)[0], $kickstart; open my $fh, $kickstart or die "Cannot open $kickstart: $!"; while (<$fh>) { chomp; my @fields = split /=/; if ( $fields[0] eq '--hostname') { $hostname = $fields[1]; print "$hostname\n"; push @bsname , $hostname; }else { $hostname = $name; print "$hostname\n"; push @bsname , $hostname; } close $fh; } }

    First, I get the warnings

    Provisioner]$ ./ Useless use of private variable in void context at ./ line + 13. Use of uninitialized value $_ in split at ./ line 13. Use of uninitialized value $hostname in concatenation (.) or string at + ./ line 24, <$fh> line 1. readline() on closed filehandle $fh at ./ line 27. Use of uninitialized value $_ in split at ./ line 13. readline() on closed filehandle $fh at ./ line 27. Use of uninitialized value $_ in split at ./ line 13. Use of uninitialized value $hostname in concatenation (.) or string at + ./ line 24, <$fh> line 1. readline() on closed filehandle $fh at ./ line 27. Use of uninitialized value $_ in split at ./ line 13. Use of uninitialized value $fields[0] in string eq at ./ l +ine 18, <$fh> line 1. Use of uninitialized value $hostname in concatenation (.) or string at + ./ line 24, <$fh> line 1. readline() on closed filehandle $fh at ./ line 27.

    I don't understand why I'm getting "Use of uninitialized value" warnings, when I initialize all variables with "my" beforehand. Also, why does the filehandle "$fh" close before the close statement? And what the "Useless use of private variable in void context" mean? All examples I was able to google on it were very different from my code and didn't help me to understand that.

    Second, when the code runs,( with added 'print @bsname;' ) it matches only once (but strangely prints twice). There are multiple kickstart files with "--hostname" directive in it, but it ignores the rest. Also the "else" part doesn't work (none of the file names are matched).

    [################### Provisioner]$ ./[################### Provisioner]$

    Can somebody please point out mistake in my code? I'm sure it will be something trivial, but I can't wrap my head around it. Thanks!

IPC::Run command is correctly constructed but does not have effect
1 direct reply — Read more / Contribute
by byrnejb
on Oct 25, 2016 at 12:55

    I am hacking at an old perl scrip that is used to generate and maintain a private CA. The script contains this code:

    . . . use IPC::Run qw( start pump finish timeout new_appender new_chunker); . . . sub cmd { my $self = shift; my $cmd = shift; my $cmdline = shift; my $args = shift; my $conf; my $cfgcmd; if ( (grep $_ eq $cmd,qw(req ca)) && !$args->{noconfig}) { $conf = $self->{csp}->writeConfig($cmd,$args); $self->{csp}->die("Unable to write configuration file") unless -f $c +onf; $cfgcmd = " -config $conf "; } elsif ($cmd eq 'x509' && !$args->{noconfig}) { $conf = $self->{csp}->writeConfig($cmd,$args); $self->{csp}->die("Unable to write configuration file") unless -f $c +onf; $cfgcmd = " -extfile $conf -extensions extensions "; } $cmd = '' if $cmd eq 'dummy'; ${$self->{_in}} = "$cmd $cfgcmd $cmdline"; if ($ENV{CSPDEBUG}) { $self->warn("Here I am"); $self->warn("# openssl $cmd $cfgcmd $cmdline\n"); } $self->{_handle}->pump while length ${$self->{_in}}; $self->{_handle}->finish; . . .
    When I run this command
    csp CA_HLL_ROOT_2016 init --verbose --type=root --keysize=4096 --days= +7317 --dige +st=sha512 "CN=CA_HLL_ROOT_2016,OU=Networked Data Services,O=Harte & L +yne Limited,L=Hamilton,ST=Ontario,C=CA,DC=harte-lyne,DC=ca"
    then I get this result:
    [CSP][ ] Here I am [CSP][ ] # openssl genrsa -des3 -passout pass:'test me' -out / +home/byrnejb/Projects/Software/rcsp/ca_test_a/csp/CA_HLL_ROOT_2016/pr +ivate/ca.key 4096 [CSP][ ] Here I am [CSP][ ] # openssl req -config /home/byrnejb/Projects/Software +/rcsp/ca_test_a/csp/CA_HLL_ROOT_2016/tmp/csp-32489.conf -x509 -sha51 +2 -days 7317 -key /home/byrnejb/Projects/Software/rcsp/ca_test_a/csp +/CA_HLL_ROOT_2016/private/ca.key -passin pass:'test me' -new -out /ho +me/byrnejb/Projects/Software/rcsp/ca_test_a/csp/CA_HLL_ROOT_2016/ca.c +rt

    There are no errors but the files specified in the command lines are not created. If I copy and paste the command lines that are output from the warn statements then the files are created without problem.

    I have zero experience with Perl. Well, not quite zero any more but not much. Is there something obvious that I am missing here? The entire project is available on github at if more context is desired.

Packaging Libraries before deploying my Scripts.
1 direct reply — Read more / Contribute
by ArunMKumar
on Oct 25, 2016 at 07:02
    Namaste Monks.. I have written a set of scripts, on a local system (my laptop) The work fine here.
    Now My scripts are required to be deployed in remote system(s) and the thing I am worried about is the availability and the installation of the Libraries that I have used.
    The 2 Libraries that are currently in use are "XML::LibXML" and "Spreadsheet::ParseExcel".
    I have this idea where I will put them in a "lib" directory in the same project Directory, and the scripts will refer from them. My questions are as follows.
    I have installed them in a directory, using the commands as follows from the extracted tar files.

    perl Makefile.Pl
    make test
    make install PREFIX=<path_to_lib> LIB=<path_to_lib>

    I also see the .pm files being populated in various tree structures in that lib directory.
    My question now is , How do i force my scripts to reference this lib directory when It wants to look for the modules?
    I am new to perl, from what I searched online I think it has to do with modifying @INC variable, while some solutions say about explicitly including these versions of the library (which I have no clue, as those post included their own perl modules).
    so.. How do i force my scripts to use these libraries exclusively, and not throw an error when i deploy them to different systems (all Linux systems with perl 5 or above for sure).
heredoc and Carriage return
4 direct replies — Read more / Contribute
by gabrielsousa
on Oct 25, 2016 at 05:18

    heredoc read the LF ( \n ) , but dont parse / stores the Carriage return ( \r )

    how can i force heredoc to read and store carriers return ( \r ) ?

    =====================added before======================

    i have a pdf file / binary inside my perl script using heredoc
    has 40 Carriage returns, i can search on VI, i see the ^M
    but when i print to a file i lose all Carriage returns..
    i'm assuming is a problem of heredoc
Detecting stale pid file under *nix
4 direct replies — Read more / Contribute
by Dallaylaen
on Oct 24, 2016 at 17:36

    This is more of a Unix question rather than a Perl one, but still...

    I'm looking for a way to stop my daemon, but I don't want to terminate an innocent bystander process. I came up with idea that PID file is created after the process has been spawned. Therefore, it's not older then the process, so the following code was written which seems to work correctly on my Ubuntu:

    open (my $fd, "<", $conf->{pidfile}) or die "Failed to read pidfile $conf->{pidfile}: $!"; my $pid = <$fd>; chomp $pid; die "Broken pid file $conf->{pidfile}" unless $pid =~ /^\d+$/; # detect stale pid if ([stat $fd]->[9] >= ([stat "/proc/$pid"]->[9] || 9**9**9)) { print "Killing pid $pid...\n"; kill INT => $pid; };

    Of course, it can still be tricked by touching the pid file, but then it's also possible to write rubbish into the pid file anyway.

    Now I would like to ask what is the proper way of avoiding sending signal to a wrong process? CPAN has a multitude of modules for PID file handling, I was unable to choose one.

    Thank you!

Default import function
4 direct replies — Read more / Contribute
by Athanasius
on Oct 24, 2016 at 02:17

    According to the documentation for import:

    There is no builtin import function. It is just an ordinary method (subroutine) defined (or inherited) by modules that wish to export names to another module. The use function calls the import method for the package used.

    However, when I create an empty module (file “”):

    package MyMod; 1;

    and print out its symbol table (file “”):

    use strict; use warnings; use Data::Dump; use MyMod; dd \%MyMod::;

    the output shows that an import function is already present:

    16:10 >perl { import => *MyMod::import } 16:10 >

    Where does it come from? Is the documentation incorrect, or am I simply misreading it?


    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

XML::LibXML drives me to drinking
4 direct replies — Read more / Contribute
by tunafish
on Oct 22, 2016 at 19:37

    I'm trying to figure out XML::LibXML. It's rough going. I need to be able to access the text content of a node by name. Here is my code:

    #!/usr/bin/perl use strict; use XML::LibXML; my $string = qq~<?xml version="1.0"?> <ItemLookupResponse xmlns=" +ervice/2013-08-01"> <Items> <Item> <ASIN>B01KI4JSQY</ASIN> </Item> </Items> </ItemLookupResponse> ~; my $parser = XML::LibXML->new->load_xml(string => $string, {no_blanks +=> 1}); my $xml = XML::LibXML::XPathContext->new($parser); $xml->registerNs('x', ' +ce/2013-08-01'); # Parse items foreach my $item ($xml->findnodes('/x:ItemLookupResponse/x:Items/x:Ite +m', $parser)){ print $item->firstChild->nodeName, "\n"; print $item->firstChild->toString, "\n"; print $item->findvalue('ASIN'), "\n"; print $item->findvalue('./ASIN'), "\n"; print $item->findvalue('./ASIN', $item), "\n"; }

    Expected result:


    Actual result:


    Probably I'm just misunderstanding something in the docs. But I don't know what it is. I tried $item->findvalue('x:ASIN'), but that threw an error. Please help. I have a family. If I become an alcoholic, they will suffer.

Shortening paths for display
1 direct reply — Read more / Contribute
by morelenmir
on Oct 22, 2016 at 17:08

    There used to be an undocumented win32 function called 'PathSetDlgItemPath'. This allowed you to set the text of a windows control to a file or folder path, automatically editing what was displayed to fit inside the available client area. It did this where necessary by shortening the path using '...' ellipsis characters.

    I wondered if there was anything similar for perl? I guess, rather than the size of a windows control it would need to be told the maximum number of characters you wanted to display.

    "Aure Entuluva!" - Hurin Thalion at the Nirnaeth Arnoediad.
Adding a database table using DBIx::Class
1 direct reply — Read more / Contribute
by davies
on Oct 22, 2016 at 08:01

    tl;dr: Are there any docs that actually show a simple example of creating a table with DBIC, whether from SQL (which I know I know how to write) or a DBIC class module (which I think I know how to write)? If not, would any kind monk please give me such an example?

    TIA & Regards,

    John Davies

How to concatenate utf8 safely?
3 direct replies — Read more / Contribute
by gregor42
on Oct 21, 2016 at 10:22

    I am humbled and seeking help.

    This concerns data containing names so getting it Right is important.

    It is likely that I am fundamentally missing something when it comes to safely concatenating strings.

    A hand-rolled point solution sometimes works as intended and others times results in the dreaded:

    Wide character in syswrite

    I assume that the problem is my code and not the data coming in since one can usually depend on people to get their own names right.. But then i18n characters are tricksy, like Hobbits...

    sub jibe { my($s,$t) = @_; my $r = join('', (is_utf8($s)?$s:decode('utf8',$s)), (is_utf8($t)?$t +:decode('utf8',$t))); return $r; }

    To give it context, let's say that we are creating common name from given name plus surname: (Anglo-centric, I know...)

    my $cn = jibe(jibe($givenname," "),$sn);

    Thank you in advance for any nudges in the right direction that anyone might provide.

    Wait! This isn't a Parachute, this is a Backpack!
Get latest file created or modified & matching part of file name :
1 direct reply — Read more / Contribute
by rahulme81
on Oct 21, 2016 at 09:49

    Hello Monks

    I have a directory with a bunch of files. I'm trying to find the latest file created or modified by time in a directory and using the following pattern

    opendir(my $DIRH, $DIR) or die "Error opening $DIR: $!"; my @files = map { [ stat "$DIR/$_", $_ ] } grep( ! /^\.\.?$/, readdir( $DIRH ) ); #This find me +all files not have dot in directory #How this grep can be accommodate for my regular expre +ssion ????? closedir($DIRH); sub latestFile { $b->[0]->ctime <=> $a->[0]->ctime } my @latest_files = sort latestFile @files; my @latest = @{$latest_files[0]}; my $name = pop(@latest); print "Latest file created fro $name\n";

    This is giving the latest file in the directory, but not the file which i need as per my regular expression.

    I need to parse the file and do something, which eventually I am able to achieve

    Facing difficulty with file name pattern match and get the latest file

New Meditations
Testing Dancer applications with a custom database
No replies — Read more | Post response
by Corion
on Oct 24, 2016 at 13:10

    While developing a plugin for Dancer as a wrapper around one of my modules, I wanted to unit test my code using a mock database instead of the database I do interactive tests with. Surprisingly, I didn't find documentation on how to supply Dancer::Plugin::Database with your own test database.

    After some reading through the test suite of Dancer::Plugin::Database, it seems that the magic is in overwriting the configuration at the right time. To give this approach a broader exposure and to maybe invite some comments or better suggestions, let's look through the code:

    In the prelude, we load Dancer, Dancer::Test and the application I'm writing, tentatively named mychat. We plan for three tests:

    #!perl -w use strict; use warnings; use Test::More import => ['!pass']; use Data::Dumper; use Dancer ':syntax'; use DBIx::RunSQL; use Dancer::Plugin::Database; # the order is important use mychat; use Dancer::Test; plan tests => 3;

    Then, we set up our own in-memory database and create all tables and triggers from the SQL file stored in sql/create.sql. This gives us a pristine database that contains only initial data.

    # set up our own database instead of whatever is in the config my $conf = { Database => { dsn => 'dbi:SQLite:dbname=:memory:', connection_check_threshold => 0.1, sqlite_unicode => 1, dbi_params => { RaiseError => 0, PrintError => 0, PrintWarn => 0, }, }, }; set plugins => $conf; # Set up a fresh instance my $dbh = database; $dbh = DBIx::RunSQL->create( dbh => $dbh, sql => 'sql/create.sql', );

    Since what I really want to test is whether image upload and retrieval works, let's fake a PNG image and "upload" it into the application:

    my $payload = join '', "\x89", 'PNG', "\x0d\x0a", "\x1a", "\x0a", (map { chr($_) x (1024 * 256) } 1..3) ; # Insert image into database my $upload = Dancer::Request::Upload->new( filename => 'test.png', tempname => 'test2.png', size => length($payload), headers => { 'Content-Type' => 'image/png', }, ); # Insert into DB my $content = mychat::UserContent->store( config->{image_store}, $dbh, $upload, { extension => 'png', content_type => 'image/png', }, $payload );

    After all this setup, we can now run three tests as if we had a standard Dancer application and can check that URLs exist where we expect them and that we get the appropriate content from each URL:

    ok $content, "We successfully saved the user content"; route_exists(['GET', '/image_store/'], "We find /image_store/fo"); # Check that we can access it through /image_store/sha1.jpg my $name = $content->{digest} . ".png"; response_status_is ['GET',"/image_store/$name"], 200, "GET '/image_sto +re/$name' succeeds" or diag Dumper read_logs();
New Cool Uses for Perl
extracting strings from non-text files
1 direct reply — Read more / Contribute
by RonW
on Oct 20, 2016 at 21:09

    A coworker (on MS Windows) was cursing he couldn't see what symbol names might be hidden in a non-text configuration file for a proprietary, 3rd party tool he has to use. Since I didn't want to risk being constantly asked to "dump symbols" using my Lunix system, I took a few minutes to write the following program in Perl. Made him happy (for now, at least).

    Note: The tool being used only supports ASCII characters, so I didn't bother with encodings. Probably didn't need to specify ":bytes" in the open statement, but no harm in doing so.

    Maybe others will find this useful.

    #!perl use 5.010_000; use warnings; use strict; if ((@ARGV < 1)) { $0 =~ m#([^\\/]+$)#; my $name = $1 // $0; print STDERR "$name file ...\n" . <<'_DESCRIPTION_'; Extract ASCII strings from files listed. Multiple files allowed. _DESCRIPTION_ exit 1; } for my $file (@ARGV) { open my $fh, '<:bytes', $file or die "Error: Can't open '$file': $ +!\n"; my $buf; while (read $fh, $buf, 1024) { my @strings = split /\P{PosixGraph}/, $buf; for (@strings) { next if /^\s*$/; print "$_\n"; } } }
Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (6)
As of 2016-10-26 21:46 GMT
Find Nodes?
    Voting Booth?
    How many different varieties (color, size, etc) of socks do you have in your sock drawer?

    Results (350 votes). Check out past polls.