Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

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
adding another file type to a hash table
1 direct reply — Read more / Contribute
by Anonymous Monk
on Dec 17, 2014 at 15:30
    Hey, so im trying to write this script that will go through the current directory open up file types grab all "SRS_####" and sort them. now that part works but im also trying to grab the equivalent .log file that is associated with the ctl. basically every #_##_XXXXXXXX.CTL will have a .log that goes with it. i wanna add the SRS_#### that is referenced within the log and add it to the current hash table.
    sub main(){ my @files = glob("*.{ctl,inc}"); my %srss; open (OUT, ">SRS_List.txt") or die "Can't open file: SRS_List.txt" +; foreach my $file (@files){ open (IN, $file) or die "Can't open file: $file"; while (<IN>){ if (my @matches = ($_ =~ /SRS[_\s]?(\d+)/gi)){ foreach my $match (@matches){ if (!$srss{$match}){ $srss{$match} = 1; } } } } close (IN); print (OUT $file."\n"); if (keys %srss){ print OUT "SRS_(".join("|", sort {$a <=> $b}(keys %srss)). +")"; %srss = undef; } else{ print(OUT "NONE"); } print (OUT "\n\n"); } close(OUT); } main();
wxPerl button background
2 direct replies — Read more / Contribute
by xircon
on Dec 17, 2014 at 14:25
    In my search for enlightenment, I have stumbled....
    $button2->SetForegroundColour(Wx::Colour->new(177,77,77));
    Works.... Button text is red, but:
    $button2->SetBackgroundColour(Wx::Colour->new(177,77,77));
    (or whatever colour). Does nothing.
exists() for a hash child-key creates the parent key? Bug?
6 direct replies — Read more / Contribute
by AnonymousPerl1
on Dec 17, 2014 at 07:31

    I can't post exact code, due to it being confidential stuff, but for the first time in a few years of mucking about in Perl, I've found a behavior that caused me to raise an eyebrow. Wisdom welcome!

    use Data::Dumper; $hash{keyA}{keyB}{keyC}{keyD}=1; if (exists($hash{keyA}{keyB}{keyE}{keyF})) { print "Hi\n"; } print Dumper (\%hash); if (exists($hash{keyA}{keyB}{keyE}{keyF})) { print "Hi\n"; }

    The expected behavior should be "Hi" is never printed because keyE doesn't exist in the hash (and obviously keyF doesn't exist if keyE doesn't exist). However, what I'm seeing both by using ::Dumper and in foreach hash looping further along in the code is that $hash{keyA}{keyB}{keyE} is being "created" just by checking to see if {keyA}{keyB}{keyE}{keyF} exists, however even with another exists() call, "Hi" will not be printed.

    If I instead do this:

    if (exists($hash{keyA}{keyB}{keyE})) {
    then everything is fine and dandy and behaves as expected (keyE doesn't get created).

    Is exists() just a dangerous function to use for nested hashes? Or did I stumble on a bug?

Occasional Read Timeout with Mech
3 direct replies — Read more / Contribute
by pirkil
on Dec 17, 2014 at 06:17

    Dear monks, my script has to fetch some data from web, the mechanism looks like this:

    for my $try (1 .. 5) { debug("fetching HTML source: try $try of 5\n") if $debug; my $mech = WWW::Mechanize->new( autocheck => 0, ssl_opts => { verify_hostname => 0, SSL_version => 'TLSv1', }, timeout => 60, ); $mech->proxy('https', $args_hr->{proxy}); # Try::Tiny try { $mech->get( $url ); } catch { $err .= $_ if $_; }; my $text = $mech->content; $err .= "Can't fetch HTML source from $url!\n" if !$mech->s +uccess(); ... sleep 30; # before next try - if download was not succ. }
    I run this script on a server (with cron job). The URL is always the same. Sometimes I got en error, variable $text contains: read timeout at /usr/local/share/perl5/Net/HTTP/Methods.pm line 268. Other runs are OK, so I am not sure what the problem is and how to avoid it. Thanks for help!
Not a GLOB reference
2 direct replies — Read more / Contribute
by GeekyBrackets
on Dec 17, 2014 at 06:06
    I get this error for the line: while($line = <$fh>) What does it mean and how can I resolve it? The entire code is: use strict; use warnings; use v5.14; use Compress::Zlib; my $filename= "example.gz"; my $fh= gzopen($filename, "rb"); my $line=0; my $counter=1; my @array=(); bwhile($line = <$fh>)/b { @array= split (' ', $line); my $num = scalar(@array); print "$array15 $array1\n" if ($array15 eq "word"); $counter++; } close $fh;
Moose problem.
2 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 17, 2014 at 03:33
    Why does give 'Use of uninitialized value in print' instead of printing "two"?
    use strict; use warnings; package Stuff { use Moose; has 'options' => ( traits => ['Array'], is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] }, handles => { all_options => 'elements', add_option => 'push', map_options => 'map', filter_options => 'grep', find_option => 'first', get_option => 'get', join_options => 'join', count_options => 'count', has_options => 'count', has_no_options => 'is_empty', sorted_options => 'sort', }, ); sub test { my ($self, $arg) = @_; $self->get_option($arg); } no Moose; 1; }; my $s = Stuff->new({elements => [ qw/one two three/ ] }); print $s->test(1);
Dear Monsk pls help me with that error
1 direct reply — Read more / Contribute
by sibyurik
on Dec 16, 2014 at 21:36

    It gives me an error no &wanted subroutine given at /usr/share/perl/5.18/File/Find.pm line 1073

    #!/usr/bin/perl # #Author: Yury Sibirski #Name: users_home_dir #Date: 16 December 2014 #Purpose: This program analyze the directory structure of a Linux disk + and identify any files larger than 500 kbytes # use File::Find; use strict; use warnings; my $path = shift || '.'; find($path); find( sub { return unless -r && -f; my $size = -s; print "$File::Find::name $size\n" if $size > 51200; }, $path );
Hi Monks could you pls help Perl dummy user
3 direct replies — Read more / Contribute
by sibyurik
on Dec 16, 2014 at 19:54

    I need analyze dir structure and find all files that larger than 515 kbytes and recursion doesn't work i have no clue why? Please help me without fancy module and package style. Thx a lot

    #!/usr/bin/perl # #Author: Yury Sibirski #Name: users_home_dir #Date: 16 December 2014 #Purpose: This program analyze the directory structure of a Linux disk + and identify any files larger than 500 kbytes # $path = shift || '.'; read_dir($path); sub read_dir { $dir = shift; opendir (DH, $dir) or die "Couldn't open current directory: $! +"; while ($file = readdir(DH)) {#print "$file\n"; if ($file eq "." or $file eq "..") { next; } elsif (-z $file) { next; } elsif (-r $file and -f $file) { $size = -s $file; print $file," ",$size, "\n" if $size > 512000; } #recursion doesn't work i don't know why? # elsif (-d $file) # { # read_dir($file); # } } closedir DH; }
Tk Canvas Item Bind
1 direct reply — Read more / Contribute
by JadedAegis
on Dec 16, 2014 at 19:11
    use strict; use Tk; use Tk::DialogBox; #Character Variables. my $name = "Na"; my $health = "HP"; my $morality = "Mo"; my $willpower = "WP"; my $potency = "Po"; my $resource = "Re"; my $target = 0; # MainWindow my $mwin = new MainWindow(-background=>'black'); #Button for adding character information my $chrb = $mwin->Button(-text=>'Add Character',-activeforeground=>'bl +ack', -activebackground=>'green',-foreground=>'green',-backgroun +d=>'black', -command=>\&charadd) -> pack(-anchor=>'w'); #Canvas, which character info is drawn on. my $canv = $mwin->Scrolled('Canvas',width=>600,height=>600,-background +=>'black',-confine=>0) -> pack(); $canv->createLine(0,20,600,20,-fill=>'green'); #DialogBox, for when a new character is added. my $diag = $mwin->DialogBox(-title=>'Add Character',-buttons=>['Ok','C +ancel'], -default_button=>'Ok'); $diag->add('Entry',-textvariable=> \$name) -> pack(); $diag->add('Entry',-textvariable=> \$morality) -> pack(); $diag->add('Entry',-textvariable=> \$willpower) -> pack(); $diag->add('Entry',-textvariable=> \$potency) -> pack(); $diag->add('Entry',-textvariable=> \$resource) -> pack(); $diag->add('Entry',-textvariable=> \$health) -> pack(); Tk::MainLoop; #Maintain GUI. $canv->bind('<current>','<Button-1>', =>\&damage); our $charc = 0; sub charadd() { ++$charc; $canv->createText(20,($charc*60)+10,-text=>$charc,-fill=>'green'); $diag->Show(); $canv->createText(40,($charc*60)+10,-text=>$name,-fill=>'green'); $canv->createText(160,($charc*60)+10,-text=>"Po: $potency",-fill=> +'green'); $canv->createText(220,($charc*60)+10,-text=>"WP: $willpower",-fill +=>'green'); $canv->createText(280,($charc*60)+10,-text=>"Re: $resource",-fill= +>'green'); $canv->createText(360,($charc*60)+10,-text=>"Mo: $morality",-fill= +>'green'); for (my $i = 1; $i <= $health; $i++) { $canv->createRectangle($i*30,($charc*60)+20,($i*30)+20,($charc +*60)+40, -fill=>'green',-tag=>'hpbox'); } } sub damage() { }
    It runs, but when I click on one of the healthboxes drawn it doesn't do anything.
    Once the script ends it feeds me this huge error that ultimately ends in:
    Usage $widget->bind(...) ... Derived.pm line 469
about DateTime::Format::Strptime
2 direct replies — Read more / Contribute
by bcostacurta
on Dec 16, 2014 at 15:59
    Hello,

    I have a problem using the package DateTime::Format::Strptime.

    Using the two following patterns :

    pattern => '%B %d %Y %H:%M:%S' eg. 'Dec 16 2014 21:03:46'

    pattern => '%B %d %H:%M:%S' eg. 'Sep 16 21:00:00'

    The first pattern works, but not the second (which does not include the year neither in pattern neither in string).

    Where could be the problem ?

    #!/usr/bin/perl use DateTime::Format::Strptime; my $t = 'Dec 16 2014 21:03:46'; my $Strp = DateTime::Format::Strptime::->new( pattern => '%B %d %Y %H:%M:%S', locale => 'en_US', ); # my $dt = $Strp->parse_datetime($t); print "'$dt'\n"; my $t2 = 'Sep 16 21:00:00'; my $Strp2 = DateTime::Format::Strptime::->new( pattern => '%B %d %H:%M:%S', locale => 'eu_US', ); # my $dt2 = $Strp2->parse_datetime($t2); print "'$dt2'\n";
    Output is :
    '2014-12-16T21:03:46' ''

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!
  • 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
  • Outside of code tags, you may need to use entities for some characters:
            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?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (9)
    As of 2014-12-18 03:05 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (41 votes), past polls