Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
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
Log::Log4perl::Layout::PatternLayout: setting combined length for two fields?
1 direct reply — Read more / Contribute
by toomas
on May 27, 2016 at 23:03

    Hello,

    Recently I discovered Log::Log4perl. This is such a great piece of work that after a week of using it I'm almost wondering how could I live without it before. But there are things about it I have not been able to figure out by studying the documentation.

    Here is my problem:

    I want to indent log messages by stack depth (for tracing program execution), and although Log::Log4perl itself does not directly support this, I have managed (with help from the Internet, including Perl Monks) to have it my way — almost. I added the following lines to log4perl.conf:

    log4perl.PatternLayout.cspec.S = sub { return ' ' x level_for_l4p() +; } log4perl.appender.std.layout.ConversionPattern = %-27F %3L %S%m%n

    and defined level_for_l4p() in my main program:

    my $zerolevel = 8; sub level_for_l4p { my $level = 0; 1 while caller( $level++ ); return ( $level - $zerolevel ); } Log::Log4perl::init( 'log4perl.conf' );

    (Appropriate numbers for $zerolevel and %F are easily found by trial and error.)

    Logs produced by this setup look basically like this:

    /My/Project/One/File.pm 12 sub0: calling sub1 /My/Project/Another/File.pm 96 sub1: entering /My/Project/Another/File.pm 105 sub1: calling sub2 /My/Project/Elsewhere.pm 72 sub2: entering /My/Project/Elsewhere.pm 84 sub2: leaving /My/Project/Another/File.pm 108 sub1: continuing after sub2 /My/Project/Another/File.pm 115 sub1: leaving /My/Project/One/File.pm 16 sub0: continuing after sub1 # etc.

    In principle, this is exactly what I want, but I don't like the appearance of the output: IMHO it fails miserably to please the eye.

    I'd much prefer being able to have the log output look like this:

    /My/Project/One/File.pm:12: sub0: calling sub1 /My/Project/Another/File.pm:96: sub1: entering /My/Project/Another/File.pm:105: sub1: calling sub2 /My/Project/Elsewhere.pm:72: sub2: entering /My/Project/Elsewhere.pm:84: sub2: leaving /My/Project/Another/File.pm:108: sub1: continuing after sub2 /My/Project/Another/File.pm:115: sub1: leaving /My/Project/One/File.pm:16: sub0: continuing after sub1

    which would also have the additional benefit of working right out of the box with Emacs' default compilation-error-regexp-alist. To achieve this, it should be possible to say something like %-32{%F:%L:}, i.e. to tell Log::Log4perl to set the total length for %F:%L: as a unit. But I have not been able to find a way to express my intention.

    Is it possible to do what I want? In case I'm missing something obvious, can anybody point me to an existing and/or simple solution?

    I am using Log::Log4perl 1.47 and Perl 5.20.0.

    Cheers,
    T.

DBD::CSV::st execute failed:
4 direct replies — Read more / Contribute
by Sandy_Bio_Perl
on May 27, 2016 at 17:49

    Dear Monks, I am runnng an sql query using DBI. The code works well on my laptop running Strawberry Perl but fails to run on our university linux server using Perl 5.10.1

    My perl progam is

    #!/usr/bin/perl use strict; use warnings; use Text::CSV; use DBI; sub RunSqlSearch; my $query = qq(SELECT sid,genotype FROM newCsv.csv WHERE genotype = 'a +'); my ($queryResult,@sidResult) = RunSqlSearch($query); print "You query $query returned the following result:$queryResult\n"; print "The sid list associated with this result are: @sidResult\n\n"; sub RunSqlSearch($){ my $query = $_[0]; # error check # if ($query eq ""){die "No value entered for $query $!\n";} # Connect to the database, (the directory containing our csv file +(s)) my $dbh = DBI->connect ("dbi:CSV:", undef, undef, { f_dir => ".", f_ext => ".csv/r", f_encoding => "utf-8", RaiseError => 1, }) or die $DBI::errstr; # Output using sql query # my $sth = $dbh->prepare($query); $sth->execute; my @row; my $queryResult=""; my @queryResult; my @sidResult; while (@row = $sth->fetchrow_array) { push @queryResult, @row; push @sidResult, $row[0].","; $queryResult .= join("\t",@row) . "\n"; } # output arguments # if ($queryResult eq ""){$queryResult = "No result found";} return ($queryResult, @sidResult); $sth->finish(); $dbh->disconnect(); }

    I get the following error message from our university server

    DBD::CSV::st execute failed: Execution ERROR: No filename given at /usr/lib64/perl5/DBD/File.pm lin +e 565. called from runSQLQuery.pl at 11. at /usr/lib64/perl5/DBD/File.pm line 565. [for Statement "SELECT sid,genotype FROM newCsv.csv WHERE genotype = +'a'"] at runSQLQuery.pl line 32. DBD::CSV::st execute failed: Execution ERROR: No filename given at /usr/lib64/perl5/DBD/File.pm lin +e 565. called from runSQLQuery.pl at 11. at /usr/lib64/perl5/DBD/File.pm line 565. [for Statement "SELECT sid,genotype FROM newCsv.csv WHERE genotype = +'a'"] at runSQLQuery.pl line 32.

    Could you please point out the error of my ways?

open() and permissions not quite as documented?
1 direct reply — Read more / Contribute
by mpersico
on May 27, 2016 at 14:29
    Is it a known behavior that if you 'open' a file for writing that does not already exist, umask settings are properly applied, yet if a file that exists is opened for (over)writing, it keeps the existing permissions, ignoring the umask settings? This drove me nuts for an hour this morning on a Linux box with Perl 5.16.
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
2 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;

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 avoiding work at the Monastery: (6)
    As of 2016-05-28 10:46 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?