Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
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
process run in background
1 direct reply — Read more / Contribute
by t-rex
on Jul 27, 2016 at 07:48

    Hello Monks, I am working on a module which is based on client-server socket model such that

    client –-->tries to connect to particular server (socket) if ( fails) then client--→ transfers a tar file and a script to the server machin +e this script untar the folder and runs server.pl on the remote server m +achine
    I have achieved this functionality but only issue is the above server runs in while(1) hence when I launch the server.pl on remote server from client , my client gets hanged so I have to give a ctrl+Z to make server.pl run in the background and start the client again. This is causing some hiccups in my module ( basically it is desired to just launch one script which in turn will do everything for you). I have tried nohup command & but of no use. I haven’t shared the code as it is huge , and I want you guys to make explain what exactly I am doing. I can share the code if need be , please help

Passing 2 tags to find() method
3 direct replies — Read more / Contribute
by Kaustubh
on Jul 27, 2016 at 01:26

    Hi Monks,
    I am stuck with the following two questions and I need your guidance to solve it.My question may seem simple or inappropriate but please consider the fact that I am a newbie to Perl.
    1)Is it possible to specify 2 html tags in find() method if you are using Mechanize Package?Below is my code snippet which fails to return any output.Basically I have given a URL to get method say for example $mech->get("abc.com/xyz") and I am using this $mech along with find and attr methods.

    foreach my $element ($mech->find('span strong')) { print $element->as_text(); }
    2)Is there any method available that can take a html tag and an attribute as parameters and return the output instead of using find() and attr() methods separately.
    The project that I am working on makes use of Mechanize Package.

problem inserting spanish character into mysql
2 direct replies — Read more / Contribute
by smithyed
on Jul 26, 2016 at 18:53

    Hello Monks! I have been having problems reading data from an xml file and inserting it into mysql. As a test I created a file with one word in it:
    Sustitución
    And wrote a quick script to to read it from the file and insert it into the database:

    Perl 5.8.8 (test.pl) use strict; use warnings; use DBI; use Encode; use utf8; my $filename = 'test.xml'; my $data; open (my $fh, '<:encoding(UTF-8)', $filename) or die "Could not open f +ile '$filename' $!"; while (my $row = <$fh>){ chomp $row; print "$row " . ( utf8::is_utf8 ( $row ) + 0) . "\n"; # prints: Su +stitución1 $data = $row; print "$data " . ( utf8::is_utf8 ( $data ) + 0) . "\n"; # prints: +Sustitución1 } ###### my $sql = "INSERT INTO testTable (a,b,c,es) VALUES (?,?,?,?)"; # USE EITHER THIS LINE OF CODE OR ... #my @array = qw(3 2 1 Sustitución); # THESE 2 LINES OF CODE my @array = (3, 2, 1); push @array, $data; print $array[3] . ( utf8::is_utf8 ( $array[3] ) + 0) . "\n"; # prints: + Sustitución1 my $connect = "DBI:mysql:$dbname"; my $dbh = DBI->connect($connect, $dbuser, $dbpass, {mysql_enable_utf8 +=> 1, 'RaiseError'=>1, 'AutoCommit'=>0, 'PrintError'=>1}) or die "Err +or: $DBI::errstr\n"; my %query = ( sql => $sql, dbh => $dbh, data => \@array ); ### # call function that tests execute(@array) runQuery(\%query,1); sub runQuery{ my %args = %{$_[0]}; my $commit = $_[1]; my $sth = $args{dbh}->prepare($args{sql}); # execute the query eval{ $sth->execute(@{$args{data}}); } or do{ my $error = DBI->errstr; $args{dbh}->rollback(); }; # commit when we are told if($commit){ # test the commit - if all went well, this day was inserted su +ccessfully! eval{ my $rc = $args{dbh}->commit(); # commit to local database, + $dbh2 print "$rc = successful commit!\n"; } or do{ my $error = DBI->errstr; $args{dbh}->rollback(); # rollback local database, $dbh2 die "Rollback - There has been a problem! $error\n"; }; } } # end sub runQuery

    The problem I am encountering is if I insert the data from the file the database contains (as viewed in both Mysql Workbench 6.3 and phpmyadmin):
    Sustitución

    If I switch the commented lines of code to the line with the word Sustitución hard coded into the array, the database contains (viewed the same as above):
    Sustitución

    What is the difference in embedding the word Sustitución directly into the array vs reading it in from a file and then appending it to the end of the array? In both cases they print properly to the terminal. The mysql portion of the code appears to be functioning properly but maybe there is an issue there as well. I've also found if I change the encoding of the perl file (test.pl) from the default to utf8 then I always get Sustitución in the db, switching it back to the default I get Sustitución (when using just the hard coded array).

    I think I'm in a condition of information overload and need guidance from a friendly Monk!!

    Thank you in advance!

How would you write this RegExp?
4 direct replies — Read more / Contribute
by harangzsolt33
on Jul 26, 2016 at 17:16

    I am so frustrated, I have been reading the RegExp help for awhile, and I just don't get it. All I want to do is find out if a string is made up of a set of characters, and print either 1 or 0 (true or false).

    Here is the character set:

    0-9 - all numbers a-zA-Z - all letters . - the decimal point \ - backslash / - forward slash - - the dash _ - the underline % - percent sign $ - dollar sign ' - single quote () - parenthesis {} - opening and closing brackets & - the and sign ! - the exclamation point ~ - wave ` - tick or whatever this is @ - the at sign # - the comment character ^ - this guy

    Any other character is NOT allowed. SO, if the string contains a character that is not allowed, then I want the match to evaluate to 1, otherwise 0. This way I can tell whether the string has any illegal characters in it.

    Here is the code I have written, which doesn't do anything. :-P :-(

    my $STR1 = '///?///'; my $STR2 = 'ABC_ABC'; print "\n" . ($STR1 =~ /(\d\w.\/~-_!@#$%\^&{}\(\).'`)/); print "\n" . ($STR2 =~ /(\d\w.\/~-_!@#$%\^&{}\(\).'`)/);
Net::SSH2::Cisco Question, help with prompts
1 direct reply — Read more / Contribute
by edimusrex
on Jul 26, 2016 at 12:54

    I am attempting to use Net::SSH2::Cisco to issue a command to a Cisco phone server. It's not an issue if it's a command which doesn't require any kind of confirmation but if it does I can't seem to get it right. Here is what I am trying to do

    #!/usr/bin/perl use warnings; use strict; use Net::SSH2::Cisco; my $host = '<my_host>'; my $user = '<my_user>'; my $password = '<my_password>'; my $session = Net::SSH2::Cisco->new(host => $host); $session->login(username => $user, password => $password); my $match = '/^.+\[(confirm)\]/'; my $command = 'service-module integrated-Service-Engine 0/0 shutdown'; my @config = $session->cmd(String => $command, Prompt => $match); $session->close; print @config;

    If I go and check the status of the service module it has not been issued a shutdown command but the script completes without any errors or warnings

    Any help would be greatly appreciated

    Thanks in advice



    ----- UPDATE -----


    I figured it out, it was pretty simple. Here's all I had to do

    #!/usr/bin/perl use warnings; use strict; use Net::SSH2::Cisco; my $host = '<my_host>'; my $user = '<my_user>'; my $password = '<my_password>'; my $session = Net::SSH2::Cisco->new(host => $host); $session->login(username => $user, password => $password); my @config = $session->cmd("service-module integrated-Service-Engine 0 +/0 shutdown\n\n\n"); $session->close; print @config;

    I didn't actually have to look for a prompt I just needed to send enter to the command line

    Thanks for reading

Removing partially duplicated lines from a file
4 direct replies — Read more / Contribute
by Sandy_Bio_Perl
on Jul 26, 2016 at 11:52

    Hello Monks. I am trying to remove all lines where parts of the line are duplicated. In the file below, I would like to remove all 'duplicate' lines (leaving the first one) where column 2 (HLA) e.g. HLA-A*11:01 and column 3 (Peptide) e.g. YVNVNMGLK are the same. I would like to leave the other lines intact. I am a bit flummoxed, having tried and failed with regex!

    ---------------------------------------------------------------------- +------------- Pos HLA Peptide Core Of Gp Gl Ip Il Ic +ore Identity Score Aff(nM) %Rank BindLevel ---------------------------------------------------------------------- +------------- 117 HLA-A*11:01 YVNVNMGLK YVNVNMGLK 0 0 0 0 0 YVNVNM +GLK GQ924620_HBe_C_ 0.62268 59.3 0.40 <= SB 28 HLA-A*11:01 WGMDIDPYK WGMDIDPYK 0 0 0 0 0 WGMDID +PYK GQ924620_HBe_C_ 0.44617 400.4 1.60 <= WB 133 HLA-A*11:01 HISCLTFGR HISCLTFGR 0 0 0 0 0 HISCLT +FGR GQ924620_HBe_C_ 0.43660 444.0 1.70 <= WB ---------------------------------------------------------------------- +------------- Pos HLA Peptide Core Of Gp Gl Ip Il Ic +ore Identity Score Aff(nM) %Rank BindLevel ---------------------------------------------------------------------- +------------- 47 HLA-A*02:05 YVNVNMGLK FLPSDFFPS 0 0 0 0 0 FLPSDF +FPS X02763_HBe_A_po 0.77090 11.9 0.08 <= SB 40 HLA-A*02:05 ATVELLSFL ATVELLSFL 0 0 0 0 0 ATVELL +SFL X02763_HBe_A_po 0.75279 14.5 0.10 <= SB 1 HLA-A*02:05 MQLFHLCLI MQLFHLCLI 0 0 0 0 0 MQLFHL +CLI X02763_HBe_A_po 0.66669 36.8 0.30 <= SB 9 HLA-A*02:05 IISCTCPTV IISCTCPTV 0 0 0 0 0 IISCTC +PTV X02763_HBe_A_po 0.52206 176.1 1.40 <= WB 147 HLA-A*02:05 YLVSFGVWI YLVSFGVWI 0 0 0 0 0 YLVSFG +VWI X02763_HBe_A_po 0.51724 185.5 1.40 <= WB 55 HLA-A*02:05 SVRDLLDTA SVRDLLDTA 0 0 0 0 0 SVRDLL +DTA X02763_HBe_A_po 0.49966 224.4 1.70 <= WB 114 HLA-A*02:05 VVNYVNTNV VVNYVNTNV 0 0 0 0 0 VVNYVN +TNV X02763_HBe_A_po 0.48729 256.6 1.80 <= WB 93 HLA-A*02:05 ELMTLATWV ELMTLATWV 0 0 0 0 0 ELMTLA +TWV X02763_HBe_A_po 0.46686 320.0 2.50 8 HLA-A*02:05 LIISCTCPT LIISCTCPT 0 0 0 0 0 LIISCT +CPT X02763_HBe_A_po 0.45053 381.9 2.50 ---------------------------------------------------------------------- +------------- Pos HLA Peptide Core Of Gp Gl Ip Il Ic +ore Identity Score Aff(nM) %Rank BindLevel ---------------------------------------------------------------------- +------------- 117 HLA-A*11:01 IISCTCPTV YVNVNMGLK 0 0 0 0 0 YVNVNM +GLK AB219428_HBe_B_ 0.62268 59.3 0.40 <= SB 28 HLA-A*11:01 WGMDIDPYK WGMDIDPYK 0 0 0 0 0 WGMDID +PYK AB219428_HBe_B_ 0.44617 400.4 1.60 <= WB 133 HLA-A*11:01 HISCLTFGR HISCLTFGR 0 0 0 0 0 HISCLT +FGR AB219428_HBe_B_ 0.43660 444.0 1.70 <= WB

    Many thanks for any help you are able to give

Error in HTTPS connection with error: No connection could be made because the target machine actively refused it. at C:/Perl/lib/LWP/Protocol/http.pm line 47
2 direct replies — Read more / Contribute
by jliu5
on Jul 26, 2016 at 11:36

    Hi Monks,

    I am trying to create a REST client to do a simple GET service at a https server, but got this error.

    Here is my sample code, please advice.:

    #! /usr/bin/env perl use REST::Client; use MIME::Base64; my $username = 'me'; my $password = 'me!!'; my $headers = {Accept => 'application/xml', Authorization => 'Basic ' +. encode_base64($username . ':' . $password)}; my $client = REST::Client->new(); $client->getUseragent->ssl_opts(verify_hostname => 0); $client->getUseragent->ssl_opts(SSL_verify_mode => SSL_VERIFY_NONE); $client->getUseragent->no_proxy('server_ip_string', 'server_ip_string' +); $client->GET("https://server_ip_string:port/upm-server/nbi/organizatio +n", $headers ); my $response = $client->responseContent(); print $response;
Extracting Tag and attributes from a Web Page
2 direct replies — Read more / Contribute
by Kaustubh
on Jul 26, 2016 at 08:23
    Hi Monks,

    My programming experience with perl is just 2 weeks.I am stuck with a problem.I need to get the value $8.39 from the following code snippet.This code snippet is obtained by selecting the view source option when we right click a web browser:-

    <span class="details-title-text"> <strong>$8.39</strong> </span>
    I am using the mechanize package.I have tried various permutations and combinations of find() & attr() methods.Basically whatever I have tried is throwing errors:-

    foreach my $b ($mech->find('span')) { my $attr_class= $b->attr('class'); if(defined($attr_class) ) { my $tag_strong=$mech->find('strong'); print Dumper($tag_strong); } }
IO::Compress::Gzip file close issues
2 direct replies — Read more / Contribute
by Paul.Unix
on Jul 26, 2016 at 07:08
    I encountered an issue with IO::Compress::Gzip. After a successful gzip I want to unlink the original file but sometimes the unlink fails with a "permission denied" I made a pragmatic work around by adding a delay and try the unlink again. But a good solution would be preferred. The same issue happens with moving the new .gz to another directory. The files are not in use by another process. Running Strawberry Perl 5.22.0 on Windows 2008 and 2012
    use warnings; use strict; use POSIX; use Cwd; use Cwd 'abs_path'; use Time::Local 'timelocal_nocheck'; # used for SCHEDULE option in +the MQX.ini use Net::Domain qw(hostname hostfqdn hostdomain domainname); use File::Basename; use File::Copy; use IO::Compress::Gzip qw(gzip $GzipError) ; use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; # module used in the state messages use Digest::MD5; # modules used in put mode use threads; use threads::shared; use Thread::Queue; if ( gzip $archfile => "$archfile.gz", AutoClose => 1, BinModeI +n => 1 ) { my $delete_try_counter = mqx_get_setting('ARCHIVEMOVETRY'); while ( -f $archfile and not unlink $archfile and $dele +te_try_counter != 0 ) { $global_EVENTLOG_IN_LQ->enqueue("WARNING, $arch_ha +shref->{'EVENTLOG'},Can not delete $archfile. Error: $! try: $delete_ +try_counter"); $delete_try_counter -= 1; sleep(mqx_get_setting('ARCHIVEMOVEWAIT')); # wait x sec +onds before retrying } $archfile .= ".gz"; # add .gz to the file name } else { # if the gzip failed try to arc +hive the original file $global_EVENTLOG_IN_LQ->enqueue("ERROR, $arch_hashref->{' +EVENTLOG'}, gzip failed on $archfile\n$GzipError"); }
how to get active web page by Perl
1 direct reply — Read more / Contribute
by liuweichuan
on Jul 26, 2016 at 02:45
    how to get flighting info from this web site. http://flight.qunar.com/site/oneway_list.htm?searchDepartureAirport=%E5%A4%A7%E8%BF%9E&searchArrivalAirport=%E5%8C%97%E4%BA%AC&searchDepartureTime=2016-07-28&searchArrivalTime=2016-07-31&nextNDays=0&startSearch=true&fromCode=DLC&toCode=BJS&from=flight_dom_search&lowestPrice=null i used these code, but i cann't get any info.
    use LWP::UserAgent; use Encode; my $content = LWP::UserAgent->new->get('http://flight.qunar.com/site/o +neway_list.htm?searchDepartureAirport=%E5%A4%A7%E8%BF%9E&searchArriva +lAirport=%E5%8C%97%E4%BA%AC&searchDepartureTime=2016-07-28&searchArri +valTime=2016-07-31&nextNDays=0&startSearch=true&fromCode=DLC&toCode=B +JS&from=flight_dom_search&lowestPrice=null')->content;
    who know how to do it, get an active page or ajax page, plz help me get this url's web info.

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: (8)
    As of 2016-07-27 13:40 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      What is your favorite alternate name for a (specific) keyboard key?


















      Results (242 votes). Check out past polls.