If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
More concise way to write these accessors?
2 direct replies — Read more / Contribute
by stevieb
on Jun 24, 2016 at 23:51

    Reviewing some of my code, and I'm wondering if and how the Monks would write these rw accessors to make them more concise (ie. more compact, without using external modules). Bonus points for a solution that uses a single routine to cover both, but is easy to an experienced Perl dev to look at in six months and immediately identify without any question what's happening.

    sub ip { my ($self, $ip) = @_; return $self->{ip} if $self->{ip}; if (! $ip && $self->{conf}{ip}){ $ip = $self->{conf}{ip}; } $ip = '0.0.0.0' if ! $ip; $self->{ip} = $ip; } sub port { my ($self, $port) = @_; return $self->{port} if $self->{port}; if (! $port && $self->{conf}{port}){ $port = $self->{conf}{port}; } $port = '7800' if ! defined $port; $self->{port} = $port; }

    {conf} is simply an element from an ini-style config file, which may not be available, and that would make the statement untrue.

    I'm taking off camping in the mountains in the AM, so I'll review any replies when I return on Monday.

Clever optimisation: by design or luck?
2 direct replies — Read more / Contribute
by BrowserUk
on Jun 24, 2016 at 19:38

    I'm a big fan of 'constant functions' and pragmas (constant & enum) that create them for reasons, the knowledge of which seems to have become lost to the current generation of perlers; and is completely lost on the authors and proponents of the newer modules, like Readonly, that are billed as (very poor) substitutes for them.

    I was working on my answer to syphilis' question in Re^3: unintentional conversion of signaling NaN to quiet NaN and thought to make a SNaN constant; and did, but I was testing it when I discovered something that is either very clever design; or simply a really cool bit of luck. I'm not sure which?

    I implemented the constant very simply as:

    use constant SNaN => unpack 'd',pack 'Q', 0x7ff0000000000001;

    But how could I be sure that it was being properly reduced to a constant value?

    With an integer constant it is quite simple with B::Deparse:

    C:\test>perl -MO=Deparse -le"use enum qw[false true]; print 'fred' if +false; print 'bill' if true" use enum ('false', 'true'); '???'; print 'bill'; -e syntax OK

    Sure enough, true & false have been defined as constant subs producing 1 & 0 respectively, and Perl has used their constant nature to optimise the code so that the entire print 'fred' if false; part of the program has been optimised away as it can never be executed. Likewise, the ... if true; has been optimised away since it can never be false. (Try that with Readonly :)

    This also works with expressions that yield a constant value:

    C:\test>perl -MO=Deparse -le"sub PI(){ 2*atan2(1,0) }; print PI; if( P +I == PI ) { print 'Here'; }" BEGIN { $/ = "\n"; $\ = "\n"; } sub PI () { 3.1415926535897931 } print 3.1415926535897931; do { print 'Here' }; -e syntax OK

    The expression has been evaluated to a constant, a constant function created. And notably, the optimiser recognises that constant == constant is always(*) true, and the if condition has been optimised away.

    But this one really impressed me;

    C:\test>perl -MO=Deparse -le"use constant SNaN => unpack'd', pack'Q',0 +x7ff0000000000001; print SNaN; if( SNaN != SNaN ) { print 'here'; }" BEGIN { $/ = "\n"; $\ = "\n"; } use constant ('SNaN', unpack('d', pack('Q', 9218868437227405313))); print unpack("F", pack("h*", "1000000000000ff7")); do { print 'here' }; -e syntax OK C:\test>perl -MO=Deparse -le"use constant SNaN => unpack'd', pack'Q', +0x7ff0000000000001; print SNaN; if( SNaN == SNaN ) { print 'here'; }" BEGIN { $/ = "\n"; $\ = "\n"; } use constant ('SNaN', unpack('d', pack('Q', 9218868437227405313))); print unpack("F", pack("h*", "1000000000000ff7")); '???'; -e syntax OK

    At first glance some will be surprised that it is the body of the equal (==) comparison that has been optimised away completely and the body of the unequal (!=) comparison that has been left behind but that isn't what impressed me. What did is this:

    1. At first I was a little disappointed to see that the unpack,pack, 'constant string' hadn't been reduced to a simple floating point constant the way 2*atan(1,0) above was.

      But then I realised that there isn't a floating point constant that can be embedded as source code that will translate to SNAN. That's why I need to use pack/unpack to define it.

    2. But the real surprise was that the optimiser recognised that SNaN == SNaN is the (*)one time when constant == constant is false!

      And then performs the appropriate optimisation; the inverse to the normal case.

    So I wonder, is this special cased in the interpreter? A product of thorough, good design? Or simply fortuitous?

    I did start to explore the source, but quickly got lost. Anyone know?


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I knew I was on the right track :)
    In the absence of evidence, opinion is indistinguishable from prejudice. Not understood.
Error in mime::LIte
2 direct replies — Read more / Contribute
by Anonymous Monk
on Jun 24, 2016 at 12:40

    Hi,

    I am getting below error, while trying mime::lite in my local.

    error:

    'sendmail' is not recognized as an internal or external command, operable program or batch file.

    The below is simple code :

    #!C:\perl\bin\perl.exe -w use FindBin; use lib "$FindBin::Bin/.."; use lib "c:\\perl\\site\\lib"; use strict; use warnings; use MIME::Lite; my @body=('test'); my $to = 'sou@rediffmail.com'; my $from = 'sou@rediffmail.com'; my $subject = 'Test Email'; my $message = 'This is test email sent by Perl Script'; my $msg = MIME::Lite->new( From => $from, To => $to, Subject => $subject, Data => $message ); $msg->send();

    any one help me in this?

Using map to populate array in for loop
1 direct reply — Read more / Contribute
by stroke
on Jun 24, 2016 at 10:47

    Trying to get a list of IP addresses from some defined IP ranges. Having found "a line of code" to enumerate each IP in the range and populate an array, I've found this doesn't work as I'd hope - only the IPs from the last range are in the array.

    Problem is that I don't really understand exactly what the inet_aton line is doing well enough to work out how to fix it - the peril of copying code, I guess!

    #!/usr/bin/env perl use strict; use warnings; use Data::Dumper; use 5.010; use Socket 'inet_aton'; my @ips; my @ranges = qw( 192.168.1.10-192.168.1.20 192.168.1.30-192.168.1.40 ); for my $range ( @ranges ) { my ( $start, $end ) = split /-/, $range; say "Found RANGE: $start - $end"; # Get each IP in the range @ips = map { sprintf "%vi", pack "N", $_ } unpack("N",inet_aton($s +tart)) .. unpack("N",inet_aton($end)); #print Dumper(@ips); # prints all IPs } print Dumper(@ips); # prints only last range of IPs # Do stuff with each IP ...

    Output from Dumper inside the for loop looks good:

    Found RANGE: 192.168.1.10 - 192.168.1.20 $VAR1 = '192.168.1.10'; $VAR2 = '192.168.1.11'; $VAR3 = '192.168.1.12'; $VAR4 = '192.168.1.13'; $VAR5 = '192.168.1.14'; $VAR6 = '192.168.1.15'; $VAR7 = '192.168.1.16'; $VAR8 = '192.168.1.17'; $VAR9 = '192.168.1.18'; $VAR10 = '192.168.1.19'; $VAR11 = '192.168.1.20'; Found RANGE: 192.168.1.30 - 192.168.1.40 $VAR1 = '192.168.1.30'; $VAR2 = '192.168.1.31'; $VAR3 = '192.168.1.32'; $VAR4 = '192.168.1.33'; $VAR5 = '192.168.1.34'; $VAR6 = '192.168.1.35'; $VAR7 = '192.168.1.36'; $VAR8 = '192.168.1.37'; $VAR9 = '192.168.1.38'; $VAR10 = '192.168.1.39'; $VAR11 = '192.168.1.40';

    Outside, not so - the array only has the last range IPs

    Found RANGE: 192.168.1.10 - 192.168.1.20 Found RANGE: 192.168.1.30 - 192.168.1.40 $VAR1 = '192.168.1.30'; $VAR2 = '192.168.1.31'; $VAR3 = '192.168.1.32'; $VAR4 = '192.168.1.33'; $VAR5 = '192.168.1.34'; $VAR6 = '192.168.1.35'; $VAR7 = '192.168.1.36'; $VAR8 = '192.168.1.37'; $VAR9 = '192.168.1.38'; $VAR10 = '192.168.1.39'; $VAR11 = '192.168.1.40';

    Thanks

How to change colour of a Tkx button when pressed
1 direct reply — Read more / Contribute
by PerlCowboy
on Jun 24, 2016 at 10:32

    Hey there PerlMonks! Almost got it, but one thing I'm having issues with is I am trying to change the color of a button once it is pressed. I currently have a series of 18 buttons using the Tkx module and am wondering how I could change the color of a button once it is pressed. I know it's on the command line, but can you have two commands on a button? My code is listed below.

    use strict; use warnings; use Tkx; open(INFILE,"d1528235.txt") or die "could not open file for reading!\n +"; open(OUTFILE, '>forecast.txt') or die "Cannot open forecast.txt: $!"; while(<INFILE>){ if (m/^\s*$/) { next; } chomp $_; my @fields = split(/\ /,$_); my @output; foreach my $field(@fields){ if($field =~ /^\*?[ABMQRWY][A-Z0-9]{4}235 / ){ push @output,$field; } # print OUTFILE "$_\n"; } if (@output) { my $line = join('',@output); print "$line\n"; print OUTFILE "$line\n"; } } my $mw = Tkx::widget->new("."); $mw->g_wm_title("Jobs Not Forecasted"); $mw->g_wm_minsize(200, 200); Tkx::button(".b", -text => "18-Letters", -width => 11, -command => sub { print OUTFILE "18L\n"; -background =>'red'}, ); Tkx::pack(".b"); Tkx::button(".c", -text => "07-Orders", -width => 11, -command => sub { print OUTFILE "07O\n";}, ); Tkx::pack(".c"); Tkx::button(".d", -text => "36-Letters", -width => 11, -command => sub { print OUTFILE "36L\n";}, ); Tkx::pack(".d"); Tkx::button(".e", -text => "38-Letters", -width => 11, -command => sub { print OUTFILE "38L\n";}, ); Tkx::pack(".e"); Tkx::button(".f", -text => "11-Orders", -width => 11, -command => sub { print OUTFILE "11O\n";}, ); Tkx::pack(".f"); Tkx::button(".g", -text => "99-Letters", -width => 11, -command => sub { print OUTFILE "99L\n";}, ); Tkx::pack(".g"); Tkx::button(".h", -text => "21-Letters", -width => 11, -command => sub { print OUTFILE "21L\n";}, ); Tkx::pack(".h"); Tkx::button(".i", -text => "23-Letters", -width => 11, -command => sub { print OUTFILE "23L\n";}, ); Tkx::pack(".i"); Tkx::button(".j", -text => "Return to L&I", -width => 11, -command => sub { print OUTFILE "OOO\n";}, ); Tkx::pack(".j"); + Tkx::button(".k", -text => "EOSSS235", -width => 11, -command => sub { print OUTFILE "EOSSS235\n";}, ); Tkx::pack(".k"); Tkx::button(".l", -text => "M4020235", -width => 11, -command => sub { print OUTFILE "M4020235 20\n";}, ); Tkx::pack(".l"); Tkx::button(".m", -text => "PRTAR235", -width => 11, -command => sub { print OUTFILE "PRTAR235\n";}, ); Tkx::pack(".m"); Tkx::button(".n", -text => "WR115235", -width => 11, -command => sub { print OUTFILE "WR115235\nWR415235\n";}, ); Tkx::pack(".n"); Tkx::button(".o", -text => "X01RA235", -width => 11, -command => sub { print OUTFILE "X01RA235\n";}, ); Tkx::pack(".o"); Tkx::button(".p", -text => "X1514235", -width => 11, -command => sub { print OUTFILE "X1514235 14\n";}, ); Tkx::pack(".p"); Tkx::button(".q", -text => "X4020235", -width => 11, -command => sub { print OUTFILE "X4020235\n";}, ); Tkx::pack(".q"); + Tkx::button(".r", -text => "SICLIC", -width => 11, -command => sub { print OUTFILE "SICLIC\n";}, ); Tkx::pack(".r"); Tkx::button(".s", -text => "EXIT", -width => 11, -command => sub { Tkx::destroy("."); }, ); Tkx::pack(".s"); Tkx::MainLoop(); exec `crossref.pl`;
Regex : Return match elements
3 direct replies — Read more / Contribute
by ravi45722
on Jun 24, 2016 at 07:47

    I am trying this regex. But not reached. Help me in solving this

    my $str = <<EO_STR; must-column08:Submit & must-column10:Delivered must-column08:Submit & must-column10:Delivered One & must-column9:No_e +rror must-column08:See Here & must-column10:Delivered | must-column9:No_err +or EO_STR my @array = *some_regex*; foreach my $element (@array) { print "$element\n"; } Needed output: must-column08:Submit & must-column10:Delivered must-column08:Submit & must-column10:Delivered One & must-column9:No_error must-column08:See Here & must-column10:Delivered | must-column9:No_error

    My trails :

     my @matches = $str =~ /(\w+)-(\w+|[0-9]+):(\w+|[0-9]+)\s[&|\|](\w+)-(\w+|[0-9]+):(\w+|[0-9]+)\s[&|\|]/g;
ENMTools_1.4.4.pl on Ubuntu 15.04?
2 direct replies — Read more / Contribute
by Steve Research
on Jun 24, 2016 at 06:58
    Hi, First post; I'm a Perl virgin not even a noob!

    I am trying to get ENMTools_1.4.4.pl running on Ubuntu 15.04.

    According to the docs I need Tk+ and Perl. How do I:
    - Check the versions that i may already have?
    - update/install the latest versions?
    - launch the *.pl script?

    I tried:
    /usr/bin/perl ./ENMTools_1.4.4.pl

    I currently get:
    Can't locate Tkx.pm in @INC (you may need to install the Tkx module) ( +@INC contains: /etc/perl /usr/local/lib/i386-linux-gnu/perl/5.20.2 /u +sr/local/share/perl/5.20.2 /usr/lib/i386-linux-gnu/perl5/5.20 /usr/sh +are/perl5 /usr/lib/i386-linux-gnu/perl/5.20 /usr/share/perl/5.20 /usr +/local/lib/site_perl .) at ./ENMTools.pl line 7. BEGIN failed--compilation aborted at ./ENMTools.pl line 7
    Any ideas?
    Steve
working with tables in OpenOffice::OODoc
1 direct reply — Read more / Contribute
by swathibandaru
on Jun 24, 2016 at 06:58

    I have created a table using

    $doc = odfDocument(file => 'test.odt', create => 'text'); doc->appendTable(tab1,5,3); doc->cellValue(tab1,0,0,"S No"); doc->cellValue(tab1,0,1,"Name"); doc->cellValue(tab1,0,2,"Value");

    In other rows & columns values are added using cellValue.

    Requirements: 1. When appendTable is used, table with default settings is created. How to change table Border to dark black with increased thickness 2. Table with all columns of same size is created. I want column 0,2 with less width, column 1 with large width. 3. I want to change Row 0 contents to Bold, as this indicates Heading to table contents.

    Unable to find any examples to do above. How to get above requirements. I am trying to create a table in openOffice word document using perl.

HTML code escaped from web page on browser
3 direct replies — Read more / Contribute
by sylph001
on Jun 24, 2016 at 05:26

    Hi Respective Monks,

    I'm having a script to print out a piece of HTML code in its output file which will be viewed.

    Meanwhile, the output file is grabbed by some mechanism and displayed on a web tool, which also will be viewed.

    The contrary is like, if I let it print out the original HTML code in the output file, the output file will look fine, but on the web tool page the HTML code will be trancated because of the '<' and '>' in it.

    To solve this, I let the script convert the '<' to '&#60' and '>' to '&#62' in the output file, then when the web tool page displays the content the whole lot of HTML code shows up right. However in this way, when people directly look at the output file itself, the '&#60' and '&#62' may look somewhat creepy.

    So monks, is there a way I can let the HTML code show up nicely on the plain output file as well as the web tool page from the web browser?

    Thanks

Handshake mechanism in perl
2 direct replies — Read more / Contribute
by t-rex
on Jun 24, 2016 at 01:51

    i am working for a project where i have implemented concurrent server , now i need to take back logs 9 in a hand shake mechanism without except module) the flow of my code is :

    main.pl { #try connecting to the server socket System(run perl_client.pl) or die “couldn’t run perl client.pl” If (fails) { Transfer files on server machine via scp Run server.pl Socket established Try connecting again to the server socket from client, (this time it w +ill connect) }
    My doubt now is how do I know whether everything is running , this code is a part of one big automation so I can’t use std libraries, maybe a log file , I know how to open and write to a file but a robust handshake mechanism is what I desire , anyone has any ideas for the same.


Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.