Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

The Monastery Gates

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

Donations gladly accepted

  • (Sep 10, 2018 at 22:53 UTC) Welcome new users!
If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
How to check the request is (GET OR POST) in CGI
2 direct replies — Read more / Contribute
by kanewilliam7777
on Sep 24, 2018 at 08:34

    I have used CGI method

    Please let me know how to check request the value (GET OR POST) in CGI

[OT] Folding Perl code with Emacs 25
2 direct replies — Read more / Contribute
by loris
on Sep 24, 2018 at 04:45

    Hi,

    To get folding in Emacs 25 for Perl programs I have cargo-cult-copied the outline-based set-up https://github.com/villadora/emacs-config/blob/master/modes.el.

    In particular I have:

    ;; CPerl mode hook (setq cperl-mode-hook 'my-cperl-customizations) (defun my-cperl-customizations () "cperl-mode customizations that must be done after cperl-mode load +s" (outline-minor-mode) (abbrev-mode) (defun cperl-outline-level () (looking-at outline-regexp) (let ((match (match-string 1))) (cond ((eq match "=head1" ) 1) ((eq match "package") 2) ((eq match "=head2" ) 3) ((eq match "=item" ) 4) ((eq match "sub" ) 5) (t 7) ))) (setq cperl-outline-regexp my-cperl-outline-regexp) (setq outline-regexp cperl-outline-regexp) (setq outline-level 'cperl-outline-level) )

    My expectation was that if I have

    =head2 STUFF =over =item foo Do foo =cut sub foo { return 'foo'; }

    I should be able to fold to

    =head2 STUFF...

    but instead I just can only fold to, say

    =head2 STUFF... =item foo Do foo =cut sub foo { return 'foo'; }

    i.e. the hierarchy, which I thought gets defined by 'outline-level' doesn't seem to work.

    I do have

    (add-hook 'outline-minor-mode-hook 'outshine-hook-function)

    to get tab-cycling, but maybe this is screwing things up.

    Any thoughts or other approaches?

    Thanks,

    loris

    Note: This is something I originally posted, somewhat spuriously, to the Orgmode mailing list several weeks ago. Not that surprisingly, I got no reply.

What does "bad handshake" mean when connecting to mysql with DBD::mysql?
1 direct reply — Read more / Contribute
by Cody Fendant
on Sep 22, 2018 at 20:05
    • My sqld is up and running
    • I can connect to it just fine with a mysql client and PHPMyAdmin and select, update etc
    • However when I try to connect to it with DBD::mysql I get "bad handshake" in DBI->errstr()

    What kind of things can I check on? How can I debug this?

CPAN modules to read xlsx file in v.5.6
2 direct replies — Read more / Contribute
by Arunkumar_141
on Sep 22, 2018 at 13:19
    Hi, Need CAPN module details to read xlsx files in v.5.6
file handing
5 direct replies — Read more / Contribute
by bigup401
on Sep 22, 2018 at 09:17

    i want to open file and insert it into dir with new filename

    my $NFILE = "09911"; #NEW FILE NAME my $FILE = '02190.JPG'; #FILE TO OPEN my $openfile = open(DATA, ">$FILE"); #OPEN FILE my $newfile = rename($openfile, $NFILE); #RENAME FILE FROM 02190.JPG T +O 09911.JPG my $writefile = open(DATA,">>", "img/$newfile"); #INSERT THE FILE IN I +MG DIR WITH NEW NAME 09911.JPG close DATA;
Perl MongoDB Results and Version (batch_size??)
2 direct replies — Read more / Contribute
by maikelnight
on Sep 21, 2018 at 15:57
    Hi Monks, i have some code that works pretty fine with MongoDB v0.705.0.0 :
    use Data::Dumper; use DateTime::Format::Strptime; use POSIX qw(strftime); use MongoDB; use Data::Structure::Util qw( unbless ); use strict; use warnings; my $mongoclient = MongoDB::MongoClient->new( host => '127.0.0.1', port => 27017 ); my $db = $mongoclient->get_database('database'); my $collect = $db->get_collection('collection')->aggregate([ {'$group' => { '_id' => {_path => '$path' , _ip => '$IP', _time => '$TIME'}, '_count' => { '$sum' => 1}, '_docs' => { '$push' => '$_id' } } }, { '$match' => { '_count' => { '$gt' => 1} }} ]); my $mongo_aggregate = unbless $collect; my @out = (@$mongo_aggregate); print Dumper @out;
    I receive a few thousand results what is expected and checked in database....so far so good...On another system with MongoDB v1.2.2 i receive only 101 results:
    use Data::Dumper; use DateTime::Format::Strptime; use POSIX qw(strftime); use MongoDB; use Data::Structure::Util qw( unbless ); use strict; use warnings; my $mongoclient = MongoDB::MongoClient->new( host => '127.0.0.1', port => 27017 ); my $db = $mongoclient->get_database('database'); my $collect = $db->get_collection('collection')->aggregate([ {'$group' => { '_id' => {_path => '$path' , _ip => '$IP', _time => '$TIME'}, '_count' => { '$sum' => 1}, '_docs' => { '$push' => '$_id' } } }, { '$match' => { '_count' => { '$gt' => 1} }} ]); my $mongo_aggregate = unbless $collect->{'_docs'}; my @out = (@$mongo_aggregate); print Dumper @out;
    If i dump my $collect i found a hint that says: '_batch_size' => 101 I believe thats the point where im stucking. I dont know how to solve the issue nor i can fix that with documentation (as im advanced beginner). Can someone please shed some light on me, please. Thanks, regards,
Prototypes required even after mocking a sub
2 direct replies — Read more / Contribute
by stevieb
on Sep 21, 2018 at 15:11

    So, I had a user of my Mock::Sub distribution file an issue report where trying to mock a subroutine that has prototypes threw a warning. After monkeying about with it, I was able to quell said warnings, but it raised something else that I don't understand. I'll post some code and context, then get to what I'm hoping to have answered.

    This is a runnable example based on the snippet that the user reported:

    use warnings; use strict; use Mock::Sub; my $m = Mock::Sub->new; sub foo ($$$){ return undef; } my $foo_sub = $m->mock('foo');

    Result:

    Prototype mismatch: sub main::foo ($$$) vs none at /home/stevieb/perl5 +/perlbrew/perls/perl-5.26.1/lib/site_perl/5.26.1/Mock/Sub/Child.pm li +ne 122. Prototype mismatch: sub main::foo: none vs ($$$) at /home/stevieb/perl +5/perlbrew/perls/perl-5.26.1/lib/site_perl/5.26.1/Mock/Sub/Child.pm l +ine 140.

    All well and good. As a response to the user, I drummed up a test script with a signal handler to catch Prototype warnings, and just evaporate them (I'll incorporate this into the distribution directly if the reporter is satisfied, enabled only if requested explicitly):

    use warnings; use strict; use feature 'say'; use Mock::Sub; $SIG{__WARN__} = sub {say $_[0] if $_[0] !~ /Prototype/}; my $m = Mock::Sub->new; sub foo ($$$){ say "hello!"; # doesn't get called return undef; } my $foo = $m->mock('foo'); $foo->return_value('test'); say foo(1, 2, 3); say foo(1, 2, 3); say foo(1, 2, 3); say $foo->called_count;

    That code does the right thing, insofar that the mocked sub is properly called and the prototype warnings are no longer displayed:

    test test test 3

    Now, what I found while testing, is that initially, I called foo() with no parameters, but the prototype stuck, resulting in fatality. Instead of foo(1, 2, 3); (proper number of params), I had just foo(), and...

    Not enough arguments for main::foo at mock.pl line 21, near "()" Execution of mock.pl aborted due to compilation errors.

    All I do when I mock out a sub, is overwrite the symbol table for it (actual code from the module):

    { no strict 'refs'; no warnings 'redefine'; my $mock = $self; weaken $mock; *$sub = sub { @{ $mock->{called_with} } = @_; ++$mock->{called_count}; if ($mock->{side_effect}) { if (wantarray){ my @effect = $mock->{side_effect}->(@_); return @effect if @effect; } else { my $effect = $mock->{side_effect}->(@_); return $effect if defined $effect; } } return if ! defined $mock->{return}; if ($mock->{return}[0] && $mock->{return}[0] eq 'params'){ return ! wantarray ? $_[0] : @_; } else { return ! wantarray && @{ $mock->{return} } == 1 ? $mock->{return}[0] : @{ $mock->{return} }; } }; }

    My question here, is if the symtab entry was overwritten correctly (ie. the mocked sub is most definitely called as desired), why does perl still think that it requires the prototyped parameters? Clearly, that information is stored somewhere, but where and how?

    Can someone point me in a direction I can look down to understand this, or even explain it to me?

    Thanks, as always,

    -stevieb

Win32::OLE on cygwin64, can't make OLE.xs
1 direct reply — Read more / Contribute
by gargle
on Sep 21, 2018 at 05:05

    Fellow monks,

    I can't install Win32::OLE 0.1712 on my cygwin64. I already changed stricmp into strcasecmp by means of look Win32::OLE, but make Win32::OLE now gives me an unexpected error:

    OLE.xs:925:17: fout: formaat is geen stringconstante en er zijn geen f +ormaat-argumenten [-Werror=format-security] warn(SvPVX(sv));

    As my cygwin64 is in dutch, it reads: error: format is no string constant and there are no format arguments.

    Any ideas on how to proceed? Do I log a bug in cpan for this module or is there a depency on some sort of cygwin library that I am missing?

    --
    if ( 1 ) { $postman->ring() for (1..2); }
First Web Crawl Task
2 direct replies — Read more / Contribute
by bennierounder
on Sep 20, 2018 at 18:28

    Hi guys,

    I'm very frustrated with this code

    #!/usr/bin/perl -w # a simple web crawler use strict; use LWP::Simple; my $url = shift || die 'Please provide an initial url after filename!' +; my $max = 10; my $html = get($url); my @urls; while ($url =~ s/(https:\/\/\S+)[">]//) { push @urls, $1; print @urls; } mkdir "web" , 0755; open (URLMAP, ">", "web/url.map" ) || die ("can't open web\/url.map\n" +); my $count = 0; for (my $i=0; $i<$max; $i++) { my $source = $urls[int(rand($#urls+1))]; getstore($source, 'web/$count.html'); print URLMAP "$count\n$source\n"; $count++; } close URLMAP;
    1,17 Top

    I run the script, perl web_crawl.pl https://www.money.co.uk and I get this!

    perl web_crawl.pl https://www.google.com
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.
    Use of uninitialized value $source in concatenation (.) or string at web_crawl.pl line 27.

    I'm trying to eventually get the prices and company names, so for example for this part of the site https://www.money.co.uk/travel-money/japanese-yen-exchange-rate.htm I want to get the prices on offer into an array in order (highest first), maybe keeping a note of the company name so may need a hash or array of hashes.
    That's the end goal, but stuck on the first hurdle, which is viewing the sites html in files where i can search the prices, then extract them from the files!!! If you can think of a better way and point me in the right direction on finding the solution, I'm all ears! Thanks in advance!

    Please help!

returning to the outer loop
4 direct replies — Read more / Contribute
by Anonymous Monk
on Sep 20, 2018 at 17:03

    This is greatly simplified - I hope it makes sense. :)

    I am trying to loop over rows of an array doing a test. If the test fails, I want to go all the way back to the outer loop, which the documentation suggests will work only with foreach.

    #!/usr/bin/perl -w use strict; my @x = ( ['aaaaa', 'bbbbb', 'ccccc', 'ddddd',], ['eeeee', 'fffff', 'ggggg', 'hhhhh',], ['iiiii', 'jjjjj', 'kkkkk', 'lllll',], ); for my $i (1 .. 1000) { for my $a (@x) { my $ifails = 0; for my $j (0 .. (scalar @$a) - 1 ) { <get external data string for pattern matching here, put i +n $c> if ($c =~ /$a->[$j]/) { $ifails++; } } if ($ifails > 1) { want to go to outer loop here, and not proc +ess the next (and subsequent) row(s) } } }

    Is there some way of doing that? Note that in the actual application, I do have more more processing below the inner loop, so a "last" statement at the test doesn't work.

    Thank you in advance.

Replace strings in text file
6 direct replies — Read more / Contribute
by TonyNY
on Sep 20, 2018 at 12:28

    Hi,

    I'm trying to replace strings in a text file but cannot get it to work using the following code:

    system("sed -i -e 's/The action failed./failed_build/g' $lookuptxtfile +");

    Any help modifying this code or using a better way to accomplish this would be greatly appreciated.

which GUI toolkit for this task?
4 direct replies — Read more / Contribute
by albert925
on Sep 20, 2018 at 01:26

    Hi, I am looking for a cross-platform GUI toolkit for Perl that can have animatable 2D textures & buttons (animatable position / rotation) , some thing that can work well with card games and board games and look nice.

    Using Perl/TK at the moment but I don't think it is best suited for this task. Any suggestions are welcome. Thanks

New Cool Uses for Perl
Finding Differential Cryptanalysis Inputs with PDL
No replies — Read more | Post response
by mxb
on Sep 21, 2018 at 10:35

    In addition to Perl and PDL, one of my favourite topics is cryptography, specifically cryptanalysis.

    One 'common' cryptanalytical attack, for which modern ciphers are designed against is differential cryptanalysis. Some older ciphers are vulnerable to this attack and various tutorials exist to teach differential cryptanalysis. One of these is by Jon King against the FEAL cipher and is located here.

    One aspect of the differential cryptanalysis attack is to enumerate all potential differentials against the non-linear round function. The below code performs this analysis against the FEAL-4 cipher's round sub-function 'G'. It successfully identifies the two fixed input differentials.

    Enjoy!

    #!/usr/bin/env perl use 5.020; use warnings; use autodie; use PDL; use PDL::NiceSlice; # This code attempts to find all differential characteristics in the # FEAL-4 cipher round subfunction 'G'. # # Reference: http://theamazingking.com/crypto-feal.php # # # 'G' function is addition of a, b and x, then bitwise rotate left # by 2 bits # a, b, x and the final value are all 8 bits. # For our purposes, x can be ignored, as it's constant 0 or 1 # # a # | # x -> [+] <- b # | # [<<<] # | # OUT # # Perform addition my $G = sequence( byte, 256 ) + sequence( byte, 256 )->transpose; # Bitwise rotation $G = ( $G << 2 ) | ( $G >> 6 ); # At this point, $G contains all possible inputs for a and b, and # the associated output value # # Now we wish to find all differentials throughout this function # # To do this, we need to find differentials between each possible # inputs to 'a', and 'b' and observe the differential in the result # # There are two known differentials for this function. A differential # value of 0 and 0x80 (128) for 'a' will always return a constant # differential output (0 and 2) respectively. # Calculate the differential table my $diffs = $G ^ $G ( (0) ); # Find the minimum and maximum value for each differential my ( $min, $max ) = minmaxover($diffs); # Print index of differentials where minimum and maximum value are # equal. As the index is also in the input value, this returns the # actual differential: print "Contant differentials for input differentials of: ", which( $min == $max ), "\n";
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: (8)
As of 2018-09-24 15:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Eventually, "covfefe" will come to mean:













    Results (191 votes). Check out past polls.

    Notices?
    • (Sep 10, 2018 at 22:53 UTC) Welcome new users!