Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

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
Outer Join on 2 files
2 direct replies — Read more / Contribute
by healingtao
on Apr 18, 2015 at 00:40
    Hello Monks, I'm a perl newbie and have the following requirement: 1) I need to do an outer join on 2 files which have about 20 columns e +ach. Both files have headers 2) The join needs to happen on key based on 3 columns from each file, +so both have to be sorted. The key is from column 1,4,5 in both files + but key column headers don't all match (can we match the key based o +n column index instead of header names?) 3) If the key matches, I need the flexibility to add specific columns +from any of the files to the output file. 4) If there is no key match, take the existing key/data from file and +add it to the output leaving the other columns blank (outer join). 5) Need to generate a separate output file leaving inputs intact. 6) The input/output files need to use '|' separators Here is an example with 2 input files and an output file using only sm +all sample of columns: File_Deal - the key here is parent_cusp,deal,tranche parent_cusp|cusp|isin|deal|tranche|det_date|col_type 38375U|36182D|36182D1|HMAG|HMBSWEE|20150416|mortgage 383333|361333|3618333|HABS|HABSDDE|20150330|mortgage2 File_ATT - the key here is Vendor, deal, tranche Vendor|visp|barnembly|deal|tranche|Fund|subamt|colamt|basamt 38375U|3DD82D|36FF333|HMAG|HMBSWEE|9010|765423|364633|46566 38EE33|361DD3|36LLE33|H99S|HAOOODE|2330|377233|347433|34488 File_Output parent_cusp|cusp|isin|deal|tranche|det_date|col_type|Fund|subamt|colam +t|basamt 38375U|36182D|36182D1|HMAG|HMBSWEE|20150416|mortgage|9010|765423|36463 +3|46566 383333|361333|3618333|HABS|HABSDDE|20150330|mortgage2|||| 38EE33|||H99S|HAOOODE|||2330|377233|347433|34488 7) The output needs to contain all the columns/data from file1 (File_D +eal) and for file2 (File_ATT) join only starting from column 6 (Fund) + until the last column (basamt). 8) based on the output - row 1 is a match so I just join from both fil +es 9) row 2 is a mismatch from File_deal, but since it's outer join I just copy row 2 from file_deal and just add blanks (since it's +missing from file_Att 10) row 2 is a mismatch from File_att but once again I need outer join +. But here I need to copy the key from file_detail to output as well, + so I just write 3 key columns into 1st, 4th, and 5th column(leave ot +hers blank), then attach data from File_ATT Here is some of the code I'm starting with from sample I found but nee +d to come up with a solution quickly as deadline is approaching, can +you please help. Thanks in advance #! /bin/env perl my $File_Deal = $ARGV[0]; my $File_ATT = $ARGV[1]; open(F1, "<", $File_Deal); open(F2, "<", $File_ATT); my %hash = (); while( <F1> ) { chomp; my($c, $c2, $c4, @val1) = split/,/, $_, -1; $hash{$c1.$c2.$c4}[0] = $val1[0]; $hash{$key}[1] = $val1[1]; $hash{$key}[2] = $val1[2]; } while( <F2> ) { chomp; my($c1,$c5, $c7, @val2) = split/,/, $_, -1; $hash{$c1.$c5.$7}[3] = $val2[0]; $hash{$key}[4] = $val2[1]; $hash{$key}[5] = $val2[2]; } for my $key (sort keys %hash) { print "$key: $hash{$key}[0]:$hash{$key}[1]\n"; }
MySQL DBI dealing with hex blob field
1 direct reply — Read more / Contribute
by edimusrex
on Apr 17, 2015 at 17:17
    I am having a bit of an issue with MySQL DBI. My script currently grabs data from a Cassandra database and populates a MySQL database with the returned values. One of the fields retrieved from Cassandra is a key field which is a hexadecimal value in the following format 0xD3BAA1BC343E492F9C7A2C310B8A5C32.
    That key is then inserted into a blob column in MySQL so that I may retain the hex value without it being converted (the key value is important for querying our Cassandra database).

    I have various option switches I can use with my script and one of them grabs the key value from MySQL and uses it to query the Cassandra database. The issue is that when the DBI returns the value it interprets or converts the value instead of leaving it in it's exact format.

    If this is making any sense and if some one could help me, that would be hugely helpful.
    Here is a sample of the code.

    if ($access) { my $sql = "SELECT `key` FROM `users`"; my $keys = &retrieveData($sql,1); foreach my $get (@{$keys}) { say $get->{key}; my $get_stmt = $cass->prepare( 'SELECT "accessedDt" FROM accou +nts WHERE key = '.$hex->as_hex)->get; my ( undef, $result ) = $get_stmt->execute( [] )->get; foreach my $row ($result->rows_hash) { my $key_find = ($row->{"accessedDt"}); if (defined $key_find) { say "I found this date --- $key_find"; } } } } sub retrieveData { my $value; my $sth = $dbh->prepare($_[0]); $sth->execute(); if ($_[1]) { $value = $sth->fetchall_arrayref({}); } else { $value = $sth->fetchrow_array(); } return $value; }
Perl koan #2300 (Perl in the browser)
3 direct replies — Read more / Contribute
by rje
on Apr 17, 2015 at 13:46

    Perl koan n. A puzzling, often paradoxical statement or suggestion, used by Perl hackers as an aid to meditation and a means of gaining spiritual awakening or something.

    For the moment, don't think about the obstacles.

    Imagine you could plug in Perl (perhaps defaulted to strict mode and built-in with Mo(o|u)(se)?) onto your browser when JavaScript gets too painful.

    What possible benefits might that give? Assuming first that JavaScript is difficult for enterprise-scale apps (hence the existence of Dart, and frameworks like AngularJS), it seems that Perl would fill the part -- and has been stable for years, and has a wide user base.

    Obstacles aside, can you see the utility and beauty of Perl5 on every browser - not just Opera?

Web Scraper : 2 process !!
1 direct reply — Read more / Contribute
by Alexander75
on Apr 17, 2015 at 11:39
    I need to get the content of "p" tag, that contents each of the seven paragraphs of my text, and, separately, the content of the "recording dates" (h4 and h3) tag, that contents the text title. "p" and "recording dates" belong to "release-height". The problem is that they are on the same level. So I don't know how to get them separately. I need to do two process, on for the "name of the artist", and the title of the artist, and one another for all of the paragraphs, but i really don't know how to proceed.
    use URI; use Web::Scraper; use Encode; use Data::Dumper; open (OUT, '>LM_Article.txt'); my $resultat = scraper { process '//body[@id="artists"]', 'entree[]' => scraper { process '//div[@class="header-bar-inner"]/h2', artiste => 'TEXT'; process '//div[@class="release-height"]/div[@class="recording- + dates"]', titre => 'TEXT'; }; my $resultat2 = scraper { process '//div[@class="release-height"]', 'entree[]' => scraper + { process '//div[@class="release-height"]/p', texte =>'TEXT'; }; } my $res = $resultat.$resultat2 ->scrape( URI- >new("http://www.bluen") ); for my $val (@{$res->{entree}}) { print OUT Encode::encode ("utf8", $val->{artiste} . "\n" . $val-> + {titre} . "\n" . $val->{texte} . "\n"); } close (OUT);
Parsing Windows CommandLine from Perl
6 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Apr 17, 2015 at 10:22

    On Windows, the following C program:

    #include <stdio.h> int main(int argc, char* argv[]) { int i; for (i = 0; i < argc; ++i) { printf("%d:%s:\n", i, argv[i]); } return 0; }
    when run like this:
    > arg.exe "abc "" xyz"
    0:arg.exe: 1:abc " xyz:
    Though escaping double quotes inside a double quoted string by repeating them (as above) is ungainly, it is common in the Windows world and I need to support it.

    Notice that the following Perl program:

    for my $arg (@ARGV) { print "$arg:\n" }
    when run with the same command line arguments:
    > perl "abc "" xyz"
    prints instead:
    abc ": xyz:

    I tried:

    use strict; use warnings; use Win32::API; my $getcmdline = Win32::API->new( 'kernel32.dll', 'GetCommandLine', [] +, 'P' ) or die "error: Win32::API GetCommandLine: $^E"; my $cmdline = pack 'Z*', $getcmdline->Call(); $cmdline =~ tr/\0//d; # remove any NULLs left over from pack Z* $cmdline =~ s/\s+$//; # remove trailing white space print "cmdline=$cmdline:\n";
    to get at the Windows command line, but ran into the "random crashing problem" described at Win32::API Memory Exception with GetCommandLine() (which returns a static string).

    It seems I'll need to use Win32::CommandLine (which I cannot currently get to build cleanly) or write a C front end to do the argument passing before launching Perl. Is there another way around this that I've missed?

Is it possible to localize the stat/lstat cache?
5 direct replies — Read more / Contribute
by bounsy
on Apr 17, 2015 at 10:08

    I have a function that gets called a lot (a wanted function for File::Find going against large numbers of files). To avoid constantly hitting the disk, I do one stat/lstat and then use -X _ repeatedly after that (using the cached results of the last stat/lstat).

    In some cases, I need to call other functions that need to be able to use stat/lstat, which will overwrite the cached results in _. The actual calls to these other functions are uncommon in frequency (exception handling, essentially), but there are many places in the main function that might need to call them.

    Ideally, I would like to be able to localize the cached results of the stat/lstat call in some way (in the called functions). Is there a way to do this? (Note that local _; doesn't compile and local *_; doesn't work.) Is there a better and/or more generic approach?

    If I can't localize in any way, one approach I'm considering is caching the results I need in a hash. For example:

    #NOTE: Depending on certain conditions, I need either stat or lstat. if (...) { stat($Filename) } else { lstat($Filename) } #Current code uses this format: # if (-X _) {...} #Possible new code (including only the tests I need to use): my %Stat = ( r => (-r _), w => (-w _), x => (-x _), s => (-s _), ... ); if ($Stat{r}) {...}


encrypt passwords
5 direct replies — Read more / Contribute
by fionbarr
on Apr 17, 2015 at 08:10
    working Crypt::CBC example
    use strict; use warnings; use Crypt::CBC; my $cipher = Crypt::CBC->new( -key => 'goldfish', -cipher => 'Blowfish' ); my $string = 'some data'; my $encrypted_string = encrypt("$string"); my $decrypted_string = decrypt($encrypted_string); print "\n$string\n"; print "\n$encrypted_string\n"; print "\n$decrypted_string\n"; # ----------------------------------------------------------- sub encrypt { my $str = shift; return ( $cipher->encrypt_hex($str) ); } # ----------------------------------------------------------- # ----------------------------------------------------------- sub decrypt { my $str = shift; return ( $cipher->decrypt( pack( "H*", $str ) ) ); } # -----------------------------------------------------------
"Unrecognized character" while use utf8 is in effect
2 direct replies — Read more / Contribute
by AppleFritter
on Apr 17, 2015 at 06:03

    Oh monks most tawny and tangy, whose wisdom and knowledge of all things Perl is unalienable and indefeasible, help me out, for I'm very much missing the obvious.

    As you will well know, Perl allows Unicode characters in variable names, so long as use utf8; is in effect. So the following snippet works as expected (apologies for the unresolved HTML entities, Perlmonks itself does not handle Unicode properly):

    my $&#x4EBA; = "World"; say "Hello, $&#x4EBA;";

    However, the following does not:

    my $&#1F310; = "World"; say "Hello, $&#1F310;";

    Perl 5.20.0 complains about this, saying:

    Unrecognized character \x{1f310}; marked by <-- HERE after my $<-- + HERE near column 5 at line 9.

    This is even though the character is in Unicode 6.3.0, which Perl 5.20.0 supports.

    So why isn't it working? Help me out, fellow monks.

use NDBM_File DB by child processes
1 direct reply — Read more / Contribute
by Anonymous Monk
on Apr 17, 2015 at 05:52

    Hi Monks, I need to use NDBM_File db across child processes. I use below code to create DB in parent

    #!/usr/bin/env perl use warnings; use Fcntl; use NDBM_File; use List::Util qw(first); my $df = 'db'; my %db; my @c_p; (tie %db, NDBM_File, $df, O_CREAT|O_RDWR, 0666) || die "$0: ERR, creat +ing DB $df : $!\n"; $db{'fields'} = ['rc', 'ev', 'h', 'u', 'oh', 'c', 'i', 'n_c']; untie %db || die "$0: Couldn't close db, $!\n"; my $pid = fork(); if ( $pid ) { # parent push @c_p, $pid; } elsif ( $pid == 0) { #child ssh_remote_exec(); exit (0); } sub ssh_remote_exec { my %_h; my @a; my %db; my $df = 'db'; (tie %db, NDBM_File, $df, O_RDWR, 0666) || die "$0: ERR, open +DB $df : $!\n"; # get output from remote exec and parse it into %_h # here open the db created in parent, use the field key to retr +ieve the array index and put there the value of key from %_h # but $db{'field'} has no data in child foreach my $k (keys %_h ) { my $i = first { $db{'fields'}->[$_] eq $k } 0..$#{$db +{'fields'}}; $a[$i] = $_h{$k}; print "key : $k, index : $i, value: $_h{$k} \n"; } print join (';', @a), "\n"; $db{'1'} = join (';', @a); untie %db || die "$0: Couldn't close db, $!\n"; }

    I need to know whether I'm doing things rite ? need your wisdom in using NDBM db across multiple child processes.

Why does widget-->destroy give the error Tk::Error widget was deleted before its visibility changed?
1 direct reply — Read more / Contribute
by thomas.bystrom
on Apr 17, 2015 at 05:42

    When running the example below I get the error:

    Tk::Error: window "" was deleted before its visibility changed at
    C:/Dwimperl/perl/site/lib/Tk/ line 1000.
    Tk callback for tkwait
    (command bound to event)


    #!/usr/bin/perl -w use strict; use Tk; use Tk::Pane; use Tk::HList; sub door { my $house = shift; my $door_W = $house->Toplevel(); my $hlist = $door_W->Scrolled( 'HList', -scrollbars => "se", -columns => 1, -header => 1, )->pack( -expand => 1, -fill => 'both'); $hlist->headerCreate(0, -text => 'Title'); $hlist->columnWidth(0, ''); $hlist->bind("<Button-1>" => [\&knock_on_door, $door_W]); my $exit_B = $door_W->Button( -text => 'Exit', -command => sub { $door_W->destroy(); }, -relief => 'raised', )->pack(-side => 'left'); } sub knock_on_door { my $frame = shift; my $pop_menu = $frame->Menu( -menuitems => [ ['command', 'Knock on door.', -command => sub { print "Knock! Knock!!!\n"; } ], '', ] )->Popup(-popover => "cursor", -popanchor => 'nw'); $pop_menu->destroy; } my $mw = MainWindow->new; $mw->Button(-text => "Close", -command =>sub{exit})->pack(); door($mw); MainLoop;

    You receive the error after selecting "knock on door" and pushing the Exit button.
    You don't recieve the error if you only push the Exit button.
    I am running TK 804.032

    Thankful for any ideas.


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!
  • 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?

    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 imbibing at the Monastery: (4)
    As of 2015-04-18 08:35 GMT
    Find Nodes?
      Voting Booth?

      Who makes your decisions?

      Results (351 votes), past polls