Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

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
Trying to understand Perl :-)
4 direct replies — Read more / Contribute
by harangzsolt33
on Jul 28, 2016 at 01:13
    I am learning Perl, and I am trying to see what happens when I write some weird code. And I have some questions...
    ################################## sub AA{6} sub BB{{{3}}} sub L{AA+BB} # Now, here Perl thinks that I am # calling AA(+BB) so, instead of # adding 6+3, it simply returns 6 print "\nL=".L."\n"; print "\nL=".((AA) + BB) ."\n"; # Now I got it right. # Okay, I understand this. So far everything is clear. ################################## sub UNIQUE::print{print 'Hello World!'} UNIQUE->print(333); sub UNIQUE::print{ print "\nMuhahaha! @_ \n"; } UNIQUE->print(; # Okay this is weird. # First of all, how does 65 become letter 'A' without using chr(65) ? # Secondly, Perl allows me to redefine my UNIQUE::print and now # this second definition overwrites the first one. # What happened to the first one??? # Why is my 'Hello World' never showing up at all? ################################## print "What on earth is this? >>> " . sub {5}; my $D = sub { print "What the Heck!"; }; # What am I doing here? # And why is this allowed in Perl? What's the point of # creating a noname sub? Okay, so if I wanted to, how # would I run my noname sub using the handle $D ? ################################## sub Red { sub LittleRed{'red'}; # sub within a sub LittleRed; # returns 'red' } print "\nPerl is getting confused here..." . Red; print "\n\n"; print LittleRed; # Wait. This is not supposed to work! # If I declare a sub within a sub, then the inner sub should # not be accessible from the outside. Is this right??? # I mean what's the point of declaring a sub within a sub # if it's the same as declaring it outside the sub? ################################### sub X{10} print "\nYES>".X; # This prints 10. Fine. sub Y{my$i=0;$i while($i++<10);}print"\nYES>".Y; # Now, why is this not printing 10?? # When the while loop ends, $i equals 10, so if I just # say "$i" then it should use that as a return value for # the sub. No? ########################### # Another question: Is there a way to # access previous return values? # Example: sub DDD { 0; 1; 2; 3; 4; 5; } print DDD; # Is it possible to do something like this # without using the = assignment operator?: # # sub DDD { # 4+4; # 5+(previous lines' result); # return previous line's result; # } # # So, DDD would return 13.
$_[OBJECT] 's example
1 direct reply — Read more / Contribute
by liuweichuan
on Jul 27, 2016 at 23:30
    I have do some example about POE; but about this point on $_OBJECT parameter, i can't know clear. i make a, contains a object:
    package baozi; sub new{ my $class = shift; my $self = bless {}, $class; } sub fun1{ my $self = shift; print "fun1......baozi \n" } 1
    then try the $_OBJECT in other pl,
    use POE; use baozi; POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->yield('next1')}, next1 => sub { print "tick ... \n"; $_[KERNEL]->delay(next2 => 1); }, next2 => \&next2, next3 =>\&baozi, }, ); POE::Kernel->run(); sub next2{ print "tick 0 ... \n"; $_[KERNEL]->yield('next3'); } sub baozi{ my $self = $_[OBJECT]; print $self; $self->baozi::fun1(); }
    I think 'next2' call 'next3' handler, and run sub baozi.$self->baozi::fun1(); can call package baozi's fun1. but I know my thinking is wrong, plz tell me more right, and help me understand $_OBJECT, thank you.
Net::SSH::Perl push variable into remote file
2 direct replies — Read more / Contribute
by rtech0
on Jul 27, 2016 at 23:14

    I am trying to grab the contents of ~/username/.ssh/ into a variable and copy it so a user on the remote machine in /home/remoteusername/.ssh/authorized_keys. I have the file already in a variable via:

    my $fnpubcert = "/home/localusername/.ssh/"; open my $fhpubcert, '<', $fnpubcert or die "error opening $fnpubcert $ +!"; my $mypubcert = do { local $/; <$fhpubcert> };

    If I try this is creates the files but empty (I am sure you know why). Please advise:

    my $cmd = "echo $mypubcert > /home/remoteusername/.ssh/authorized_keys +"; my ($stdout,$stderr,$exit) = $ssh->cmd("$cmd"); if ($stdout || $stderr) { print "STDOUT: $stdout STDERROR: $stderr\n"; + } my $cmd = 'chown remoteusername.remoteusername /home/remoteusername/.s +sh/authorized_keys; chmod 600 /home/remoteusername/.ssh/authorized_ke +ys'; my ($stdout,$stderr,$exit) = $ssh->cmd("$cmd"); if ($stdout || $stderr) { print "STDOUT: $stdout STDERROR: $stderr\n"; + }

    ps I thought it might be this but doesn't work:

    my $cmd = "cat > /home/vmsys/.ssh/authorized_keys"; print $mypubcert | my ($stdout,$stderr,$exit) = $ssh->cmd("$cmd");

    Thank y'all in advance!

No tools? Use Perl?!
2 direct replies — Read more / Contribute
by Boyd.Ako
on Jul 27, 2016 at 22:20

    So, I have an "isolated system" (not internet connected) under "configuration management" with perl on it. I have an XML file that I'd like parse the extract and format specific information from it.

    "Normally" I'd install some XML perl module. But being "isolated" I can't download it. And even if I was able to "configuration management" says no new software without a shit ton of red tape just for a few little packages. Scripts that an admin writes in an exception.

    The XML file is a Nessus scanner results file. The section that I want to extract are between <RemoteHost> and </RemoteHost> for several servers in the file. For each RemoteHost section I'd like to only pull sections like the hostname, CVEs (list), and synopsis (multi line).

    I've tried using the flip-flop operator but it just gives me everything. If there's a way to pick and choose what parts I want; I don't know how to do it.

    Any suggestions?

    #! /usr/bin/perl use strict; use warnings; use FileHandle; my $file; if (-e $ARGV[0]){ $file = $ARGV[0]; hostreport(); } else { die; } sub hostreport { open(my $fh, "<file"); while (<$fh>){ print if (/^\<ReportHost/../^\<\ReportHost>/); } } print $file;
please delete
No replies — Read more | Post response
by Cody Fendant
on Jul 27, 2016 at 17:21
    question based on a misunderstanding
Simple comparison of 2 files
5 direct replies — Read more / Contribute
by Q.and
on Jul 27, 2016 at 14:47

    I know this is an elementary problem, so if this is a repeated question, please kindly flag, but I have yet to find something that works in the way I'm thinking about the problem. If the code seems overcomplicated for the task at hand, it's in part because the real script and files are more complex and because I'm new, so any suggested solutions that stay as close as possible to the code given here will be most appreciated.

    Say I have two files, FILE1 contains:
    A  1_1
    A  1_2
    B  1_3
    C  1_4

    and FILE2 is:
    A  2_1
    B  2_2

    I would like to compare both files and have it print:

    A from FILE1 with number 1_1 and A from FILE2 with number 2_1 match
    A from FILE1 with number 1_1 and B from FILE2 with number 2_2 DO NOT match
    A from FILE1 with number 1_2 and A from FILE2 with number 2_1 match
    A from FILE1 with number 1_2 and B from FILE2 with number 2_2 DO NOT match
    B from FILE1 with number 1_3 and A from FILE2 with number 2_1 DO NOT match
    B from FILE1 with number 1_3 and B from FILE2 with number 2_2 match
    C from FILE1 with number 1_4 and A from FILE2 with number 2_1 DO NOT match
    C from FILE1 with number 1_4 and B from FILE2 with number 2_2 DO NOT match

    The way I've been constructing the code so far however, obviously does not loop over the files in the way that I'm aiming for. That code is below, along with example output.

    #!perl open (FILE1, $ARGV[0]); open (FILE2, $ARGV[1]); while ($_ = <FILE1>) { chomp; @FILE1 = split; ($FILE1letter, $FILE1number) = @FILE1; @FILE2 = split(' ',<FILE2>); ($FILE2letter, $FILE2number) = @FILE2; # print "$FILE1letter from FILE1 with number $FILE1number and $FILE +2letter from FILE2 with $FILE2number match\n"; #prints the same as below if ($FILE1letter == $FILE2letter) { print "$FILE1letter from FILE1 with number $FILE1number and $F +ILE2letter from FILE2 with number $FILE2number match\n"; } else { print "$FILE1letter from FILE1 with number $FILE1number and $F +ILE2letter from FILE2 with number $FILE2number DO NOT match\n"; }

    Output from above code:
    A from FILE1 with number 1_1 and A from FILE2 with number 2_1 match
    B from FILE1 with number 1_2 and C from FILE2 with number 2_2 match
    C from FILE1 with number 1_3 and from FILE2 with number match

    I would appreciate any direction, brief explanation of what about my current code is not feasible for producing my desired output, and/or suggestions for better constructing the script. Thanks in advance.

    Clarification: The goal of the real script is really not to just print matches and mismatches, but to do many things within each loop. However, I realized that my if statement was not evaluating correctly, as it was printing even when there was no match and I think the larger problem is the looping structure of the entire code. In the real script, I would like it to evaluate lines from the two files ONLY when $FILE1letter is equal to $FILE2letter, but have it simplified to just a difference detection problem above in order to try to help myself learn how to solve smaller problems within larger ones.

Revising Input Method
2 direct replies — Read more / Contribute
by PinePerl
on Jul 27, 2016 at 13:15

    The following code is modified from the Perl Cookbook and is just a demonstration of what I intend, not the actual code being implemented...

    use Term::ReadLine; $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];


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


    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



    #!/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 !!


    update: edited/code tags by stevieb

process run in background
3 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 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 on remote server from client , my client gets hanged so I have to give a ctrl+Z to make 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

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

    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 musing on the Monastery: (10)
    As of 2016-07-28 12:36 GMT
    Find Nodes?
      Voting Booth?
      What is your favorite alternate name for a (specific) keyboard key?

      Results (254 votes). Check out past polls.