Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Cool Uses for Perl

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

This section is the place to post your general code offerings -- everything from one-liners to full-blown frameworks and apps.

Let's play poker
2 direct replies — Read more / Contribute
by reisinge
on Jun 09, 2016 at 03:50

    I haven't coded in a while, so I did this small exercise to refresh my programming skills and to have some fun:

    #!/usr/bin/env perl use 5.014; use warnings; use autodie; use charnames ':full'; use List::Util 'shuffle'; use Getopt::Long; use Pod::Usage; GetOptions( "h|?|help" => \( my $help ), "hands=i" => \( my $hands ), "cards=i" => \( my $cards ), ) or pod2usage(1); pod2usage( -exitval => 0, -verbose => 2, -noperldoc => 1 ) if $help; deal(deck(), $cards, $hands); sub deck { my $n_cards = 52; my @suit = ( "\N{BLACK HEART SUIT}", "\N{BLACK SPADE SUIT}", "\N{BLACK DIAMOND SUIT}", "\N{BLACK CLUB SUIT}", ); my @rank = ((2 .. 10), qw(J Q K A)); my @deck; my $i = 0; while (@deck < $n_cards) { for my $s (@suit) { for my $r (@rank) { $deck[$i++] = "$r$s"; } } } return \@deck; } sub deal { my $deck = shift; my $n_cards = shift // 5; my $hands = shift // 1; my @shuffled = shuffle(@$deck); binmode STDOUT, ':utf8'; for (1 .. $hands) { my @hand; for (1 .. $n_cards) { die "no more cards in deck ...\n" unless @shuffled; push @hand, shift @shuffled; } say(join " ", @hand); } } __END__ =head1 NAME cards - deal cards from deck of 52 cards =head1 SYNOPSIS cards [options] options: -h, -?, --help brief help message --hands N number of hands to deal [1] --cards N cards per hand [5] =cut

    The script is to be seen on GitHub too.

    It looks to me it might benefit from OOP, something like:

    deck->new(cards => 52); deck->shuffle(); deck->deal(cards => 5, hands => 4);

    I have little experience with OOP, so if you have some hints how to get started, just let me know.

    There is not such thing as best practice unless you specify the context. -- brian d foy
i2c attached LCD Character Display for a Raspberry Pi
1 direct reply — Read more / Contribute
by anita2R
on May 24, 2016 at 12:28

    I was unable to find a Perl script to make my SainSmart LCD character display with i2c 'backpack' work from my Raspberry Pi.

    Code for using these devices is available mainly for the Arduino. There is also code in C and python, but I could not find a simple working example in Perl. There is a module for an HTBackpackV2 (HiPi::Interface::HTBackpackV2), but I wasn't able to get this working with the SainSmart LCD.

    I found a python script written by Matt Hawkins here: and I used his python script as the basis for my Perl Script - thanks Matt.

    This script only provides basic display functionality and is run by calling it with two parameters, -s a string of text to display and -l the line number to display the text on. Hopefully it will provide both a way for others to get one of these LCD's working as well as provide the basis for more comprehensive implementations. The subroutines writeByte and sendByte are the key ones, together with the initialization sequence in the init subroutine.

    The script must be run as root to set up the i2c object, but drops back to the regular user immediately after - enter your user name and user group in the two variables $user and $group which you will find at lines 39 & 40.

    When called with no text and no line parameter the LCD initialization code is run.

    After the code I have added some explanation about the way the data is transferred from the backpack to the LCD, including the transition from the power-up 8-bit mode to 4-bit mode. It took me some time to get my head round this!

    In addition to -l 1 & -l 2 for the two lines, -l 50 & -l 51 turn the display off and back on. When the display is turned off with -l 50, the data remains in the LCD's DDRAM memory and the previous text will be displayed by -l 51 (a simple flashing display can be implemented)

    If no line number is given, the text is printed on line 1 and overflows to line 2 if required. All existing text is cleared.

    Examples (run as root/sudo):

    Code for a Raspberry Pi with SainSmart 2 line, 16 character LCD display with i2c backpack at 0x3f, attached to the Pi's default i2c pins.

    Mode of operation & initialization

Automate and dispatch unit test runs across perl/berrybrew on remote Windows and Unix systems
No replies — Read more | Post response
by stevieb
on Apr 27, 2016 at 13:17

    My Test::BrewBuild test deployment system is now reasonably stable, and has the ability to dispatch test runs to remote test servers. This means with a single command, you can run your unit tests across any number of perl instances on any Operating Systems automatically, and get the results delivered back to you.

    To do this, we use the bbdispatch to send brewbuild commands to previously configured remote testers. To start a bbtester, log on to the system and run bbtester start. That'll start the tester and put it in the background.

    Now's probably a good time to state that Git is required to be installed on all systems used for network testing, and one should peruse the basic system setup doc.

    In these examples, I have three testers set up. tester1 is the DNS name of a Ubuntu Linux system running perlbrew, tester2 is a Windows 2008 Server running berrybrew, and the localhost is a FreeBSD server, again running perlbrew.

    There are three flags for bbdispatch:

    • -c: A quoted string containing the brewbuild commands to run. Eg: "brewbuild -i 5.20.3 -R". If omitted, we will default to simply "brewbuild"
    • -r: A string containing a repository you want to test. Eg: If you are currently in a repository directory, we'll automatically fetch and use it and you can omit this flag
    • -t: These are your testers. This flag can be specified multiple times.

    Note that you can alternatively use a config file to store the dispatcher information.

    Here's the most basic example. We're already in a repository working directory so we can omit -r, we're only working on a tester on localhost, and we'll just use the default brewbuild test run:

    # start a tester on the localhost me@host:~/repos/mock-sub$ bbtester start Started the Test::BrewBuild test server at PID 20584 on IP address 0.0 +.0.0 and TCP port 7800... # dispatch a test run of my [metamod://Mock::Sub] # module (from within the repo dir) me@host:~/repos/mock-sub$ bbdispatch -t localhost localhost - x86_64-linux 5.18.4 :: PASS 5.20.3 :: PASS 5.22.1 :: PASS

    Things get more useful when you have multiple testers across multiple different Operating Systems.

    This example does a basic run using the same repo as above, but this time I'm explicitly setting it. I'm also dispatching to three tester systems:

    $ bbdispatch -t localhost -t tester1 -t tester2 -r +stevieb9/mock-sub tester1 - MSWin32-x64-multi-thread 5.22.1_64 :: PASS 5.10.1_32 :: PASS 5.20.3_32 :: PASS tester2 - x86_64-linux 5.18.4 :: PASS 5.20.3 :: PASS 5.22.1 :: PASS localhost - amd64-freebsd 5.10.1 :: PASS 5.14.4 :: PASS 5.22.1 :: PASS

    Below, we use the -c flag to tell brewbuild that we want to perform test on the current module (I'm back in the repo dir again so I omit -r), and then have brewbuild run unit tests of all the module's reverse dependencies (-R) to ensure our proposed updated module doesn't break down-river (ie. modules that require/use your module) modules.

    $ bbdispatch -t localhost -t tester1 -t tester2 -c "brewbuild -R" tester1 - MSWin32-x64-multi-thread reverse dependencies: File::Edit::Portable, Devel::Examine::Subs, Deve +l::Trace::Subs File::Edit::Portable 5.10.1_32 :: PASS 5.20.3_32 :: PASS 5.22.1_64 :: PASS Devel::Examine::Subs 5.20.3_32 :: PASS 5.22.1_64 :: PASS 5.10.1_32 :: FAIL Devel::Trace::Subs 5.20.3_32 :: PASS 5.22.1_64 :: PASS 5.10.1_32 :: FAIL localhost - amd64-freebsd reverse dependencies: File::Edit::Portable, Devel::Examine::Subs, Deve +l::Trace::Subs File::Edit::Portable 5.10.1 :: PASS 5.22.1 :: PASS 5.14.4 :: FAIL Devel::Examine::Subs 5.10.1 :: PASS 5.14.4 :: PASS 5.22.1 :: PASS Devel::Trace::Subs 5.10.1 :: PASS 5.14.4 :: PASS 5.22.1 :: FAIL tester2 - x86_64-linux reverse dependencies: File::Edit::Portable, Devel::Examine::Subs, Deve +l::Trace::Subs File::Edit::Portable 5.18.4 :: PASS 5.20.3 :: PASS 5.22.1 :: PASS Devel::Examine::Subs 5.18.4 :: PASS 5.20.3 :: PASS 5.22.1 :: PASS Devel::Trace::Subs 5.18.4 :: PASS 5.20.3 :: PASS 5.22.1 :: FAIL

    Notice that some results are FAIL. In this case, we create a bblog directory in the directory you're working in, and generate log files for each individual fail. This allows you to see what broke and where, without having to go to each individual system. You can then update/fix code, then run another dispatch. Here's an example of the files that were generated by the above run:

    $ ls bblog tester1_Devel-Examine-Subs-5.10.1_32-FAIL.bblog tester1_Devel-Trace-Subs-5.10.1_32-FAIL.bblog tester2_Devel-Trace-Subs-5.22.1-FAIL.bblog localhost_Devel-Trace-Subs-5.22.1-FAIL.bblog localhost_File-Edit-Portable-5.14.4-FAIL.bblog

    The log files contain all errors that the tester would have produced to STDOUT and STDERR, with the cpanm build logs appended.

    On a normal dispatch run (without running revdep), the log file would have appeared as tester1_5.10.1_32-FAIL.bblog. Running brewbuild in standalone mode (no dispatching): 5.10.1_32-FAIL.bblog. You can optionally save even the PASS logs if you choose by using the -S, --save flag to brewbuild.



    • we don't actually shell out and run the brewbuild commands directly with system() or backticks or the like. We dissect the command string, turn the arguments into their respective parameters, and use the API to do the actual testing
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.
Script to copy files from directory 'a' to 'b' by newest time no more than 'max' files in dest
No replies — Read more | Post response
by symgryph
on Apr 25, 2016 at 19:39

    This is my rather convoluted way of ensuring that the following is true: 1. No more than x number of files in my 'to' directory 2. Newest files will be given the highest precedence in the move 3. Zero length files will be killed 4. Only move .log files via glob. If anyone wants to use or improve, feel free, since I think a hash would have been a lot less complex than an array with a sort and regex substring match....ick.

    #!/usr/bin/perl -w #This file sees how many files are currently in a target directory use File::Copy; chdir "/tmp/to/"; @filesto = glob("*.log"); $numFiles = scalar @filesto; #maxfiles needs to be 1 larger than your maximum value due to perl usi +ng a 0 based index for arrays. $maxfiles = 5 - $numFiles; if ($maxfiles <=0) { exit; } chdir "/tmp/from"; @filesfrom = glob("*.log"); $counter=0; foreach (@filesfrom) { ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($filesfrom[$counter]); #Unlink files that are zero bytes prior to copy. if ($size eq 0) { unlink $filesfrom[$counter]; $counter--; next; } $filestoCreated[$counter] = $ctime . " " .$filesfrom[$counter]; $counter++; } #@sortedlist = reverse sort @filestoCreated; #This is a particularly nasty sort which essentially uses a regex as s +ubstring match to only sort the numeric part of my hacked up array. E +nsures that we get #a numeric sort only. @sortedlist = sort { ($b =~ /(^\d+)/)[0] <=> ($a =~ /(^\d+)/)[0] || uc($a) cmp uc($b) } @filestoCreated; #This section ensures that the system will never copy more than the ma +x number of files defined in maxfiles. $loopcounter=scalar (@sortedlist); if ($loopcounter > $maxfiles) { $loopcounter = $maxfiles-1; print "Loopcounter is greater than than maxfiles: $maxfiles Loopc +ounter: $loopcounter\n"; } $countfinals=0; while ($countfinals<$loopcounter) { my @execute= split / /, $sortedlist[$countfinals]; system "/bin/mv /tmp/from/$execute[1] /tmp/to/$execute[1]"; $countfinals++; }
    "Two Wheels good, Four wheels bad."
[perl6] Open "regex.ext" file with corresponding program and ask for deletion
No replies — Read more | Post response
by mimosinnet
on Apr 25, 2016 at 05:28

    I have been happily playing with perl6. This code opens with the corresponding program and asks for deletion of files with a defined pattern and extension. For example:

    $ Files perl pdf

    Open the pdf files that have 'perl' in the name and asks for deletion. Available in github

    #!/usr/bin/env perl6 # Reads files in the form of pattern.extension and asks for deletion # Modules {{{ use v6; use IO::Glob; # }}} # Variables {{{ # Program associated to extension my %exe = 'pdf' => 'mupdf', 'PDF' => 'mupdf', 'txt' => 'less', 'odt' => 'lowriter', 'doc' => 'antiword', # Exolore using docx2txt 'docx' => 'lowriter', # Explore using feh and delete with ctrl-del 'JPG' => 'xv', 'jpg' => 'xv', 'png' => 'xv', 'flv' => 'mpv', 'vimbackup' => 'gvim' ; # extensions my @extensions = %exe.keys; # }}} # sub main {{{ sub MAIN($pattern is rw, $ext) { die "The extension '$ext' has not been defined" unless $ext ~~ @ex +tensions.any; # variables {{{ $pattern = "*" if $pattern eq "all"; my $program = %exe{$ext}; my @files = glob("*$pattern*.$ext"); # }}} # Read and Delete Files {{{ for @files -> $file { my @args = $program, $file; my $command = run @args; $command.exitcode == 0 or die "system @args failed: $!"; my $delete = prompt("\n \n Delete file $file (s/n) "); last if $delete eq ""; next if $delete ne "s"; say "mv $file /tmp/$file"; my $io =$file); $io.rename("/tmp/$file"); prompt("\n Press 'return' to continue "); } # }}} # Exit and list files {{{ @files = glob("*.$ext"); say "-" x 60; for @files -> $file {say "$file ";} say "-" x 60; # }}} } # }}} # sub usage {{{ sub USAGE () { say "USAGE:\n Files regex/all [ @extensions ]"; } # }}}
No replies — Read more | Post response
by QuillMeantTen
on Apr 10, 2016 at 14:04

    As older and wiser monks mill around the courtyard, no one wonders about the lack of news from young Quill. Last time he was seen he got a well deserved beating for tempting those who lack in wisdom with tools beyond their understanding that could easily be made to wreck havoc on their home networks.

    So, even if his arrival is of no surprise, his cries of
    I REKT IT!
    prove challenging to ignore and disturb many an elder from their own medidations.

    Fast enough, one of those whose deep thoughts got interrupted ask him:
    "you rekt what?"
    "Exactly, EUREKA, that's it!" answers the feverish apprentice.

    As more monks come to the courtyard he begins to expose his latest idea...

    After spending long hours reflecting on the foolishness of my misdeeds and how providing script kiddies with weapons is the most desecrating act one could perpetrate inside those holy walls, I found something even more subversive and potentially destructive.

    Some of you, if interested in voting methods might have heard about condorcet methods. I for one think that those are way better than the currently used one. And I have my favorite. Mam or Maximize Affirmed Majorities, aka MTM (minimize thwarted minorities) can be considered a variant of the Tideman method. Once I started reading about it I wanted to use it and tell others about it.

    As many of you know by now when I get my eyes and mind on an algorithm I can not rest until I have implemented it myself to try and understand it as completely as possible.

    Today I give you a small script that implements the MAM voting procedure, you can use it to simulate elections with as many ballots as you want or to run it on ballots you may have collected, just put votes in text files with a .bt extension.

    Say you have 6 candidates, a possible ballot could be:

    1 3 2,4
    Meaning, you wish one to win, if not one then three, if three does not win you dont care whether 2 or 4 win. Any candidates left out of a ballot are considered equally ranked at the bottom. Hence this ballot is equivalent to:
    1 3 2,4 5,6

    Update:Patched the code for eventualities that did not happen during testing:
    1. no one ranks two candidates strictly, then complete the tiebreak from a randomly generated strict ballot
    2. Make tiebreaking rules conform so if the two majorities concern the same winner then the loser will be compared using the tiebreak
    3. Make majorities calculation output two different majorities in case of 1 vs 2 has same votes as 2 vs 1 and let the tiebreak mechanism do its work
    4. patch bug in majorities calculation where < and = would be treated the same way
    5. Now allows for any number of candidate (regex \d limited it to 9)
    6. To allow result comparison I added the schulze voting method, now accessible with the -s option
    7. Fixed a typo causing a miscalculation when in shulze mode
    So here is the code, I hope you'll have as much fun using it as I had writing it! Cheers :-)

Etags for Emacs and Moose
2 direct replies — Read more / Contribute
by choroba
on Apr 05, 2016 at 18:17
    When working on a larger project (50k+ lines), I usually can't remember the structure of the packages and I need some kind of a tool to help me. The simplest but still quite a powerful solution is etags (yes, I use Emacs). It generates a TAGS file that Emacs can use to show where a given subroutine is declared, etc. (Similar tool exists for vim, but I'm not familiar with the output format enough to make my script support both the editors.)

    The problem is that the default setting for Perl reports not only all the subroutine declarations, but also declarations of lexical variables (my). I don't need to know where a lexical variable was declared: normally, it's in the same block where the cursor is, maybe one level higher. What I'd like to have, though, are the attributes' accesors that Moo(se) provides; they're declared with has which etags can't handle.

    I haven't found a way how to persuade etags to handle multiline declarations, neither have I found any other solution. So, I created a simple script that creates the TAGS file that's more useful for me than the default. It still doesn't handle all the possibilities (different names for setters/getters, builders, delegation, etc.) - you can check the END section for all the constructs it can parse.

    The current version of the code is here, but you can find it at GitHub where it might change as I (or you!) add new features.

    ($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,
Decode contact list from Nokia phone.
No replies — Read more | Post response
by ambrus
on Apr 05, 2016 at 17:03

    The Nokia 6303c mobile phone can save a backup of the contact list (i.e. phone book) to the SD card. This node tells how to extract the list of contacts from such a backup to a human-readable file.

    This description comes with no warranty. If you lose your contacts, you are on your own.

    Note that the following procedure only saves the contacts from the phone memory. If you have contacts in the SIM card, you may have to copy those to the phone memory first.

    I know of no procedure to restore a contact list to the phone. As far as I've tried, the phone can't even load the backups it wrote itself.

GqrxRawAudioPlot(wxPerl, GD, UDP client, UDP server, & memory file)
No replies — Read more | Post response
by jmlynesjr
on Apr 03, 2016 at 21:19

    GqrxRawAudioPlot(wxPerl, GD, UDP client, UDP server, & memory file)

    AKA - Another wxPerl example.

    Back in June I was looking into the purchase of Digilent's Analog Discovery USB O-scope(still looking). I was considering wrapping the SDK shared library until kovacslattila pointed out that a Linux version of the Waveforms software was under development(now available). The result was that I dropped my plan to wrap the SDK shared library. What I had put together at that point was a simulated O-scope display based on wxPerl and GD. Reference: Digilent Inc. Analog Discovery

    Fast forward to October... I had been playing with the Gqrx Software Defined Radio package and had developed a wxPerl script that used Telnet and threads to implement a scanner function on top of Gqrx. Reference: SDR Scanner(aka Threaded wxPerl Example)

    Last month, a user on the Gqrx google group asked if there was a way to display the raw audio produced by Gqrx. As it turns out, one channel of the demodulated audio is output to a UDP port. It sounded like a fun challenge and a reason to dig out the simulated O-scope code. Listed below is the script and the script(provides test UDP packets so that the plot code can be run without having to have SDR hardware and Gqrx installed). If you don't want to run these scripts, you can see a screen snapshot at jmlynesjr.

    If nothing else, it's another wxPerl example along with GD graphics, memory file usage, a UDP client and a UDP server.


    There's never enough time to do it right, but always enough time to do it over...

Activate your perl programs by touch with!
2 direct replies — Read more / Contribute
by Discipulus
on Apr 01, 2016 at 03:09 is not yet published, but perlmonks deserves a preview
    Just by including this incredibly simple module
    you can prevent unwanted access to
    your perl programs and
    protect your compiled application from
    unintended double clicks. Here the code and example usage
    #!/usr/bin/perl use strict; use warnings; package Touchable; exit 0 unless (stat ($0))[9] && (($^T - (stat ($0))[9] ) < 3);

    Example of usage:
    # consuming script: use strict; use warnings; use Touchable; print "here $0\n"; # usage example perl # works only if touch activated.. touch & perl here

    Have a nice 1st of April!

    Have fun!


    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Automate Perl/BerryBrew unit testing on Unix/Windows (Take 2)
No replies — Read more | Post response
by stevieb
on Mar 18, 2016 at 21:46

    Disclaimer: this isn't just a cool use for/of Perl, it's a request to get some testers of an extremely easy to use app so I can hopefully get feedback.

    NOTE: The current version this doc is based on is v0.05. I only uploaded it to CPAN a while ago, so it may not be indexed yet. Previous versions won't act according to this doc. You can either wait for it to be indexed, or fetch the zip/tarball file and install manually.

    When I say easy to use, I mean it. If you have PerlBrew or BerryBrew installed and a module you've developed that's structured in a sane way:

    cpan Test::BrewBuild cd /path/to/MyModule brewbuild


    perl-5.8.9 :: PASS perl-5.10.1 :: PASS perl-5.22.1 :: PASS perl-5.23.8 :: PASS

    ...yep, that's it. It'll run all of your unit tests across all of your currently installed *brew instances. We can get much deeper, however, I'll start with some explanations. I'm looking for feedback, so if you aren't interested in forking and submitting a PR or opening a bug report and it errors/warns on you, all you have to do is set a debug level and either post the output here, or email me at my CPAN email address.

    brewbuild --debug 7 # or brewbuild -d 7

    This app/module works across both *nix and Windows, recognizes both ExtUtils::MakeMaker and Module::Build installers, and can be configured *very* easily with custom build plugins if neither of these work for you. I'll show the default plugin, then I'll provide an example of how to include your own.

    Default bundled plugin:

    package Test::BrewBuild::Plugin::DefaultExec; sub brewbuild_exec { return <DATA>; } 1; __DATA__ if ($^O eq 'MSWin32'){ my $make = -e 'Makefile.PL' ? 'dmake' : 'Build'; system "cpanm --installdeps . && $make && $make test"; } else { my $make = -e 'Makefile.PL' ? 'make' : './Build'; system "cpanm --installdeps . && $make && $make test"; }

    That's it. Unfortunately at this time, it's not possible via CLI args to include a non-installed plugin, so unless you want to write one to put on the CPAN, you just need to copy a file into ~/perl5/perlbrew/perls/*PERLVER*/lib/site_perl/*PERLVER*/Test/BrewBuild/Plugin directory. Then:

    brewbuild --plugin 'Test::BrewBuild::Plugin::CustomPlugin' # or just set the TBB_PLUGIN environment variable to make it persisten +t

    Using local plugins is imminent, just not there yet.

    Now, here are some use cases. Note that all command line arguments have a single letter (ie. -d for --debug) shortforms:

    Remove all existing *brew perl instances (less the one you may be using), install two new random versions, and test against all instances including the pristine ones:

    brewbuild --remove --count 2

    Run against all currently installed instances, and install one random new one and test against it too:

    brewbuild --count 1

    Install a few specific versions (use just the number portion from *brew available) and test against all installed:

    brewbuild --version 5.20.3 -v 5.22.1 -v 5.8.9

    The current documentation describes more situations, and you can read the docs for all installed pieces of the module here.

    Note that ironically, I wrote this project to perform unit testing as I'm a huge stickler (I often have 100 times the number of lines of test code than I do code), but in this case, it has happened backwards. Don't worry, tests are coming fast and furious.

    I wrote this module because Travis-CI doesn't perform tests on Windows. This module allows me to run my tests against all perl versions on both nix and Windows prior to putting it into the CPAN Testers wheelhouse.

    Thanks for reading, and if you get a chance to test it out, I'd greatly appreciate any and all feedback.



Getting numeric month for comparisons
4 direct replies — Read more / Contribute
by Lady_Aleena
on Mar 05, 2016 at 07:47

    I wrote this little script to get numeric months for comparisons. The input can be in initial uppercase, all uppercase, and all lowercase. I added a few other languages for fun.

    #!/usr/bin/perl use strict; use warnings; my @month_numbers = (1..12); my %month_names = ( 'English' => [qw(January February March April May June July Aug +ust Spetember October November December)], 'English abbr' => [qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Now De +c)], 'Dutch' => [qw(januari februari maart april mei juni juli aug +ustus september oktober november december)], 'French' => [qw(janvier février mars avril mai juin juillet ao +űt septembre octobre novembre décembre)], 'German' => [qw(Januar Februar März April Mai Juni Juli August + September Oktober November Dezember)], 'Greek' => [qw(Ianuários Fevruários Mártios Aprílios Máios Iú +nios Iúlios Avghustos Septémvrios Októvrios Noémvrios Thekémvrios)], 'Italian' => [qw(gennaio febbraio marzo aprile maggio giugno lu +glio agosto settembre ottobre novembre dicembre)], 'Spanish' => [qw(enero febrero marzo abril mayo junio julio ago +sto septiembre octubre noviembre diciembre)], ); my %months; for my $language (keys %month_names) { @months{@{$month_names{$language}}} = @month_numbers; @months{map(uc $_, @{$month_names{$language}})} = @month_numbers; @months{map(lc $_, @{$month_names{$language}})} = @month_numbers; } sub get_month_number { my $month = shift; return $months{$month}; }

    So, if you want the month number for July, you use it like the following.

    print get_month_number('July');

    The above will return 7.

    Now you can put dates in the right order. I'll be modularizing this shortly. 8)


    Code simplified from morgon's (no @month_numbers array) and poj's (case insensitive input) suggestions.

    my %months; for my $language (keys %month_names) { my $number = 0; $months{lc $_} = ++$number for @{$month_names{$language}}; } sub get_month_number { my $month = lc shift; return $months{$month}; }

    Added aprile to Italian list of months from AnomalousMonk.

    No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
    Lady Aleena
Coverage History
2 direct replies — Read more / Contribute
by choroba
on Feb 17, 2016 at 10:07
    You probably know how to use Devel::Cover, or even Coveralls as part of your Travis CI. I wanted to see how the coverage of my tests changes in time for each coverage type: that's something you can't get from the mentioned module and services easily. CPANCover shows it for released versions, but I wanted a more granular report.

    I've written a program that does it. At the end, it creates a PNG graph that shows how each coverage type changed with each commit. It also modifies the HTML pages generated by cover so you can navigate between commits by clicking on the arrows.

    If you use git as your version control system, your distribution stores code in the lib/ directory, and tests are located in `t/`, you can try the following code without modification (tested on Linux only). It checks for its dependencies, but if you want to be prepared, here's the list:

    Comments welcome. If you want to modify the code to handle SVN or CVS, use other tools to create the graph or track changes in different directories, we should probably start a GitHub project.

    If you have lots of commits, the first run can take some time. The next run will only process the commits that haven't been processed, yet, if you don't delete the created directories.

    Update: Added CPANCover.

    ($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,
A Thanks sample POP3 Autoresponder
1 direct reply — Read more / Contribute
by Anonymous Monk
on Feb 12, 2016 at 09:41
    Thanks for your help. I run this out of the crontab.

Add your CUFP
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?

    What's my password?
    Create A New User
    [choroba]: erix Reminds me of people selling second hand clothes made by the famous "Keep Away From Fire" brand

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (5)
    As of 2017-01-16 16:42 GMT
    Find Nodes?
      Voting Booth?
      Do you watch meteor showers?

      Results (151 votes). Check out past polls.