Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
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
foreach vs. while inside a directory tranversing subroutine
2 direct replies — Read more / Contribute
by TomJerry
on May 25, 2015 at 23:25

    This is a very simple test program for traversing a directory.

    I got two versions, the only difference is listing a directory --- one uses while(<*>), the other uses foreach(). Both should work.

    However, strange things happened. The 1st is always trapped in a infinite looping, while the 2nd works well. Why?

    # 1st form sub traverse_file { my $dir = shift; if (-d $dir) { while (<$dir/*>) { traverse_file($_); } } else { print "$dir\n"; } }
    # 2nd form sub traverse_file { my $dir = shift; if (-d $dir) { my @subdirs=<$dir/*>; foreach (@subdirs){ traverse_file($_); } } else { print "$dir\n"; } }
YAML problem
1 direct reply — Read more / Contribute
by luxs
on May 25, 2015 at 21:53
    Hi, I'm sending data through the POST from HTML and then try to save it as YAML. This is a form to create data
    <form action="/send.pl" method="POST"> <input name="product" size="50"> <input type="submit" value="Go"> </form>
    here is the processing of the data in send.pl:
    use YAML::Syck; use CGI::Fast ':standard'; while ( my $q = new CGI::Fast ) { my $data; $data->{'product'}=$q->param('product'); $data->{'product_test'}="test product"; #for test that YAML is working DumpFile( 'test.yml', $data ); print "Content-type: text/html\n\n"; print "q=".$q->param('product'); # this is for test only }
    The result on the screen is perfect. q contains what ever it should contain. But the YAML file is bad.
    --- product: ~ product_test: "test product"
    Why the data are destroyed?
Using pack/unpack on a PNG file
4 direct replies — Read more / Contribute
by sierpinski
on May 25, 2015 at 17:44

    Hello monks,

    I've been reading about PNG files and pack/unpack for a little while, and thought I understood it enough to perform a simple operation, but apparently I was mistaken. I created a PNG file with another script, and now I'm trying to get to know pack/unpack so I can read/write the associated binary data. The script doesn't error, but only makes a single byte file with "very short lines (no magic)" as a result. Here is the code:

    #!/usr/bin/perl use strict; use warnings; my $ifh = open("<:raw", "./file-bar.png"); my $data = unpack('a*', $ifh); my $outputfile = "newfile.png"; open (my $ofh, '>:raw', $outputfile) or die "Could not open '$outputfile' $!"; print $ofh pack('a*', $data); close $ofh; print("Image created.\n");
    Here are the file types of the initial and created files:
    $ file file-bar.png file-bar.png: PNG image data, 400 x 300, 4-bit colormap, interlaced $ file newfile.png newfile.png: very short file (no magic)
    I've tried to piece together bits of code from various sources, so that's why it's not of the same style, but feel there's no point in cleaning up code that doesn't work yet. Any help is greatly appreciated.
Compare three columns of one file with three columns of another file in perl
3 direct replies — Read more / Contribute
by anonym
on May 25, 2015 at 17:41

    Hi, I am trying to match the three columns (first three) of one file with the columns 0,3,4 of the second file using perl.My code so far is

    #!usr/bin/perl use strict; use warnings; my $infile1 = $ARGV[0]; my $infile2 = $ARGV[1]; my $outfile = $ARGV[2]; open (INFILE1,"<", $infile1) || die "Cannot open $infile1:$!\n"; open (INFILE2, "<", $infile2) || die "Cannot open $infile2:$!\n"; open (OUTFILE, ">", $outfile) || die "Cannot open $outfile:$!\n"; my @array1; my @array2; my @array3; my @array4; my $_; while (<INFILE1>) { chomp; @array1 = split (' ', $_); push (@array2, "@array1\n"); #print "@array2\n"; } while (<INFILE2>) { chomp; @array3 = split (' ', $_); push (@array4, "@array3\n"); #print "@array4\n"; } #print "@array2\n"; #print "@array4\n"; foreach my $array2(@array2) { my @line = split(/\s+/,$array2); my $chr1 = $line[0]; my $start1 = $line[1]; my $end1 = $line[2]; #print "$line[0]\n"; foreach my $array4(@array4) { my @values = split(/\s+/, $array4); my $chr2 = $values[0]; my $start2 = $values[3]; my $end2 = $values[4]; if (($chr1 eq $chr2 ) && ($start1 eq $start2) && ($end1 eq $end2)) + { #print "$start2\n"; print "$chr2\t$start2\t$end2\n"; } } }

    please help me with this code.Thanks.

Remove line from file based on numeric column value
2 direct replies — Read more / Contribute
by Bama_Perl
on May 25, 2015 at 17:18
    I wish to loop through multiple files, and their respective lines in the file. I have done is successfully already. Want I want to do now is remove lines in a file based on a numeric value in one of the columns. If I have an input such as this:
    XP.sta1 -41.5166 0.0513 0.6842 0.1794 0 CPHI.BHZ 300 +.2458 -42.2436 XP.sta2 3.5972 0.0500 0.7699 0.1213 0 E000.BHZ 30 +0.5616 2.5545 XP.sta3 3.7112 0.0267 0.7813 0.1457 0 E002.BHZ 30 +0.6140 2.6160 XP.sta4 4.2891 0.0214 0.6870 0.1308 0 E004.BHZ 30 +1.2073 2.6006
    I want to remove the line IF the 8th column numeric value is < -10 or > 10. Here's my code so far:
    open(TABLEC,$mFile); @tablec = <TABLEC>; for ($j = 2; $j < $stop; $j++) { chomp ($tablec[$j]); ($netSta,$delayTime) = (split /\s+/,$tablec[$j])[1,9]; next if $delayTime < -10 or $delayTime > 10;
    I am reading through multiple files, and for lines in between 2 and "stop" I want to remove that line if the 8th column value is <-10 or > 10. From the input above, I want to remove the line beginning with XP.sta1, since the 8th column is -40. How do I do this without simply deleting the 8th column value? This script is slightly modified, but if I run with the above code structure, the output is this:
    XP.sta1 -41.5166 0.0513 0.6842 0.1794 0 CPHI.BHZ 30 +0.2458 2.5545 XP.sta2 3.5972 0.0500 0.7699 0.1213 0 E000.BHZ 30 +0.5616 2.6160 XP.sta3 3.7112 0.0267 0.7813 0.1457 0 E002.BHZ 30 +0.6140 2.6006 XP.sta4 4.2891 0.0214 0.6870 0.1308 0 E004.BHZ 30 +1.2073
    Where in the 8th column, that value of -42.4326 is removed, but not the entire line. How do I delete the entire line, rather than just the value in column 8? Thanks for the help.
Can't ioctl TIOCGETP
No replies — Read more | Post response
by fbicknel
on May 25, 2015 at 16:12
    I'm sure many have seen the dilemma: the solution is even posted in the error message: Thing is: I did install Term::ReadKey (and Term::ReadLine::Gnu). I just enjoyed the adventure of compiling a new 5.20 Perl and cpanm installs most everything I throw at it without complaining. I know it's using the local versions (I'm using lib::local) as they appear in the dump: So the question is: what else is wrong? ReadLine is working (up arrows, ^R, etc). It's just this annoying message.

Gnome2::Canvas - things on top of other things
2 direct replies — Read more / Contribute
by Anonymous Monk
on May 25, 2015 at 13:53

    This script below draws a combination of squares and text on a Gnome2::Canvas. I want to guarantee that the text will always be visible above the squares, but the script doesn't work as intended.

    I'm using Gnome2::Canvas::Item->lower_to_bottom() and ->raise(). There's a white background, which is placed like this:

        $bg->lower_to_bottom();

    Then there are some red squares, which are placed like this:

    $square->lower_to_bottom(); $square->raise(1);

    Finally, there is some text, which is placed like this:

    $text->lower_to_bottom(); $text->raise(2);

    Clicking on a red square destroys its canvas object, and replaces it with a (new) yellow square, placed in the same way:

    $replaceSquare->lower_to_bottom(); $replaceSquare->raise(1);

    Unfortunately, the example script doesn't have the desired effect. Initially, four of the five text labels are drawn beneath their (red) squares. The text is only revealed by clicking on the red square.

    Can anyone tell me what I'm doing wrong?

    #!/usr/bin/perl package canvas; use strict; use diagnostics; use warnings; use Gtk2 '-init'; use Glib qw(TRUE FALSE); use Gnome2::Canvas; # Canvas size doesn't matter that much, as long as it's a bit bigger t +han the window my $size = 600; my $flipFlag = FALSE; # Create the window my $window = Gtk2::Window->new(); $window->set_title('Canvas'); $window->set_position('center'); $window->set_default_size($size, $size); $window->set_border_width(5); $window->signal_connect (destroy => sub { Gtk2->main_quit; }); # Add a VBox containing a Gnome2::Canvas my $vBox = Gtk2::VBox->new(FALSE, 0); my $canvasFrame = Gtk2::Frame->new(undef); $canvasFrame->set_border_width(3); my $canvasScroller = Gtk2::ScrolledWindow->new(); $canvasScroller->set_border_width(3); $canvasScroller->set_policy('always','always'); my $canvas = Gnome2::Canvas->new(); $canvas->set_scroll_region(0, 0, $size, $size); $canvas->set_center_scroll_region(1); $canvas->set_pixels_per_unit(1); my $canvasRoot = $canvas->root(); $canvasScroller->add($canvas); $canvasFrame->add($canvasScroller); $vBox->pack_start($canvasFrame, TRUE, TRUE, 0); $window->add($vBox); # Draw a white background my $bg = Gnome2::Canvas::Item->new ( $canvasRoot, 'Gnome2::Canvas::Rect', x1 => 0, y1 => 0, x2 => $size, y2 => $size, fill_color => '#FFFFFF', outline_color => '#FFFFFF', ); $bg->lower_to_bottom(); # Draw some squares above the background for (my $count = 0; $count < 5; $count++) { my ($square, $posn, $newColour); $posn = ($count * 100); $square = Gnome2::Canvas::Item->new( $canvasRoot, 'Gnome2::Canvas::Rect', x1 => ($posn + 10), y1 => ($posn + 10), x2 => ($posn + 60), y2 => ($posn + 60), outline_color => '#000000', fill_color => '#FF0000', ); $square->lower_to_bottom(); $square->raise(1); # Click on a red square? Then destroy it, and replace it with a ye +llow one! $square->signal_connect (event => sub { my ($widget, $event) = @_; my $replaceSquare; if ($event->type eq 'button-press') { $square->destroy(); $replaceSquare = Gnome2::Canvas::Item->new( $canvasRoot, 'Gnome2::Canvas::Rect', x1 => ($posn + 10), y1 => ($posn + 10), x2 => ($posn + 60), y2 => ($posn + 60), outline_color => '#000000', fill_color => '#FFFF00', ); $replaceSquare->lower_to_bottom(); $replaceSquare->raise(1); } }); } # Draw some blue text above the squares for (my $count = 0; $count < 5; $count++) { my $text = Gnome2::Canvas::Item->new( $canvasRoot, 'Gnome2::Canvas::Text', x => (($count * 100) + 25), y => (($count * 100) + 25), fill_color => '#0000FF', font => 'Sans', size => 10000, anchor => 'GTK_ANCHOR_W', text => 'Hello world!', ); $text->lower_to_bottom(); $text->raise(2); } # Open the window $window->show_all(); Gtk2->main();
Perl replace
3 direct replies — Read more / Contribute
by varunparihar
on May 25, 2015 at 07:46
    Hi, I am trying to replace some string with "jdbc:oracle:thin:@jnpodb:1521:tiborcl" but as a result, am getting the output as "jdbc:oracle:thin::1521:tiborcl" after replacement. Can someone tell me how to deal with "@" ? Thanks in Advance!
strangeness with prototypes and 'logical defined or'?
4 direct replies — Read more / Contribute
by ed_hoch
on May 25, 2015 at 06:49

    on 5.16.2, why does

    perl -ce 'sub foo (&) {} foo {;} || 7'

    work just fine, while

    perl -ce 'sub foo (&) {} foo {;} // 7'

    gives compilation errors? this doesn't seem like a shell-escaping issue; if I copy it into a separate file, the same thing holds.

    Thanks,

    Ed

Appending a single Scalar after a match
2 direct replies — Read more / Contribute
by SavannahLion
on May 25, 2015 at 04:36

    So I found myself updating an old script (parses oodles of HTML files). and unknowingly introduced a subtle bug.
    Here is a condensed version of the original code. The match is irrelevant.

    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; ($k) = $t =~ /^\s*(.*?)\s*$/g; print $k ."\n";

    Without thinking, I made a subtle change.
    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; ($k) .= $t =~ /^\s*(.*?)\s*$/g; print $k ."\n";

    A '1' kept getting shoved into $k. Goes without saying that I spend hours chasing this new bug down until I realized I was trying to use a list in a scalar context. So after much cursing I went and fixed the bug like thus.
    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; $t =~ /^\s*(.*?)\s*$/g; ($k) .= $1; print $k ."\n";

    After a fashion, I got to thinking. Is there a way to get it back to a one liner again and still append the value of $1 to $k? I tried several variations on the original but can't seem to work out a solution. My thought was something along the lines of:
    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; ($k) .= $($t =~ /^\s*(.*?)\s*$/g)[0]; print $k ."\n";

    I tried several variations but I can't quite seem to get it right. My gut says it should be feasible, but my brain can't quite put it together
    Any ideas?


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 studying the Monastery: (5)
    As of 2015-05-26 06:09 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      In my home, the TV remote control is ...









      Results (494 votes), past polls