Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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
Revising Input Method
1 direct reply — Read more / Contribute
by PinePerl
on Jul 27, 2016 at 13:15
    $term = Term::ReadLine->new("APP DESCRIPTION"); $OUT = $term->OUT || *STDOUT; $term->addhistory($fake_line); $line = $term->readline(PROMPT); print $line

    I am trying to make improvements to a program created in early 2000's. The built-in terminal interface works similar to the recipe above, yet the interface prevents the user from revising input once the terminal text wraps.

    PROMPTThis is a test. This is being written from a terminal. As I writ +e, I get closer to the edge. The prompt continues on the line below w +ithout me hitting the return key. When I press up with an arrow key, +I get these characters ^[[A^[[A

    Could someone please advise me on how to do either of the two: 1) allow the word wrap and modify all revised text similar to emacs, or 2) get rid of the word wrap and in turn allow revision of the paragraph before submitting it as input.

    If you are aware of a different tool that provides these features, please let me know as I'm unaware of all available Perl modules and have been learning so much this past month.

How to pass a pointer to an array of 'unsigned char' C data type with Win32::API
1 direct reply — Read more / Contribute
by apeks_okad
on Jul 27, 2016 at 12:00
    Dear Perl Monks, I need a help in Win32::API

    I am working on a hardware test automation, The interface to hardware is Automotive Interface 4 (AI4 : USB to SENT) and the H/W manufacturer has provided a C DLL which exports set of functions to communicate with the hardware.

    I am trying to import the C DLL via Win32::API module so i can automate the communication via perl.

    I have a problem with one API ,KSENT_TX. This function requires a pointer to an array of unsigned char as one of its arguments.

    The header file extern declarations(provided by the manufacturer) looks as follows:

    MOD_EXTERN unsigned char _stdcall KSENT_TX(unsigned char channel, unsigned char *data, unsigned long cyclic);

    I have problems passing the right values to this function. Perl.exe crashes every time I try executing my code.

    my $Tx = Win32::API::More->new( 'AID.dll', 'KSENT_TX', 'CPN', 'C'); #### $^E is non-Cygwin only die "Error: $^E" if ! $Tx; #### or on Cygwin and non-Cygwin die "Error: ".(Win32::FormatMessage(Win32::GetLastError())) if ! $Tx; my $rettx = $Tx->Call(0, $data_ref, 1);

    I tried various methods to pass the array reference

    my $data_ref = [0x81 , 0x55, 0x00, 0xE0];

    or

    my @data = (129,85,0,224); my $data_ref = \@data;

    also

    my $data_ref = pack ('C*', (0x81 , 0x55, 0x00, 0xE0));

    All of it leads to the same PERL crash. I am a novice to PERL development so maybe I am missing something really basic here. Can you please help me with this problem

Perl Code Changes Behavior if Two Subroutine definitions are swapped
2 direct replies — Read more / Contribute
by rkabhi
on Jul 27, 2016 at 10:04

    Hello Perl Monks !!

    I came across a really unexpected issue while developing a code to read a netlist file containing just few lines. I have written down system details, the code and input file and finally I describe the problem at the end

    System and Setup Info: Linux RHEL6 Perl Version 5.10.1

    ***************************************************

    Code:

    #!/usr/bin/perl use strict; use warnings; use Switch; #Common Variable Initialization my %DeviceList = (); my $netlist_file = "/home/abhishek_r/Tool_Development/Voltrace/Perl/ne +tlist.scs"; my @InbuiltDeviceList = ('resistor','capacitor','inductor','vsource',' +isource'); my @subcktslist = getSubcktList($netlist_file); print @subcktslist; TraceSubcktDevices($netlist_file); sub getSubcktList{ my $netlist = $_[0]; my @subckts = (); open(READ_NETLIST, "<$netlist") or die "Couldn't open netlist file + for read, $!"; while(<READ_NETLIST>){ chomp; s/^\s+//; #To remove leading blanks (if any) in the line #ignore line if it contains comments or initializing words for + spectre switch() { case /^[*\/]/i {next;} case /simulator\s+lang/i {next;} case /^include/i {next;} } if(/subckt/i) { my $line = $_; my @words = split(/\s+/,$line); #Split the read line in $_ + with white spaces as delimiter my $nameindex = 1; #Default index where subckt name i +s usally found if(/inline/i){ #To change name index if subckt de +finition includes inline $nameindex = 2; } push @subckts,$words[$nameindex]; } } close(READ_NETLIST); return @subckts; } sub TraceSubcktDevices{ #Input: (netlist_file, subcktname, key +_init) where subcktname is the name of subckt that needs to be traced + in the netlist my $netlist = $_[0]; my $subcktname = "hello"; $subcktname =~ s/^\s*|\s*$//g; #To remove all leading and trainin +g blanks from input subckt name my $key_init = $_[2]; my $skip=0; #Default Skip status for netlist l +ine. 0 indicates "don't skip" and is set for TOPLEVEL if($subcktname){ #Set skip flag if input subckt name is not + blank i.e. the tracing is not required at TOPLEVEL $skip = 1; } open(READ_NETLIST, "<$netlist") or die "Couldn't open netlist file + for read, $!"; while(<READ_NETLIST>){ $skip = $skip + 1; print "Hello"; } close(READ_NETLIST); }

    Input File: netlist.scs

    // Generated for: spectre // Generated on: Jul 26 15:10:24 2016 // Design library name: custom // Design cell name: TOPLEVEL // Design view name: schematic simulator lang=spectre global 0 //--------------------------------// // Library name: custom // Cell name: inv // View name: schematic subckt inv IN OUT VDD VSS M0 (OUT IN VSS VSS) nch l=60n w=200n m=1 nf=1 sd=200n ad=3.5e-14 \ as=3.5e-14 pd=750n ps=750n nrd=0.5 nrs=0.5 sa=175n sb=175n sca +=0 \ scb=0 scc=0 M2 (OUT IN VDD VDD) pch l=60n w=200n m=1 nf=1 sd=200n ad=3.5e-14 \ as=3.5e-14 pd=750n ps=750n nrd=0.5 nrs=0.5 sa=175n sb=175n sca +=0 \ scb=0 scc=0 ends inv // End of subcircuit definition. // Library name: custom // Cell name: BUF_DELAY // View name: schematic subckt BUF_DELAY IN OUT VDD VSS I1 (net11 OUT VDD VSS) inv I0 (IN net11 VDD VSS) inv ends BUF_DELAY // End of subcircuit definition. // Library name: custom // Cell name: INV_DELAY // View name: schematic subckt INV_DELAY IN OUT VDD VSS I2 (net08 OUT VDD VSS) inv I1 (net11 net08 VDD VSS) inv I0 (IN net11 VDD VSS) inv ends INV_DELAY // End of subcircuit definition. // Library name: custom // Cell name: TOPLEVEL // View name: schematic I2 (BUF_IN BUF_OUT VDD VSS) BUF_DELAY I3 (INV_IN INV_OUT VDD VSS) INV_DELAY I4 (INV_IN net8) isource type=pwl wave=[ 1u 1 2u 2 ] V3 (VSS 0) vsource dc=0 type=dc V2 (INV_IN 0) vsource dc=0 type=dc V1 (BUF_IN 0) vsource dc=5 type=dc V0 (VDD 0) vsource dc=5 type=dc R0 (net8 VSS) rm1w l=10u w=2u mf=1 C0 (net8 0) capacitor c=1p //----------------- Entering Netlist Footer -------------------//

    The Problem: In the code, there are two subroutines getSubcktList() and TraceSubcktDevices(). The former subroutine works fine. The latter subroutine (i.e. TraceSubcktDevices()) is showing a very unexpected behavior. I have listed my observations below:

    1) If the above code is run "as is" making sure that correct path of netlist.scs file is supplied at the beginning, the code gets stuck (I use Linux command line to run the code) with no response

    2) If I swap the subroutines, i.e. define TraceSubcktDevices() first and getSubcktList(), the code works fine printing "Hello" as many times as the number of lines in input file netlist.scs

    Can anyone please let me know why this is unexpected behavior being observed?

    Thanks !!

    Abhishek

    update: edited/code tags by stevieb

process run in background
2 direct replies — 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--&#8594; 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;

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


















      Results (248 votes). Check out past polls.