Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
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
howto parse (or determining end) of a line of perl
3 direct replies — Read more / Contribute
by perl-diddler
on Aug 24, 2016 at 20:26
    I have a little calc I wrote in perl that really just provides and eval & print loop for the user.

    I have made changes over the years, but one of the things that has always bothered me is, if I want to add a complex expression -- anything that is multi-lined, how to get my input loop to know when it needs more input OR when it doesn't (vs. _could_ take more input).

    My 'semi-model' for that would be something like bash, where if you type 'the beginning of a control structure, bash will change to a different prompt to indicate it wants more input.

    How might I do the same in my eval/print loop?

    As it is now, I can define functions on 1 line, for example, but there is no easy way to extend that to more than one line.

    I could force the use of an 'extend char', like backslash at the end of line -- but in bash, those are only needed if it is ambiguous -- i.e. if the line is already well formed, you need to enter '\' to tell bash to keep parsing. Ex. (using 'home>' as normal prompt):

    home> int a=1+1\ > +2; echo $a 4
    You can't enter partial *expressions* in bash and have it "auto continue" (that I know of). I.e.
    home> a=1+<cr> -bash: 1+: syntax error: operand expected (error token is "+")
    But I could enter a '\' at the end of line and continue it as I did above.

    Where bash works to auto-detect is in its control structures (or like if a quote is still open). Ex:

    home> for ((i=0;i<10;++i)); then<cr> > [...]
    On the 2nd line, it doesn't display the normal prompt, but a single greater than sign. How could I get my input/eval loop to get feedback from perl that I'm in the middle of a similar structure and change the prompt and not try to eval it?

    -------------

    Clarification: how can I do that w/o writing an entire perl parser? ;-)

Captured single quote results in captured phantom quote
2 direct replies — Read more / Contribute
by Ach
on Aug 24, 2016 at 17:21

    This appears to be a bug in v5.22.2 built for cygwin-thread-multi:

    DB<1> $line = "\"quoted-text\" \cM\cJ" DB<2> x $line 0 "\"quoted-text\" \cM\cJ"

    My original regex:

    DB<3> x $line =~ m/^(\s*)((?'quote'"?)[^\s"]*\g{quote})\s+(\[[^\]]*\ +]|)\s*$/ 0 '' 1 '"quoted-text"' 2 '"' 3 ''

    Remove backreference:

    DB<4> x $line =~ m/^(\s*)((?'quote'"?)[^\s"]*")\s+(\[[^\]]*\]|)\s*$/ 0 '' 1 '"quoted-text"' 2 '"' 3 ''

    Replaced named with unnamed group:

    DB<5> x $line =~ m/^(\s*)(("?)[^\s"]*")\s+(\[[^\]]*\]|)\s*$/ 0 '' 1 '"quoted-text"' 2 '"' 3 ''

    Replace unnamed group with internals of group:

    DB<6> x $line =~ m/^(\s*)("?[^\s"]*")\s+(\[[^\]]*\]|)\s*$/ 0 '' 1 '"quoted-text"' 2 '' 3 ''

    Needless to say, the commands 2-5 resulted in the wrong result for array element 2.

    Has this been discovered and fixed yet?

     

    Ach

f
4 direct replies — Read more / Contribute
by RadioEngineer
on Aug 24, 2016 at 16:01
    q
Merge log files causing Out of Memory
2 direct replies — Read more / Contribute
by malokam
on Aug 24, 2016 at 11:13

    I have this script that merges log files. It reads the list of dirs from a file and looks for a certain log file and merges all the content and saves to another file (in a separate directory)

    While the script itself is sound and is working on my sandbox, it goes "Out of Memory!" on the machine I am trying to run this script.

    Can I optimize the script any further? Or is there some other way to do the same more effectively?

    #!/usr/bin/perl ###################### Globals ##################################### +#### %keydirs; ## Hash for use in tracking directories @d; @ed; $profile = `\. ~/.profile`; # Load user profile $log_for_days = eval(86400 * 91); ## 91 is the number of days for rete +ntion ###################### Globals ##################################### +#### &date_calc; &get_dirs; foreach $dir1_(@d) { chomp $dir1_; @dir_ = split(/\//,$dir1_); $num = eval(@dir_ - 1); $logfile = "@dir_[$num].$myLog"; $delfile = "@dir_[$num].$delTime"; if(-e "$dir1_/logs/$delfile") { $del_old_recs = `rm -f $dir1_/logs/$delfile`; } chop $dir1_; get_ldat($dir1_); open(ARCLOG,">$dir1_/logs/$logfile"); print ARCLOG "@data1"; close(ARCLOG); undef @data1; } ############################ Subroutines ########################### +#### sub date_calc { ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time + - 86400); $syear = $year+1900; $smon = sprintf '%02d',$mon+1; $smday = sprintf '%02d',$mday; $shour = sprintf '%02d', $hour; $smin = sprintf '%02d', $min; $ssec = sprintf '%02d', $sec; $myTime = "$smon/$smday/$syear $shour:$smin:$ssec"; $myLog = "$syear"."$smon"."$smday"; ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear,$fwday,$fyday,$fisdst) = local +time(time); $fsyear = $fyear+1900; $fsmon = sprintf '%02d',$fmon+1; $fsmday = sprintf '%02d',$fmday; $fshour = sprintf '%02d', $fhour; $fsmin = sprintf '%02d', $fmin; $fssec = sprintf '%02d', $fsec; $fmyTime = "$fsmon/$fsmday/$fsyear"; ($dsec,$dmin,$dhour,$dmday,$dmon,$dyear,$dwday,$dyday,$disdst) = local +time(time - $log_for_days); $delyear = $dyear+1900; $delmon = sprintf '%02d',$dmon+1; $delmday = sprintf '%02d',$dmday; $delhour = sprintf '%02d',$dhour; $delmin = sprintf '%02d',$dmin; $delsec = sprintf '%02d',$dsec; $delTime = "$delyear"."$delmon"."$delmday"; } sub get_dirs { open(DIRFILE,"</opt/scripts/dirs") || die "Cannot open file for readin +g:$^E\n"; @directories = <DIRFILE>; close(DIRFILE); foreach $directory(@directories) { next unless $directory !~ /\#/ig; chomp $directory; @dire = split(/(encrypt|decrypt|\:)/,$directory); if(! exists($keydirs{$dire[2]})) { $keydirs{$dire[2]} = 1; @d = (@d,$dire[2]); } } } sub get_ldat { $dirtoget = "@_"; chomp $dirtoget; if(-e "$dirtoget/encrypt") { @encdir = `ls -Af $dirtoget/encrypt 2>&1`; } else { @encdir = ""; } foreach $endir(@encdir) { chomp $endir; if($endir !~ /\./) { if(-e "$dirtoget/encrypt/$endir/sample.log") { @data = `cat $dirtoget/encrypt/$endir/sample.log`; $cnt=0; $dcnt= eval(@data - 1); foreach $row(@data) { if($row !~ /$fmyTime/i) { $cnt++; } else { last; } } $cnt = eval($cnt - 1); $icnt=0; for($icnt=0;$icnt<= $cnt;$icnt++) { push @data1,$data[$icnt]; } $cnt = eval($cnt + 1); for($icnt2=$cnt;$icnt2<=$dcnt;$icnt2++) { push @data2,$data[$icnt2]; } open(LOG,">$dirtoget/encrypt/$endir/sample.log"); print LOG "@data2"; close(LOG); } } undef $cnt; undef $dcnt; undef @data; undef $row; undef $icnt; undef $irow; undef $irow2; undef @data2; } if(-e "$dirtoget/decrypt/sample.log") { @data = `cat $dirtoget/decrypt/sample.log`; $cnt=0; $dcnt=@data; foreach $row(@data) { if($row !~ /$fmyTime/i) { $cnt++; } else { last; } } $icnt=0; for($icnt=0;$icnt< $cnt;$icnt++) { push @data1,$data[$icnt]; } for($icnt2=$cnt;$icnt2<=$dcnt;$icnt2++) { push @data2,$data[$icnt2]; } open(LOG,">$dirtoget/decrypt/sample.log"); print LOG "@data2"; close(LOG); } undef $cnt; undef $dcnt; undef @data; undef $row; undef $icnt; undef $irow; undef $irow2; undef @data2; }
Matching all text after a specific character
2 direct replies — Read more / Contribute
by Anonymous Monk
on Aug 24, 2016 at 09:17

    I have a set of file-names in this format:

    XYX_WT_7_25h_Trimmed_75.SAM

    And I want to match the second to last _ and all text after it (_Trimmed_75.SAM). Ordinarily I would use:

    /_[^_]+$/

    To grab everything after the final _ but being new to Perl i'm not sure how I would do this for the second to last. Any help would be much appreciated!

Hash of Hash of Arrays
3 direct replies — Read more / Contribute
by voltas
on Aug 24, 2016 at 08:04
    I have a working code that reads a log file and produces output like below:
    => [ 'Testing { ', 'JIRA' => 'COM-6789 ', 'Program' => 'Testing ', 'rev' => 'r876391 ', 'Reviewer' => 'Balise Mat ' 'Description' => 'Audited }, { ', 'Program' => 'Testing ', 'rev' => 'r698392 ', 'Reviewer' => 'Chan Joe ', 'JIRA' => 'COM-6789 ' 'Description' => 'SO hwat }, { ', 'JIRA' => 'COM-6789 ', 'Reviewer' => 'Chan Joe ', 'Program' => 'Testing ', 'rev' => 'r327896 ' 'Description' => 'Paid the Due } ], ' => [ 'Development { ', 'JIRA' => 'COM-1234 ', 'Reviewer' => 'John Wick ', 'rev' => 'r345676 ', 'Program' => 'Development ' 'Description' => 'Genral fix }, { ', 'Program' => 'Development ', 'rev' => 'r909276 ', 'Reviewer' => 'None ', 'JIRA' => 'COM-1234 ' 'Description' => 'Updating Received } ],
    I want to print my output like Hash of Hash of Arrays, i.e. take Development as my first hash with the JIRA ID as the values and JIRA ID as the 2nd hash and the associated values. Example :
    'Development { COM-1234 { ', 'JIRA' => 'COM-1234 ', 'Reviewer' => 'John Wick ', 'rev' => 'r345676 ', 'Program' => 'Development ' 'Description' => 'Genral fix }, { ', 'Program' => 'Development ', 'rev' => 'r909276 ', 'Reviewer' => 'None ', 'JIRA' => 'COM-1234 ' 'Description' => 'Updating Received } }, ],
    Code snippet:
    #!/usr/bin/perl use strict; use warnings; use 5.010; use Data::Dumper; my @records = do { local $/ = '------------------------------------------'; <>; }; chomp @records; my %jira; foreach (@records) { next unless /\S/; my %rec = /^(\w+):\s*(.+?)$/mg; push @{$jira{$rec{JIRA}}}, \%rec; } say Dumper \%jira; my %prog foreach (@records) { next unless /\S/; my %rec = /^(\w+):\s*(.+?)$/mg; push @{$jira{$rec{Program}}}, \%rec; } say Dumper \%prog;
Hash searching
2 direct replies — Read more / Contribute
by Oligo
on Aug 24, 2016 at 07:29

    Hello Monks,

    I'm trying to master the art of searching with hashes. I have a file with a list of search terms (one line = one term):

    J00153:42:HC5NCBBXX:6:1101:10896:14959 J00153:42:HC5NCBBXX:6:1101:10896:14959 J00153:42:HC5NCBBXX:6:1101:26616:20709 J00153:42:HC5NCBBXX:6:1101:27549:19935

    ...and a master file I want to search for those terms in (again, one line per record):

    J00153:42:HC5NCBBXX:6:1101:10896:14959 99 gnl|Btau_4.6.1|chr16 + 72729218 1 12M J00153:42:HC5NCBBXX:6:1101:27549:19935 83 gnl|Btau_4.6.1|chr8 + 49556412 1 7M

    I started by opening the query file and reading each line into an array. Then while-ing through the master file, returning matching lines where the array elements match the relevant part of the master file:

    # Open query file and read into array $queryfile = $ARGV[0]; open (QUERYFILE, $queryfile) or die "Cannot open query file\n"; @queries = <QUERYFILE>; close QUERYFILE; # Open main file $mainfile = $ARGV[1]; open (MAINFILE, $mainfile) or die "Cannot open searchable file\n"; # Search through main file while ($inline = <MAINFILE>) { @split = split /\t/, $inline; $ID = $split[0]; if (grep /$ID/, @queries) { print $inline; } else { } } exit;

    This works fine, but the files are huge and the code takes an age to run. So, I tried converting the array to a hash (array elements = hash keys, values all = 1) but I can't seem to get the pattern matching syntax right; the code runs much faster but nothing comes back. So far I have:

    # Open query file and read into array $queryfile = $ARGV[0]; open (QUERYFILE, $queryfile) or die "Cannot open query file\n"; @queries = <QUERYFILE>; close QUERYFILE; # Convert array to hash %hash = map {$_ => 1} @queries; # Open main file $mainfile = $ARGV[1]; open (MAINFILE, $mainfile) or die "Cannot open searchable file\n"; # Search through main file while ($inline = <MAINFILE>) { @split = split /\t/, $inline; $ID = $split[0]; if (defined $hash{$ID}) { print $inline; } else { } } exit;

    Any Perly wisodom greatly appreciated!

DBI - Insert NULL value into DB
3 direct replies — Read more / Contribute
by Yaerox
on Aug 24, 2016 at 05:33
    Got some trouble handling undef/null values from database. (The following code is some kind of pseudocode.) I'm fetching data from DB-1 table test. Table test looks like:
    ID | SOMEVALUE -------------- 1 | NULL 2 | text 1 | NULL
    Now I copy this lines by doing an insert on a second database with the same table called DB-2 table test2:
    while ( ( $id, $value ) = $hStatement->fetrow_array ) { $hStatement2->prepare( INSERT INTO test2 VALUES ( ?, ? ) ); $hStatement2->execute( $id, $value ); }
    The result is fine test2 looks like test table. BUT ... i get uninitialized errors when those undefined values (NULL) are used. I see two ways to solve the problem: 1) Use constants, so i handle all those possible undefs and I concat my string as insert-statement and doing
    $hStatement2->prepare( $sSQL_Statement ); $hStatement2->execute( );
    2) Run this part of the code in a block using "no warnings". I don't like both ways because method 1 needs alot of if-code and statements are proberly less optimized for the database. But suppressing warnings is even worse imo. So I'd like to ask if any of you guys know, how to solve this problem in a good programmers way.
Authenticate HTTPS website with IE Automation
1 direct reply — Read more / Contribute
by rapid_perl
on Aug 23, 2016 at 23:48
    Hi All, I am trying to automate the authentication of a secured portal for my automation project.I have tried number of ways of doing the same but still struggling with the same. If we do the same with LWP or machanize it is achieved but the content I am getting back in response is the not same as we get in IEautomation content method which is actual HTML content of web page. Can anybody provide me with the solution if they have encountered the same situation earliar. I would prefer if somebody come up with a solution achieved through Win32::IEAutomation package.
Parsing UTF-8 characters ( is changed to )
2 direct replies — Read more / Contribute
by ashesh28
on Aug 23, 2016 at 22:57
    Hi Monks , Am in a bit of confusion here with no clue on what is causing this exception. I have written a perl script which extracts rows of data from SharePoint list using SOAP::Lite Module. The extraction works properly , but in certain scenarios the special character symbols are converted when i open the CSV file which is created by Perl script. Part of Code snippet which extract the mentioned columns and write it into a CSV file. I have already parsing them as UTF-8
    my $element_rowlimit = name( 'rowLimit' => 10000 ); #print $soap->serializer->envelope( 'method' => 'GetListItems', $eleme +nt_listname, $element_query, $element_rowlimit ); my $som = $soap->GetListItems( $element_listname, $element_query, $ele +ment_rowlimit ); my @results = $som->dataof('//GetListItemsResult/listitems/data/row'); my $oc = Text::CSV->new({sep_char => ',', eol => $/ }) or die Text::CSV->error_diag(); open my $of, '>', 'Load_Data.csv' or die $!; binmode $of, ':utf8'; chomp @results; foreach my $data (@results) { my $item = $data->attr; chomp $item; $oc->print($of,[@$item{qw( ows_Job_x0020_ID ows_Justific +ation )}]); } close $of;
    Lets say the Value of Justification column in Sharepoint is as : "RMS Roughness (Rq) is ~3.7 for both wafers." But, when extracted by perl , the comment is changed to following : "RMS Roughness (Rq) is ~3.7 for both wafers."

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.
  • 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 browsing the Monastery: (2)
    As of 2016-08-25 05:19 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      The best thing I ever won in a lottery was:















      Results (353 votes). Check out past polls.