Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

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
Moving from scripting to programming
9 direct replies — Read more / Contribute
by whittick
on Oct 28, 2016 at 05:19

    Firstly sorry for the ambiguous title. I have been using Perl for a good few years now, after having taught myself using 'Learning Perl'.

    My question is, how do I move from by basic, procedural scripts to more of a fully fledged, object oriented approach?

    When tasked with a problem I will follow the same format each time, using basic variables, arrays and functions. Yet when I find an existing solution to a problem the code is much more complex.

    I guess what I'm asking is: Is there a recommended text to read after having completed the exercises in 'Learning Perl' that will take me to the next level (somewhere I could start thinking about applying for junior Perl dev roles)?


Can't use an undefined value as an ARRAY reference at ./ line 14.
3 direct replies — Read more / Contribute
by Anonymous Monk
on Oct 27, 2016 at 23:27

    I have a small code like below. I saved this into a file named as: ./

    If we run this code without using the option -libFile like this: -test true
    it writes out the message:
    Can't use an undefined value as an ARRAY reference at ./ line 14.

    How should I initialize $lib on Line 7? I tried setting it to an empty array but it did not help. Kindly help!
    1 #!/usr/bin/perl 2 use strict; 3 use warnings; 4 5 use Getopt::Long; 6 my $test = "true"; 7 my $lib ; 8 9 GetOptions("libFile=s@" => \$lib, 10 "test=s" => \$test, 11 ); 12 13 if($test eq "true") { 14 if( (scalar @$lib) > 0) { 15 print "Pass\n"; 16 } 17 }
moving from mac to PC
3 direct replies — Read more / Contribute
by flieckster
on Oct 27, 2016 at 21:30
    Hey there, simple question but why can't i chdir on PC like i do mac? this throws out errors Can't find string terminator "'" anywhere before EOF at C:\Users\bflieck\Desktop \ line 12. Press any key to continue . . .
    #!/usr/bin/env perl use File::Find; use File::Copy; use Net::SMTP; use File::Basename; use File::Slurp; use POSIX qw(strftime); my $date = strftime("%m-%d-%y",localtime); my $time = strftime("%I:%M:%S",localtime); my $findme = '\photorepos\Perl\Mother\WorkLoad\'; chdir($findme) or warn "$!";
using perl to get sms messages
4 direct replies — Read more / Contribute
by Datz_cozee75
on Oct 26, 2016 at 17:54

    Hello Monks,

    Is there a perl way to get the sms messages off my phone? If it matters, I have a $69 Blu android that I regret buying as the internal storage was quite simply fraudulently-advertised at 4 gigs. It is 2 gigs, and with OS loaded, 1. (What did I expect for seventy bucks?)

    Anyways, I've got someone who's trying to put the squeeze on me and appears not to know why that isn't a good idea. Are there other software tools for this purpose? Thank you for your comment.

fork(): terminating the child without killing the parent
3 direct replies — Read more / Contribute
by Bloehdian
on Oct 25, 2016 at 20:25

    Hello Monks,

    I wrote a test application in which the process is forked. The resulting parent process sends a message continuously via pipe using syswrite to the child.

    I installed a signal handler in the parent for signal SIGHUP, so that I can "advice" the parent from the command line to terminate the child (on sending SIGHUP to the parent process). At least I try to do this.

    Here is the code:

    use strict; use warnings; use Errno qw( EWOULDBLOCK ) ; my $from_parent; my $to_child; my $pid; my $mesg_parent = "Hello Child!"; my $mesg_child; my $test; pipe( $from_parent, $to_child ); if ( $pid = fork() ) { # Parent $SIG{ HUP } = sub{ kill( 15 , $pid ); print( "KILLED CHILD!!!\n" ) +}; close( $from_parent ); while ( 1 ) { eval{ $test = syswrite( $to_child, $mesg_parent, length( $mesg_p +arent ) ); }; select( undef, undef, undef, .5); if ( $@ ) { print( "trapped error when writing to pipe \$to_child_ssl\n" +); next; } if ( defined $test ) { print( "Sent message \"$mesg_parent\" to child\n" ); } } } else { # Child close( $to_child ); while ( 1 ) { $test = sysread( $from_parent, $mesg_child, 13 ); select( undef, undef, undef, .5 ); if ( ! defined $test ) { if ( $! == EWOULDBLOCK ) { print( "sysread would be blocked by \$from_parent: $!\n" ) +; next; } else { die ( "Error when trying to read from \$from_parent: $!\n" + ); } } print( "In child\n" ); print( $mesg_child . "\n" ); $mesg_child =~ s/Child/Parent/; print $mesg_child . "\n"; } }

    When I run the script and execute

    kill -1 <pid>

    in a different terminal window with <pid> being the parent process's PID than the final output is as follows:

    Sent message "Hello Child!" to child In child Hello Child! Hello Parent! Sent message "Hello Child!" to child In child Hello Child! Hello Parent! KILLED CHILD!!! Sent message "Hello Child!" to child Sent message "Hello Child!" to child xyz@v32470:~/projekte/$

    i.e., not only the child┤, but the parent as well is terminated.

    If I use

    kill 1 <pid>

    then obviously only the parent process is killed, the child continues to run:

    In child Hello Child! Hello Parent! Terminated xyz@v32470:~/projekte$ In child Hello Child! Hello Parent! In child In child In child In child

    The kill command comes back with an error message btw:

    xyz@v32470:~$ kill 1 31055 -bash: kill: (1) - Operation not permitted

    How can this behaviour explained and how could I reach that only the child is killed by the parent and the parent continues to work?

    The backgroud: I want to use this code as the basis for a script in which the parent checks whether the child is still running by sending messages via pipe to the child and checks the response (i.e., in the final version the communication would be bidirectional).

    Is this feasible using this approach at all?

    From my ┤point of view it boils down to the qestion whether I could trap an error as indicated in the script when trying to syswrite() to the Řipe after the child passed away. Is this possible?

    Cheers Bloehdian
Syntax Question Related to "join" on a Complex Data Structure
2 direct replies — Read more / Contribute
by perldigious
on Oct 25, 2016 at 17:12

    Due to my own programming vocabulary deficiencies, poor Google foo, or both I'm unable to search effectively for an answer to this syntax question. Sparing what I hope is unnecessary detail, I have in the past done the following and was amazed (not for the first time) that Perl let me do this and furthermore did exactly what I wanted.

    my $sales_line = join "\t", @data[@sales_indexes{@sales_columns}];

    Where I use the @sales_columns array to give me a hash slice of %sales_indexes (using @ instead of % for a list) which I use to take an array slice of @data, join it with tabs, and then store the result as the $sales_line string. Yeah... I think I said that all correctly. When this worked it was one of those, "damn I love Perl" moments for me. I often physically walk over to the only other Perl user I know and say exactly that whenever they happen.

    Which brings me to my question, because it's somewhat similar, and it's a rare case of Perl not understanding what I meant and/or doing what I wanted, and I'm hoping the error is mine and I just have the exact syntax wrong. I tried the following which gives a syntax error.

    my $transcripts_line = join "\t", @transcripts{$transcript_ip}{$transcript_id}{@transcripts_columns};

    Where %transcripts is a 3D hash that I'm trying to use the same up front @ instead of % trick to get the value list I want from the hash slice that I was hoping would be provided by the @transcripts_columns array ($transcript_ip and $transcript_id are simple scalars). I attempted the below as well, which doesn't give a syntax error, but doesn't work as expected either.

    my $transcripts_line = join "\t", ($transcripts{$transcript_ip}{$transcript_id}{@transcripts_columns});

    The way I did solve my problem was as follows.

    my $transcripts_line = join "\t", map {$transcripts{$transcript_ip}{$transcript_id}{$_}} @transcripts_columns;

    Which is fine, but... the first line of code I gave that worked was just so, well... succinct and pretty. :-)

    As I said, I'm hoping I've just messed up the syntax with what I originally tried and I don't actually have to resort to the map inside of a join to make this work.

    Any thoughts from the monastery?

    I love it when things get difficult; after all, difficult pays the mortgage. - Dr. Keith Whites
    I hate it when things get difficult, so I'll just sell my house and rent cheap instead. - perldigious
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.
2 direct replies — 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!

New Meditations
RFC: Shortening line length in HTML Emails
1 direct reply — Read more / Contribute
by LanX
on Oct 27, 2016 at 12:02

    My team is using TinyMCE in a web-application to create templates for HTML emails. (not my idea)

    We've been confronted with strange errors where whitespaces occasionally where introduced in the middle of the emails after sending.

    This was particularly ugly b/c sometimes HTML tags where broken, like in </sp an>

    A closer investigation revealed that by RFC lines in Emails are not allowed to have more than 1000 characters (only fair) and that TinyMCE sometimes tended to glue HTML code into one "physical" line, especially when

    • "visual" lines where separated by <br> tags
    • or when the text was introduced by cut&paste from other applications.
    So I need a pragmatic solution to avoid such "monster" lines after editing an email text.

    I came up with the following idea, which should be as safe as possible without starting to parse HTML

    1. prepend a \n before every <br> tag
    2. if overlong unbroken text-chunks remain, replace the last blank with a \n
    3. return an error to the user if the later fails
    The idea is to change a minimal amount of HTML code in a transparent way.

    (I suppose that <pre> -tags are not used with monster lines and that the inner code of HTML and CSS doesn't distinguish if a whitespace is a blank or a line-break)

    That's the code I came up with, comments are welcome! :)

    use strict; use warnings; use Data::Dump qw/pp dd/; my $body = <<'__HTML__'; <br /><br/><br><break> asdfghjk rtz ertzuiop rtzuiopu rtzuiop tzuiopu rtghljh AaaaaaaaaaaaaaABbbbbbbbbbbbbbbB __HTML__ #pp $body; my $err = FC012_shorten_lines_mail_body(\$body); #pp $body; print $err,$body; sub FC012_shorten_lines_mail_body { my ($body_ref) = @_; my $err = undef; # callback with closure for error my $replace_last_whitespace = sub { my ($chunk) = @_; # dd "CHUNK: $chunk"; my $ok = $chunk =~ s/ ([^\s]*)$/\n$1/; unless ($ok) { my $snip_length = 4; # for testing, should be 40 my $start_chunk = substr ($chunk,0,$snip_length); my $end_chunk = substr ($chunk,-$snip_length,$snip_length); $err .= "Failed to shorten chunk >>$start_chunk...$end_chunk< +<\n"; } return $chunk; }; # --- prepend all <br>-tags with real linebreak $$body_ref =~ s#(<br[ />])#\n$1#g; # --- find all reamining chunks in one line and # replace last whitespace with \n my $length = 15; # for testing, should be 998 $$body_ref =~ s/([^\n]{$length})/ $replace_last_whitespace->($1) /g +e; # --- return potential error message return $err ; }


    Failed to shorten chunk >>Aaaa...aaaA<< Failed to shorten chunk >>Bbbb...bbbb<< <br /> <br/> <br><break> asdfghjk rtz ertzuiop rtzuiopu rtzuiop tzuiopu rtghljh AaaaaaaaaaaaaaABbbbbbbbbbbbbbbB

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

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();
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 surveying the Monastery: (11)
As of 2016-10-28 16:15 GMT
Find Nodes?
    Voting Booth?
    How many different varieties (color, size, etc) of socks do you have in your sock drawer?

    Results (386 votes). Check out past polls.