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
Parse one file, send the records to two different files
2 direct replies — Read more / Contribute
by BigRedEO
on May 27, 2016 at 12:19
    I have a program that is ALMOST doing what I want. I had a working program to scrub and format data before it gets loaded into a MySQL table, after working with "test" data that I was given in the form of a .CSV file. Worked just fine. Then I got the actual data and discovered there were quite a few error records in there - out of about 65,400 records, 272 of them were missing most of the data - most importantly, the three fields to create a Primary Key are all empty/blank. So I threw in what I figured would be an easy IF/ELSE - if those three fields were blank, write that record to an error file, else scrub the data. It does work in that it has separated out the error records from my "clean" file, but the error file is all wrong. The .CSV file I'm testing with has over 65,400 lines and the "clean" file is that amount minus 272 records. But my "error" file ends up with 8 million records in it! So I've got something I'm missing here and I was hoping another pair of eyes would catch it. (PS - no, I do not use the Text::CSV module. It is not available to me, nor will it be) Here are sample records from the .CSV file with the 4th record being one of the "error" records -
    650096571,1,1,used as store paint,14,IFC 8012NP,Standalone-9,3596,56,1 +/31/2015,80813,A97W01251,,1/16/2015,0.25,0.25,,SW,CUSTOM MATCH,TRUE,O +,xts,,,,,,,1568,61006,1,FALSE 650368376,1,3,Tinted Wrong Color,16,IFC 8012NP,01DX8015206,,6,1/31/201 +5,160720,A87W01151,MATCH,1/31/2015,1,1,ENG,CUST,CUSTOM MATCH,TRUE,O,C +i52,,,,,,,1584,137252,1,FALSE 650175433,3,1,not tinted - e.w.,16,COROB MODULA HF,Standalone-7,,2,1/3 +1/2015,95555,B20W02651,,1/29/2015,3,3,,COMP,CUSTOM MATCH,TRUE,P,xts,, +,,,,,1627,68092,5,FALSE 650187016,2,1,checked out under cash ,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    And here is my script -
    #!/usr/bin/perl/ use strict; use warnings; use Data::Dumper; use Time::Piece; my $filename = 'uncleaned.csv'; # Open input file open my $FH, $filename or die "Could not read from $filename <$!>, program halting."; # Open error handling file open ( my $ERR_FH, '>', "errorFiles.csv" ) or die $!; # Read the header line of the input file and print to screen. chomp(my $line = <$FH>); my @fields = split(/,/, $line); print Dumper(@fields), $/; my @data; # Read the lines one by one. while($line = <$FH>) { chomp($line); # Scrub data of characters that cause scripting problems down the line +. $line =~ s/[\'\\]/ /g; # split the fields of each record my @fields = split(/,/, $line); # Check if the storeNbr field is empty. If so, write record to error +file. if (!length $fields[28]) { print $ERR_FH join (',', @$_), $/ for @data; } else { # Concatenate the first three fields and add to the beginning of each +record unshift @fields, join '_', @fields[28..30]; # Format the DATE fields for MySQL $_ = join '-', (split /\//)[2,0,1] for @fields[10,14,24,26]; # Scrub colons from the data $line =~ s/:/ /g; # If Spectro_Model is "UNKNOWN", change if($fields[22] eq "UNKNOWN"){ $_ = 'UNKNOW' for $fields[22]; } # If tran_date is blank, insert 0000-00-00 if(!length $fields[10]){ $_ = '0000-00-00' for $fields[10]; } # If init_tran_date is blank, insert 0000-00-00 if(!length $fields[14]){ $_ = '0000-00-00' for $fields[14]; } # If update_tran_date is blank, insert 0000-00-00 if(!length $fields[24]){ $_ = '0000-00-00' for $fields[24]; } # If cancel_date is blank, insert 0000-00-00 if(!length $fields[26]){ $_ = '0000-00-00' for $fields[26]; } # Format the PROD_NBR field by deleting any leading zeros before decim +als. $fields[12] =~ s/^\s*0\././; # put the records back push @data, \@fields; } } close $FH; close $ERR_FH; print "Unsorted:\n", Dumper(@data); #, $/; #Sort the clean files on Primary Key, initTranDate, updateTranDate, an +d updateTranTime @data = sort { $a->[0] cmp $b->[0] || $a->[14] cmp $b->[14] || $a->[26] cmp $b->[26] || $a->[27] cmp $b-> [27] } @data; open my $OFH, '>', '/path/cleaned.csv'; print $OFH join(',', @$_), $/ for @data; close $OFH; exit;
Simplify code in Perl with "unless" condition
4 direct replies — Read more / Contribute
by Chaoui05
on May 27, 2016 at 11:29
    Hi Monks of Monastery ! I did this following code to compare some screenshots between differents browsers. I use Selenium::Screenshot. But i find that it's too heavy. I use the condition "unless" which is not very handy i think, and it's the first time i use it. My code here :
    unless ($screen{'firefox'}->compare($screen{'chrome'})) { my $diff_file = $screen{'firefox'}->difference($screen{'chrome'}); print '#The images are not the same; see ' . $diff_file . ' for de +tails'. "\n"; `$diff_file`; unless ($screen{'internet explorer'}->compare($screen{'firefox'})) { my $diff_file = $screen{'internet explorer'}->difference($screen{' +firefox'}); print '#The images are not the same; see ' . $diff_file . ' for de +tails'. "\n"; `$diff_file`; unless ($screen{'chrome'}->compare($screen{'internet explorer'})) { my $diff_file = $screen{'chrome'}->difference($screen{'internet ex +plorer'}); print '#The images are not the same; see ' . $diff_file . ' for de +tails'. "\n"; `$diff_file`;
    I have a newbie question also. I just would like to know how is it possible to simplify my code with "unless"?

    Regards !

    Lost in translation
Recovery of a "multi-perl" installation
1 direct reply — Read more / Contribute
by haricot-48
on May 27, 2016 at 10:14

    Hi Monks,
    while doing the initial setup of a server (that will host a web application) I've found something unexpected and I need your help to proceed with my job.
    The installation of a new perl module (DBD::Oracle) gave me this output message:

    Multiple copies of Driver.xst found in: /usr/local/lib/x86_64-linux-gnu/perl/5.22.1/auto/DBI/ /usr/lib/x86_64-linux-gnu/perl5/5.22/auto/DBI/ at Makefile.PL line 39. Using DBI 1.636 (for perl 5.022001 on x86_64-linux-gnu-thread-multi) installed in /usr/local/lib/x86_64-linux-gnu/perl/5.22.1/auto/DBI/

    I've searched and I found that the server seems to have two different "Perl installations" (forgive me if I'm not using the proper term)

    Here follows an excerpt of the content of the two paths:

    root@xyz# ll /usr/lib/x86_64-linux-gnu/perl5/5.22/auto/ total 44 drwxr-xr-x 11 root root 4096 May 27 09:48 ./ drwxr-xr-x 13 root root 4096 May 27 09:48 ../ drwxr-xr-x 3 root root 4096 May 13 16:19 Algorithm/ drwxr-xr-x 2 root root 4096 May 27 09:46 DBI/ drwxr-xr-x 2 root root 4096 May 9 16:48 FCGI/ drwxr-xr-x 3 root root 4096 May 13 16:19 File/ drwxr-xr-x 3 root root 4096 May 9 16:48 HTML/ drwxr-xr-x 2 root root 4096 May 9 16:47 LibAppArmor/ drwxr-xr-x 3 root root 4096 May 9 16:43 Locale/ drwxr-xr-x 4 root root 4096 May 9 16:43 Text/ drwxr-xr-x 3 root root 4096 May 27 09:48 YAML/ root@xyz# ll /usr/local/lib/x86_64-linux-gnu/perl/5.22.1/auto/ total 16 drwxrwxr-x 4 root root 4096 May 27 11:28 ./ drwxrwxr-x 7 root root 4096 May 27 08:19 ../ drwxrwxr-x 3 root root 4096 May 27 11:28 DBD/ drwxrwxr-x 2 root root 4096 May 27 08:19 DBI/

    I don't want to have different installation on the server and, most of all, I don't want the new modules to be installed in the /usr/local/lib/ path, as it seems to be happening to the DBD::Oracle module.
    I've found many posts/answers that explain how different (and coexistent) perl installations can be created; none of them tells how they can be deleted.
    I would like to know if there is a procedure to recovery the main perl installation and roll back to a single "instance".
    Will there be side effects if I delete all the content of the /usr/local/lib/ installation?

    Thank you very much in advance.

XML Parsing
3 direct replies — Read more / Contribute
by nikmit
on May 27, 2016 at 09:34

    Update:

    Posting here seems to mobilise me to look harder, even on a Friday afternoon before a 3 day weekend...
    XML::Simple seems to do what I asked for below.

    Of course, comments still welcome.

    ------

    I have been looking at XML parsing modules all day and either can't find the one I need or found it and couldn't figure out how to use it... so I humbly ask for help.

    Given this XML

    <City name="Some City"> <Properties location="SomeCountry"> <StreetList version="1"> <Street name="Foo Street" bars="none"> <Street name="Bar Street" bars="plenty"> </StreetList> </City> <City name="Other City"> <Properties location="Narnia"> <StreetList version="5"> <Street name="Lovely Street" bars="some"> <Street name="Gray Street" bars="none"> </StreetList> </City>

    What is the best way to load only a single 'City' element with its related information, to query further?
    I want to choose a street to visit while I'm in a given city with something like

    my $current_city = 'Some City'; my $xml = Module->parse('myfile.xml', //City[@name=$current_city); my @street_list = $xml->findnodes('/Street'); print "In $current_city these streets have bars: "; foreach my $street (@street_list) { if ($street->{bars} ne 'none') { my $street_name = $street->{name}; print "$street_name"; } }

    Running that would produce

    In Some City these streets have bars: Bar Street
X Error in Tk remote drag and drop
1 direct reply — Read more / Contribute
by prenaud
on May 27, 2016 at 08:10

    Hello,

    I use PERL on Linux Mint and I have an error when I drop a file from the Cinnamon desktop on a Tk widget :

    X Error of failed request: BadWindow (invalid Window parameter) Major opcode of failed request: 25 (X_SendEvent) Resource id in failed request: 0x2fd00fd Serial number of failed request: 164 Current serial number in output stream: 165

    My source code is:

    #!/usr/bin/perl use strict; use Tk; use Tk::DropSite; my $mw = new MainWindow(-width => 500, -height => 300); my $label = $mw->Label()->pack->place(-relwidth => 1.0, -relheight => +1.0); $label->DropSite(-droptypes => ['XDND'], -dropcommand => [\&dropFile, +$label]); MainLoop; sub dropFile { print "DROP\n"; }

    What is wrong in this code ?

    Perl version is 5.18.2 and Tk version is 804.033

    Thanks for the help.

Using Config::IniFiles Module Obtain Comma Separated Values into An Array
6 direct replies — Read more / Contribute
by perlPsycho
on May 27, 2016 at 02:45
    Hello Wise Monks,
    I come forth Seeking your Knowledge for the good of Humanity.
    I need to get the values with a Single id "j" rather than many like 'i' either as CSV or space.
    The only constrain I was given that I should
    use only Config::IniFiles Predefined Method
    to get this and store it an array.
    Not REGEX or SPLIT FUNCTION or Any other third party Methods .

    Please Help me with your Wise Knowledge.


    This is my Code:
    #! /usr/bin/perl use warnings; use strict; use Getopt::Long; use Config::IniFiles; # SAMPLE : SET CONFIGURATION SAMPLE FILE TO READ. my ($sample,%ini,$cfg,%input_config_citi); GetOptions('config=s'=>\$sample); # TIE : OBTAIN THE CONFIG FILES CONTETNS $cfg= Config::IniFiles->new(-file=>$sample); tie %ini,'Config::IniFiles', (-file=>$sample); %input_config_citi=%{$ini{'hello'}}; #my @arr=$cfg->val('hello','i'); my @arr=$cfg->val('hello','j'); print "\n\nThe values are : \n\n"; print "$_\n",for(@arr);




    SOLUTION FOUND BY MYSELF:

    ANSWER


    Dont Mind the Morons Reply down below without Any Answers, Has got not answers Just some whining

    I need to get the values with a Single id "j" rather than many like 'i' either as CSV or space.


    Well Instead of CSV or spaces, I used an \n with EOT.

    It is so clear.
    How can you not Understand..??????????

    If you Already knew the Answer..??
    Then What were you Waiting For...???????????????????????
Numerical Value question
5 direct replies — Read more / Contribute
by OGProphet
on May 26, 2016 at 22:59

    Hey guys!

    So I'm very new at this so please bear with me.

    I've created a script that allows you to print specific excel files within a folder based on the keyword. The keyword is consistent with all the files e.g., 160526GRAD.

    Everything works fine except for this specific part of the file name where the number changes all the time. ex 160526GRAD-T5, 160526GRAD-T6, 160526GRAD-T7.

    My question is, is there a way to have the script look for any number value or a range of values (0-100) when trying to look for that file? I've searched hours but I haven't been able to find what I need =(

    my $a = qw(0,100); $keyword_EVO100 = "$path"."Output\\$keyword_EVO100"; $keyword_folder = "$path"."Output\\$keyword\_$initial\_$i";
    my $PRIMERMAP_open = $Excel->Workbooks->Open("$keyword_folder\\$keywor +d\_EVO100\\$keyword\-T$a\_PRIMERS_PrimerList.xlsx"); my $PRIMERMAP = "$keyword_folder\\$keyword\_EVO100\\$keyword\-T$a\_PRI +MERS_PrimerList.xlsx"; if(!(-e $PRIMERMAP)) { print "Primer List file is missing. Please make sure file is in correc +t folder!\n"; print "Press <Enter> to exit\n"; <>; exit(1); } $PRIMERMAP_open->PrintOut; $PRIMERMAP_open->close;
Using .pod as a standalone file rather than in .pm and it showing up in MetaCPAN
2 direct replies — Read more / Contribute
by rockyb
on May 26, 2016 at 19:00

    I'd prefer to have some documentation associated with a Perl Module, but I would rather not put it inside the code or .pm file but rather its own .pod file.

    The reason I'd like to do this is so that it can be shared in say a github wiki where folks can interactively edit.

    Before a release though, I'd copy the wiki into the distribution.

    So what are practices or best practices for having documentation showing up on search.cpan.org or metacapan.org outside of the code?

Using Alarms for MySQL DB
1 direct reply — Read more / Contribute
by satishkumaryarru
on May 26, 2016 at 17:27
    Hi, I have set an alarm to interrupt execution MySQL Delete operation after few seconds. But though timeout happens, it is not interrupting the DB operation. That query hangs on. Please check my below code and correct me if any thing wrong in it. Kindly help!!
    eval { local $SIG{ALRM} = sub { die "alarm\n" }; alarm $timeout_in_seconds; $mtd_prod_sqlQuery_delete->execute($mtd_replica_row[0]); alarm 0; }; if ($@) { print "Delete from MTD Prod Timeout\n"; }
Modules inheritance
2 direct replies — Read more / Contribute
by Arsenii Gorkin
on May 26, 2016 at 17:06
    Hi monks!

    I am working on a complex software and have a lot of modules here. I heard about inheritance in Perl but have never used it on practice. I have a few modules. Let's call them A.pm, A::1.pm, A::2.pm and A::3.pm.

    A.pm calls from inside module A::1, A::1 calls A::2 A::3 calls A (parent) and A::1

    What is the best practice to handle this problem?

    The questions are:

    1) Do I have to call all the modules I need from inside every module, or daughter modules automatically inherit functions from parent A.pm?

    2) What to do with daughter modules which call their "sisters"? Like: does A::3 must call A::1?

    thanks!

    Regards

    Arsenii.


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.