Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
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
the case where regex seems to work slower
3 direct replies — Read more / Contribute
by rsFalse
on Jul 26, 2017 at 05:08
    Hello.

    Couple of days ago I was solving this stringy problem from codeforces contest -> http://codeforces.com/contest/832/problem/B.

    After I solved it using regexes, I wanted to find others who approached same way, and only I've found was solution in Ruby. And the maximum time for any test case with mine solution was about 3x slower than with contestants' who used Ruby.
    Time-limit: 2000 ms; Memory Limit: 256 MB;
    Here are two links for solutions:
    Ruby - http://codeforces.com/contest/832/submission/28852992
    Perl - http://codeforces.com/contest/832/submission/28885266
    I can see 94 test cases, but sadly - not whole but only pieces of them.
    TC #84:
    Perl: Time: 997 ms, memory: 3180 KB
    Ruby: Time: 77 ms, memory: 12304 KB
    TC #93:
    Perl: Time: 171 ms, memory: 21796 KB
    Ruby: Time: 311 ms, memory: 42948 KB
    (about 15-50 ms are used anytime solving any TC)

    Both solutions seem similar. Except of chomping or not chomping input lines (which also can influence speed). Both solutions compile final regex before use it over next n (1 ≤ n ≤ 10e5) query strings. During contest I haven't compiled regex and got time-limit-exceeded >2000 ms comparing to 93 ms with compiled (qr//) regex (at TC #47).

    I can't see whole TC #84, but logically it contains 4 lines:
    b *aaaaa... 1 ...aaaaa...
    where triple points means sequence of some symbols.
    Here I hardcoded one of possible variants which takes some hundreds ms to complete:
    #!/usr/bin/perl use warnings; use strict; $\ = $/; my $dict = 'b'; $_ = '*' . 'a' x (9e4 - 1e4) . "\n"; s/\?/[$dict]/g; s/\*/[^$dict]*/; my $qr = qr/^$_$/; print $_ =~ $qr ? "YES" : "NO" for 'a' x (0 + 1e4) . 'a' x (9e4 - +1e4) . "\n";


    So what is the worst test case for mine solution? Is there a better solution using regex? Why is such difference between Perl and Ruby at 84th TC?

    Upd. Codeforces is using Perl 5.20.1, -> problemset -> custom-test.
    To find other solutions of this problem, you go to problem -> status, and setup "status filter".
How to Check Hashes for Missing Items when Keys can be Values and vice versa
5 direct replies — Read more / Contribute
by ozboomer
on Jul 26, 2017 at 02:45

    Hi again, all... and apologies straight-up for the weirdo tiitle(!)

    I'm now working on a project where I want to do some two-way checking for 'missing values' and I think the start of the process involves building some hashes.

    I think the code below is a start... and is easier to deal with when compared to trying to see if an element I want to add to an anonymous hash already exists in that anonymous hash, even though there's a couple of lots of processing involved.

    The code works Ok... but there are a couple of things still to be worked out:-

      1. The code allows me to see the sites used within each "dsk" item... but I also want to see the "dsk" items used at each site. Can I do that with a single hash... or (as I expect) I'll need to maintain at least a couple of hashes?
      2. Is there a "better"(?) way to do this sort of thing? I have an inkling there might be something with 'map' that could help.

    So... to the code:-

    use Data::Dumper; %data_hash = (); %output_hash = (); while( <DATA> ) { # Build list of unique (sit +e:dsk) items ($site, $buf) = split(/,/, $_); @input_item = split(/:/, $buf); foreach $input_field (@input_item) { # EX: "VAR8=36!206!207!" @dsk_list = ($input_field =~ /([0-9]+)!([0-9]+)!$/); # Get last + 2 of 3 items foreach $dsk (@dsk_list) { # Each dsk item in the inpu +t... next if ($dsk == 0); # Skip '0' dsk items $key = $site . ":" . $dsk; # Build composite key $data_hash{$key}++; # ...and save it } } } foreach $key ( sort keys %data_hash ) { # Build list of dsk -> (mul +ti sites) ($site, $dsk) = split(/:/, $key); push( @{$output_hash{$dsk} }, $site ); } foreach $dsk (sort {$a <=> $b} keys %output_hash) { # Show list of si +tes for each dsk printf("Dsk: %d:\n", $dsk); foreach $site (sort {$a <=> $b} @{$output_hash{$dsk}}) { printf(" %d\n", $site); } printf("\n"); } __DATA__ 1108,VAR6=36!204!205!:VAR8=36!206!207!:VAR13=36!70!0!:VAR14=36!70!71!: +VAR15=36!71!0! 377,VAR12=36!97!96! 512,VAR6=36!90!91!:VAR8=36!92!93!:VAR11=36!0!70!:VAR12=36!189!190! 587,VAR2=36!550!0!:VAR4=36!554!0!:VAR6=36!551!0!

    ...and some example output:-

    Dsk: 70: 512 1108 Dsk: 71: 1108 Dsk: 90: 512 Dsk: 91: 512 Dsk: 92: 512 Dsk: 93: 512 Dsk: 96: 377 Dsk: 97: 377 Dsk: 189: 512 Dsk: 190: 512 Dsk: 204: 1108 Dsk: 205: 1108 Dsk: 206: 1108 Dsk: 207: 1108 Dsk: 550: 587 Dsk: 551: 587 Dsk: 554: 587

    Ultimately, I expect to use defined() to see if an element exists or not, which will let me display the 'missing items' I mentioned at the start... or I could use some sort of 'union/intersection' construct on the arrays of keys...

    Would appreciate any clues on how to approach this...

    Thanks...

Delete lines if matched expression
2 direct replies — Read more / Contribute
by DespacitoPerl
on Jul 25, 2017 at 22:46

    I am developing a script, which to delete the lines in a report, if matched expression are found in waiver file, which is a filtering file. Note that report format, the first few line are different format to the lines i want to check and delete if matched in waiver file. Report file:

    **************************************** Report : noise_parameters Version : K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode : report_at_source ignore arrival : true include beyond Rails : true enable propagation : true analysis type : violators **************************************** Report : noise -all_violators -nosplit -low -above Version: K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode: report_at_source slack type: height noise_region: above_low pin name (net name) width height slack ----------------------------------------------------- es (esg) 135.42 0.37 -0.20 es (esh) 129.19 0.38 -0.17 es (esm) 184.15 0.49 -0.14 and so on...

    waiver file:

    es,135.42,0.37,"Waived,by","Waived,Date","Approved,by","Approved,date +" es,129.19,0.38,,"Waived,by","Waived,Date","Approved,by","Approved,dat +e"

    output:

    **************************************** Report : noise_parameters Version : K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode : report_at_source ignore arrival : true include beyond Rails : true enable propagation : true analysis type : violators **************************************** Report : noise -all_violators -nosplit -low -above Version: K-2015.12 Date : Mon Jul 24 02:42:46 2017 **************************************** analysis mode: report_at_source slack type: height noise_region: above_low pin name (net name) width height slack ----------------------------------------------------- es (esm) 184.15 0.49 -0.14 es (esb) 208.55 0.48 -0.13 and so on

    my code is like this

    #! /tools/perl/5.8.8/linux/bin/perl use strict; use warnings; use Data::Dumper; # Source script my $report = $ARGV[1] ; my $waiver = $ARGV[3] ; my $result = $ARGV[5] ; # Set up a hash to receive the information my %identifier = (); # Read the violations file into the hash open my $filter, '<', $waiver or die; while (my $vline = <$filter>) { next unless $vline =~ /\S/; #skip blank lines my ($pins2, $w2, $h2) = split /,/, $vline; $identifier{$pins2}{'w2'} = $w2; $identifier{$pins2}{'h2'} = $h2; } print Dumper \%identifier; # Read input file line by line and compare 2 files open my $input, '<', $report or die; open my $output, ">", $result or die; while (my $wline = <$input>){ my ($pins1, $nets, $w1, $h1, $slack) = split /\s+/, $wline; # delete the contents if matched if (exists $identifier{$pins1}) { if ( ($w1 == $identifier{$pins1}{'w2'}) && ($h1 <= $identifier{$pi +ns1}{'h2'}) ) { my $start = 1; } else { my $start = 0; } } else { my $start = 0; } printf $output "$wline"; next if (my $start == 0); #if ($start == 0) { # printf $output "%-44s %-24s %-8s %-8s %-8s %-1 +0s\n", $pins1, $nets1, $w1, $h1, $slack; # } } close $filter; close $input; close $output;
Calculating holidays
4 direct replies — Read more / Contribute
by htmanning
on Jul 25, 2017 at 18:56
    Monks, I'm trying to calculate whether a given date is a major holiday, namely Thanksgiving. The string is in date format like this 2017-11-20. Using DateTime I can do things like tell the day of the week of the server, but how do I parse a date submitted in a string to figure out if it is the 4th Thursday of the month? I'm confused. I believe Thanksgiving is between the 22nd and 28th and the 4th Thursday of the month, but I don't know how to calculate that from a date. I can do something like this:
    $thanks = "2017-11-24"; my ($thyear, $thmonth, $thday) = split(/-/,$thanks);
    but I don't know how to figure out which Thursday it is.
"sketch" directory not being added with 'make manifest'
1 direct reply — Read more / Contribute
by stevieb
on Jul 25, 2017 at 18:48

    Another day, another request for advice.

    In RPi:WiringPi, I have a docs/ directory that includes subdirs breadboard/, fritzing/, schematic/ and sketch/. As you can see by browsing my docs dir on CPAN, sketch/ doesn't show up, but it's there.

    When I do a make manifest it doesn't get added, but all other directories do just fine. Can anyone spot something I'm missing in my MANIFEST.SKIP file here, or provide an answer as to why this directory refuses to be included?

    # MANIFEST.SKIP ^images/ .bs$ .c$ .o$ .sh$ ~$ ^blib/ ^pm_to_blib/ .old$ .orig$ .tar.gz$ .bak$ .swp$ .hg/ .hgignore$ ^_build/ ^Build$ ^MYMETA\.yml$ ^MYMETA\.json$ ^README.bak$ ^Makefile$ .metadata/ .idea/ pm_to_blib$ .git/ .debug$ .gitignore$ .ignore.txt$ .travis.yml$ .iml$ build/ ^\w+.list$ .bblog$ .base$ main$

    It's a pretty old skip file which needs to be cleaned up, but it's what I'm running with that shows the problem so I'm posting it as is in case I'm overlooking a regex or something.

    Here's the current MANIFEST as of a minute ago, after running make manifest.

Perl in programming contests and problem solving
3 direct replies — Read more / Contribute
by rsFalse
on Jul 25, 2017 at 16:49
    Hello.

    There are many programming contests and websites for problem solving. Do you like to solve problems and when do you use Perl? Can you suggest programming contests or websites with string problems or something at which Perl excels?

    Usually in programming contests there are algorithmic problems. You are given some task, which contain: 1. problems description, 2. input constraints and format, 3. output format, 4. time and memory limits. Then you write and submit some code, and testing system tests your code using some test cases which you do not know, except you know constraints. After testing, system tells verdict: accepted, wrong-answer, time-limit-exceeded or something else.
    Some examples of online contests are: codeforces (many languages available, Perl including), topcoder; some examples of online judges are: SPOJ, ProjectEuler, Timus, Rosalind. Some online judges like Project Euler accepts only answers, not code. Majority of people write solutions for these problems in C++ language. Less people use Java, C, Python, Pascal. That is because C++ is fast and short to express and have macros. Many problems are composed in such way that only very fast algorithm can solve all edge cases in a given time limit. For example if author's solution solve the problem in 1 s, then time limit can be set around 2-5 s. If author solved with C++, then it is often impossible to achieve such speed with higher level languages, like Perl or Python. So, Perl was used mostly not in usual competitive programming, but in golf contests :D

    I am using Perl in contests for fun and am solving easiest tasks, when tasks which are more difficult require better understanding of algorithms and data structures.

    If you want to try Perl in solving some string problems, I can suggest codeforces.com -> problemset and choose tag "strings". You can see pieces of test cases and solutions of other users to comparison code and comparison time program consumed on each test case. If you have a nice solution for a problem or you are stuck in it you can start discussion here(?). Websites have their own forums/blogs for discussing problems, but usually these discussions are not language specific. That discussions can be about which Perl structures to use to gain better speed or similar. While using Perl I've discovered that many my solutions on simple tasks are about the same speed as Python users. And do you know if any of more popular online judge systems are written in Perl?
WWW-Authenticate with [WWW::Mechanize::Firefox]
No replies — Read more | Post response
by ptizoom
on Jul 25, 2017 at 15:32
    Hi,

    I am trying to automate data scraping of a well know router which has not SNMP services. It needs to answer a basic authentication challenge which starts with this request:

      WWW-Authenticate: basic realm="'Default: admin/1234"
    but with WWW::Mechanize::Firefox, we do not seem to build this WWW-Authenticate response...

    following the examples in... https://developer.mozilla.org/en-US/docs/Mozilla/Tech/XPCOM/Reference/Interface/nsILoginManager/Using_nsILoginManager I use this code:
    use WWW::Mechanize::Firefox; use File::Temp qw/ :seekable /; my $url = 'http://192.168.1.1/'; my $formSubmitURL; my $httprealm = 'Default: admin/1234'; my $username = 'admin'; my $password = '1234'; my $res; my $hostname = $url; (my $u = "$url") =~ s!/$!!; my $mech = eval { WWW::Mechanize::Firefox->new( autodie => 0 , launch => '/usr/bin/firefox' || system(qq(which firefox) +) , autoclose => 0 , activate => 1 # bring the tab to the foreground , log => [qw[debug]] ) }; my $nsILoginManager = $mech->repl->expr(<<'JS'); Components.classes["@mozilla.org/login-manager;1"] .getService(Components.interfaces.nsILoginManager) JS my $logins = $nsILoginManager->findLogins({}, $url, $formSubmitURL, $h +ttprealm); my $count = $logins->{length}; my $nsILoginInfo; unless($count) { $nsILoginInfo = $mech->repl->expr(<<"JS"); var nsILI = new Components.Constructor( "\@mozilla.org/login-manager/loginInfo;1" , Components.interfaces.nsILoginInfo , "init" ); new nsILI("$hostname", null, "$httprealm", "$username", "$password +", "", "") JS # in resource://gre/components/nsLoginManager.js $res = $nsILoginManager->addLogin($nsILoginInfo); } (my $tpl_f = $url) =~ s/.*\/\///g; $tpl_f =~ s/\/.*//g; $tpl_f .= '_XXXXXX'; my $temp_p = File::Temp->newdir(TEMPLATE => $tpl_f, OPEN => 0); my %attr = (':content_file' => $temp_p->dirname . '.html', no_cache => + 1); $res = $mech->get($url, %attr);

    but I always get this response ...

    $mech->content '<html><head></head><body>WWW::Mechanize::Firefox</body></html>'
    which is the first page.

    Whereas remarkably, the file... "" $temp_p->dirname . '.html' "", contains the routers starting page:

    <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://ww +w.w3.org/TR/html4/frameset.dtd"> <html><head><meta http-equiv="Content-Type" content="text/html; chars +et=utf-8"> <title>Some Technology</title></head>(.v.)<noframes><body></body></no +frames></html>
  • what is the way to automatically build this basic authentication challenge response with WWW::Mechanize::Firefox ?
  • thx.
how to execute 'tmboot -y'
5 direct replies — Read more / Contribute
by ytjPerl
on Jul 25, 2017 at 14:24

    Hi guys, I need to execute 'tmboot -y' to startup application, and before that I need to run setenv.cmd to setup the environment. I have my code as below, but it was running with failure, stating 'tmboot' is not recognized as internal or external command. usually when I dont run setenv.cmd before 'tmboot -y', I got that error. but I already ran that in my script. I do not what is wrong with my script, thanks

    use warnings; use strict; chdir "/server/setup"; my $env = system('setenv.cmd'); my $output = system('tmboot -y'); print $output;
Proc::ProcessTable won't install
1 direct reply — Read more / Contribute
by roperl
on Jul 25, 2017 at 14:18
    I'm trying to use Proc::ProcessTable on Solaris 10
    I downloaded and compiled Perl 5.26.0 and installed to /opt/perl-5.26.0, which I symlink to /opt/perl
    I'm trying to install Proc::Process 0.53 to /opt/perl
    #/opt/perl/bin/perl Makefile.PL Checking if your kit is complete... Looks good Writing MYMETA.yml and MYMETA.json Generating a Unix-style Makefile Writing Makefile for Proc::ProcessTable Writing MYMETA.yml and MYMETA.json #make cp Killfam.pm blib/lib/Proc/Killfam.pm cp Killall.pm blib/lib/Proc/Killall.pm cp ProcessTable.pm blib/lib/Proc/ProcessTable.pm cp example.pl blib/lib/Proc/example.pl cp Process.pm ../blib/lib/Proc/ProcessTable/Process.pm AutoSplitting ../blib/lib/Proc/ProcessTable/Process.pm (../blib/lib/au +to/Proc/ProcessTable/Process) Manifying 1 pod document Running Mkbootstrap for ProcessTable () chmod 644 "ProcessTable.bs" "/opt/perl-5.26.0/bin/perl5.26.0" -MExtUtils::Command::MM -e 'cp_nonem +pty' -- ProcessTable.bs blib/arch/auto/Proc/ProcessTable/ProcessTable +.bs 644 "/opt/perl-5.26.0/bin/perl5.26.0" "/opt/perl-5.26.0/lib/5.26.0/ExtUtil +s/xsubpp" -typemap '/opt/perl-5.26.0/lib/5.26.0/ExtUtils/typemap' P +rocessTable.xs > ProcessTable.xsc mv ProcessTable.xsc ProcessTable.c /opt/solarisstudio12.3/bin/cc -c -D_REENTRANT -I/usr/local/include + -DPERL_USE_SAFE_PUTENV -O -DVERSION=\"0.53\" -DXS_VERSION=\"0.53 +\" -KPIC "-I/opt/perl-5.26.0/lib/5.26.0/sun4-solaris-thread-multi/COR +E" -DPROC_FS -D_POSIX_PTHREAD_SEMANTICS ProcessTable.c /opt/solarisstudio12.3/bin/cc -c -D_REENTRANT -I/usr/local/include + -DPERL_USE_SAFE_PUTENV -O -DVERSION=\"0.53\" -DXS_VERSION=\"0.53 +\" -KPIC "-I/opt/perl-5.26.0/lib/5.26.0/sun4-solaris-thread-multi/COR +E" -DPROC_FS -D_POSIX_PTHREAD_SEMANTICS OS.c "OS.c", line 121: warning: implicit function declaration: bless_into_p +roc rm -f blib/arch/auto/Proc/ProcessTable/ProcessTable.so /opt/solarisstudio12.3/bin/cc -G -L/usr/lib -L/usr/ccs/lib -L/opt/sol +arisstudio12.3/prod/lib/sparc -L/opt/solarisstudio12.3/prod/lib -L/li +b -L/usr/local/lib OS.o ProcessTable.o -o blib/arch/auto/Proc/Proce +ssTable/ProcessTable.so \ \ chmod 755 blib/arch/auto/Proc/ProcessTable/ProcessTable.so Manifying 3 pod documents # make test "/opt/perl-5.26.0/bin/perl5.26.0" -MExtUtils::Command::MM -e 'cp_nonem +pty' -- ProcessTable.bs blib/arch/auto/Proc/ProcessTable/ProcessTable +.bs 644 Manifying 1 pod document No tests defined for Proc::ProcessTable::Process extension. PERL_DL_NONLAZY=1 "/opt/perl-5.26.0/bin/perl5.26.0" "-MExtUtils::Comma +nd::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_ +harness(0, 'blib/lib', 'blib/arch')" t/*.t t/process.t .. ProcessTable.c: loadable library and perl binaries are +mismatched (got handshake key 7f80080, needed 8180080) t/process.t .. Dubious, test returned 1 (wstat 256, 0x100) Failed 3/3 subtests Test Summary Report ------------------- t/process.t (Wstat: 256 Tests: 0 Failed: 0) Non-zero exit status: 1 Parse errors: Bad plan. You planned 3 tests but ran 0. Files=1, Tests=0, 0 wallclock secs ( 0.04 usr 0.01 sys + 0.05 cusr + 0.01 csys = 0.11 CPU) Result: FAIL Failed 1/1 test programs. 0/0 subtests failed. *** Error code 1 make: Fatal error: Command failed for target `test_dynamic'
    So look like somewhere is picking up the already installed perl at /bin/perl
    ProcessTable.c: loadable library and perl binaries are mismatched (got handshake key 7f80080, needed 8180080)

    How can I fix this?
how to put Chart::Gnuplot::DataSet->new and Chart::Gnuplot->new into a subroutine?
2 direct replies — Read more / Contribute
by buchi2
on Jul 25, 2017 at 10:52
    Hello!

    I have several datasets with different y-values, sometime with different x-values, which I want to give to Chart::Gnuplot::DataSet->new.

    In the moment I copy the codeblock 10times and give another ydata/xdata.

    More nicefull it will be, if I can do it with a subroutine, if it is possible?

    in the moment e.g.:
    my $tempmin = Chart::Gnuplot::DataSet->new( xdata => \@yfix, ydata => \@minit, style => "lines", color => "dark-gray", linetype => "dash", width => 1, ); my $tempmax = Chart::Gnuplot::DataSet->new( xdata => \@yfix, ydata => \@maxit, style => "lines", color => "dark-gray", linetype => "dash", width => 1, );

    But I have no idea, how a subroutine have to look, where I pass e.g. @x, @y and other plotparameters to?

    And as next step a subroitine to which I can give some plotsets and some other parameters, like filename, for creating a picture. And call it again with other parameters for the next picture?

    Regards, Buchi


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 all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others perusing the Monastery: (7)
    As of 2017-07-26 17:29 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      I came, I saw, I ...
























      Results (400 votes). Check out past polls.