Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
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
Using Alarms for MySQL DB
No replies — Read more | Post response
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!! <code> 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"; } <code>
Modules inheritance
1 direct reply — 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.
Detecting URLs with URI
2 direct replies — Read more / Contribute
by htmanning
on May 26, 2016 at 15:47
    Monks, I'm using the following to detect urls and make them clickable links.
    use URI; use URI::Find; find_uris($description, sub { my ($find_uri, $orig_uri) = @_; my $uri = URI->new( $orig_uri ); $uri = $uri->canonical->as_string; return '<a href="' . $uri . '" target=_blank>' . $uri . '</a>'; });
    I'm having 2 issues with the following. First, some people leave off the "http://" and simply type "www." Secondly, believe it or not some people write their URLS in all caps. What is the best way to address these two issues?
MIME::Lite ssleay error
1 direct reply — Read more / Contribute
by sweetblood
on May 26, 2016 at 14:33
    I'm having a strange problem using MIME::Lite, quite some time ago I wrote or mostly stole a sendmail function. I've been using this in many different perl scripts for at least 15 years probably longer, never had a problem. Recently we built up a windows 2008R2 64bit server for passing data around SQL and the like.

    This script here illustrates the issue, using komodo and strawberry perl. When I simply run the script it does all that I ask it to ie: I get my email, but I also get the error listed at the bottom. If however I break on the first eval in the function then run from there I get no error. Again, the script does run to completion either way.

    Any ideas?
    #!/usr/bin/perl -w use strict; use MIME::Lite; use File::Basename; sendmail('someuser@foobar.com', "Foo", "bar\n"); sub sendmail { my ($recipients, $subject, $msg) = @_; my ($me) = basename($0) =~ /^([^\.]*?)\./; my $mailhost = 'mail.foobar.com'; my $fromAddress = $me . '@foobar.com'; $msg =~ s/[\r\n]//g; my $type = ($msg =~ /\n/) ? 'text/plain' : 'text/html'; eval { $msg=MIME::Lite->new( To => "$recipients", From => "$fromAddress", Subject => "$subject", Type => $type, #'text/html', Data => "$msg" ) or warn "new $!"; }; do { warn 'MIME::Lite->new() - ' . $@; return 0; } if $@; eval { MIME::Lite->send('smtp', "$mailhost") or warn $!; $msg->send() or warn "sending $!"; }; do { warn 'MIME:Lite->send() - ' . $@; return 0; } if $@; 1; }

    Error
    Use of uninitialized value in subroutine entry at blib\lib\Net\SSLeay.pm (autosplit into blib\lib\auto\Net\SSLeay\randomize.al) line 924.

    Sweetblood

Selective lines updation from one file (file1) to another (file2) without changing the rest of the sections to a new fine($dir/file2)
1 direct reply — Read more / Contribute
by anirbanphys
on May 26, 2016 at 14:20

    Hello All,

    I am trying to write a perl code which will do the following task.

    The code will read two .lib file, ref_lib.lib and org_lib.lib. After doing the operations it will dump final_lib/org_lib.lib.

    From ref_lib.lib it will only read the lines from "cell(" ( everything in between) to "leakage_power". And whatever it is reading from ref_lib.lib will be stored in a variable, say $attr_org.

    Similarly it will also read org_lib.lib. Now the code will dump everything, from line1 of org_lib.lib to final_lib/org_lib.lib, except the lines in between "cell(" and "leakage_power". This lines will be replaced by $attr_org.

    The structure of final_lib/org_lib.lib are also given below.

    I tried to write the code but can not understand where it is going wrong.

    Can you folks please let me know what change should be in the code?

    # Staring of perl code attr_update.pl my $ref_lib = $ARGV[0]; my $org_lib = $ARGV[1]; my $cell_flag = 0; my $lkg_flag = 0; my $attr_org; my $cell_name_ref; my $cell_name_org; system "rm -rf final_lib"; system "mkdir final_lib"; if ($#ARGV !=1) { print STDERR "Usage of script: perl attr_update.pl <REF_LIB> <ORG_LI +B> \n" ; } open (REFLIB,"<","$ref_lib") || die "Can not open REF_LIB" ; open (ORGLIB,"<","$org_lib") || die "Can not open ORG_LIB" ; open (FINALLIB,">","final_lib/$org_lib") || die "Can not open ORG_LIB" + ; while (my $line = <REFLIB>) { chomp($line); #print "$line \n"; if ($line=~m/^\s*cell\(.*/g){ $cell_flag = 1; $lkg_flag = 0; $cell_name_ref = $line; #print "OK 1\n"; } #<STDIN> if ($line=~m/^\s*leakage_power\(\)/g){ $cell_flag = 0; $lkg_flag = 1; } if (($cell_flag ==1) && ($lkg_flag == 0)){ $attr_org = $line; #print "$attr_org \n"; } while (my $line_2 = <ORGLIB> ){ chomp ($line_2); if ($line_2=~m/^\s*cell\(.*/g){ $cell_name_org = $line_2; } if ($cell_name_ref == $cell_name_org){ print FINALLIB "$attr_org \n"; } else { print FINALLIB "$line_2 \n"; } } }
    ##Staring of ref_lib.lib library_for_dev_47nm_proj { cell(and2_f2) { area : 434.7; cell_type : combo; cell_function : A * B; timing_const : NIL; clock_present : NIL; leakage_power() { power_pin : "VDD" ; when : "!A&!B" ; value : "0.000047" ; } pin(A1) { direction : input; capacitance : 2.141; } pin(Y) { direction : output; function : "A1 * B1"; } } cell(nand2_f2) { area : 359.1; cell_type : combo; cell_function :(A1 * B1)\u201; timing_const : NIL; clock_present : NIL; leakage_power() { power_pin : "VDD" ; when : "!A&B" ; value : "0.00057" ; } pin(A1) { direction : input; capacitance : 12.547; } pin(B1) { direction : input; capacitance : 12.259; } pin(O) { direction : output; function : "(A1 * B1)\u2019"; } } cell(dfr_f5) { area : 4819.5; cell_type : seq; cell_function : d=!q; timing_const : YES; clock_present : YES; leakage_power() { power_pin : "VDD" ; when : "D" ; value : "5.00057" ; } pin(Q) { direction : output; function : "IQ"; } } }
    ##Staring of org_lib.lib library_for_dev_47nm_proj { lu_table_template(t4x3) { variable_1: total_output_net_capacitance ; variable_2: input_net_transistion ; index_1 {\u201c5, 20, 60, 200\u201d} ; index_2 {\u201c0.01, 0.1, 2.0\u201d} ; } cell(and2_f2) { cell_type : combo; cell_function : A * B; timing_const : NIL; clock_present : NIL; leakage_power() { power_pin : "VDD" ; when : "!A&!B" ; value : "0.000047" ; } pin(A1) { direction : input; capacitance : 2.141; } pin(B1) { direction : input; capacitance : 1.948; } pin(Y) { direction : output; function : "A1 * B1"; } } cell(nand2_f2) { area : 359.1; cell_type : combo; cell_function : (A1 * B1)\u201; clock_present : NIL; leakage_power() { power_pin : "VDD" ; when : "!A&B" ; value : "0.00057" ; } pin(A1) { direction : input; capacitance : 12.547; } pin(B1) { direction : input; capacitance : 12.259; } pin(O) { direction : output; function : "(A1 * B1)\u2019"; } } cell(dfr_f5) { area : 4819.5; timing_const : YES; clock_present : YES; leakage_power() { power_pin : "VDD" ; when : "D" ; value : "5.00057" ; } ff(IQ,IQN) { next_state : "DATA1"; clocked_on : "CLK2\u2019"; clear : "RST3\u2019"; } pin(DATA1) { direction : input; capacitance : 51.289; } pin(CLK2) { direction : input; capacitance : 52.305; } pin(RST3) { direction : input; capacitance : 28.602; } pin(Q) { direction : output; function : "IQ"; } } }
    ##Staring of final_lib/org_lib.lib library_for_dev_47nm_proj { lu_table_template(t4x3) { variable_1: total_output_net_capacitance ; variable_2: input_net_transistion ; index_1 {\u201c5, 20, 60, 200\u201d} ; index_2 {\u201c0.01, 0.1, 2.0\u201d} ; } cell(and2_f2) { area : 434.7; cell_type : combo; cell_function : A * B; timing_const : NIL; clock_present : NIL; leakage_power() { power_pin : "VDD" ; when : "!A&!B" ; value : "0.000047" ; } pin(A1) { direction : input; capacitance : 2.141; } pin(B1) { direction : input; capacitance : 1.948; } pin(Y) { direction : output; function : "A1 * B1"; } } cell(nand2_f2) { area : 359.1; cell_type : combo; cell_function : (A1 * B1)\u201; timing_const : NIL; clock_present : NIL; leakage_power() { power_pin : "VDD" ; when : "!A&B" ; value : "0.00057" ; } pin(A1) { direction : input; capacitance : 12.547; } pin(B1) { direction : input; capacitance : 12.259; } pin(O) { direction : output; function : "(A1 * B1)\u2019"; } } cell(dfr_f5) { area : 4819.5; cell_type : seq; cell_function : d=!q; timing_const : YES; clock_present : YES; leakage_power() { power_pin : "VDD" ; when : "D" ; value : "5.00057" ; } ff(IQ,IQN) { next_state : "DATA1"; clocked_on : "CLK2\u2019"; clear : "RST3\u2019"; } pin(DATA1) { direction : input; capacitance : 51.289; } pin(CLK2) { direction : input; capacitance : 52.305; } pin(RST3) { direction : input; capacitance : 28.602; } pin(Q) { direction : output; function : "IQ"; } } }
Pass an object, a variable in an Array
1 direct reply — Read more / Contribute
by Chaoui05
on May 26, 2016 at 10:21
    Hi everybody, I have a beginner question : How to add an object or a variable in an Array with Perl. I'am using Selenium::Screenshot package I have my Object here ..
    my $white = Selenium::Screenshot->new( png => $driver->screenshot, exclude => [{ size => { width => 100, height => 100 }, # s +ize => $elem->get_size, location => { x => 5, y => 5 }, #location => $el +em->get_element_location, }] ); $white->save( file => "snapScreenshot-$browser" );
    That i would like to retrieve in this Array. But i'am not sure it's well done ..?
    $screenshots{$browser} = new Selenium::Screenshot;
    Thanks
    Lost in translation
Parse html file with java script
1 direct reply — Read more / Contribute
by perlmad
on May 26, 2016 at 10:00

    Hi Monks

    I am using www::mechanize module to parse the webpage and get the html content by HTML::TreeBuilder

    here is my code

    $mech -> get($home_url); print " base is :",$mech->response()->base,"\n\n"; #print " Home page is :",$mech->uri(),"\n\n"; my $parser = HTML::TokeParser->new($mech->content); html_table_parse(); sub html_table_parse { while( my $div =$parser->get_tag('div') ) { my $div_id=$div->get_attr('id'); next unless defined ($div_id) and $div_id eq 'jqxgrid'; my $div_contenttablejqxgrid=$parser->get_tag('div'); my $div_contenttablejqxgrid_id=$div_contenttablejqxgrid +->get_attr('id'); next unless defined ($div_contenttablejqxgrid_id) and $ +div_contenttablejqxgrid_id eq 'contenttablejqxgrid'; my $div_row=$parser->get_tag('div'); my $div_row_id=$div_row->get_attr('role'); next unless defined ($div_row_id) and $div_row_id eq 'r +ow'; my $div_gridcell=$parser->get_tag('div'); my $div_gridcell_id=$div_gridcell->get_attr('role'); next unless defined ($div_gridcell_id) and $div_gridcel +l_id eq 'gridcell'; print "Content is ",$div_gridcell_id->get_text,"\n\n"; } }

    The problem is there is no div tag 'jqxgrid' and 'contenttablejqxgrid' and 'role' is found in the html content and end of the html content has lot of java script files they are

    </script> ^M <script type="text/javascript" src="/js/jqwidgets/jqxcore.js"></s +cript> <script type="text/javascript" src="/js/jqwidgets/jqxdata.js"></s +cript> <script type="text/javascript" src="/js/jqwidgets/jqxbuttons.js"> +</script> <script type="text/javascript" src="/js/jqwidgets/jqxscrollbar.js +"></script> <script type="text/javascript" src="/js/jqwidgets/jqxmenu.js"></s +cript> <script type="text/javascript" src="/js/jqwidgets/jqxlistbox.js"> +</script> <script type="text/javascript" src="/js/jqwidgets/jqxdropdownlist +.js"></script> <script type="text/javascript" src="/js/jqwidgets/jqxcheckbox.js" +></script> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.js"></s +cript> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.sort.js +"></script> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.filter. +js"></script> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.selecti +on.js"></script> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.columns +resize.js"></script> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.pager.j +s"></script> <script type="text/javascript" src="/js/jqwidgets/jqxcalendar.js" +></script> <script type="text/javascript" src="/js/jqwidgets/jqxdatetimeinpu +t.js"></script> <script type="text/javascript" src="/js/jqwidgets/jqxdata.export. +js"></script> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.export. +js"></script> <script type="text/javascript" src="/js/jqwidgets/jqxgrid.sort.js +"></script> <script type="text/javascript" src="/js/auctionQuery.js"></script +> </body>^M </html> </script>

    Questions: 1) How to get the div tag element ? , 2) Hot to work javascript with perl while webpage parsing ?, 3) Is this possible to disable java script ?,

    Please help me to find how to proceed with it

hash question
3 direct replies — Read more / Contribute
by duyet
on May 26, 2016 at 06:46
    I've been working with hash for a while now, but there is something i really don't understand.
    my $hash = {}; do_something( $hash ); print Dumper( $hash ); sub do_something { my $hash = shift; $hash = { a => 'alpha', b => 'beta', }; print Dumper( $hash ); }
    when exectuted:
    { 'a' => 'alpha', 'b' => 'beta' } {}
    but if using:
    do_something_else( $hash ); print Dumper( $hash ); sub do_something_else { my $hash = shift; $hash->{g} = 'gamma'; $hash->{d} = 'delta'; print Dumper( $hash ); }
    it shows:
    { 'd' => 'delta', 'g' => 'gamma' } { 'd' => 'delta', 'g' => 'gamma' }
    To me the initialization of $hash is the same in both subs, but apparently it is not. It's probably something very trivial, but i just miss it. Would you please explain why? TIA.
Recover a variable from a loop
4 direct replies — Read more / Contribute
by Chaoui05
on May 26, 2016 at 04:14
    Hi Monks ! I am on a learning curve with Perl. I am trying to compare Screenshot between two different browsers for a same image ,in some Test. All is ok. I'am using Selenium::Screenshot and Test::Class modules. But when i would like to compare my screenshots outside of a loop, i have some issues. Here code i did:
    sub Login_test : Tests { my $self = shift; foreach my $browser (@{$self->{browsers}}) { diag ("#browser $browser"); my $driver = Test::Selenium::Remote::Driver->new( browser_name => +$browser); $driver->get_ok("$url","Get url ok"); $driver->pause(2000); $driver->set_window_size(600, 600); $driver->pause(2000); my $white = Selenium::Screenshot->new( png => $driver->screenshot, exclude => [{ size => { width => 100, height => 100 }, # s +ize => $elem->get_size, location => { x => 5, y => 5 }, #location => $el +em->get_element_location, }] ); $driver->find_element('login','id')->send_keys("ok"); $driver->find_element('password','id')->send_keys("okok"); $elem = $driver->find_element('login','id'); $driver->mouse_move_to_location(element => $elem); $driver->click_ok('Click on Button submit ok'); $driver->pause(5000); $white->save( file => "snapScreenshot-$browser" ); #$driver->execute_script('document.getElementsByTagName("body")[0] +.style.backgroundColor = "red"'); my $blue = Selenium::Screenshot->new(png => $driver->screenshot); $blue->save( file => "snapScreenshot1-$browser" ); $elem = $driver->find_element('//a[@href="/logout"]'); $driver->mouse_move_to_location(element => $elem); $driver->click_ok('Logout ok'); $driver->pause(3000); $driver->quit(); } unless ($white{browser_name => $browser[0]}->compare($blue{browser_n +ame => $browser[1]})) { $diff_file = $white->difference($blue); print '#The images differ; see ' . $diff_file . ' for details'. "\ +n"; my $open_cmd; if ($^O eq 'darwin') { $open_cmd = 'open' } elsif ($^O eq 'MSWin32') { $open_cmd = ''; } else { $open_cmd = 'display'; } `$open_cmd $diff_file`; } }
    And here my output in Shell :
    Global symbol "%white" requires explicit package name at MyTest.pm lin +e 33. Global symbol "@browser" requires explicit package name at MyTest.pm l +ine 33. Global symbol "%blue" requires explicit package name at MyTest.pm line + 33. Global symbol "@browser" requires explicit package name at MyTest.pm l +ine 33. Global symbol "$diff_file" requires explicit package name at MyTest.pm + line 34. Global symbol "$blue" requires explicit package name at MyTest.pm line + 34. Global symbol "$diff_file" requires explicit package name at MyTest.pm + line 35. Global symbol "$diff_file" requires explicit package name at MyTest.pm + line 38.
    What can i do ? Thanks !!
    Lost in translation
Problem in mirror method
2 direct replies — Read more / Contribute
by perlmad
on May 26, 2016 at 01:26

    Hi Monks

    I am using mirror method to get the update webpage content

    here is my code

    if($mech->mirror("url","$filename") == RC_NOT_MODIFIED ) { print " link not Updated \n\n\n"; if($mech->response()->is_success){ print " response is success\n\n"; print " content :",$mech->response()->as_strin +g,"\n\n"; } else { print "failure \n\n"; } } else { print " link updated...\n\n"; $mech->save_content($filename); }

    When i run this above code i get some irregular files except download file

    # Command line output error Cannot rename '-23348' to '': No such file or directory $ls -23094 -23348 code.pl config.ini downloads downloads1 downloads2 + Download_Status.doc output.txt $ ls ./* -lthr 727 May 26 09:41 ./config.ini 9.2K May 26 09:54 ./code.pl 11M May 26 09:54 ./-23094 113 May 26 09:55 ./Download_Status.doc 26M May 26 10:04 ./-23348

    my doubt is why am getting this "-23348" file and how can i get update page content???

    Please Help me to find a correct path


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 musing on the Monastery: (11)
    As of 2016-05-26 21:30 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?