Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight

Seekers of Perl Wisdom

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

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
Can't Insert Data To Multiple Table With DBI::Mysql
3 direct replies — Read more / Contribute
by pakeidoprek
on Jun 26, 2016 at 09:59

    Get Parameter By Form & then insert into tbl

    if ( param('Submit') ) { # get data from parameter to database my @params = param(); my $full_name = param ('full_name'); my $pob = param ('pob'); my $dob = param ('dob'); my $gender = param ('gender'); my $address = param ('address'); my $email = param ('email'); my $phone = param ('phone'); my $username = param ('username'); my $password = param ('password'); my $high_school = param ('high_school'); my $school_dep = param ('school_dep'); my $year_in = param ('years'); # data to tbl:students # ---------------------------------------------------------------- my $students = $dsn->prepare("INSERT INTO students (username, password) values (?,?) "); $students->execute($username,$password) or die $DBI::errstr; $students->finish(); # data to tbl:students_bio # ---------------------------------------------------------------- my $students_bio = $dsn->prepare("INSERT INTO students_bio ( username, full_name, pob, dob, gender, addr, email, phone, high_school, school_dep, years ) values (?,?,?,?,?,?,?,?,?,?,?) "); $students_bio->execute($username,$full_name,$pob,$dob, $gender,$address,$email,$phone, $high_school,$school_dep,$year_in) or die $DBI::errstr; $students_bio->finish(); # data to tbl:students_parent # ---------------------------------------------------------------- my $students_parent = $dsn->prepare("INSERT INTO students_parent (username) values (?) "); $students_parent->execute($username) or die $DBI::errstr; $students_parent->finish(); };

    I don't have problem to insert data to 1 tables with this method. but when i used this methods to insert data to multiple or more tables, the data just insert into 1st table and no activity with the 2nd $ 3rd table

    I'm so sorry if my english so bad. Thank's for the attention, Cheers for u, i'm from indonesia.

Array skips number if checked for defined.
3 direct replies — Read more / Contribute
by $h4X4_|=73}{
on Jun 26, 2016 at 09:57

    I have some thing happening in a package that seems strange to me. Lets say I have a blank array @array = (); when I check if the array{hash} is defined that should not be. Then push to that array and check the number again the array shifts to the next number.
    I hope the code explains it better...

    #!/usr/bin/perl use warnings; use strict; # add to @Foo::THING push(@Foo::THING, { 'check' => '1',} ); # Should say "Some Thing" Foo::check_THING(0) ? print "Some Thing\n" : print "No Thing\n"; # Should say "No Thing" Foo::check_THING(1) ? print "Some Thing\n" : print "No Thing\n"; # add to @Foo::THING push(@Foo::THING, { 'check' => '1',} ); # Check if it was added? Foo::check_THING(1) ? print "Some Thing\n" # I think it should be this : print "No Thing\n"; # But we get this # Why is it 2? Foo::check_THING(2) ? print "Some Thing\n" # WTF? : print "No Thing\n"; package Foo; our @THING = (); sub check_THING { my $id = shift; defined $THING[$id]{check} ? return 1 : return 0; }

Only showing part of POD when not rendered as HTML
1 direct reply — Read more / Contribute
by perlancar
on Jun 26, 2016 at 06:51

    I have some text tables on my module POD, e.g. Bencher::Scenario::Accessors::Get.

    I'm thinking of showing a sortable HTML table (which contains some JavaScript) instead when the POD is rendered to HTML as in sites like This will be done using =begin HTML ... =end HTML POD commands.

    I'd also like that the text table is not displayed on HTML output, so the user is not seeing two tables (one text and one HTML). Any idea? Two of mine so far:

    1) in the =begin HTML ... =end HTML snippet, hide the text table DOM element using some CSS or JS. But this will depend on how the POD is rendered to HTML, i.e. I can make it work on but it might not work on other sites like say which might render the HTML differently.

    2) put the text table in =begin man ... =end man *and* =begin text ... =end text. But this feels dirty. What about other output formats?

Simple regrep question
3 direct replies — Read more / Contribute
by monkeybus
on Jun 26, 2016 at 03:24

    Hello Monks, it's been a long time since this kitchen table hobbyist asked you all a question.

    Suppose I wants to parse a text file and extract all URL's that begin with  http:// and finish with .mp3

    How would I go about doing that?

    It is just the regrep that is having me tear my hair out, what is left of it.

    Thanks a lot, folks.

altering value in tied hash
2 direct replies — Read more / Contribute
by rlmoe
on Jun 25, 2016 at 22:44

    The following code is providing inconsistent output. After the code is some output from runs: the first run with 200 records yields what I expect; the second, with 250 records, yields something I cant explain. Is it not permitted to change the value of a tied hash in an each iteration?

    use strict; print "$^V\n"; my $records=shift; unlink "test_tie_hash"; use BerkeleyDB; my %MAIN; tie %MAIN, "BerkeleyDB::Hash", -Filename => "test_tie_hash", -Flags => + DB_CREATE, or die "Cannot open file: $! $BerkeleyDB::Error\n"; my $key="AAAAAAA"; my $store="LLLL"; foreach (1 .. $records){ ++$key; $MAIN{$key}= $store; } untie %MAIN; tie %MAIN, "BerkeleyDB::Hash", -Filename => "test_tie_hash", -Flags => + DB_CREATE; my %count=(); while ((my $key,my $value)=each (%MAIN)){ $count{$value}++; } untie(%MAIN); foreach(keys(%count)){ print "INITIAL LOAD\n$_ $count{$_} records\n\n"; } %count=(); $key=""; tie %MAIN, "BerkeleyDB::Hash", -Filename => "test_tie_hash", -Flags => + DB_CREATE; while ((my $key,my $value)=each (%MAIN)){ if($key=~m/U/){ $value .= "-YYYYYYYYYYYYYYYYYYYYYYYYYYYY"; $MAIN{$key}=$value } elsif($key=~m/L/){ $value .= "-ZZZZZZ"; $MAIN{$key}=$value; } else{ $value .= "-WWWWWWWWWWWWWWWWW"; $MAIN{$key}=$value; } } untie(%MAIN); tie %MAIN, "BerkeleyDB::Hash", -Filename => "test_tie_hash", -Flags => + DB_CREATE; while((my $key,my $value)=each (%MAIN)){ #print "$key $value\n"; $count{$value}++; } untie(%MAIN); foreach(keys(%count)){ print "$_ $count{$_}\n"; }




    It seems that some values in the tied hash are unaltered and some are altered more than once. Thanks.

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 = '' 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?
3 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
3 direct replies — Read more / Contribute
by Anonymous Monk
on Jun 24, 2016 at 12:40


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


    '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 = ''; my $from = ''; 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( ); 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: - $VAR1 = ''; $VAR2 = ''; $VAR3 = ''; $VAR4 = ''; $VAR5 = ''; $VAR6 = ''; $VAR7 = ''; $VAR8 = ''; $VAR9 = ''; $VAR10 = ''; $VAR11 = ''; Found RANGE: - $VAR1 = ''; $VAR2 = ''; $VAR3 = ''; $VAR4 = ''; $VAR5 = ''; $VAR6 = ''; $VAR7 = ''; $VAR8 = ''; $VAR9 = ''; $VAR10 = ''; $VAR11 = '';

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

    Found RANGE: - Found RANGE: - $VAR1 = ''; $VAR2 = ''; $VAR3 = ''; $VAR4 = ''; $VAR5 = ''; $VAR6 = ''; $VAR7 = ''; $VAR8 = ''; $VAR9 = ''; $VAR10 = ''; $VAR11 = '';


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 ``;

Add your question
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.
  • 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 musing on the Monastery: (12)
    As of 2016-06-27 18:58 GMT
    Find Nodes?
      Voting Booth?
      My preferred method of making French fries (chips) is in a ...

      Results (341 votes). Check out past polls.