Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options

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
word based levenstein distance path
2 direct replies — Read more / Contribute
by Anonymous Monk
on May 20, 2015 at 08:31

    Hi Perlmonks,

    I use the following perl library for determining the edit transcript between two strings but now I want to do the same based on words and not characters. Is there any way to modify it and gain from that? Please note that I don't need the levenshtein distance but the path.


    sub EditTranscript { my $str = shift; my $str2 = shift; my $dist; my $transcript; for (my $i = 0; $i <= length($str); $i++) { $dist->[$i]->[0] = $i; $transcript->[$i]->[0] = "D"; } for (my $i = 0; $i <= length($str2); $i++) { $dist->[0]->[$i] = $i; $transcript->[0]->[$i] = "I"; } my $cost; for (my $i = 1; $i <= length($str); $i++) { for (my $j = 1; $j <= length($str2); $j++) { if (substr($str,$i-1,1) eq substr($str2,$j-1,1)) { $cost = 0; } else { $cost = 1; } $dist->[$i]->[$j] = Min($dist->[$i-1]->[$j] + 1, $dist->[$i]->[$j-1] + 1, $dist->[$i-1]->[$j-1] + $cost); if ($dist->[$i]->[$j] eq $dist->[$i]->[$j-1] + 1) { $transcript->[$i]->[$j] = "I"; } if ($dist->[$i]->[$j] eq $dist->[$i-1]->[$j]+1) { $transcript->[$i]->[$j] = "D"; } if ($dist->[$i]->[$j] eq $dist->[$i-1]->[$j-1] + $cost) { if ($cost eq 0) { $transcript->[$i]->[$j] = "-"; } else { $transcript->[$i]->[$j] = "S"; } } } } my $st = Traceback($transcript,length($str),length($str2)); $st = scalar reverse $st; return $st; } sub Traceback { my $transcript = shift; my $i = shift; my $j = shift; my $string; while ($i > 0 || $j > 0) { if (defined $transcript->[$i]->[$j]) { $string .= $transcript->[$i]->[$j]; } last if (!defined $transcript->[$i]->[$j]); # to keep us from getting caught in loops if ($transcript->[$i]->[$j] eq "S" || $transcript->[$i]->[$j] +eq "-") { $i-- if ($i > 0); $j-- if ($j > 0); } elsif ($transcript->[$i]->[$j] eq "I") { $j-- if ($j > 0); } else { $i-- if ($i > 0); } } return $string; } sub Min { my @list = @_; @list = sort {$a <=> $b} @list; return shift @list; }
Handle sending SOAP::Lite call which may not get a response
1 direct reply — Read more / Contribute
by walshy
on May 20, 2015 at 04:45
    I've been using SOAP::Lite, with very good results so far, to emulate some terminals that use SOAP to connect to a server.
    I now need to add in heartbeat functionality.
    I've found a problem with the server not always responding to heartbeats. I've raised this with the devs, but as the terminal I'm simulating copes with this, I need to be able to cope too. Thing is, SOAP Lite's "call" blocks for (or at least that's how I'm reading it) a response and the occasions when I get no response cause me to crash. Message gen code:
    my $heartbeat = SOAP::Lite->new(proxy => $proxy); $heartbeat->default_ns('lws:Heartbeat'); $heartbeat->autotype(0); $heartbeat->transport->timeout(1); $self->heartbeat($heartbeat); my $state = 1; my (@hbArgs) = ( SOAP::Data->name( 'deviceName' => $self->{id} ), SOAP::Data->name( 'username' => $self->{userName} ), SOAP::Data->name( 'sessionId' => $self->sessInfo->{sessionI +d} ), SOAP::Data->name( 'state' => $state ), SOAP::Data->name( 'taskId' => $self->{taskId} ), SOAP::Data->name( 'location' => ''), ); my (@obj) = SOAP::Data->name( 'obj' => \SOAP::Data->value( @hbArgs, ), ); my (@message) = SOAP::Data->name( 'message' => \SOAP::Data->value( @obj, ), ); print "Let's try\n"; $self->call( "heartbeat", "sendPulse", \@message); print "WE're back!!\n";
    and my call:
    sub call { my ($self, $handle, $cmd, $params) = @_; if($cmd eq "sendPulse") { # Don't need to do anything with the heartbeat response $self->TOOLS::Print::sending("Sending heartbeat"); $self->{$handle}->call( $cmd, @{$params} ); return $self->{call}; } $self->callResp($self->{$handle}->call( $cmd, @{$params} )); if($cmd ne "login")

    $proxy = '';
    Let's try
    500 read timeout at /usr/users/stevew/Testing/Director/perl5/../lib/ line 278
    Line 278 being (from above):

    $self->{$handle}->call( $cmd, @{$params} );
    Is there a way to send a SOAP message using SOAP::Lite and not expect a response?
grep Question
5 direct replies — Read more / Contribute
by Shivam05
on May 20, 2015 at 03:06

    Hi, I am trying to grep label(" in the array, it will generate error while executing . sample code:

    $grepper=join('','label','(','"'); print "$grepper\n"; $array[0]="label("; $array[1]="label"; @LABEL = grep(/$grepper/, @array); print "@LABEL \n";

    And also, i tried this line directly:

    @LABEL = grep(/label\(\"/, @array); print "@LABEL \n";

    if i use this it does not take " correctly in the label(". How can i over come the problemand solution for this.

    --Shiva Prasad.

sanitize user input for system() call
3 direct replies — Read more / Contribute
by EnochRoot
on May 19, 2015 at 14:42
    Because Crypt::Eksblowfish::Bcrypt doesn't support the $2y$ bcrypt variant, I'm using htpasswd to do it. Is this function a safe way to sanitize the user input, a password, by using IPC::System::Simple's capturex(@args)? I'll then be storing this in a DB and having apache authenticate off it using AuthBasicProvider dbd in the vhost:
    sub generate_apache_bcrypt_hash { my($plaintext) = @_; my $bcrypt_hash = ''; try { $bcrypt_hash = capturex("/bin/htpasswd","-nbB","''", $plaintext); } catch { print STDERR "generate_apache_bcrypt_hash = '$_'\n" if $DEBUG; }; # remove: # - extra 3 chars at the front # - 1 trailing spaces # - line break $bcrypt_hash = substr $bcrypt_hash,3; chomp($bcrypt_hash); chop($bcrypt_hash); return $bcrypt_hash }
perl script logging into multiple routers
1 direct reply — Read more / Contribute
by xubu83
on May 19, 2015 at 14:00


    I tried to login to a router with a perl script. I opened a thread about this 2 days ago:

    Here is the code for the script for logging into 1 router. This script works fine.

    #!/usr/bin/perl -- use strict; use warnings; use WWW::Mechanize 1.73; my $browser = WWW::Mechanize->new( autocheck => 1 ); $browser -> agent("Mozilla/5.0"); $browser -> credentials('','TEL','admin' => 'guess'); $browser -> timeout(10); $browser->show_progress( 1 ); $browser->get(''); if( $browser->success ){ die " we logged in game over"; }

    Now i have some problems if i modify the script for logging into 3 routers. I made a text file with the 3 IP's of the routers i want to login. The perl script is reading the IP's from the text file and fills the 3 IP's as strings in an array. I use a for loop for looping through the array and to setup a connection with the 3 routers. I have a 401 Authentication error when i run the script.

    #!/usr/bin/perl use strict; use warnings; use WWW::Mechanize 1.73; my $file = "output.txt"; open (FH, "< $file") or die "Can't open $file for read: $!"; my @lines; while (<FH>) { push (@lines, $_); } close FH or die "Cannot close $file: $!"; my $browser = WWW::Mechanize->new( autocheck => 1 ); $browser -> agent("Mozilla/5.0"); $browser -> timeout(10); $browser -> show_progress( 1 ); for (my $i=0; $i <= @lines; $i++) { my $url = "$lines[$i]"; $browser -> credentials("$url",'TEL','admin' => 'guess'); $browser->get("http://$url"); if( $browser->success ){ print "login to $url was successfull!!"; } }
    Contect of textfile (output.txt):

    This is the error message: ** GET ==> 401 Unauthorized Error GETing Unauthorized at line 21.

    For some reason there is a problem when using variable $url in $browser -> credentials and $browser->get. I tried lots of things but can't figure it out. anyone a suggestion?

Cross-platform accented character file names sorting
3 direct replies — Read more / Contribute
by perlimpinpin
on May 19, 2015 at 11:49

    Most Reverent Monks,

    The included script reads a directory containing Latin-1 accented characters and displays a correctly sorted list on both Linux and Windows OS, but a few changes are needed:

    - Linux : Uncomment 'use utf8::all', save with the default utf-8 encoding and run.

    - Windows : Comment out 'use utf8::all' (line 8), save with the default iso-8859-1 or ANSI encoding, chcp 1252 on the command line and run.

    To test accented characters, create a subdirectory named 'test' containing several files whose name start with normal uc and lc ascii characters and Latin-1 (Western Europe) accented characters (example: Drives, eval1, Eval2, Úval3, ╔val4, files, ▄bermensch, utilities). This is the sorted directory you'll get with ls (Linux) or dir (Windows), or with any graphical file and directory manager.

    use utf8::all; # Comment out for Windows use Unicode::Collate; # No argument: current directory; com. line accepts dir. name. my $dir = ($ARGV[0] ? shift : '.'); opendir(my $dh, $dir) or die "\n\tCannot open directory : $!\n"; my @list = grep {!/^[\.]{1,2}$/} readdir $dh; #^ skips '.' and '..' print "$_\n" for @list; print "\tEnd unsorted\n\n"; my $collator = Unicode::Collate->new(level => 1); my @entries = $collator->sort(@list); print "$_\n" for (@entries); print "\tEnd sorted\n\n";

    Looking for a simpler way, I added the following snippet, which doesn't work:

    [...] use Config; use utf8::all if $Config{osname} eq 'Linux'; # perl adamantly ignores +the condition [...]

    Further, perl cannot chcp on a Windows terminal.

    My question : Is it possible to write a 'universal script' that would automatically detect the OS and act accordingly?

    -0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0

    Thank you so much, Monks!

    With $^O, I get 'MSWin32' on my Windows 8 (64 bits) machine. So, just add the two following lines to my script:

    use if $^O ne 'MSWin32', 'utf8::all'; system('chcp 1252') if $^O eq 'MSWin32';

    Kludgy, but it does the job on both Linux and Windows, and possibly on Unix and Mac, too. If the user still gets funny characters, he has to manually save his file with the correct encoding, iso-8859-1 or ANSI for Windows or UTF-8 for most other OSes (untested). This is apparently the only thing that Perl cannot do for the unwary user!

    'Confundant omnes , ultimus alienat'

printing special characters taken in command line
4 direct replies — Read more / Contribute
by bagana14
on May 19, 2015 at 11:45
    Hi, I want to print the text which was taken as command line input. Input can contain special characters also. For ex: perl D^JkAPE\(SjKHnNl0 >> should print D^JkAPE\(SjKHnNl0. I could not find any post related to my problem. Can someone please help me here.
what is busy(0)
2 direct replies — Read more / Contribute
by gimcdan
on May 19, 2015 at 11:24

    Hi Monks, Once again I've exhausted my resources and come humbly asking... more old code I need help with: before every...


    there is a call to:


    Which I assumed was some kind of wait or well, not really sure, but could not find anything about this? As always, your expertise is greatly appreciated.

workday webservices using Perl
2 direct replies — Read more / Contribute
by PERL_fresher
on May 19, 2015 at 07:53

    Hello Fellow monks need some help and Im not familiar with SOAP messages or anything to do with web services. Basically I need to make a call to workday web service

    I have been given workday URL, User ID and Password which Im not sharing for obvious reasons, I have been given below XML snippet to mention that my call should be made with below format only
    <soapenv:Envelope xmlns:bsvc="urn:com.workday/bsvc" xmlns:soapenv=""> <soapenv:Header> <wsse:Security soapenv:mustUnderstand="1" xmlns:wsse=" +00401-wss-wssecurity-secext-1.0.xsd"> <wsse:UsernameToken wsu:Id="UsernameToken-16" xmlns:wsu=" +s-200401-wss-wssecurity-utility-1.0.xsd"> <wsse:Username>#P_USER_NAME</wsse:Username> <wsse:Password Type=" +04/01/oasis-200401-wss-username-token-profile-1.0#PasswordText">#P_US +ER_PASSWORD</wsse:Password> <wsse:Nonce EncodingType=" +ss/2004/01/oasis-200401-wss-soap-message-security-1.0#Base64Binary">w +mtQ0Smma6txNXooNWIVFw==</wsse:Nonce> <wsu:Created>2011-08-31T18:35:44.675Z</wsu:Created> </wsse:UsernameToken> </wsse:Security> </soapenv:Header> <soapenv:Body> <bsvc:Employee_Personal_Info_Update bsvc:version="v24.0"> <bsvc:Employee_Reference> <bsvc:Integration_ID_Reference> <bsvc:ID bsvc:System_ID="WD-EMPLID">#P_WORKDAY_ID< +/bsvc:ID> </bsvc:Integration_ID_Reference> </bsvc:Employee_Reference> <bsvc:Employee_Personal_Info_Data> <bsvc:Personal_Info_Data> <bsvc:Person_Data> <bsvc:Contact_Data> <bsvc:Internet_Email_Address_Data> <bsvc:Email_Address>#P_VALUE</bsvc:Ema +il_Address> <bsvc:Usage_Data bsvc:Public="1"> <bsvc:Type_Reference bsvc:Primary= +"1">WORK</bsvc:Type_Reference> </bsvc:Usage_Data> </bsvc:Internet_Email_Address_Data> </bsvc:Contact_Data> </bsvc:Person_Data> </bsvc:Personal_Info_Data> </bsvc:Employee_Personal_Info_Data> </bsvc:Employee_Personal_Info_Update> </soapenv:Body> </soapenv:Envelope>

    Keeping this in mind and searching around places I have built something that basically does make similar calls Below is my code

    use SOAP::Lite +trace => [ transport => sub { print $_[0]->as_string } + ]; my $soapRequest = SOAP::Lite -> uri('urn:com.workday/bsvc') -> readable(1) -> ns('urn:com.workday/bsvc','bsvc') -> proxy(''); my $Username = SOAP::Header->name('wsse:Username' => $username); my $Password = SOAP::Header->name('wsse:Password') ->attr({'Type'=>' +/wss/2004/01/oasis-200401-wss-username-token-profile-1.0#PasswordText +'}) ->value($password); my $Nonce = SOAP::Header->name('wsse:Nonce') ->attr({'EncodingType'=>'http://docs.oasis- +4Binary'}) ->value($nonce); my $Created = SOAP::Header->name('wsu:Created' => $created); my $UsernameToken = SOAP::Header->name('wsse:UsernameToken') ->attr ({ 'wsu:Id'=>'UsernameToken-16', 'xmlns:wsu'=> 'http://docs.oasis-open. +org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd' }) ->value(\SOAP::Header->value($Username,$Passwo +rd,$Nonce,$Created)); my $security = SOAP::Header->name('wsse:Security') ->attr ({ 'soapenv:mustUnderstand'=>'1', 'xmlns:wsse' => ' +s/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd' }) ->value(\SOAP::Header->value($UsernameToken)); my $Type_Reference = SOAP::Data ->name('bsvc:Type_Reference') ->attr({'bsvc:Primary'=>'1'}) ->value('WORK'); my $Usage_Data = SOAP::Data ->name('bsvc:Usage_Data') ->attr({'bsvc:Public'=>'1'}) ->value(\SOAP::Data->value($Type_Reference)); my $Email_Address = SOAP::Data ->name('bsvc:Email_Address') ->value(''); my $Internet_Email_Address_Data = SOAP::Data ->name('bsvc:Internet_Em +ail_Address_Data') ->value(\SOAP::Data->value($Email_Address,$Usa +ge_Data)); my $Contact_Data = SOAP::Data ->name('bsvc:Contact_Data') ->value(\SOAP::Data->value($Internet_Email_Add +ress_Data)); my $Person_Data = SOAP::Data ->name('bsvc:Person_Data') ->value(\SOAP::Data->value($Contact_Data)); my $Personal_Info_Data = SOAP::Data ->name('bsvc:Personal_Info_Data') ->value(\SOAP::Data->value($Person_Data)); my $Employee_Personal_Info_Data = SOAP::Data ->name('bsvc:Employee_Pe +rsonal_Info_Data') ->value(\SOAP::Data->value($Personal_Info_Data +)); my $Type_Reference = SOAP::Data ->name('bsvc:Type_Reference') ->attr({'bsvc:Primary'=>'1'}) ->value(\SOAP::Data->value($Person_Data)); my $Employee_Personal_Info_Data = SOAP::Data ->name('bsvc:Employee_Pe +rsonal_Info_Data') ->value(\SOAP::Data->value($Personal_Info_Data +)); my $bsvc_ID = SOAP::Data ->name('bsvc:ID') ->attr({'bsvc:System_ID'=>'WD-EMPLID'}) ->value('1234'); my $Int_ID = SOAP::Data ->name('bsvc:Integration_ID_Refer +ence') ->value(\SOAP::Data->value($bsvc_ID)); my $Employee_Reference = SOAP::Data ->name('bsvc:Employee_Reference') ->value(\SOAP::Data->value($Int_ID)); my $params = SOAP::Data ->name('bsvc:Employee_Personal_Info_Update') ->attr({'bsvc:version'=>'v24.0'}) ->value(\SOAP::Data->value($Employee_Reference +)); $soapRequest->call($params,$Employee_Reference,$Employee_Personal_Info +_Data,$security);

    Error that Im getting is

    HTTP/1.1 500 Internal Server Error Connection: close Date: Tue, 19 May 2015 11:38:55 GMT Host: TE: deflate,gzip;q=0.3 Server: Workday Integration Server /2015.20.649 Content-Type: text/xml Client-Date: Tue, 19 May 2015 11:38:55 GMT Client-Peer: Client-Response-Num: 1 Client-SSL-Cert-Issuer: /C=US/O=GeoTrust Inc./CN=GeoTrust SSL CA - G4 Client-SSL-Cert-Subject: /C=US/ST=California/L=Pleasanton/O=Workday, I +nc./CN=* Client-SSL-Cipher: AES128-SHA Client-SSL-Warning: Peer certificate not verified Client-Transfer-Encoding: chunked Set-Cookie: WorkdayLB=36942858.1835.0000; path=/ Strict-Transport-Security: max-age=15638400; includeSubDomains X-WD-REQUEST-ID: F5S|E139FF4A|555B20CF X-Workday-Forwarded-For: <?xml version="1.0" encoding="utf-8"?><SOAP-ENV:Envelope xmlns:SOAP-EN +V=""><SOAP-ENV:Body><SOAP-EN +V:Fault xmlns:SOAP-ENV="" xm +lns:wd="urn:com.workday/bsvc"><faultcode>SOAP-ENV:Client.validationEr +ror</faultcode><faultstring>Invalid request</faultstring></SOAP-ENV:F +ault></SOAP-ENV:Body></SOAP-ENV:Envelope>
SOLVED: Info from Outlook Global Address List
1 direct reply — Read more / Contribute
by VinsWorldcom
on May 19, 2015 at 07:42

    I'm trying to get information from the Outlook Global Address List (GAL). I've used OLE and Outlook pretty successfully before and I'm connecting and getting some information now, but can't seem to expand the output.

    #!perl use strict; use warnings; use Win32::OLE; my $outlook = Win32::OLE->new('Outlook.Application'); die unless $outlook; my $namespace = $outlook->GetNamespace("MAPI"); for my $k (sort(keys(%{$namespace->AddressLists->Item("Global Address +List")->AddressEntries("Lastname,Firstname")}))) { printf "$k = %s\n", $namespace->AddressLists->Item("Global Address + List")->AddressEntries("Lastname,Firstname")->$k; }

    The above produces the following output (admittedly the Lastname,Firstname has been changed as well as the data retuned in 'ID' to obfuscate any sensitive data):

    VinsWorldcom@C:\Users\VinsWorldcom\tmp> Address = /O=EXCHANGE/OU=ORG/CN=RECIPIENTS/CN=LASTNAFI1 AddressEntryUserType = 0 Application = Win32::OLE=HASH(0x2821978) Class = 8 DisplayType = 0 ID = 00000000AABBCCDDEEFFAABBCCDDEEFFAABBCCDDEE00000000000000AABBCCDDE +EFFAABBCCDDEEFFAABBCCDDEEFFAABBCCDDEEFFAABBCCDDEEFFAABBCCDDEEFFAABBCC +DDEEFFAABBCCDDEE00 Name = Lastname,Firstname Parent = Win32::OLE=HASH(0x28219f0) PropertyAccessor = Win32::OLE=HASH(0x2821990) Session = Win32::OLE=HASH(0x2821a08) Type = EX

    The issue is the only relevant information from the output above is "Name". Looking at the GAL in Outlook, there are a ton of other fields (e.g., Address, phone number, email address, manager, etc.). I did a "print pack 'H*', $<ID>" and a bunch of hex is the first part followed by the content in the "Address" output. Certainly not enough encoded data to produce all the missing fields.

    I've done some expansion of the "Win32::OLE=HASH(...)" values and they don't return anything useful either - just values for:

    Application = Win32::OLE=HASH(0x26c16c0) Class = 112 Parent = Win32::OLE=HASH(0x26c1720) Session = Win32::OLE=HASH(0x26c16d8)

    Some Google-ing has produced (among others):

    UPDATE: Reference here: and solved it.

    for my $k (sort(keys(%{$namespace->AddressLists->Item("Global Address +List")->AddressEntries("Lastname,Firstname")->GetExchangeUser}))) { printf "$k = %s\n", $namespace->AddressLists->Item("Global Address + List")->AddressEntries("Lastname,Firstname")->GetExchangeUser->$k; }

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 scrutinizing the Monastery: (11)
    As of 2015-05-22 20:58 GMT
    Find Nodes?
      Voting Booth?

      In my home, the TV remote control is ...

      Results (465 votes), past polls