Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

The Monastery Gates

( #131=superdoc: print w/ replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Remove double bracket and singe quotes
4 direct replies — Read more / Contribute
by lobs
on May 02, 2016 at 10:50
    So I am trying to remove double brackets and singe quotes. Here is example text
    'C-3PO' or 'See-Threepio' is a humanoid robot character from the [[Sta +r Wars]] universe who appears in the original ''Star Wars'' films, th +e prequel trilogy and the sequel trilogy.
    What I have done is
    $doc =~ s/\[\[//g; $doc =~ s/\]\]//g; $doc =~ s/\'//g;
    Does not work at all. Please help.
What am I not understanding about $,
2 direct replies — Read more / Contribute
by Anonymous Monk
on May 01, 2016 at 01:55
    Easy way around this, but I want to understand why it is not working as I expect.
    #!/usr/bin/perl -w use strict; my @array = ( 'abc', 'def', 'ghi', 'jkl', 'mno', 'pqr', 'stu', 'vwx', 'yz ' ); print "@array[2,4]\n";
    Outputs:
    ghi mno
    I want to get rid of the space, so I added:
    local $, = undef;
    But there is still a space in the output. Why? And is there some clever way of getting rid of the space without the obvious method of combining the two elements in a temporary variable and printing that?
Device::SerialPorDevice::SerialPort;t Problem
2 direct replies — Read more / Contribute
by kurta
on Apr 30, 2016 at 14:25

    This is a weird one. I'm reading data from a GPS module. The following code gives the expected response:

    #! /opt/local/bin/perl -w use strict; require 5.000; use lib "/opt/local/lib/perl5/"; use Data::Dump qw(dump); use Device::SerialPort; my $port = Device::SerialPort->new("/dev/tty.usbserial"); $port->are_match("\r\n"); $port->baudrate(9600); $port->databits(8); $port->parity("none"); $port->stopbits(1); while (1) { my $s = $port->lookfor(); next if $s eq ''; print $s,"\n"; if ($s=~/.*GPGGA.*/){ my @a=$s=~/(\d+\.\d{2}),(\d+\.\d+),(N|S),(\d+\.\d+),(E|W)/; print "==",dump(@a); } }
    But if I comment out the "print $s,"\n";" statement, I get nothing. Here's some sample output:

    $GPRMC,108746.88,A,2048.37808,N,80113.44007,W,8.352,,388416,,,D*61
    $GPVTG,,T,,M,8.352,N,8.652,K,D*23
    $GPGGA,108746.88,2048.37808,N,80113.44007,W,2,89,1.82,26.8,M,-29.6,M,,8888*51
    ==("108746.88", "2048.37808", "N", "80113.44007", "W")$GPGSA,A,3,16,26,22,31,23,27,51,80,89,,,,1.78,1.82,1.36*83
    $GPGSV,4,1,14,83,15,210,80,84,11,840,13,87,13,381,,80,47,173,32*7F
    $GPGSV,4,2,14,89,42,311,31,11,83,103,,16,58,824,29,22,87,193,11*7E
    $GPGSV,4,3,14,23,78,208,20,26,26,844,19,27,63,117,26,31,18,897,17*7D

    I suspect there's something strange going on with buffering, but don't understand why printing a variable should make a difference. Any perl-ly wisdom would be appreciated

    === ARGH! Just added a "/n" to the print "==",dump(@a); line and now it works. Why doesn't the buffer flush on print? Is Device::SerialPort resetting something?
DBIx::Class Looping thru resultset
3 direct replies — Read more / Contribute
by phildeman
on Apr 29, 2016 at 16:04

    Hi All,

    Can variables be used in place of column names when looping through DBIx::Class array of objects.
    For example:

    my @db_colnames = ('lastname','firstname','middlename'); my @rows = $schema->resultset( 'myTable' )->search({}, {order_by => [qw +/ lastname firstname middlename /] } ); foreach my $row (@rows) { foreach my $col (@db_colnames) { print $row->$col ."\t"; } print "\n"; }

    No value printed. However, when I used the actual column name to retrieve the data, it worked fine. For example:

    . . print $row->lastname . "\t" . $row->firstname . "\t" . $row->middlenam +e . "\t"; print "\n"; . .

    Thanks for your help.

Parse multiline logfile
2 direct replies — Read more / Contribute
by chris2013
on Apr 29, 2016 at 15:04
    Dear All,

    I'd like to parse a Charon (StrongSwan) logfile.

    Somewhere it logs a failed login. If this is found, I'd like to lookup the username and IP address, that are mentioned some lines above.

    What's the best approach? Is there any framework that can do that? Where I only have to fill-in the regex?

    Should I read the whole logfile to an array and then go back? Or is there something like grep? I've tried to use a shell script and let perl one-liners do the regex stuff. Unfortunately I couldn't escape the single quotes in front and after the e-mail address. They have to be quoted because of the shell and the regex. Tried to write them to an evironment variable but that didn't work. Probably, there are completely different and better solutions.

    export MYP="identity '([A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,})'" EMAIL=`grep -B15 "$DATE" $LOGFILE | grep "$CONID" | grep identity | pe +rl -nle 'print "$1" if /$ENV{MYP}/'`

    Example:

    Apr 29 10:01:10 vpn.example.com charon: 07[NET] <con1|33> received pac +ket: from 2.204.0.13[55842] to 27.3.213.112[4500] (80 bytes) Apr 29 10:01:10 vpn.example.com charon: 14[IKE] <con1|33> received EAP + identity 'jd@example.com' Apr 29 10:01:11 vpn.example.com charon: 14[IKE] <con1|33> EAP-MS-CHAPv +2 verification failed, retry (1)

    - Chris

Filtering array of strings and numbers
3 direct replies — Read more / Contribute
by nysus
on Apr 29, 2016 at 11:28

    I'm stuck on what I think should be a simple problem. I want to filter out elements from an array. I don't know if they array contains strings or numbers or both. And I don't know if the value I want to filter out is a string or number:

    my $string_or_number; my @filtered = grep { $string_or_number ne $_ } @strings_or_numbers;

    What's the best way to accomplishing this without throwing an error if the wrong equality operator is used?

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Detached forking in a CGI script
4 direct replies — Read more / Contribute
by xylose
on Apr 29, 2016 at 11:06

    I'm having a problem satisfying a number of constraints in a CGI script I'm writing.

    I need the script to fork a child process and to get hold of the pid of this child, but to then not make the parent (the CGI process) wait for the child, and allow it to exit immediately.

    One extra complication is that in the child I exec a new program (an R script), but capture STDOUT and STDERR into log files, so I can't close those filehandles before doing the exec.

    I've tried a number of different approaches, but anything which gives me the pid and starts the child process correctly always makes the parent hang until the child is done.

    My current (not working) best guess is:

    $SIG{CHLD} = 'IGNORE'; my $pid = fork(); if ($pid) { # We're the child and we need to start the analysis # First we'll write out pid into a file in the run # folder so that the results tracker can tell if we've # died. open (PID,'>','pid.txt') or die "Failed to write to pid file : $!" +; print PID $pid; close PID or die "Failed to write to pid file: $!"; exec("Rscript analysis.r > log.txt 2>errors.txt"); exit(0); } print $q->redirect("script.cgi?job_id=$job_id");

    In this version the child runs, but the parent doesn't exit until the child has completed.

    Any ideas how I can have my cake and eat it?

    Thanks.

Another concurrent HTTP requests script - code review request
No replies — Read more | Post response
by alanek
on Apr 29, 2016 at 06:02
    Hi PerlMonks! After years of using Parallel::ForkManager to speed up making thousands of HTTP request, I was adviced by Ikegami at Stackoverflow.com to give Net::Curl::Multi a try. And I have to say its awesome! Now, becouse its my first time using it, and becouse final version of the code will have to deal with external, 3rd party API, I would really want to be sure its working fine and doesnt have any bugs. Below You will find my test script based on Ikegami's advice. It works, I dont have any problems with it, but maybe some more experienced Perl users would notice something that I didnt, or tell me if I shouldn't do something like I did, etc. My main concern is the LINE loop and way that I add URL to N::C::M queue, fill the queue with more URLs, wait for one of them to finish, and go to the next URL and add it. Some notes:
    • Im using external txt file with URLs becouse there might be A LOT of them (hundret of thousands even) so I dont want to load everything to array.
    • As I don't fully understand how Net::Curl::Multi's concurrency works, please tell me whether I should expect any problems with putting MySQL UPDATE command (via DBI) inside RESPONSE loop (besides higher server load obviously - I expect final script to run with at least 50 concurrent N::C::M workers)
    Thanks!
    #!/usr/bin/perl use Net::Curl::Easy qw( :constants ); use Net::Curl::Multi qw( ); sub make_request { my ( $url ) = @_; my $easy = Net::Curl::Easy->new(); $easy->{url} = $url; $easy->setopt( CURLOPT_URL, $url ); $easy->setopt( CURLOPT_HEADERDATA, \$easy->{head} ); $easy->setopt( CURLOPT_FILE, \$easy->{body} ); return $easy; } my $maxWorkers = 10; my $multi = Net::Curl::Multi->new(); my $workers = 0; my $i = 1; open my $fh, "<", "urls.txt"; LINE: while ( my $url = <$fh> ) { chomp( $url ); $url .= "?$i"; print "($i) $url\n"; my $easy = make_request( $url ); $multi->add_handle( $easy ); $workers++; my $running = 0; do { my ($r, $w, $e) = $multi->fdset(); my $timeout = $multi->timeout(); select $r, $w, $e, $timeout / 1000 if $timeout > 0; $running = $multi->perform(); RESPONSE: while ( my ( $msg, $easy, $result ) = $multi->info_r +ead() ) { $multi->remove_handle( $easy ); $workers--; printf( "%s getting %s\n", $easy->getinfo( CURLINFO_RESPON +SE_CODE ), $easy->{url} ); } # dont max CPU while waiting select( undef, undef, undef, 0.01 ); } while ( $workers == $maxWorkers || ( eof && $running ) ); $i++; } close $fh;
Any module for saving data as perl data?
3 direct replies — Read more / Contribute
by PerlBroker
on Apr 29, 2016 at 03:25
    Is there any module or way, to simply save data as Perl, for example if I have $a = "hello", that I can save it in exact that form in a file: $a = "hello"; including the same for hashes and arrays?
Suppress 'Can't chdir to' warnings for File::Find
3 direct replies — Read more / Contribute
by mabossert
on Apr 28, 2016 at 12:03

    I am writing some prototype code for a larger application that needs to search all directories from a particular starting point and return all directories that contain certain types of files. The function works fine excepts for producing warnings related to not being able to chdir to directories for which the user who runs the application does not have sufficient permissions to read.

    Perhaps I am just being pickier than I should, but the application needs to traverse directories that belong to the user and also ones that do not belong to the user, but for which the user has sufficient permissions to read. When I run the test code, everything works as expected, but produces warnings. They are expected, but I would like to suppress them or "tell" File::Find to skip any directories that the user does not have permissions to access. On the other hand, maybe there is a way to tell File::Find to first test if it can read the directory and then move on if it cannot?

    Here is my current code. Any suggestions would be greatly appreciated.

    #!/usr/bin/env perl use strict; use warnings; use 5.016; use Carp qw(cluck carp croak); use JSON qw( encode_json ); use File::Find; use Data::Dumper; my %seen; my @files; find ({ wanted => \&wanted }, '/mnt/lustre'); say Dumper(\@files); sub wanted { if($File::Find::name =~ /\.nt$|^dbQuads$|^graph.info$|^string_table_ +chars.index$|^string_table_chars$/ && !exists $seen{$File::Find::dir} +) { my $user = (getpwuid ((stat $File::Find::dir)[4]))[0]; my $name = $1 if $File::Find::dir =~ /\/([^\/]+)$/; #=+ Would like to know how big the directory contents are my $raw_size = 0; my $db_size = 0; my $built = 0; find(sub { if(-f $_ && $_ =~ /\.nt$/) { $raw_size += -s $_; } elsif(-f $_ && $_ =~ /^dbQuads$|^string_table_chars.index$|^stri +ng_table_chars$/) { $db_size += -s $_; $built = 1; } },$File::Find::dir); my %temp = ( owner => $user, raw_size => $raw_size, db_size => $db_size, name => $name, path => $File::Find::dir, built => $built ); push @files, \%temp; $seen{$File::Find::dir} = 1; } }
Error Message - PL_perl_destruct_level at /usr/lib64/perl5/DynaLoader.pm
3 direct replies — Read more / Contribute
by NorCal12
on Apr 28, 2016 at 00:45

    I am new to this forum and certainly not a Perl expert.

    I have a website that is an auction for the commercial fishing industry. It has been up and running since 2011. It is currently located on a shared hosting site and I am in the process of moving it to a VPS site on another company's server. I have move all the files and database to the new location and I have been testing everything before I have the DNS pointed to the new location. For the most part everything looks good. I have an archive section, where a user can look at tables of past sales. These are generated from data stored in a mysql database. The display of past sales works fine.

    However, when I test a new sale I get an error when that sale is being inserted into the database. For speed in testing I have been using a "buy-it-now" feature rather than have to wait for an auction to end.

    The code begins as below:

    #!/usr/bin/perlml BEGIN { my $base_module_dir = (-d '/home/jeffer36/perl' ? '/home/jeffer36/per +l' : ( getpwuid($>) )[7] . '/perl/'); unshift @INC, map { $base_module_dir . $_ } @INC; unshift @INC, '/home/jeffer36/perl5/lib/perl5','/home/jeffer36/perl5/ +lib/perl5/x86_64-linux','/home/jeffer36/perl5/lib/perl5/x86_64-linux/ +Bundle'; } use POSIX qw(strftime); use File::Copy; use strict; use CGI; use CGI::Session; use CGI::Carp qw(fatalsToBrowser); use File::CounterFile; use Data::Dumper; use DBI; #use DBD::mysql;

    When the sale is being inserted into the database this is the error message:

    install_driver(mysql) failed: Can't load '/home/jeffer36/perl5/lib/perl5/x86_64-linux/auto/DBD/mysql/mysql.so' for module DBD::mysql: /home/jeffer36/perl5/lib/perl5/x86_64-linux/auto/DBD/mysql/mysql.so: undefined symbol: PL_perl_destruct_level at /usr/lib64/perl5/DynaLoader.pm line 200, <BUYERFILE> line 88. at (eval 16) line 3 Compilation failed in require at (eval 16) line 3, <BUYERFILE> line 88. Perhaps a required shared library or dll isn't installed where expected at ../auction/buyit.pl line 284</P.

    Line 284 in buyit.pl is:

    my $dbh = DBI->connect("DBI:mysql:$db:$server", $userid, $passwd);

    I have search the web for information on this error message and have come up empty. Does anyone have suggestions on how to correct the problem?

The process cannot access the file because it is being used by another process?[Problem disappeared!]
6 direct replies — Read more / Contribute
by BrowserUk
on Apr 27, 2016 at 17:44

    Update!

    Before I posted, I tried a bunch of things and ran it at least a dozen times getting the exact same failure. I the cut the script of the top of the data, renamed the file .dat and stuck the script into a new file of the old name. I changed <DATA> to <> and supplied the data file on the command line and it worked first time.

    I've just recreated the all in one script; and now it runs perfectly. I have no explanation for the error or the cure; but I suspect 1nickt called it.

    Thanks for your help guys.


    I'm getting this error when I try to run the following code:

    C:\Motor>parseAns.pl The process cannot access the file because it is being used by another + process.

    Another process is accessing the DATA pseudo-handle?

    The data is large 2.4 million, but I'm sure I've processed much larger datasets from <DATA> before; and I've commented out the storing of the data to the array, so it isn't running out of memory. Cluebats anyone?

    #! perl -slw use strict; my @data; my $i = 0; #$data[ $i++ ] = [ split ' ' ] ++$i while <DATA>; print $i; __DATA__ -69.282032302755084 40.000000000000014 0 -1 -69.123493781255831 39.908467741935496 -1.4443382565142906e-006 -1 -68.748013135538145 40.911009397420145 0 -1 -68.964955259756593 39.816935483870985 -2.990721348858345e-006 -1 -68.370049396495517 40.298149116372635 -6.3944096502804299e-006 -1 -68.202015544462682 41.814890597403163 0 -1 ... 2.4 million lines omitted.

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I knew I was on the right track :)
    In the absence of evidence, opinion is indistinguishable from prejudice.
New Meditations
Reversed .= operator
4 direct replies — Read more / Contribute
by 1nickt
on Apr 29, 2016 at 12:40

    Hi all,

    I'm sure we've all wished for a concatenation operator that would prepend a string to a string in the same way the .= operator appends.

    So why isn't there one?

    It's silly that you can write:

    $foo .= 'bar';
    But not:
    $baz =. 'qux';
    and instead have to do:
    $baz = 'qux' . $baz;

    Today I got to wondering if I had missed that such an operator had been introduced in some recent Perl version so I ran the code, and to my surprise Perl said:

    Reversed .= operator at -e line 5. syntax error at -e line 5, near "=."
    Now, if Perl knows that this particular syntax error is a "reversed .= operator", and not, say, "some new operator I didn't know about" - i.e. the syntax is not in use for anything else - then why isn't it implemented?

    Can any guts gurus shed any light?


    The way forward always starts with a minimal test.
Regular Expreso 2
2 direct replies — Read more / Contribute
by choroba
on Apr 26, 2016 at 16:24
    As you might have noticed, I like programming puzzles and brain teasers. But I hadn't participated in a real public contest... until today. I registered to Regular Expreso 2 on HackerRank. The participants had 24 hours to solve 8 tasks, Perl was among the supported languages. The contest was regular expression-centered, your code had to always end the same:
    $Test_String = <STDIN> ; if($Test_String =~ /$Regex_Pattern/){ print "true"; } else { print "false"; }

    The top 10 contestants (most points + shortest time) won a T-shirt. Once I realised there were more then 10 people with the full score, I knew I wasn't getting one, but I still wanted to get the full score.

    But I had no idea how to solve one of the tasks: the input was a long string of zeroes and ones. Your regex had to recognise whether the string encoded two binary numbers in the following way: when you reversed the string and extracted the odd digits, you got a number three times greater than the one built from the remaining digits. For example,

    1110110001 => 00111, 10101 7 21 3 * 7 = 21, accept!

    I wrote a short script to generate some examples, but I wasn't able to find the pattern. Moreover, the regex couldn't have more than 40 characters!

    Then I remembered Perl has a way to run code in a regex: the (?{...}) pattern. I read the relevant perlre section several times and tried something like the following:

    use bigint; sub check { my ($bin, $three) = ('0b') x 2; my $s = $_; while ($s) { $three .= chop $s; $bin .= chop $s; } return oct $three == 3 * oct $bin } $Regex_Pattern = qr/(?{ check() })/;

    The problem here is that (?{...}) always matches. Fortunately, you can use the code pattern as the condition in

    (?(condition)yes-pattern|no-pattern)

    As the yes-pattern, I used ^ which always matches, and (*FAIL) for the no-pattern:

    $Regex_Pattern = qr/^(?(?{ check() }) ^ | (*FAIL) )/x;

    The qr adds some characters, so to be sure I don't overflow, I renamed the subroutine to c and golfed the solution to

    '^(?(?{c()})^|(*F))'

    I got the full score! Would you call such a solution cheating? On one hand, I see that's not what the organisers wanted me to do, on the other hand, that's what Perl regular expressions give you. In fact, with the "start or fail" pattern, I can solve almost any problem with a regular expression!

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
New Cool Uses for Perl
Saving some seconds.
No replies — Read more | Post response
by BrowserUk
on Apr 26, 2016 at 15:14

    After posting my solution to 1161491 I had some 'free time' so I was playing.

    My REPL which (can) time chunks of code for me automatically, produced some depressing numbers:

    C:\test>p1 [0]{0} Perl> use Algorithm::Combinatorics qw[ permutations ];; [0]{0.00943684577941895} Perl> $iter = permutations( [ reverse 1 .. 9 +] );; [0]{0.000318050384521484} Perl> printf "\r%s\t", join '', @$_ while de +fined( $_ = $iter->next );; 123456789 [0]{22.5874218940735} Perl>

    22.5 seconds to generate 9! = 362880 permutations seemed longer than I would have expected; so then I wondered how much of that was down to the generation and how much the formatting and printing:

    [0]{0} Perl>@d = permutations( [ reverse 1 .. 9 ] );; [0]{2.31235218048096} Perl> [0]{0} Perl> printf "\r%s\t", join '', @$_ for @d;; 123456789 [0]{18.9919490814209} Perl>

    So less than 2.5 seconds for the generation and almost 19 for the formatting and printing. (Leaving 1 second 'lost in the mix'.)

    Of course, that one line for printing is doing rather a lot. Unpacking the contents of the anon arrays to a list; joining the list of digits into a string; and then interpolating that into another string before writing it out. So then I wondered about the cost of each of those elements of the task.

    Looking at the code I saw that I could avoid 300,000 calls to each of join and printf by interpolating the lists from the array references directly into a string; provided I set $" appropriately:

    [0]{0} Perl> $"=''; $_ = "@$_" for @d;; [0]{1.93835282325745} Perl>

    That was a nice saving, so then I thought about writing the output. Rather than use a loop: print for @d; which means calling print 300,000 times -- with all the calls into the kernel that involves -- why not join those 300,000 strings into a single string (one call to join) and the output it with a single call to print:

    [0]{} Perl> $d = join "\r", @d;; [0]{0.0442740917205811} Perl> print $d;; 123456789 [0]{4.72821307182312} Perl>

    Summing the individual parts came out to ~10 seconds rather than the original 22.5. So let's put it all together and verify it:

    [0]{0} Perl> $"=''; @d = permutations( [ reverse 1 .. 9 ] ); $_ = "@$_ +" for @d; $d = join "\r", @d; print $d;; 123456789 [0]{9.26112604141235} Perl>

    Sure enough. Under 10 seconds; over 50% saved. Nice.

    Can we go further?:

    [0]{0} Perl> $"=''; print join "\r", map "@$_", permutations( [ revers +e 1 .. 9 ] );; 123456789 [0]{10.0599029064178} Perl> [0]{0} Perl> $"=''; print join "\r", map "@$_", permutations( [ revers +e 1 .. 9 ] );; 123456789 [0]{10.086268901825} Perl>

    And the answer is no. Sometimes the elimination of intermediate variables -- especially intermediate arrays when the alternative is several long lists -- backfires.

    Still. Another 5 minutes of 'idle time' waiting for another long simulation run occupied with an fun exercise, the lessons of which just might stay in my consciousness long enough to become influencial in the code I write in future.

    A few otherwise idle minutes spent now, saving a few seconds on something that doesn't really benefit from that saving; that just might save me hours or days if the lessons happen to be applicable to my next project; or the one after that.

    (If only I could apply those same level of savings to the simulation software I using -- open source, but I cannot compile it locally -- as perhaps then I would be lookng at a 20 hour wait for its completion rather than the 40+ I have in prospect :().


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I knew I was on the right track :)
    In the absence of evidence, opinion is indistinguishable from prejudice.
New Monk Discussion
unreaping , reversing reaped, resurrecting a node
2 direct replies — Read more / Contribute
by beech
on May 03, 2016 at 02:45
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 chanting in the Monastery: (9)
As of 2016-05-03 16:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?