Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
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
RegExp: words excepstions list similar to characters' one.
1 direct reply — Read more / Contribute
by nikolay
on Jun 29, 2016 at 02:23
    Hi. How do i use words excepstions list (like [^qwe|asd]) -- similar to characters' one ([^ghjk])? -- I try to write a script, that would exchange word parts, that contains sign '-', where these parts do not contain (exception) given lists? For example, in the code below
    $z='Web-developer, perl-program, explicit-element, function-call, 2-x +speed.'; print "|$z|\n---\n"; $vrm='(?^ui:(\W)([^(\d|web)]+)-([^(proramm|call)]+)) "1>$1<3>$3< 2> +$2<"'; @bz=split "\t", $vrm; for( $i=0; $i<$#bz; $i+=2 ){ while( $z=~s#$bz[$i]#$bz[$i+1]#g ){ print "|$z|\n"; # <STDIN>; } }

    i want that each part in the 2-word combination, except 'explicit-element', will remain the same, and only 'explicit-element' be turned to 'element explicit' -- because their parts are listed in lists: 'Web-developer' remains the same because its first part 'Web' is in the regular expression, before the sign '-', same for '2-x', whereas 'perl-program' and 'function-call' second parts ('program' and 'call') are listed in the regular expression after sign '-'.

    So, what to do in PERL w/ the exception list for words? Thank you for any advance.

show/hide an Entry field
2 direct replies — Read more / Contribute
by dadenn
on Jun 28, 2016 at 20:29
    I have a Perl-Tk script that uses frame/checkbox/Entry widget to ask for a new LDAP password. I use show=>'*' to mask the actual password. I have over 300 group accounts that have complex passwords and have to change every 180 days. We make up an excel spreadsheet (password protected) to create the new passwords, then copy/paste them into the script. I need a way to toggle from the masked password to the clear text password to ensure the copy/paste was what I expected before I issue the LDAP command to alter it. Is this even possible?
Restful Client Query
4 direct replies — Read more / Contribute
by beckmanel
on Jun 28, 2016 at 12:57

    Problem implementing a relatively simple restful client query, that I have already implemented in curl. A request for device information from a cisco ISE server.

    #!/usr/bin/perl use warnings; use REST::Client; use LWP::UserAgent; use JSON; use MIME::Base64; use Data::Dumper; $ENV{HTTPS_VERSION} = 3; $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; ######################################################## # This works in the shell ######################################################## #curl -k 'https://<myuser>:<mypassword>@<myhost>/webacs/api/v1/data/De +vices' my $host = 'https://<myhost>'; my $user = '<myuser>'; my $pwd = '<mypassword>'; my $client = REST::Client->new(host => $host); my $encoded_auth = encode_base64("$user:$pwd", ''); $client->GET("/webacs/api/v1/data/Devices", {'Authorization' => "Basic $encoded_auth", 'Accept' => 'application/json'}); print 'Response: ' . $client->responseContent() . "\n"; print 'Response status: ' . $client->responseCode() . "\n"; foreach ( $client->responseHeaders() ) { print 'Header: ' . $_ . '=' . $client->responseHeader($_) . "\n"; } __END__ Response: Can't connect to <myhost>:443 LWP::Protocol::https::Socket: SSL connect attempt failed with unknown +errorerror:14077410:SSL routines:SSL23_GET_SERVER_HELLO:sslv3 alert h +andshake failure at /usr/lib/perl5/site_perl/5.10.0/LWP/Protocol/http +.pm line 47. Response status: 500 Header: Content-Type=text/plain Header: Client-Date=Tue, 28 Jun 2016 13:56:58 GMT Header: Client-Warning=Internal response
    Thank You !!
Perligata array indices
1 direct reply — Read more / Contribute
by msh210
on Jun 28, 2016 at 12:44

    I can't get Perligata array indices to work: it uses the index instead of the array value. Here's my code, with # comments where the result is unexpected:

    adnota -MLingua: +:Romana::Perligata ute strict. ute warnings. adnota use stric +t; use warnings; huic vestibulo perlegementum da. adnota $_ = read +line STDIN; his lacunam tum hoc scindementa da. adnota @_ = spli +t ' ', $_; meis apis lacunam tum hoc scindementa da. adnota my @ap = +split ' ', $_; meo io nullum da. adnota my $i=0; meo mo haec admetamentum da. adnota my $m = $ +#_; per in nullum tum mum conscribementis fac sic adnota for (0..$ +m) { hoc tum lacunam egresso scribe. adnota print S +TDOUT $_, ' '; hoc horum tum lacunam egresso scribe. adnota print S +TDOUT $_[$_], ' '; # prints $_ instead cis adnota } scribe novumversum egresso. adnota print STD +OUT $/; meis bis. adnota my @b; meo vo. adnota my $v; per vum in nullum tum mum conscribementis fac sic adnota for $v (0 +..$m) { vum tum lacunam egresso scribe. adnota print S +TDOUT $v, ' '; vum aporum tum lacunam egresso scribe. adnota print S +TDOUT $ap[$v]; # prints $v instead vo borum vum aporum da. adnota $b[$v] += $ap[$v]; # doesn't assign adnota + # (@b has a 'once' warning, not on adnota + # this line, in simpler versions of adnota + # this script) cis adnota } scribe novumversum egresso. adnota print STD +OUT $/; per in his fac sic scribe hoc tum lacunam egresso cis adnota for (@_) +{print STDOUT $_, ' '} scribe novumversum egresso. adnota print STD +OUT $/; per in bis fac sic scribe hoc egresso cis adnota for (@b) +{print STDOUT $_} # doesn't print

    Can anyone help, please?

    $_="msh210";$"=$\;@_=@{[split//,uc]}[2,0];$_="@_$\1";$\=$/;++$_[0]for$...1;print lc substr crypt($_,"@_"),1,6
socket programming error while using it in modular way
2 direct replies — Read more / Contribute
by t-rex
on Jun 28, 2016 at 12:10

    hello monks, i am trying something like

    sub client_socket_create() { my $socket = new IO::Socket::INET ( PeerHost => 'ltsbml02.aus.stglabs.ibm.com', PeerPort => 7777, Proto => 'tcp', ); print "$socket \n"; return $socket; }

    then my calling script calls client_main()passing this $socket but to my shock when i print this $socket in client_main() it gives me nothing a space just

    sub client_main($) { my $socket = @_; print "$socket \n"; # some processing # }

    what could i possibly doing wrong ?

Entering text into richtext field
No replies — Read more | Post response
by rahul.xeqtr
on Jun 28, 2016 at 12:07

    Hi PerlMonks, I am automating a sharepoint page to add certain testcases in the pre-existing list.I am importing the data from an excel file and trying to add it to sharepoint textfileds. For most of the field I am fine, but there 1 field that has taken my sleep away.It is a richtext field. my code is as follows

    #!/usr/bin/perl use strict; use warnings; use Test::More; use Test::WWW::Selenium; use Spreadsheet::ParseExcel; my $parser = Spreadsheet::ParseExcel->new(); my $workbook = $parser->parse("Additional test cases.xls"); if ( !defined $workbook ) { print "i am in if"; die $parser->error(), ".\n"; } # Parameters are passed through to WWW::Selenium my $sel = Test::WWW::Selenium->new( host => "localhost", port => 4444, browser => "*chrome", browser_url => "http://www.goo +gle.com", default_names => 1, error_callback => sub { ... }, ); # use special test wrappers around WWW::Selenium commands: $sel->open_ok("https://afsi.sharepoint.com/Answers/IT/Application% +20Support/Lists/75%20Kendospecific%20Regression%20testing/AllItems.as +px", undef, "fetched sharepoint's site alright"); $sel->window_maximize(); $sel->type_ok("cred_userid_inputtext","rahul.pandey\@afsi.com"); $sel->wait_for_page_to_load_ok(500000000); sleep(5); $sel->type_ok("ctl00_ContentPlaceHolder1_UsernameTextBox","rahul.p +andey\@afsi.com"); $sel->type("ctl00_ContentPlaceHolder1_PasswordTextBox","f4TLxCQT") +; sleep(5); $sel->click("ctl00_ContentPlaceHolder1_SubmitButton"); $sel->wait_for_page_to_load_ok(500000000); sleep(10); my $j=4030; for my $worksheet ( $workbook->worksheets() ) { #for ($i=3;$i++;$i<148) { $sel->click_ok("//*[\@id='Ribbon.ListItem-title']/a/sp +an[1]","","ribbon titled item clicked"); sleep(5); $sel->click_ok("//*[\@id='Ribbon.ListItem.New.NewListI +tem-Large']/a[1]/span/span/img","","ribbon titled new item clicked"); $sel->wait_for_page_to_load_ok(500000000); sleep(10); my $cell = $worksheet->get_cell( 1,2); my $test_Status=$cell->value(); $cell = $worksheet->get_cell( 1,3); my $test_location=$cell->value(); $cell = $worksheet->get_cell( 1,4); my $sub_test_location=$cell->value(); $cell = $worksheet->get_cell( 1,5); my $Test=$cell->value(); $cell = $worksheet->get_cell( 1,6); my $Expected_Result = $cell->value(); #$sel->type_ok("//*[\@id='Title_fa564e0f-0c70-4ab9-b86 +3-0177e6ddd247_\$TextField']", "$test_Status", "test status added for + $j"); #$sel->type_ok("//*[\@id='Issue_x0020_ID_a1517b7b-f6f5 +-48c1-a445-319c3c86aa3b_\$NumberField']", "$j", "test id added for $j +"); #$sel->type_ok("//*[\@id='Test_x0020_Location_80797698 +-d44a-4f1c-b78a-9067d196e97c_\$TextField']", "$test_location", "test +location added for $j"); #$sel->type_ok("//*[\@id='SubTest_x0020_Location_87a5c +789-0ad7-4974-93e9-6787c1f0c4be_\$TextField']", "$sub_test_location", + "sub test location added for $j"); #$sel->type_ok("//*[\@id='Test_af9f0da2-5c9c-46a7-9b09 +-7bcf92800f59_\$TextField']", "$Test", "TEST added for $j"); $sel->type_ok("//*[\@id='Expected_x0020_Result_2549932 +9-daed-4ae4-b963-7ed8dc142ec3_\$TextField_label']", "$Expected_Result +", "Expected Location added for $j");### this line of code is not wor +king for me sleep(15); #$sel->click_ok("//*[\@id='Ribbon.ListForm.Edit.Commit +.Publish-Large']/span[1]/span/img","","Test Case $j added"); $j=$j+1; # } }

    The line of code that is not working for me is  $sel->type_ok("//*[\@id='Expected_x0020_Result_25499329-daed-4ae4-b963-7ed8dc142ec3_\$TextField_label']", "$Expected_Result", "Expected Location added for $j"); This particular field has following x-paths

    <div class="ms-rtestate-field ms-rtefield ms-inputBox ms-inputBoxActiv +e" id="Expected_x0020_Result_25499329-daed-4ae4-b963-7ed8dc142ec3_$Te +xtField_topDiv"><div id="Expected_x0020_Result_25499329-daed-4ae4-b96 +3-7ed8dc142ec3_$TextField_inplacerte_label" style="display:none">Rich + text editor Expected Result</div><div rtedirty="false" aria-multilin +e="true" aria-haspopup="true" aria-autocomplete="both" role="textbox" + class="ms-rtestate-write ms-rteflags-0 ms-rtestate-field" id="Expect +ed_x0020_Result_25499329-daed-4ae4-b963-7ed8dc142ec3_$TextField_inpla +certe" style="min-height:84px" aria-labelledby="Expected_x0020_Result +_25499329-daed-4ae4-b963-7ed8dc142ec3_$TextField_inplacerte_label" co +ntenteditable="true"><p></p><span rtenodeid="2" id="ms-rterangecursor +-start"></span><span id="ms-rterangecursor-end"></span><br></div><div + style="clear : both;"></div></div> <div rtedirty="false" aria-multiline="true" aria-haspopup="true" aria- +autocomplete="both" role="textbox" class="ms-rtestate-write ms-rtefla +gs-0 ms-rtestate-field" id="Expected_x0020_Result_25499329-daed-4ae4- +b963-7ed8dc142ec3_$TextField_inplacerte" style="min-height:84px" aria +-labelledby="Expected_x0020_Result_25499329-daed-4ae4-b963-7ed8dc142e +c3_$TextField_inplacerte_label" contenteditable="true"><p></p><span r +tenodeid="2" id="ms-rterangecursor-start"></span><span id="ms-rterang +ecursor-end"></span><br></div>
undefined value as filehandle from Curl.pm
2 direct replies — Read more / Contribute
by wanderedinn
on Jun 28, 2016 at 09:46

    I am trying to understand why I am receiving the following error:

    Can't use an undefined value as filehandle reference at /home/geof/httppost/lib/perl5/site_perl/5.8.8/LWP/Curl.pm line 236

    I have to admit, I don't understand what the code is attempting. Maybe someone can enlighten me? Code with line numbers below:

    233 my $content = ""; 234 open( my $fileb, ">", \$content ); 235 $self->{agent}->setopt( CURLOPT_WRITEDATA, $fileb ); 236 $self->{retcode} = $self->{agent}->perform;

    How is it that the open() above will even work? Can anyone explain to me why I an getting the 'undefined' error? Thanks for any assistance.

Queries for elastic search using perl
2 direct replies — Read more / Contribute
by ravi45722
on Jun 28, 2016 at 09:32
    #$condition = "((column08=Submit & column10=Delivered & column09=Somet +hing) | (column08=Delivered))"; $condition = "(column08=Submit & column10=Delivered & column09=Somethi +ng)"; #$condition = "((column08=Submit & column10=Delivered & column09=Somet +hing) | (column08=Delivered & column09=Something))";

    Hope you have idea on elastic search. From the GUI i will get these type of conditions. I have to parse this into elastic search queries. Is there any easiest way to do this.

    Example : { 'query' => { 'constant_score' => { 'filter' => { 'bool' => { + 'must' => [ + { + 'term' => { + 'column08' => 'Submit' + } + }, + { + 'term' => { + 'column10' => 'Delivered' + } + }, + { + 'term' => { + 'column09' => 'Something' + } + } + ] } } } } }

    Any help will be appreciated.

    Upto now I tried this. But missing some where

    #!/usr/bin/perl #use strict; #use warnings; use Data::Dumper; use List::MoreUtils qw(any uniq); use JSON; $condition = "((column08=Submit & column10=Delivered & column09=Someth +ing) | (column08=Delivered))"; #$condition = "(column08=Submit & column10=Delivered & column09=Someth +ing)"; #$condition = "((column08=Submit & column10=Delivered & column09=Somet +hing) | (column08=Delivered & column09=Something))"; my $char_index = -1; my $stack = 0; my @condition_array = (); sub parse_function { $start_pos = $_[0]; $end_pos = ($_[1]); my @return_array = (); my $end_pos = ($end_pos - $start_pos)+1; my $string = substr($condition,$start_pos,$end_pos); print $string,$/; if (($string =~ m/(=|!=)/)) { my @matches = grep defined, split / ([|&]) /, $string; if ((scalar @matches) > 1) { foreach my $one (@matches) { if (($one =~ tr/=//) == 1) { my ($key,$value)=(split /=/,$one); push @return_array, { term => { $key => $value} }; } elsif (($one =~ tr/!=//) == 1) { my ($key,$value)=(split /!=/,$one); push @return_array, { term => { $key => $value} }; } else { push (@symbol_array,$one); } } @symbol_array = uniq (@symbol_array); $symbol_count = scalar @symbol_array; if ($symbol_count > 1) { print "Check the condition once again... Getting multi + symbol in one brace"; exit; } if (@symbol_array[0] == '&') { $return_hash{'bool'}{'must'} = [@return_array]; } elsif (@symbol_array[0] == '|') { $return_hash{'bool'}{'should'} = [@return_array]; } push @condition_array, %return_hash; print Dumper \@condition_array; exit; $count = @condition_array; return $count; } else { my ($key,$value)=(split /=/,$string); push @condition_array, { term => { $key => $value} }; $count = @condition_array; return $count; } } else { #print "In final else loop"; my @matches = grep defined, split / ([|&]) /, $string; foreach my $one (@matches) { if ($one == '&' or $one == '|') { push (@array_symbol,$one); } else { push (@return_array,$one); } } @array_symbol = uniq (@array_symbol); $count_array_symbol = @array_symbol; if ($count_array_symbol > 1) { print "In final loop : Got two different operators"; exit; } else { if ($array_symbol[0] == '|') { foreach my $instance (@return_array) { $return_hash{'bool'}{'should'} = [@condition_array +[int($instance)]]; } } if ($array_symbol[0] == '&') { foreach my $instance (@return_array) { $return_hash{'bool'}{'match'} = [@condition_array[ +int($instance)]]; } } push @condition_array, \%return_hash; print Dumper \%return_hash; $count = @condition_array; return $count; } } } HERE: $char_index = -1; foreach my $char (split //, $condition) { $char_index++; if ( (index($condition,'(') != -1)) { if ($char eq "(") { $open_brace_index = $char_index; } elsif ($char eq ")") { $returned = parse_function(($open_brace_index+1),($char_in +dex-1)); $first_string = substr($condition,0,$open_brace_index); $last_string = substr($condition,($char_index+1),(length($ +condition)-$char_index)); #print $last_string,$/; $condition = $first_string.$returned.$last_string; print $condition,$/; goto HERE; } } else { $main_hash{"query"}{"constant_score"}{"filter"} = @condition_a +rray[(int($condition)-1)]; my $json = encode_json \%main_hash; print $json; print Dumper \%main_hash; #print "In this loop"; } } exit;
creating a directory remotely implicitly
4 direct replies — Read more / Contribute
by t-rex
on Jun 28, 2016 at 09:14

    Hi guys , I am transferring a file on remote host using openssh package using function scp_put(), the place where i intend to transfer this file has to be under certain directory which also should be created by us based on a uid/date. but it throws me error that transfer failed coz directory is not present on remote host. so how do i create this directory remotely.

    for example : $sourcedir = "/tmp/xyz/test.tar"; $remotedir = "/tmp/some-dir/myfolder_uid_date/"; ssh->scp_put ( $sourcedir, $remotedir); or die "scp failed";

    the output should be i should be able to transfer test.tar in the remote dir path, but i need to create this remote dir path on the fly or from host itself. how can i achieve this ? right now i get error no such file or directory /tmp/some-dir/myfolder_uid_date/

ExtUtils::MakeMaker and module version
1 direct reply — Read more / Contribute
by frazap
on Jun 28, 2016 at 09:12
    When I run perl Makefile.PL for the Glib perl module, I received a message
    "Requested 'glib-2.0 >= 2.24.0' but version of glib-2.0 is 2.16.5"
    As far as I'm award my PKG_CONFIG_PATH does not include any glib-2.0 of version 2.24 And
    pkg-config glib-2.0 --modversion 2.16.5
    Which is the version I would like to build.

    Where does that 2.24 requirement comes from ?

    Thanks

    François


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 wandering the Monastery: (10)
    As of 2016-06-29 07:59 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      My preferred method of making French fries (chips) is in a ...











      Results (371 votes). Check out past polls.