Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
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
Sub set where all are connected
4 direct replies — Read more / Contribute
by Sanjay
on Nov 22, 2019 at 11:18

    Have a set where all members are connected directly or indirectly. A-B means A and B are connected directly. Order of A-B or B-A immaterial. A-B and B-C means A and C are indirectly connected. A, B, C, ... are ID nos.

    Now want to find the largest collection (sub set) where each is directly connected with each other - if X-Y, X-Z, Y-Z then X, Y and Z are directly connected. If more than one such sub set, then would like to have all such sub sets, if possible.

    This seems more a Graph problem than a Set problem. Looked at all the Graph and Set modules but could not find anything. Googled too.

    Surprised that this problem is not common. Help appreciated

WWW::Mechnize redirect handling
1 direct reply — Read more / Contribute
by nikster
on Nov 22, 2019 at 08:30

    Dear Perlmonks, I turn to you for guidance! Please help me see the light after the long dark of redirect horrors...

    (read: I don't understand why this code is not able to fetch a redirect url).

    I need to access an api, which is secured by a single sign on service, which then redirects to the actual api and provides a token for using it.

    I wrote the following code, expecting it to fetch the location header of the redirect url (shortened it a bit for better readability):

    #!/usr/bin/env perl use WWW::Mechanize; use HTTP::CookieJar::LWP (); use IO::Socket::SSL qw(); my $uri ="https://sso.employer.com/serviceredirect/login?service=https +://actualserviceurl.employer.com/my/service"; my $username = "username"; my $password = q(password); my $fields = { username => $username, password => $password, }; my $m = WWW::Mechanize->new( cookie_jar => $cookie_jar, autocheck => 1 +, ssl_opts => { SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE, +verify_hostname => 0 }, env_proxy => 1, keep_alive => 1, timeout => 3 +0, agent => 'myagent' ); $m->max_redirect(2); my $content = $m->post($uri); $m->submit_form( form_number => 1, fields => $fields, button => 'submit' ); print $content->headers()->as_string;

    I'm able to fetch headers here, but only the ones for the login site.

    No 302, no Location Header.

    If I add "print $content->decoded_content();", I only get the java script from that site.

    BUT, I know that it works in general, because when I add:

    $m->add_handler("request_send", sub { shift->dump; return });

    I can see that it's redirecting and even the Token I'm looking for (shortened too):

    POST https://sso.employer.com/serviceredirect/login?service=https://ac +tualserviceurl.employer.com/my/service Accept-Encoding: gzip User-Agent: myagent Content-Length: 0 Content-Type: application/x-www-form-urlencoded (no content) HTTP/1.1 200 OK [...] HTTP/1.1 302 Found Cache-Control: no-cache, no-store, max-age=0, must-revalidate Date: Fri, 22 Nov 2019 13:20:31 GMT Pragma: no-cache Via: 1.1 login.1and1.org Location: https://actualserviceurl.employer.com/my/service?ticket=xxxs +uperlonggeneratedticketidxxx [...]

    It seems to me that mechanize stops processing the headers / doesn't recognize them to belong $content somehow, while it's generally working...

    I'm really lost here.

    What am I doing wrong?

Converting to number doesn't always work...
5 direct replies — Read more / Contribute
by harangzsolt33
on Nov 21, 2019 at 23:47
    Dear Monks,

    I have a sub called TEST() which converts every sort of input to a number. It should return 0 if the input value is undefined or uninitialized or blank or contains letters only. But if it contains digits, it should return those digits only.

    So, if I ask to convert "55a" then it returns "55" which is fine. But if I try to convert "a55" then it returns 0, which baffles me! It should return 55. Why does this happen?

    Edit: It seems like I am able to access the value of $N from within the warning exception, but I cannot modify it. The changes do not stick. So, I guess the question is how can I export the value of $N from within the warning sub { } so that it would overwrite the value of $N in the TEST sub?

    #!/usr/bin/perl -w use strict; use warnings; my @TEST_VALUES = ('55a', 'a55'); foreach my $i (@TEST_VALUES) { print "Calling TEST('$i'): "; print "\nTEST return value = ", TEST($i), "\n"; } exit; ####################################### sub TEST { print " TEST() was called "; defined $_[0] or return 0; my $N = shift; print "with argument: '$N'\n"; # If we get a warning, it's probably because $N # is not a number. So, we remove all non-digits # and then it becomes a number! local $SIG{__WARN__} = sub { print "\t\t(((warning '$N'->"; $N =~ tr +|0-9||cd; $N = "0$N"; print "'$N')))\n"; }; $N += 0; print "\nThe value of N is now '$N'\n"; return int($N); }
Propagaing error from deeply nested calles
2 direct replies — Read more / Contribute
by likbez
on Nov 21, 2019 at 17:15
    Esteemed monks,

    What is the best way to escape from multilevel, deeply nested calls to the main program (say with the call nesting level close to a hundred) that resulted in error somewhere close the most deep nesting level (unwinding of failed calls).

    Can I use exceptions mechanism for this to jump immediately to the main program? If yes, how?

    For example, in the example below (for demonstration purposes only) we need to exit from all levels if we detect a loop in recursion calls. And the required code is rather ugly and inefficient: checks need to be made both on entry and after each subroutine call in each module.

    use v5.10; use warnings; use strict 'subs'; use feature 'state'; $global_failure=0; $rc=d('d'); say "\nProgram ended"; say "Failure_code is $global_failure"; exit $rc; sub d { state $recursion_level=0; $recursion_level++; if ($recursion_level>10){ $global_failure++; return $recursion_level; } print $_[0].$recursion_level; $rc=e('e'); if( $rc ){ $global_failure++; $global_failure++; print '-'.$_[0].$recursion_level; $recursion_level--; return $recursion_level; } $recursion_level--; return 0; } sub e { state $recursion_level=0; $recursion_level++; if ($recursion_level>10){ $global_failure++; print '-'.$_[0].$recursion_level; $recursion_level--; return $recursion_level; } print $_[0].$recursion_level; $rc=f('f'); if ($rc) { $global_failure++; print '-'.$_[0].$recursion_level; $recursion_level--; return $rc; } $recursion_level--; return 0; } sub f { state $recursion_level=0; $recursion_level++; if ($recursion_level>10){ $global_failure++; print '-'.$_[0].$recursion_level; $recursion_level--; return $recursion_level; } print $_[0].$recursion_level; $rc=f('f'); if ($rc) { $global_failure++; $recursion_level--; print '-'.$_[0].$recursion_level; return $rc; } $recursion_level--; return 0; }
    ... ... ...
convert csv with quotes to xls
3 direct replies — Read more / Contribute
by Anonymous Monk
on Nov 21, 2019 at 16:15
    Hi Perl Monks, I've been knocking myself our for several hours trying to figure this one out but I can't. I'm trying to convert a csv file with several quoted items into any excel format. The quotes are killing everything that I've written. Removing the quotes then running the script gets the formatting wrong because the quoted text or numbers belong together. Here's an example of a piece of the csv file:

    "Searched for: San Francisco_Microbiome" "Title","Amount","Phase","Program","Awards Year","Solicitation Year","Small Business Name","Small Business Address","Woman Owned","Principal Investigator Name","PI Phone","PI Email","Business Contact Name","BC Phone","BC Email","Abstract" "SBIR Phase I: Enhancing the skin microbiome for mosquito repellency: Next generation mosquito repellent derived from big data analysis","$225,000.00"

    This is the code that I found online that I've been trying to modify with zero success:
    use strict; use Spreadsheet::WriteExcel; use Text::CSV_XS; # Check for valid number of arguments if ( ( $#ARGV < 1 ) || ( $#ARGV > 2 ) ) { die("Usage: csv2xls csvfile.txt newfile.xls\n"); } # Open the Comma Separated Variable file open( CSVFILE, $ARGV[0] ) or die "$ARGV[0]: $!"; # Create a new Excel workbook my $workbook = Spreadsheet::WriteExcel->new( $ARGV[1] ); my $worksheet = $workbook->add_worksheet(); # Create a new CSV parsing object my $csv = Text::CSV_XS->new; # Row and column are zero indexed my $row = 0; while (<CSVFILE>) { if ( $csv->parse($_) ) { my @Fld = $csv->fields; my $col = 0; foreach my $token (@Fld) { $worksheet->write( $row, $col, $token ); $col++; } $row++; } else { my $err = $csv->error_input; print "Text::CSV_XS parse() failed on argument: ", $err, "\n"; } }
    I thought about converting to tab delimited or pipe delimited then converting to excel but it got to be possible so I'm reaching out to the monks who are always smarter and wiser than me. Thanks!
Add comment to PowerPoint Win32::OLE
2 direct replies — Read more / Contribute
by IB2017
on Nov 21, 2019 at 15:00

    I am trying to add two elements to an existing PowerPoint if a specific term (in my example "transformation" is found: 1) a text object and with a red background (no transparency) and 2) a note/comment. I manage to do 1) but can't find the option to set the background but I fail completely on point 2). Any suggestion?

    #!perl use strict; use warnings; use utf8; use Cwd; use Win32::OLE; use Win32::OLE 'CP_UTF8'; use Win32::OLE::Const 'Microsoft PowerPoint'; $Win32::OLE::Warn = 3; $Win32::OLE::CP = CP_UTF8; my $file = "original.pptx"; my $dir = getcwd(); my $filename = $dir . '\\' . $file; print ("Starting PowerPoint\n"); my $process = Win32::OLE->GetActiveObject('Powerpoint.Application') || Win32::OLE->new('Powerpoint.Application', 'Quit'); print ( "Opening '$filename'\n" ); my $ppt = $process->Presentations->Open($filename); $file =~ s/original/TCF6203/; $filename = "$dir/$file"; my @activeslides = $process->ActivePresentation->Slides->in; foreach my $slide (@activeslides) { my $name = $slide->{Name}; foreach my $shape ($slide->Shapes->in){ if ($shape->TextFrame->HasText){ #TO DO: to get all elements I sho +uld create a loop here if ($shape->HasTextFrame){ my $text = $shape->TextFrame->TextRange->Text; print "$name\nText $text = "; if ($text =~ /transformation/){ my $TextBox=$slide->Shapes->AddTextbox({Orientation=>1, Left=>5, Top=>5, Width=>250, Height=>250, }); $TextBox->TextFrame->TextRange->{Text} ="Big Ole Test"; #$slide->NotesPage->TextRange->{Text} ="Big Ole Test"; #CO +MMENT OUT TO TRY TO ADD NOTE/COMMENT print "OK\n"; } else { print "NOTHING TO DO\n"; }; } } } } print ( "Saving '$filename'\n" ); $ppt->SaveAs($filename);
REST::Client POST help
3 direct replies — Read more / Contribute
by ogrp
on Nov 21, 2019 at 12:02

    Hi

    Very newbie here so any help appreciated. We have the following API and information.

    https://api.sixfold.com/v1/companies/{company_id}/carrier-shipments/{shipment_id}/allocation

    application/json { "type": "vehicle", "vehicle_id": "123" }

    What am I doing wrong below in the POST command? It returns "Forbidden", which in this case means there is something awry with the format. The headers seem to be OK.

    use REST::Client; use JSON; use Data::Dumper; my $client = REST::Client->new(); $client->POST ('https://api.sixfold.com/v1/companies/296/carrier-shipm +ents/0005360404/allocation','{"type":"vehicle", "vehicle_id":"39257" +}',{Authorization => 'Bearer 096dd6e084d5f30fazzz', "Content-type" => + 'application/json'}); print Dumper($client->responseContent());
Why does /i not seem to work
4 direct replies — Read more / Contribute
by perlpipe
on Nov 21, 2019 at 10:31
    my $r="abc|xyz"; my $rx=qr($r); my $c="XYZ"; my $x1=($c=~/$rx/i); my $x2=(lc($c)=~/$rx/i); say "\$x1=$x1"; say "\$x2=$x2";

    Results in:

    $x1=

    $x2=1

    Shouldn't the /i give us a case insensitive match?

    Perl version: This is perl 5, version 28, subversion 0 (v5.28.0) built for MSWin32-x64-multi-thread

    Running on Windows 10

    Am I missing something obvious>

    TIA

Add optional modules to TEST_REQUIRES?
6 direct replies — Read more / Contribute
by dkechag
on Nov 21, 2019 at 09:26
    Hello. I am preparing to upload a new version of my Test2::Aggregate module to CPAN. I don't like dependencies myself, so when I want to add something like an optional function that not many would use and which would require a dependency, I load the module in runtime making a note in the documentation. So, PREREQ_PM does not contain these extra modules, however I do have tests around them that just skip if you don't have the module. The thing is, cpantesters and cpancover won't actually install the extra modules hence won't actually test these features (unless they happen to have them - but from cpancover at least I see they might not). But, if I add the modules to TEST_REQUIRES, then any user installing the module will have the extra modules installed anyway, which is what I tried to avoid in the first place.

    Comments? Should I just add them to TEST_REQUIRES and not worry about it? I bet I am being a bit too OCD, but I don't like installing things I don't use.

    Thanks!
HSTS policy breaks cpan utility on Windows
5 direct replies — Read more / Contribute
by syphilis
on Nov 21, 2019 at 07:22
    Hi,
    On Ubuntu:
    $ wget http://www.cpan.org/authors/01mailrc.txt.gz URL transformed to HTTPS due to an HSTS policy --2019-11-21 21:21:48-- https://www.cpan.org/authors/01mailrc.txt.gz
    Who is imposing that "HSTS policy" ? (It seems to have sprung up in the last day or two.)
    That file, which is the first thing that my cpan utility tries to download whenever I try to install a module, can no longer be downloaded (by me, at least) over HTTP protocol ... and on Windows there's nothing automatically available to the cpan utility that can perform HTTPS downloads.

    I've installed wget into MSYS2 on the Windows machine (as it's capable of https downloads).
    How do I configure the cpan utility to use wget ?
    And how do I specify that https://www.cpan.org/authors/01mailrc.txt.gz should be downloaded, not http://www.cpan.org/authors/01mailrc.txt.gz .

    Cheers,
    Rob

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 drinking their drinks and smoking their pipes about the Monastery: (6)
    As of 2019-11-23 02:12 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Strict and warnings: which comes first?



      Results (113 votes). Check out past polls.

      Notices?