Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
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
mod_perl best practice to consume dynamic file
2 direct replies — Read more / Contribute
by machtkampf91
on Jul 27, 2017 at 09:43

    Good morning,

    I would like to create a mod_perl module for my Apache server that consumes a JSON object found in a file external to the module. I will be using a Handler that will examine each request running through my Apache server and compare that request to information found in the JSON file. The plan is to update the JSON file with new information on a time interval (every 15-30 minutes or so).

    I'm aware that I can check the file for updates and reload its contents each time a request is fed through the module. However, being new-ish to mod_perl I am curious if there is a best practice regarding this kind of use case.

    Thank you!

"sketch" directory not being added with 'make manifest'
2 direct replies — 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.

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;
how to access array of hash with arrays?
2 direct replies — Read more / Contribute
by buchi2
on Jul 25, 2017 at 10:05
    Hello!

    In a hash I have some arrays. This I get work. But now I want to build several of this hashes an array. I did it with push. But how I can get out now a value?

    #!/usr/bin/perl -w my %hierhash; my @feld; my @hashfeld; my $wert; @hashfeld = (); %hierhash = &dofn(0,5,1); print "1 $hierhash{'var2'}[3] \n"; push(@hashfeld,%hierhash); %hierhash = &dofn(0,5,2); print "2 $hierhash{'var2'}[3] \n"; push(@hashfeld,%hierhash); $wert = $hashfeld[0]->{'var2'}[3]; print "$wert \n"; sub dofn () { my ($i, $ivon, $ibis, $imal); my %hashfn; $ivon = $_[0]; $ibis = $_[1]; $imal = $_[2]; for ($i = $ivon; $i < $ibis; $i++) { push(@{$hashfn{'var1'}}, $i*$imal); push(@{$hashfn{'var2'}}, $i*$imal*10.); push(@{$hashfn{'var3'}}, $i*$imal*20.); } return %hashfn; }
    Regards, buchi
POE child autoflush stdout
1 direct reply — Read more / Contribute
by sub_soNic
on Jul 24, 2017 at 12:17

    Hi guys!

    I have been playing around with POE for a while, I would like to create a little script that forks subprocesses while there are tasks to process and also log the result of those tasks. It works fine except for the "logging" part

    I replaced the while(1) with sleep for making the problem more obvious. The problem is that the stdout/stderr is only displayed after the parent is done with the sleep wherever I put it, the rest of the code is executed tho just fine. So the child processes might not autoflush with POE?.. If so, could you give me an advice please how to force it or some workaround.

    use POE; use POE::Component::Client::SMTP; use POE qw( Wheel::Run ); use strict; use warnings; $|++; POE::Session->create( inline_states => { _start => \&on_start, got_child_stdout => \&on_child_stdout, got_child_stderr => \&on_child_stderr, got_child_close => \&on_child_close, got_child_signal => \&on_child_signal, get_next_logic => \&on_get_next_logic, } ); POE::Kernel->run(); exit 0; sub on_start { print "on_start\n"; $_[KERNEL]->yield("get_next_logic"); sleep(10); } sub get_next_file { print "get_next_file\n"; } sub on_get_next_logic { my $child; print("get_next_logic\n"); $child = POE::Wheel::Run->new( Program => sub { get_next_file() }, StdoutEvent => "got_child_stdout", StderrEvent => "got_child_stderr", CloseEvent => "got_child_close", #Conduit => "pty" ); $_[KERNEL]->sig_child($child->PID, "got_child_signal"); # Wheel events include the wheel's ID. $_[HEAP]{children_by_wid}{$child->ID} = $child; # Signal events include the process ID. $_[HEAP]{children_by_pid}{$child->PID} = $child; print( "Child pid ", $child->PID, " started as wheel ", $child->ID, ".\n" ); sleep(10); } ####### signal handling stuff i haven't touched ##### # Wheel event, including the wheel's ID. sub on_child_stdout { my ($stdout_line, $wheel_id) = @_[ARG0, ARG1]; my $child = $_[HEAP]{children_by_wid}{$wheel_id}; print "pid ", $child->PID, " STDOUT: $stdout_line\n"; } # Wheel event, including the wheel's ID. sub on_child_stderr { my ($stderr_line, $wheel_id) = @_[ARG0, ARG1]; my $child = $_[HEAP]{children_by_wid}{$wheel_id}; print "pid ", $child->PID, " STDERR: $stderr_line\n"; } # Wheel event, including the wheel's ID. sub on_child_close { my $wheel_id = $_[ARG0]; my $child = delete $_[HEAP]{children_by_wid}{$wheel_id}; # May have been reaped by on_child_signal(). unless (defined $child) { print "wid $wheel_id closed all pipes.\n"; return; } print "pid ", $child->PID, " closed all pipes.\n"; delete $_[HEAP]{children_by_pid}{$child->PID}; } sub on_child_signal { print "pid $_[ARG1] exited with status $_[ARG2].\n"; my $child = delete $_[HEAP]{children_by_pid}{$_[ARG1]}; # May have been reaped by on_child_close(). return unless defined $child; delete $_[HEAP]{children_by_wid}{$child->ID}; }
    Thank you very much!
crypt function has string length limit?
3 direct replies — Read more / Contribute
by jamroll
on Jul 24, 2017 at 11:18
    i'm using perl's 'crypt' function.

    does it have a limit on the size of the string being passed in?

    #!/usr/bin/perl # must have's! use strict; use warnings; use CGI::Carp qw(fatalsToBrowser); use DBI; use URI::Escape; use lib "/var/www/html/Pm"; my $pw = "Aardvark"; # 8 characters my $salt = "ab"; my $pwCrypted = crypt($pw, $salt); print "content-type: text/plain\n\n"; if (crypt("Aardvarks", $salt) eq $pwCrypted) { print "yup" } else { pr +int "nope"; } exit 1;
    the above prints "yup", not "nope" as you might expect....seems crypt does have a limit, although the doc i reference doesn't state the existence of such a limit. is there an equivalent which operates exactly the same?
Understanding endianness of a number
3 direct replies — Read more / Contribute
by stevieb
on Jul 23, 2017 at 11:07

    Hey all,

    I ran into a situation recently where I was reading from an I2C device, and the byte ordering was in the opposite endianness that I was expecting. Although I fixed the problem by reversing the bytes before returning them, I went off to research exactly what endian was. I've spent numerous hours testing, reading and more testing, but I still can't grasp it fully. I'm hoping just one or two more examples will have it 'click'.

    So, I'll start off with a couple of examples here to see if I have the basics down. Please feel free to elaborate with other examples or comments etc.

    Set up our number, and two byte scalars (full version copy/pastable at the bottom of the post):

    use warnings; use strict; use feature 'say'; my $num = 1023; # 0x03ff my ($b1, $b2);

    Now, if I do the following bit shifting, the printf() is printing the bytes in big endian format, correct?

    $b1 = ($num & 0xff00) >> 8; $b2 = $num & 0xff; printf("%x, %x\n", $b1, $b2); # 3, ff

    Likewise, if I reverse the operations/bytes, this one will print in little endian format, right?

    $b1 = $num & 0xff; $b2 = ($num & 0xff00) >> 8; printf("%x, %x\n", $b1, $b2); # ff, 3

    Full code:

    use warnings; use strict; use feature 'say'; my $num = 1023; my ($b1, $b2); $b1 = ($num & 0xff00) >> 8; $b2 = $num & 0xff; printf("%x, %x\n", $b1, $b2); $b1 = $num & 0xff; $b2 = ($num & 0xff00) >> 8; printf("%x, %x\n", $b1, $b2);
sub variables
4 direct replies — Read more / Contribute
by Todd Chester
on Jul 22, 2017 at 19:33
    Dear Perl Monks,

    In Perl 5, is there a way to name my variables in the () of the sub declaration, as I do in Perl 6?
    sub DoSomething( $DataStr ) {;}

    Many thanks, -T
Space inserted into output file
3 direct replies — Read more / Contribute
by He77e
on Jul 22, 2017 at 11:36

    Greetings Esteemed Monks,

    I am relatively new to Perl so this may be an easy fix.

    My script here is meant to import a CSV, parse, output a new string containing the elements in FASTA format into an array and write to a file.

    The problem I come across is that before each new entry a blank space (\s) is inserted; I assume the problem is with the way I am exporting the array to a file but I cannot find a method which deals with the problem.

    Any help? (script shown below)

    use Text::CSV; use Data::Dumper qw(Dumper); print "Enter file name: \n"; my $file = <STDIN>; chomp $file; print "Enter output file name: \n"; my $ofile = <STDIN>; my $csv = Text::CSV->new({ sep_char => ',' }); my @fasta; open(my $data, '<', $file) or die "Could not open '$file' $!\n"; while (my $line = <$data>) { chomp $line; if ($csv->parse($line)) { my @fields = $csv->fields(); #print Dumper \@fields; $fields[4]=~s/\s//gs; #removes spaces within the sequence push @fasta,"\>$fields[0]\_$fields[1]\_$fields[2]\_$fields[3]\n$ +fields[4]\n"; #outputs the correct format } else { warn "Line could not be parsed: $line\n"; } } #print Dumper \@fasta; open (FH,">$ofile"), print FH"@fasta", close; end;

    Sample input: (it is in TSV format but is read into the script anyway without a problem)

    XP_014917420.1 CYP26A1 Acinonyx jubatus Cheetah  MGFPFFGE +TLQMVLQRRKFLQMKRRKYGFIYKTHLFGRPTVRVMGADNVRRILLGEHRLV SVHWPASVRPILGSGC +LSNLHDSSHKQRKKVIMRAFSREALQYYVPVIAEEVGTCLEQWL SCGERGLLVYPQVKRLMFRIAMRI +LLGCEPRLANGGDAEQQLVEAFEEMTRNLFSLPIDV PFSGLYRGMKARNLIHARIEENIRAKICGLRA +AEAEAEAGGGCKDALQLLVDHSWERGER LDMQALKQSSTELLFGGHETTASAATSLITYLGLYPHVLQ +KVREELKSKGLLCKSNQDNK LDMEILGQLKYIGCVIKETLRLNPPVPGGFRVALKTFELNGYQIPKGW +NVIYSICDTHDV ADIFTNKEEFNPDRFMLPHPEDASRFSFIPFGGGAKILLKIFTVELARHCDWRLLN +GPPT MKTSPTVYPVDDLPARFTRFQGET XP_002916147.1 CYP26A1 Ailuropoda melanoleuca Giant Panda +MGLPALLASALCTFVLPLLLFLAAIKLWDLYCVSGRDRSCALPLPPGTMGFPFFGETLQM VLQRRKFL +QMKRRKYGFIYKTHLFGRPTVRVMGADNVRRILLGEHRLVSVHWPASVRTIL GSGCLSNLHDSSHKQR +KKVIMRAFSREALQCYVPVIAEEVGTCLEQWLSCGERGLLVYPQ VKRLMFRIAMRILLGCDPRLASGG +DAEQQLVEAFEEMTRNLFSLPIDVPFSGLYRGMKAR NLIHARIEENIRAKICGLRTAEAASGCKDALQ +LLIEHSWERGERLDMQALKQSSTELLFG GHETTASAATSLITYLGLYPHVLQKVREELKSKGLLCKSN +QDNKLDMEILEQLKYIGCVI KETLRLNPPVPGGFRVALKTFELNGYQIPKGWHVIYSICDTHDVADSF +TNKDEFNPDRFL QPHPEDASRFSFIPFGGGLRSCVGKEFAKMLLKIFTVELARHCDWRLLNGPPTMKT +SPTV YPVDGLPARFTHFQGEI XP_006276679.1 CYP26A1 Alligator mississippiensis American Al +ligator MGFALLASALCTLLLPLLLFLAAVKLWGLYCESGRDPGCPLPLPPGTMGLPFFGETLQ +MV LQRRKFLQVKRRKYGCIYKTHLFGRPTVRVLGADNVRRILLGEHRLVAVQWPASVRTILG SGCLS +NLHDARHKQRKKVIMRAFSRDALRHYAPVMQEEVSGCLARWLGRGGACLLVYPEV KRLMFRIAMRLLL +GFEPHQADSGSERQLVEAFEEMSRNLFSLPIDVPFSGLYRGLRARNI IHARIEANIRNRMARAEPGGG +PKDALQLLLEQAQRHGQPLNMQELKESATELLFGGHETT ASAATSLITFLGLHPEVLQKVRKELQGNG +LLCSPNQDSKTLDMEVLEQLKYTGCVIKETL RLSPPVPGGFRVALKTFELNGYQIPKGWNVIYSICDT +HDVAELFTNKDKFNPDRFMSPSP EDSSRFSFIPFGGGVRSCVGKEFAKILLKIFTVELARNCDWQLLN +GPPTMKTGPIVYPVD NLPAKFVGFSGQI XP_021123924.1 CYP26A1 Anas platyrhynchos Mallard  MGFSALL +ASALCTFLLPLLLFLAAVKLWDLYCVSSRDPSCPLPLPPGTMGLPFFGETLQM VLQRRKFLQMKRRKY +GFIYKTHLFGRPTVRVMGAENVRHILLGEHRLVSVQWPGSPPPPP LPRPPGQVIMRAFSRDALQHYVP +VIQEEVSACLARWLGAAGPCLLVYPEVKRLMFRIAMR ILLGFQPRQAGPDGEQQLVEAFEEMIRNLFS +LPIDVPFSGLYRGLRARNIIHAKIEENIR AKMARKEPEGGYKDALQLLMEHTQGNGEQLNMQELKESA +TELLFGGHETTASAATSLIAF LGLHHDVLQKVRKELQVKGLLCSPNQEKQLDMEVLEQLKYTGCVIKE +TLRLSPPVPGGFR IALKTLELNGYQIPKGWNVIYSICDTHDVADLFTNKDEFNPDRFMSPSPEDSSRF +SFIPF GGGLRSCVGKEFAKVLLKIFIVELARSCDWQLLNGPPTMKTGPIVYPVDNLPTKFIGFSG QI

    Sample output: (note the \s added to every entry excluding the first)

    >XP_002916147.1_CYP26A1_Ailuropoda melanoleuca_Giant Panda MGLPALLASALCTFVLPLLLFLAAIKLWDLYCVSGRDRSCALPLPPGTMGFPFFGETLQMVLQRRKFLQM +KRRKYGFIYKTHLFGRPTVRVMGADNVRRILLGEHRLVSVHWPASVRTILGSGCLSNLHDSSHKQRKKV +IMRAFSREALQCYVPVIAEEVGTCLEQWLSCGERGLLVYPQVKRLMFRIAMRILLGCDPRLASGGDAEQ +QLVEAFEEMTRNLFSLPIDVPFSGLYRGMKARNLIHARIEENIRAKICGLRTAEAASGCKDALQLLIEH +SWERGERLDMQALKQSSTELLFGGHETTASAATSLITYLGLYPHVLQKVREELKSKGLLCKSNQDNKLD +MEILEQLKYIGCVIKETLRLNPPVPGGFRVALKTFELNGYQIPKGWHVIYSICDTHDVADSFTNKDEFN +PDRFLQPHPEDASRFSFIPFGGGLRSCVGKEFAKMLLKIFTVELARHCDWRLLNGPPTMKTSPTVYPVD +GLPARFTHFQGEI >XP_006276679.1_CYP26A1_Alligator mississippiensis_American Alligator MGFALLASALCTLLLPLLLFLAAVKLWGLYCESGRDPGCPLPLPPGTMGLPFFGETLQMVLQRRKFLQVK +RRKYGCIYKTHLFGRPTVRVLGADNVRRILLGEHRLVAVQWPASVRTILGSGCLSNLHDARHKQRKKVI +MRAFSRDALRHYAPVMQEEVSGCLARWLGRGGACLLVYPEVKRLMFRIAMRLLLGFEPHQADSGSERQL +VEAFEEMSRNLFSLPIDVPFSGLYRGLRARNIIHARIEANIRNRMARAEPGGGPKDALQLLLEQAQRHG +QPLNMQELKESATELLFGGHETTASAATSLITFLGLHPEVLQKVRKELQGNGLLCSPNQDSKTLDMEVL +EQLKYTGCVIKETLRLSPPVPGGFRVALKTFELNGYQIPKGWNVIYSICDTHDVAELFTNKDKFNPDRF +MSPSPEDSSRFSFIPFGGGVRSCVGKEFAKILLKIFTVELARNCDWQLLNGPPTMKTGPIVYPVDNLPA +KFVGFSGQI >ARO89874.1_CYP26A1_Andrias davidianus_Chinese Giant Salamander MSLYTLFASALCTLVLPLLLFLAAVKLWELYCISTRDRSCRCPLPPGTMGLPFFGETLQMVLQRRKFLQM +KRRKYGCIYKTHLFGRPTVRVMGAENVKQILLGEHRLVSVHWPASVRTILGSGCLSNLHDSQHKNRKKV +IMQAFSREALQHYIPVIEEEVRGALAQWLGGGGASVLVYPEVKRLMFRIAMRILLGFEPHQTDREMEQQ +LVEAFEEMIRNLFSLPIDVPFSGLYRGLKARNVIHAKIEENIRAKMAKESDTQYKDALQLLIEHTQKNG +EQLNMQELKESATELLFGGHETTASAATSLMTFLALHSDVLHKVRKELQIKDLLCDNKPLNIEALEQLK +YTGCVIKETLRLSPPVPGGFRVALKTFELNGYQIPKGWNVIYSICDTHDVAEIFPNKEEFNPDRFMSSH +PEDNSRFNFIPFGGGLRSCVGKEFAKILLKIFTVELARTCDWQLLNGAPTMKTGPIVYPVDNLPTKFIG +FNGII >XP_012310130.1_CYP26A1_Aotus nancymaae_Nancy Ma's Night Monkey MGLPALLASALCTFVLPLLLFLAAIKLWDLYCVSGRDRSCALPLPPGTMGFPFFGETLQMVLQRRKFLQM +KRRKYGFIYKTHLFGRPTVRVMGADNVRRILLGEHRLVSVHWPASVRTILGSGCLSNLHDSSHKQRKKV +IMRAFSREALKCYVPVIIEEVGSSLEQWLSCGERGLLVYPEVKRLMFRIAMRILLGCEPQLAGDRDAEQ +QLVEAFEEMTRNLFSLPIDVPFSGLYRGVKARNLIHARIEQNIRAKICGLRASEASRGCKDALQLLIEH +SWERGERLDMQALKQSSTELLFGGHETTASAATSLITYLGLYPHVLQKVREELKSKGLLCKSNQDNKLD +MEILEQLKYIGCVIKETLRLNPPVPGGFRVALKTFELNGYQIPKGWNVIYSICDTHDVAEIFTNKEEFN +PDRFMLPHPEDASRFSFIPFGGGLRSCVGKEFAKILLKIFTVELARHCDWQLLNGPPTMKTSPTVYPVD +NLPARFTHFHGEI
    Any help would be greatly appreciated!
Passing hashes to sub
1 direct reply — Read more / Contribute
by PSP
on Jul 22, 2017 at 04:28
    my $loopCnt=0; my %prevsidstat=%{getSessStat()}; while (1) { debug("Sleeping for $ENV{SESSNAP_INTRVL}...\n"); sleep $ENV{SESSNAP_INTRVL}; my %cursidstat=%{getSessStat()}; if ((keys %cursidstat) != 0 ) { my $ComResult={sidStatComp(%prevsidstat,%cursidstat)}; my %prevsidstat=%cursidstat; } last; }

    Here I am getting hash reference when %{getSessStat()} is executed. Now I want to pass two hash references to sub to process them further, however just printing them in sub getting following error. Appreciate in advance for help. Odd number of elements in anonymous hash at line 65, <SQLPLUS> line 20.

    Sub code:
    #***************************************************** sub sidStatComp { #***************************************************** my (%prevsidstat,%cursidstat)=@_; print "Previous\n"; for my $instsid (keys %prevsidstat) { print "$instsid => $prevsidstat{$instsid}{SQLEXECINFO}\n"; } print "Current\n"; for my $instsid1 (keys %cursidstat) { print "$instsid1 => $cursidstat{$instsid1}{SQLEXECINFO}\n"; } return 1; }
Get TAP output when compiling Perl and running "make test"
1 direct reply — Read more / Contribute
by Rjevski
on Jul 21, 2017 at 15:53

    Hello,

    I am currently working on automating our Perl builds and I'd like to know how do I get the TAP output when I run make test so that the continuous integration system can pick up failures and display them nicely (manually going through a 5k line build log is not fun).

    I've already tried setting PERL_TEST_HARNESS_DUMP_TAP as well as HARNESS_OPTIONS but those have no effect when running through make for some reason.

    Steps to reproduce:

    curl https://cpan.metacpan.org/authors/id/S/SH/SHAY/perl-5.20.3.tar.bz +2 | tar -jxC /root cd /root/perl* ./Configure -des -Dprefix=/opt/perl-5.20.3 make -j $(nproc) make test

    I am running Perl 5.20.3 on Debian 9.0 amd64.

    Regards.

Tk::TableMatrix won't build on Strawberry 5.26.0
3 direct replies — Read more / Contribute
by aplonis
on Jul 21, 2017 at 09:17

    Running Strawberry version 5.26.0 on Win 10 Pro. And, alas, Tk::TableMatrix will not build. I get this error...

    Checking dependencies from MYMETA.json ... Checking if you have ExtUtils::MakeMaker 0 ... Yes (7.24) Checking if you have Tk 800.022 ... Yes (804.033) Building and testing Tk-TableMatrix-1.23 cp TableMatrix.pm blib\lib\Tk\TableMatrix.pm AutoSplitting blib\lib\Tk\TableMatrix.pm (blib\lib\auto\Tk\TableMatrix +) cp TableMatrix/Spreadsheet.pm blib\lib\Tk\TableMatrix\Spreadsheet.pm cp TableMatrix/SpreadsheetHideRows.pm blib\lib\Tk\TableMatrix\Spreadsh +eetHideRows.pm cd pTk && gmake gmake[1]: Entering directory 'C:/Users/gan/.cpanm/work/1500635987.1034 +8/Tk-TableMatrix-1.23/pTk' gmake[1]: *** No rule to make target '..\blib\arch\Tk\pTk\.exists', ne +eded by 'config'. Stop. gmake[1]: Leaving directory 'C:/Users/gan/.cpanm/work/1500635987.10348 +/Tk-TableMatrix-1.23/pTk' gmake: *** [Makefile:1171: pTk/libpTk.a] Error 2 -> FAIL Installing Tk::TableMatrix failed. See C:\Users\gan\.cpanm\wor +k\1500635987.10348\build.log for details. Retry with --force to force + install it.

    And --force also failed. Anyone know how to work through this?

New Meditations
Perl Security Testing
4 direct replies — Read more / Contribute
by zentara
on Jul 24, 2017 at 10:02
    Hi, the Test Driven Development, for software and for pancakes node interested me, and I went off on a tangent from talexb's original meditation. So I post a new meditation, with my reply as a starter.

    Original reply: ##########################

    I'm a total amateur compared to you fellows, but I do find when I write my code, for the first draft, I almost always print out arrays and variables after everytime I use them. I almost always get things wrong the first time thru, so my method is very helpful to me.

    It's my guess is that the reason TDD failed is that the Test that you didn't account for, is the one that causes the bug, ( if any).

    What is more worring to me is the security vulnerabilities which Perl5 is susceptible to.

    For instance, could a normal or guest user on your machine, with access to Perl scripts, cause a buffer-overflow of some sort, and gain root access? I'm sure the NSA would pay for that information. :-)

    How safe is Perl out there in the wild? Are systems being hacked thru Perl? As far as know, Perl has been very safe in my limited use. I guess security is the number one test.

    So what do you experts feel, know, and or are hiding concerning Perl's security, assuming the scripts are written and run correctly? Was there ever a real buffer overflow exploit? etc

    Should I worry about other users on my linux box getting root escalation if I let them login?


    I'm not really a human, but I play one on earth. ..... an animated JAPH
Test Driven Development, for software and for pancakes
3 direct replies — Read more / Contribute
by talexb
on Jul 23, 2017 at 11:16

    It's Sunday morning in Toronto, so that means pancakes for breakfast.

    I use the same recipe from the Joy of Cooking that I've used for the last fifteen years or so, which starts with me heating up my two cast iron pans to a 4.5 setting. After making the batter, I make just one pancake in the middle of each pan, and check that they cook at the right speed to confirm I have the correct pan temperature. And I taste the finished pancake, to make sure I haven't messed up the recipe. (Yes, it's possible to forget a crucial ingredient when following a well-worn recipe -- it's amazing what forgetting salt does do a dish.)

    I make pancakes four to a pan, so they're 'silver dollar' pancakes, not more than three inches across. I monitor the colour and the speed at which they're cooking as I go, adjusting the heat if necessary. Finished pancakes go into a covered dish to stay warm.

    I believe I'm a careful cook, and I'm also a careful developer. That means test early, and test often. You want no surprises when it's time to dish up the goods to your family (pancakes) or your customers (software). Dreaming up new dishes or new applications it's important to be creative, to try new approaches. Cooking or writing software, you have to be methodical, thoughtful, and meticulous.

    I consider myself very lucky to have gone to a really good university, but what I studied (Systems Design Engineering) bears only a tangential relationship to the work I do now. It was actually really good training at reading/comprehension, time management, mental gymnastics, and getting the job done. As long as another program had the same goals, I think pretty much any degree or diploma would have done. An Engineering degree from Waterloo just helped me get my foot in the door that much easier.

    Conclusion? Do your development with tests, right from the start. You'll thank yourself, again and again. And it makes for good pancakes. ;)

    Alex / talexb / Toronto

    Thanks PJ. We owe you so much. Groklaw -- RIP -- 2003 to 2013.

New Cool Uses for Perl
Reading/writing Arduino pins over I2C with Perl
No replies — Read more | Post response
by stevieb
on Jul 23, 2017 at 14:25

    In today's episode of Cool Uses for Perl, loosely inspired by this thread, I'm going to show how to set up an Arduino (Uno in this test case) with a pseudo-register that allows toggling one if its digital pins on and off, and another pseudo-register to read an analog pin that the digital pin is connected to, over I2C. Because it's digital to analog, the only possible values of the analog read will be 0 (off) or 1023 (full on, ie. 5v). This is an exceptionally basic example, but with some thought, one can imagine the possibilities (read/write EEPROM, set PWM etc etc).

    We'll then use RPi::I2C to toggle the digital pin and read the analog pin over the I2C bus. Note I'm not using the encompassing RPi::WiringPi distribution in this case. The benefit to using that is to clean up Raspberry Pi's GPIO pins, which we aren't using any. In fact, any Linux device with I2C can be used for this example, I just so happen to be using one of my Pi 3 boards.

    First, the simple Arduino sketch. All I2C devices require putting themselves on the "wire" with a unique address. I'm using 0x04, which is how the Pi will identify the Arduino on the I2C bus.

    #include <Wire.h> // Arduino I2C address #define SLAVE_ADDR 0x04 // pseudo register addresses #define READ_A0 0x05 #define WRITE_D2 0x0A uint8_t reg = 0; void read_analog_pin (){ switch (reg){ case READ_A0: { __read_analog(A0); break; } } } void __read_analog (int pin){ int val = analogRead(pin); uint8_t buf[2]; // reverse endian so we're little endian going out buf[0] = (val >> 8) & 0xFF; buf[1] = val & 0xFF; Wire.write(buf, 2); } void write_digital_pin (int num_bytes){ reg = Wire.read(); // global register addr while(Wire.available()){ uint8_t state = Wire.read(); switch (reg){ case WRITE_D2: { digitalWrite(2, state); break; } } } } void setup(){ Wire.begin(SLAVE_ADDR); // set up the I2C callbacks Wire.onReceive(write_digital_pin); Wire.onRequest(read_analog_pin); // set up the pins pinMode(2, OUTPUT); pinMode(A0, INPUT); } void loop(){ delay(10000); }

    Now, I'll show a simple script that loops 10 times, toggling the digital pin then displaying the value from the analog pin. Arudino's Wire library sends data a byte at a time, so we have to do some bit manipulation to turn the two bytes returned in the read_block() call back together into a single 16-bit integer. I wrote the merge() sub to take care of this job.

    use warnings; use strict; use RPi::Const qw(:all); use RPi::I2C; use constant { ARDUINO_ADDR => 0x04, READ_REGISTER => 0x05, WRITE_REGISTER => 0x0A, }; my $device = RPi::I2C->new(ARDUINO_ADDR); for (0..9){ my (@bytes_read, $value); $device->write_byte(HIGH, WRITE_REGISTER); @bytes_read = $device->read_block(2, READ_REGISTER); $value = merge(@bytes_read); print "$value\n"; # 1023 $device->write_byte(LOW, WRITE_REGISTER); @bytes_read = $device->read_block(2, READ_REGISTER); $value = merge(@bytes_read); print "$value\n"; # 0 } sub merge { return ($_[0] << 8) & 0xFF00 | ($_[1] & 0xFF); }

    Output:

    1023 0 1023 0 1023 0 1023 0 1023 0 1023 0 1023 0 1023 0 1023 0 1023 0

    update: I must acknowledge Slava Volkov (SVOLKOV) for the actual XS code. Most of the low-level hardware code I've been working on over the last year has been wrapping C/C++ libraries, a decent chunk of it has had me following datasheets to write my own, but in this case, I bit the whole XS file from Device::I2C and just presented a new Perl face to it so it fit in under the RPi::WiringPi umbrella. It just worked.

Download free Microsoft ebooks, fun with Mojolicious and CSS selectors
No replies — Read more | Post response
by marto
on Jul 21, 2017 at 11:35

    I was made aware that Microsoft giving away free ebooks. Excuse the clickbaity page title, I have nothing to do with it. While people have posted wget scripts to download them all, it doesn't rename them so you end up with some random file names. I threw the script below together really quickly, consider it a cheap hacky but functional (no errors here) script. For each 'Category' it creates a directory, and uses Mojolicious/Mojo::UserAgent to get the page, parse what we need from it, download each file to the it's associated category directory, with the actual ebook name.

    Caveats:

    • Ensure you have an up to date Mojolicious installed (cpanm Mojolicious).
    • Copy the script below into it's own directory before running.
    • Not all ebooks are available in all formats. I just select the top one in the list. Most are PDF, some are ebup or .doc
    #!/usr/bin/perl use strict; use warnings; no warnings 'utf8'; use Mojo::UserAgent; my $ebookURL = 'https://blogs.msdn.microsoft.com/mssmallbiz/2017/07/11/largest-free-m +icrosoft-ebook-giveaway-im-giving-away-millions-of-free-microsoft-ebo +oks-again-including-windows-10-office-365-office-2016-power-bi-azure- +windows-8-1-office-2013-sharepo/'; =head1 NAME ms-ebook-dl - Download free Microsoft ebooks =head1 DESCRIPTION A quick hack using L<Mojolicious> to download and properly name a bunc +h of free ebooks from Microsoft. =head1 INSTALLATION Ensure you have an up to date L<Mojolicious> installed: C<cpanm Mojolicious> Clone the repo: C<git clone https://github.com/MartinMcGrath/ms-ebook-dl> =head1 LICENSE This is released under the Artistic License. See L<perlartistic>. =head1 AUTHOR marto L<https://github.com/MartinMcGrath/> =head1 SEE ALSO L<http://perlmonks.org/?node_id=1195726> L<https://blogs.msdn.microsoft.com/mssmallbiz/2017/07/11/largest-free- +microsoft-ebook-giveaway-im-giving-away-millions-of-free-microsoft-eb +ooks-again-including-windows-10-office-365-office-2016-power-bi-azure +-windows-8-1-office-2013-sharepo/> =cut my $ua = Mojo::UserAgent->new; print "Get page\n"; my $res = $ua->get( $ebookURL )->res; # css selector we want the first table witin the entry-content div, sk +ipping # the first row which is a header, but not a 'th' tag. my $selector = 'div.entry-content table:first-of-type tr:not(:first-of +-type)'; warn "Parse page\n"; $res->dom->find( $selector )->each( sub{ my $category = $_->children->[0]->all_text; my $title = $_->children->[1]->all_text; my $url = $_->children->[2]->at('a')->attr('href'); my $type = $_->children->[2]->at('a')->all_text; # download each file print "downloading: $title\n"; # create category directory unless it already exists mkdir $category unless( -d $category ); $ua->max_redirects(5) ->get( $url ) ->result->content->asset->move_to($category . '/' . $title . '.' + . $type); # play nice sleep(7); });

    Update: code updated with some POD, also on on github.

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 wandering the Monastery: (7)
As of 2017-07-27 20:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I came, I saw, I ...
























    Results (422 votes). Check out past polls.