Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic

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
trying to implement file tail with regular expression
1 direct reply — Read more / Contribute
by mkhayat
on Feb 11, 2016 at 06:06

    I build a script to read from diagnostic file and track a message. in case the message found a service in a server will restarted. I was successful in this however once the script reach end of the file it start again and this mean that it will keep restarting the service. I searched and found that there is library which called file::tail library which is made for this kind of issues unfortunately i was not able to modify my script in able to use this library. I am new in perl and I am trying to find my way into perl world. please help me :)

    use File::Tail; my $diagfile; my $Checkoutput; my $hostName1; my $hostName2; sub init { my ($dir) = @_; my $line; my $var; my $val; open (LREP2, "$dir/config/param.ini"); while ($line = <LREP2>) { chop $line; ($var,$val) = split(/=/, $line); if ($var eq "DIAGFILE") { $diagfile = $val; } if ($var eq "CHECKFILE") { $Checkoutput = $val; } if ($var eq "HOSTNAME1") { $hostName1 = $val; } if ($var eq "HOSTNAME2") { $hostName2 = $val; } } close LREP2; } #MAIN die "Usage: $0 <app_root_dir>" unless @ARGV == 1; my $app_root_dir = shift; &init($app_root_dir); my $line; open (DIAG, "$diagfile"); my $clock = 0; while (1) { open LOGFILE, ">>$app_root_dir/logs/detailedlog.log"; while ($line = <DIAG>) { if ($line =~ /is higher than 5 seconds/) { if ($clock == 0) { $clock = 60; my $commandStr2 = "sc \\\\$hostName1 stop AudioSrv >$a +pp_root_dir\\logs\\StopServiceOutput1.txt" ; print LOGFILE "about to execute=$commandStr2\n"; system($commandStr2); print LOGFILE "just executed=$commandStr2\n"; my $commandStr4 = "sc \\\\$hostName2 stop AudioSrv >$a +pp_root_dir\\logs\\StopServiceOutput2.txt" ; print LOGFILE "about to execute=$commandStr4\n"; system($commandStr4); print LOGFILE "just executed=$commandStr4\n"; sleep(5); my $commandStr3 = "sc \\\\$hostName1 start AudioSrv >$ +app_root_dir\\logs\\StartServiceOutput1.txt"; print LOGFILE "about to execute=$commandStr3\n"; system($commandStr3); print LOGFILE "just executed=$commandStr3\n"; my $commandStr5 = "sc \\\\$hostName2 start AudioSrv >$ +app_root_dir\\logs\\StartServiceOutput2.txt"; print LOGFILE "about to execute=$commandStr5\n"; system($commandStr5); print LOGFILE "just executed=$commandStr5\n"; } $clock --; sleep(1); } close LOGFILE; } sleep(65); }
Multiple values assigned to same key in hashes
2 direct replies — Read more / Contribute
by achs
on Feb 11, 2016 at 03:48
    Hi, Below I pasted a code that I got from here for assigning multiple values to the key in perl hashes. This code is working for one and not for the other. I don't understand where it is going wrong. If anybody can help me do this, it will be hugely appreciated. use strict; use warnings; use diagnostics; use Data::Dumper; my %hash; my $key; my $value; my @data = ("foo",1, "bar",2, "foo",3, "baz",4); while ($key = shift (@data)) { $value = shift (@data); # push the value on the array push @{$hash{$key}}, $value; } print Dumper \%hash; The array in the two cases mentioned is different. I am getting output as below where you can see the keys not as usual. I am not able to access the keys also, basically it is not getting.
Perl Sort date and time inside csv file
4 direct replies — Read more / Contribute
by ukhare
on Feb 11, 2016 at 02:06


    My file file.csv is having some columns among which column 1 represents date and time, I am trying to sort it by date and time but it is sorting only based on time. please check and suggest.

    #!/usr/bin/perl use strict; my $input_dir = "d://perl//output"; my $output_dir = "d://perl//output"; my $input_file = "$input_dir//file.csv"; my $output_file = "$output_dir//output2_file.csv"; open (OUTPUT, ">>$output_file") or die "Error 016: Error creating $out +put_file \n"; open (INPUT, "<$input_file") or die "Error 001: Error locating file $i +nput_file \n"; my @array =(<INPUT>); #print "Array\n"; #@print join( "\n", @array )."\n\n"; print "Sort Date\n"; print join( "\n", @sortedTime )."\n\n"; print OUTPUT; close (OUTPUT); close (INPUT);

    data in file.csv looks like





Proper way to create packages and re-usable code?
7 direct replies — Read more / Contribute
by bt101
on Feb 10, 2016 at 22:25
    Hi I normally write one-file scripts. However I have written a rather extensive set of routines and I would like to re-use the code for several programs. I gather the way to do this is to split up the code and put it into packages. However my mind is boggling on how several things should work. One example is...let's say your original one-file program writes logs using log4perl. In that case you simply initialize the log and then call routines to write to that log from anywhere in your program. How does/should this work when you have split the code into packages? If you initialize log4perl in the main code, how to all of the package routines write to the log file? It is so simple with C where multiple files are just linked into one flat program. I'm fundamentally missing something.
Strange bug with map
2 direct replies — Read more / Contribute
by erwan
on Feb 10, 2016 at 18:52

    Hi everyone,

    Can anyone help me understand what happens here:

    version 1:

    map { die "bug before!" if (!defined($_)); } values %{$self->{docs}}; my @docsObservs = map { $_->getObservations() } values %{$self->{docs} +}; map { die "bug after!" if (!defined($_)); } values %{$self->{docs}}; print "ok\n";


    bug after! at .....

    Version 2:

    map { die "bug before!" if (!defined($_)); } values %{$self->{docs}}; my @docsObservs; foreach my $docP (values %{$self->{docs}}) { push(@docsObservs, $docP->getObservations()); } map { die "bug after!" if (!defined($_)); } values %{$self->{docs}}; print "ok\n";



    This is just one part of a quite big program that I'm in the process of debugging, so I certainly still have bugs. But I'm puzzled by the fact that switching from version 1 to version 2 (without any other change) solves the issue. I can happily use version 2 of course, but I can't see what is wrong in the first version and I don't like that ;) Any idea?


foreach loop running too many times...?
2 direct replies — Read more / Contribute
by fasoli
on Feb 10, 2016 at 15:18

    Hello dear monks! I've been driving myself crazy over the code below, I can't figure out how to make it run properly :( The files that I'm trying to match are in the style of AC0001_F00001_S00001.tpr, AC0002_F00002_S00001.tpr, AC0003_F00003_S00001.tpr etc. AC goes from 1 to 50 (so AC0001 to AC0050) and frames go from F00001 to F00020.

    So what I'm doing is: I'm putting all my tpr files in an array, then I match their names and then I want to say "for molecule 1 to 2" and "for frame 1 to 2" -> print what files you are finding. However what happens is that, because of the foreach loop, the script print the files that it finds 6 times in total, which is exactly how many tpr files I have. I have tried closing the foreach loop earlier, before the for loops, but that makes no sense. Is there a syntax error? Or am I using the loops totally wrong?

    #!/usr/bin/perl/ use strict; use warnings; my $tpr = "tpr"; my $id; my $filepath; my $batch; my $number; my $molec; my $frame; my $mdstep; my @tpr; @tpr = `ls *.tpr`; print "Script start \n"; print "\n"; foreach (@tpr) { /(\w{2})(\d{4})_F(\d{5})_S(\d{5})/; $id = "AC"; $molec = $2; $frame = $3; $mdstep = $4; for ($molec=2; $molec<=2; $molec++) { for ($frame=1; $frame<=2; $frame++) { my $molecform = sprintf ("%04d", $molec); my $frameform = sprintf ("%05d", $frame); print "$id${molecform}_F${frameform}_S${mdstep}\.$tpr \n"; } } } # end of loop through tpr files
CGI Help
2 direct replies — Read more / Contribute
by phizymonk
on Feb 10, 2016 at 13:34

    So I am just getting into CGI using perl, and the last time I posted I had a lot of help to understand hashes and things, so I figured I would ask here.

    print $q->header("text/html"), $q->start_html("Images in $imagedir"), $q->print("These are all the images in the directory");

    with this code snippet $q is set to "new CGI" is this just laying the ground work for the html part of the script that is running? the goal is to make a script that prints all the images in a directory.

    also I am sort of confused by this regex and I think I am confused because we have not used grep before

     grep { /\.(?:gif|jpg)$/i }
Listbox, radio buttons and text box in sub function?
1 direct reply — Read more / Contribute
by Ppeoc
on Feb 10, 2016 at 08:26
    Hi Monks! I am trying to write a sub function that returns values to the main function using TK GUI. I got the listbox working but cant seem to get the text box to return values to the main function. Here is my code,
    sub myListBox{ my @choice1; my $path; my @listbox_items = @_; my $mw = MainWindow->new; $mw->protocol('WM_DELETE_WINDOW',sub{return;}); my $lsb = $mw -> Frame(); $mw->title("Select terms"); my $lb = $mw->Scrolled("Listbox", -scrollbars => "osoe", -height => 200, -width => 400, -selectmode => "multiple", -exportselection =>1)->pack( ); $lb->insert('end', @listbox_items); $lb->pack(-side => "left"); $lb->Button(-text => "Exit", -command => sub{exit; })->pack(-side => "bottom", -fill => 'x'); $mw->Button(-text=>"Select", -command => sub { foreach ($lb->curselection()) { push @choice1, $listbox_items[$_]; } $mw->destroy()}, )->pack(-side => "bottom", -fill => 'x'); my $label = $mw->Label(-text=>"Enter Directory Path:")->pack( ); + my $entry = $mw->Entry()->pack( ); my $localpath = $entry->get(); MainLoop; return @choice1,$localpath; }
    No value is returned for $localpath. The code runs fine for just the listbox. But when I start adding radio buttons and text boxes, the code gets messed up. My idea is to have a listbox in the left, radiobuttons on top right and text box on bottom right. Any help will be highly appreciated.
Error opening file handle within while loop
5 direct replies — Read more / Contribute
by rjc33
on Feb 10, 2016 at 07:28

    Hi Monks,

    I've written a short script which loops through a file, using some information from a specific line to extract a section of the file using an external program. This section (called $mafBlock) is then used in another external program, and it is the output of this program (called m2.gff) that I am interested in. However, each time the loop proceeds the output file m2.gff is overwritten, so I thought one solution would be to try and open this file within the loop, and then print the lines I require to another output file (m2_most-cons.gff). If I do this I get a syntax error for opening this second filehandle, I've tried a few different ways of writing this but none seem to work. My code is:

    use warnings; use strict; my $maf = "input.maf"; open (IN1, "input.maf") or die; open (OUT1, ">m2.maf") or die; open (OUT2, ">m2_most-cons.gff") or die; while (my $line1 = <IN1>) { chomp $line1; if ($line1 =~ /^s\sficAlb2/) { my @columns = split(/\t/, $line1); my $start = $columns[2] + 1; my $end = $columns[2] + $columns[3]; my $chrom = $columns[1]; my $mafBlock = qx(maf_parse --start $start --end $end $maf); print OUT1 "$mafBlock1\n"; my $phastCons = qx(phastCons --target-coverage 0.3 --expected- +length 45 --rho 0.31 --most-conserved m2.gff --seqname $chrom --msa-f +ormat MAF m2.maf nonconserved-all-4d.mod); print "$phastCons\n" open (IN2, "m2.gff") or die; while (my $line2 = <IN2>) { if ($line2 =~ /^fic/) { print OUT2 "$line2\n"; } } } open (OUT1, ">m2.maf") or die; close IN2; } close IN1; close OUT1; close OUT2; exit;

    Apologies if this is something completely wrong, I'm new to coding and this seemed the most intuitive way to collect the output required.

    Many thanks in advance!
Special character in authorization_basic
1 direct reply — Read more / Contribute
by balakrishna_bk
on Feb 10, 2016 at 05:49

    Hi, I have special character '<' in my password and I get error when i try to login. I tried the following options to encode my password, but still fails

    1. add '\' in front of '<' in password 2. passing username and password in url https://username:'pass<1234'' 3. used uri_escape from URI::Escape uri_escape($pwd) 4. encoded using base64 $r->header( "Content-Type" => "application/soap+xml;charset=UTF-8", "S +OAPAction" => "", "Authorization" => "Basic U1BDX1NJVEUyNFg3OjNmUlRMb +2NjQmZmWHk=" ); sub do_webservice { my ( $weburl, $usr, $password, $webxml ) = @_; print FD "\nXML: \n$webxml\n"; print FD "\nURL: \n$weburl\n"; my $ua = LWP::UserAgent->new(); $ua->ssl_opts( verify_hostnames => 0 ); my $r = HTTP::Request->new( "POST", $weburl ) or warn "POST FAIL +ED:$!\n";; $r->header( "Content-Type" => "application/soap+xml;charset=UTF- +8", "SOAPAction" => "" ); $r->authorization_basic( $usr, $password ); $r->content($webxml); my $response = $ua->request($r); print FD "START Dumper of $response\n"; print FD Dumper $response; print FD "END Dumper of $response\n"; print FD "DEBUG: Response is $response \n"; return $response; }

    Any help is appreciated. Regards, Bala

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 taking refuge in the Monastery: (4)
    As of 2016-02-13 12:17 GMT
    Find Nodes?
      Voting Booth?

      How many photographs, souvenirs, artworks, trophies or other decorative objects are displayed in your home?

      Results (429 votes), past polls