This section is the place to post your general code offerings.

Number functions I have lying around
1 direct reply — Read more / Contribute
by Lady_Aleena
on Mar 30, 2015 at 20:30

    I was going through old scripts I had lying around and decided to clean them up a bit. I don't remember why I wrote them or what I am going to do with them. I think they are lukewarm uses for perl, and I probably reinvented the wheel on some of them. Instead of them just lying around my hard drive collecting dust, I share them with you, kind reader. Do with them what you will.

    The first function lists primes, the second two functions list fractions, the last few are about Roman numerals. I lumped them together in a module called Numbers because I ran out of imagination.

    Welcome to my sandbox.

    If you want to see a Roman numeral (MDCCCMVCXXVII) with the overline, go to your display settings and set up the overline class in your style sheet as follows...

    .overline { text-decoration: overline; }
    No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
    Lady Aleena
Binary DeBruijn sequences.
No replies — Read more | Post response
by BrowserUk
on Mar 30, 2015 at 13:55

    I needed a binary (alphabet 0|1) DeBruijn sequence, and found a simple rule for producing one (see the comments).

    I first coded it using strings of '0' and '1' characters and a hash to detect words already included.

    Very quick to code, but using one byte per bit, and a hash, the size rapidly chewed through gobs of memory, long before I reached my target of 31-bit words.

    #! perl -slw use strict; ### Prefer Ones: ### Write n zeros. ### Then, always write a one unless it would cause the repetition of a +n n-length string; ### In which case, write a zero. our $N //= 4; my $seq = '0' x $N; my %seen = ( $seq => 1 ); for( $N .. 2**$N ) { $seq .= ( not exists $seen{ substr( $seq, -( $N-1 ) ) . '1' } ) ? +'1' : '0'; ++$seen{ substr( $seq, -$N ) }; } $seq .= substr $seq, 0, $N-1; print length $seq; <STDIN>; my $re = '(.)(?=(' . '.'x($N-1) . '))'; print $1 . $2 while $seq =~ m[$re]g;

    So then I coded another version that used vec to produce the sequence directly into bits; and another bitvector to track the words seen.

    This was much tricker to code -- despite the apparent simplicity of the code -- and goes much higher, using a mere faction of the memory, but unfortunately stops before my target because vec (as of the version of Perl I'm using) still treats its second argument as a signed, 32-bit integer despite that a) negative offsets make no sense; b) I'm using a 64-bit version of Perl :(

    (If you try it with -N=7 or greater, I strongly recommend redirecting the output, or disabling it, because watching 100s or 1000s of 0s & 1s scroll up the screen is a very boring occupation :)

    #! perl -slw use strict; ### Prefer Ones: ### Write n zeros. ### Then, always write a one unless it would cause the repetition of a +n n-length string; ### In which case, write a zero. our $N //= 4; my $t1 = "b${ \(2**$N+$N-1) }"; my $seen = ''; my $mask1 = ( 1<<$N )-1; my $seq = pack 'Q*', (0) x 100; my $val = 0; for( $N .. 2**$N+$N-1 ) { ## if N=5; 5 .. 36; if N=6 +, 6 .. 64+6-1 = 69; $val = ( $val << 1 ) & $mask1; vec( $seen, $val | 1, 1 ) or do{ $val |= 1; vec( $seq, $_, 1 ) = 1 +; }; vec( $seen, $val , 1 ) = 1; } print unpack $t1, $seq;

    Note: both the above versions produce the 2N+N-1 bit complete sequence, rather than the 2N sequence that is shown in the Wikipedia page which only become complete once you 'wrap them around'.

    Ultimately, I ended up moving to C to achieve my target, which even more tricky (damn, I miss vec in C), but it eventually allowed me to produce the 1/4GB binary sequence I was after.

    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'm with torvalds on this
    In the absence of evidence, opinion is indistinguishable from prejudice. Agile (and TDD) debunked
"Spritz" crypto algorithm
No replies — Read more | Post response
by RonW
on Mar 24, 2015 at 16:41

    For testing purposes, I implemented Rivist's new crypto algorithm in Perl. It is a proposed replacement for his (once very popular) RC4 algorithm. Thought there might be some curiosity value to it.

Distribute the leftovers
No replies — Read more | Post response
by GotToBTru
on Mar 20, 2015 at 12:46

    We get the quantity of a product shipped from the database, and a list of individual carton labels from an external file. The actual contents of each carton are unknown. Working assumption would be qty per carton = shipped qty / carton count. Easy enough. But what if the division doesn't come out clean?

    use POSIX qw/ceil/; ... $sq = $shipped_quantity; $cc = $carton_count; foreach $label(@label_list) { if ($cc == 0) { print "Qty per carton math error"; next OUTER; } $per_container = ceil($sq/$cc); $sq -= $per_container; $cc -= 1; ... }

    If shipped quantity is 8 and carton count is 5, first 3 cartons will have 2 each, last 2 have 1.

    Yeah, almost too simple to mention. But this came up today, and I remember little code bits like this better when I write them down somewhere.

    Update: s/box/carton/

    Dum Spiro Spero -- from perl source generate Main logic of this script (summary/abstract/outline)
1 direct reply — Read more / Contribute
by Anonymous Monk
on Mar 13, 2015 at 04:03
Extract names and email addresses from a maildir folder
No replies — Read more | Post response
by peterr
on Mar 11, 2015 at 04:25

    Had a lot of help from Mark Overmeer with this one ..

    #!/usr/bin/perl # # Name: # # Extract names and email addresses from a maildir folder # # - Also displays the number of messages (files) found and the numb +er of parts in each message # - Displays structure of each message and then outputs the names a +nd email addresses # - Where the name/email address is found in the 'body' part of a m +essage (i.e NOT in From:, To:, Cc: etc,etc), # then usually only the email address will be returmed # # This script has been adapted from , which is part of +the Mail::Box module , vers 2.118, # by Mark Overmeer (http:// ) # # This code can be used and modified without restriction. # # Usage: perl Smith\,\ Bill\ \&\ Nancy/ (maild +ir folder name) # use warnings; use strict; use lib '..', '.'; use Mail::Box::Manager; sub emails_from_body($); # # Get the command line arguments. # die "Usage: $0 folderfile\n" unless @ARGV==1; my $foldername = shift @ARGV; # # Open the folder # my $mgr = Mail::Box::Manager->new; my $folder = $mgr->open($foldername, access => 'r') or die "Cannot open $foldername: $!\n"; # # List all messages in this folder. # print "Mail folder $foldername contains ", $folder->nrMessages, " mess +ages:\n"; my %emails; foreach my $message ($folder->messages) { my @parts = ($message, $message->parts('RECURSE')); print $message->seqnr, ' has '.@parts." parts\n"; $message->printStructure; foreach my $part (@parts) { foreach my $fieldname (qw/To Cc Bcc From Reply-To Sender/) { my $field = $part->study($fieldname) or next; $emails{$_}++ for $field->addresses; } my $ct = $part->contentType || 'text/plain'; $ct eq 'text/plain' || $ct eq 'text/html' or next; $emails{$_}++ for emails_from_body $part->body->decoded; } } print "$_\n" for sort keys %emails; $folder->close; exit 0; ### HELPERS sub emails_from_body($) { $_[0] =~ /([-\w.]+@([a-z0-9][a-z-0-9]+\.)+[a-z]{2,})/gi; }

    It works. :)

Convert Doxygen to POD
No replies — Read more | Post response
by RonW
on Mar 06, 2015 at 19:01

    This is a work in progress, but usable.

    Because, at work, my team and I use Doxygen to aid in producing code documentation, and not being satisfied with the available preprocessors for handling Perl in Doxygen, I considered improving one of them or maybe writing a new one. Then it occurred to me that converting Doxygen markup in to POD might make more sense.

    For my team and I, Doxygen has been very handy in documenting our code. Partly because the document source is right there with the code source. And because it helps us avoid violating the "Don't Repeat Yourself (DRY)" rule. This "filter" brings some of Doxygen's features to documenting Perl.

    Currently, this "filter" only generates POD from Doxygen-style markup. Any POD markup is passed through as-is. A future version, possibly based on PPI, might include an enhanced POD markup to provide these features.

    Again, this is a work in progress. I know I need to improve the structure. Also, it is not yet a module. There are also quirks I haven't put time in to working out.

    Update: Fixed bugs in handling of $VERSION and in handling of parameters.

EEPROM on i2c Real Time Clock Modules
1 direct reply — Read more / Contribute
by anita2R
on Mar 03, 2015 at 18:16

    Recently I bought a Real Time Clock module to attach to a Raspberry Pi using i2c. Getting the RTC up and running was pretty straight forward, but then I noticed that the board included an Atmel AT24C32 eeprom.

    Despite extensive searches I could not find information on accessing the eeprom. I already had the HiPi::BCM2835::I2C module installed, but again the available documentation was limited, but in the end I produced two scripts for reading and writing to the eeprom, using its sequential 32 byte read and write function. This allows sequential reads or writes for up to 32 bytes from a page address.

    As a 'less than Perl Monks novice' I humbly place the following two scripts here for others who want to use the eeproms on their RTC modules. Any advice on improving my code would be welcome

    Write to eeprom

    The script must be called as root, but permissions are put back to a normal user in the script. The two variables $user and $group need to be entered, and if necessary the eeprom address on the i2c bus should be changed - it is currently 0x57, and is on the i2c-1 bus (change to i2c-0 for rev. 1 Raspberry Pi's)

    The write program requires a start address after the -a parameter (there is no default) and input can be piped to the script, entered as text in quotes after a -t parameter, or put as a path/filename after -t for a text file to be used as source

    Example calls

    Write to eeprom code (improved commenting - thanks to roboticus)

    Read from eeprom

    The script to read from the eeprom is simpler. It requires a start address after the -a parameter (defaults to 0) and a length of data to read after the -l parameter (defaults to 32). Optionally a -o parameter takes a path/filename to receive output. A valid path is required, but if the file is not present it is created. Existing files are appended to. With no -o option the output is to screen, formatted with the eeprom hex addresses, if a -h parameter is included the data is displayed in hex, rather than the default character display.

    Revised Read from eeprom code based on feedback from roboticus


binmode can save your bacon
No replies — Read more | Post response
by poltr1
on Feb 28, 2015 at 02:02

    Another "war story" here -- not a question, but something worth passing on: A previous client of mine had some Summit and Zeiss precision measuring (i.e. metrology) machines, and about 6,000 programs to perform measurements on the various parts this company manufactured. They were in the process of migrating network operating systems (from Novell to Microsoft), and thus, had to change the hardcoded drive mappings in these files. All 6,000 of them.

    No way was I going to do this manually. (Laziness, y'know?) I could write a perl script to perform a search-and-replace mission. And I did. But there was another problem: the script wasn't finding the filepaths based on the regex I wrote. So I then did a hexdump on a couple of these files. That's when I discovered the files were in binary format, but the filepaths were plain-text. What was I to do? RTFD. I came across the binmode command, which enabled me to open up files in binary format. So I tried it. And it worked -- it finally matched the regex, and replaced the old drive mapping with the new path.

    binmode FILEHANDLE;

    But there were still some paths that didn't get converted. These were mostly for external shape definition files, and comprised about 10% of the total set of programs. So I called the vendor to see if they had a product to do what we wanted to do. And the vendor told me "it couldn't be done". I knew otherwise, but I wasn't going to tell the vendor that they were wrong.

    Bottom line: Using binmode, Perl can be used to edit binary files. But Be Careful How You Use It!

Color highlighted perl grep
1 direct reply — Read more / Contribute
by FreeBeerReekingMonk
on Feb 23, 2015 at 12:49

    To highlight a grep, we use grep --color, however, sometimes either grep does not have highlighting (AIX), or, we want to highlight multiple expressions with different colors.

    usage: ls -l | grep -e foo -e bar |./ this that foo bar

    #!/usr/bin/perl use Term::ANSIColor; while(<STDIN>){ for $i (1..15){ next unless(defined($ARGV[$i-1])); s/($ARGV[$i-1])/&colored($1,"ansi15 on_ansi$i")/gexi; } print; }

    Of course, just use an alias or put it in the path and call it just "hl" for sanity. It supports 15 different arguments, but can be extended to the 255 different combinations Linux has. On some terminals however, you want your own selected colours, in that case, you will need to specify them by hand, for example:

    #!/usr/bin/perl use Term::ANSIColor; $VERSION = '1.1'; @C = ('black on_yellow','black on_green','black on_cyan','black on_red +', 'red on_white', 'black on_magenta', 'white on_red', 'white on_blue +', 'blue on_white', 'yellow on_cyan' ); while(<STDIN>){ for $i (0..$#C){ s/($ARGV[$i])/&colored($1,$C[$i])/gexi if($ARGV[$i]); } print; }

    In the latter example, you can specify many more attributes, like bold and underscore, even blink... peruse for examples.

    Caveats: Do not grep on digits 0..15 (except as first argument), as the ansi codes also contain numbers...

random file script
1 direct reply — Read more / Contribute
by etherald
on Jan 30, 2015 at 23:50
    here's my random file script to recursively choose a number of random files matching a regex from a directory or list of directories
    #!/usr/bin/env perl # recursively choose a number of files optionally matchinng a regex # from a directory or list of directories. defaults to cwd. # outputs absolute paths by default, relative with -r # use like so: # randomfile -n 23 -p \(mp3\|ogg\|flac\)$ ~/music ~/music2 use strict; use warnings; use Getopt::Long; use Cwd; use File::Random qw/random_file/; use File::Spec; my $pat = '^.+$'; my $num = 1; my $relative = 0; GetOptions( 'p|pattern=s' => \$pat, 'n|number=i' => \$num, 'r|relative' => \$relative, ); while ($num) { my $random_file; my $dir; do { $dir = $ARGV[rand @ARGV] or cwd(); $random_file = random_file( -dir => $dir, -check => qr/$pat/, -recursive => 1); } until $random_file; $random_file = "$dir/$random_file"; $random_file = File::Spec->abs2rel($random_file) if $relative; print "$random_file\n"; --$num; }
Alphabetize in Esperanto
1 direct reply — Read more / Contribute
by aplonis
on Jan 30, 2015 at 10:21

    A hobby of mine is translating Jack Vance into Esperanto. And yes, I have permission for this! These I distribute for free in EPub format. In each ebook I like to embed a mini linked-in dictionary to help out beginners.

    I was wanting to re-organize some standalone EPubs into one omnibus EPub. I wanted one end-of-book dictionary instead of six end-of-chapter ones. That meant re-alphabetizing hundreds of anchor links. No big deal to do it in Perl...except that it's Unicode...and Esperanto. Here's how I did it.

yellow pages
2 direct replies — Read more / Contribute
by japh2963
on Jan 29, 2015 at 01:32

    was looking for freelance work and came across a request for a script that would scrape yellow pages website. Hopefully the poster will google more before they spend $300 bucks for this...


    #!/usr/bin/perl # program: # purpose: search for phone number on # date: 2015.01.28 use strict; use warnings; use LWP::Simple; my $usage = "\n\tusage: perl $0 [PHO-NEN-UMBR]\n"; my $baseUri = ''; my $phoneNumber = $ARGV[0]; die $usage unless($phoneNumber =~ m/^\d{3}-?\d{3}-?\d{4}$/); my $content = get("$baseUri$phoneNumber"); $content =~ s/\s+/ /g; $content =~ s/\&nbsp;/ /g; $content =~ s/>\s*</\n/g; my $hits = 0; foreach my $e(split /\n/, $content){ chomp $e; if($e =~ m/^.*itemprop=['|"](\S+)['|"].*>(.*),?<\/\S+.*$/i){ my $itemProp = $1; my $itemValue = $2; $itemValue =~ s/,\s*$//; print "$itemProp: $itemValue\n"; $hits++; } } print "no results found for number '$phoneNumber'\n" if(!$hits); exit;
MD5 checksums for Windows
1 direct reply — Read more / Contribute
by golux
on Jan 13, 2015 at 11:58
    This program "" (for Windows) generates checksums matching those produced by the "md5sum" program in Linux. I wrote it because I often need to validate whether 2 files on different computers are the same.

    Enter "" without arguments for a syntax message. Both files and/or directories (ie. "folders") are accepted as arguments. With the switch -R subdirectories are searched recursively. The switches -s <key> and -r control how the output is sorted. The -d switch gives a final report of any duplicate checksums found.

    Hope this might be of general use to others as well!

    Update:   At Anonymous Monk's suggestion, I've added a "-c" switch which produces a checksum format compatible with "md5sum". It does this by skipping the filesize, and prefixing the path with '*' to signify that the checksum was done in binary mode.

    say  substr+lc crypt(qw $i3 SI$),4,5
How to perldebug a Term::ReadLine application
1 direct reply — Read more / Contribute
by LanX
on Dec 01, 2014 at 09:42

    the problem

    I recently heard monks complaining that applications using Term::ReadLine can't be debugged within the perldebugger b/c it's interface relies on Term::Readline.

    the trick

    here one solution (at least for linux) I wanted to have documented (before I forget it again ;)

    call the script you want to debug (here ) from a shell with

    PERLDB_OPTS="TTY=`tty` ReadLine=0" xterm -e perl -d ./

    and a second xterm will be opened running the program.

    how it works

    a second xterm is started running the debugger, but b/c of the TTY setting in PERLDB_OPTS all debugger communication goes via the parent xterm , while the calc app normally displays in the child xterm .

    ReadLine=0 tells the debugger not to rely on a working Term::ReadLine.

    NB: It's important that calling the second xterm blocks the execution in the first xterm till it's finished. Like this keystrokes aren interpreted by two applications in the first xterm. Just put an & at the end to see how things get messed up otherwise if the shell tries to step in.

    how it looks like

    first xterm

    becomes the front end for the debugger

    as you see I get the lines from the app in the second xterm listed can set a breakpoint at the end of the loop and tell twice to continue till next breakpoint.

    second xterm

    runs the application, I'm asked to enter a calculation which is evaluated, interupted twice by a breakpoint at line 9.

    Enter code: 1+2 3 Enter code: 4+4 8

    the test script

    > cat ./ use Term::ReadLine; my $term = Term::ReadLine->new('Simple Perl calc'); my $prompt = "Enter code: "; my $OUT = $term->OUT || \*STDOUT; while ( $_ = $term->readline($prompt) ) { my $res = eval($_); warn $@ if $@; print $OUT $res, "\n" unless $@; $term->addhistory($_) if /\S/; }

    tested with Term::ReadLine::Gnu installed.


    you can use this approach whenever you want the debugger communication separated into a separate term. e.g. Curses::UI comes to mind


    the solution is not "perfect", of course you need to arrange the windows and switch with Alt-Tab between them. (maybe screen could solve this or an emacs inegration)

    Furthermore you won't have a history with arrow navigation within the debugger, cause TRL was disabled.

    another approach is to communicate via sockets with a debugger run within emacs, since emacs has it's own TRL-emulation this shouldn't interfere.

    see also Re: Testing terminal programs within emacs (SOLVED) for an approach to handle all this automatically, by restarting a script with altered environment and different terminal.


    see perldebguts , perldebtut and perldeb,

    Also "Pro Perl Debugging" book and various TK tools on CPAN.

    Cheers Rolf

    (addicted to the Perl Programming Language and ☆☆☆☆ :)

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!
  • 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
  • Outside of code tags, you may need to use entities for some characters:
            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.