Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Cool Uses for Perl

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

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

CUFP's
"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
ppi-outline.pl -- 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: multipart-mo.pl # # 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 multipart.pl , which is part of +the Mail::Box module , vers 2.118, # by Mark Overmeer (http://http://search.cpan.org/dist/Mail-Box/ ) # # This code can be used and modified without restriction. # # Usage: perl multipart-mo.pl 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

    anita2R

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 |./highlight.pl 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 ANSIColor.pm 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: yp.pl # purpose: search for phone number on www.yellowpages.com # date: 2015.01.28 use strict; use warnings; use LWP::Simple; my $usage = "\n\tusage: perl $0 [PHO-NEN-UMBR]\n"; my $baseUri = 'http://www.yellowpages.com/search?search_terms=+'; 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 "sum.pl" (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 "sum.pl" 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 calc_TRL.pl ) from a shell with

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

    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 ./calc_TRL.pl 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.

    generalisation

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

    discussion

    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.

    TIMTOWTDI

    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 ☆☆☆☆ :)

The hills are alive...
4 direct replies — Read more / Contribute
by Lady_Aleena
on Nov 26, 2014 at 22:25

    ..with The Sound of Music. ;)

    I had @SoM_notes and $SoM sitting around doing nothing, so this evening, I made them do something. In make_SoM_song and get_SoM_def, you enter a string of alphabetical notes (c, d, e, f, g, a, b). The notes can be separated by a comma, semicolon, or a space. The functions will return the note name given by Maria von Trapp in The Sound of Music.

    I wrote random_SoM_note and random_SoM_song because I couldnt' help myself. Most of you know how much I love to randomly generate things. :)

    make_SoM_song, get_SoM_def, and random_SoM_song all return array references.

    Enjoy the code!

    package SoundofMusicSong; use strict; use warnings; use Exporter qw(import); our @EXPORT_OK = qw(make_SoM_song get_SoM_def random_SoM_note random_S +oM_song); my @base_notes = qw(c d e f g a b); my @SoM_notes = qw(do re me fa so la te); my %notes; @notes{@base_notes} = @SoM_notes; my $SoM = { 'do' => 'a deer a female deer', 're' => 'a drop of golden sun', 'me' => 'a name I call myself', 'fa' => 'a long long way to run', 'so' => 'a needle pulling thread', 'la' => 'a note to follow so', 'te' => 'a drink with jam and bread', }; sub make_SoM_song { my ($user_song) = @_; my @song_notes = split(/[ ,;]/, $user_song); my @new_song = map { $_ = $_ =~ /^[a-g]$/ ? $notes{$_} : 'not a note +'; $_ } @song_notes; return \@new_song; } sub get_SoM_def { my ($user_song) = @_; my $notes = make_SoM_song($user_song); my @new_song = map { $_ = $$SoM{$_} ? $_.' '.$$SoM{$_} : 'not a note +'; $_ } @$notes; return \@new_song; } sub random_SoM_note { my $note = $SoM_notes[rand @SoM_notes]; return $note; } sub random_SoM_song { my ($number_of_notes) = @_; my $notes = $number_of_notes ? $number_of_notes : int(rand(100)) + 1 +; my @new_song; push @new_song, random_SoM_note for (1..$notes); return \@new_song; } 1;
    No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
    Lady Aleena
CPAN Namespace Navigator
1 direct reply — Read more / Contribute
by Discipulus
on Nov 25, 2014 at 06:23
    CPAN Namespace Navigator is an interactive program that let you to navigate all namespaces on CPAN.
    The idea born when i read that before upload something to CPAN is better to explore existing modules, but when i asked here in the chat how to browse it i discovered that ther is not a real exploration program to do it.

    So the challenge was to hack directly the fomous file 02packages.details.txt that we receive (gzipped) when we search some module with some CPAN client. I used Term::ReadLine not without some headache.

    I decided (unwisely) to eval directly the data received to build up a big HoH with the whole hierarchy of CPAN modules and reletad infos. As suggested (wisely) by ambrus and yitzchak i looked at tye's Data::Diver and on my own at an ancient and unmaintained Data::Walker one.

    I was not able to bind Data::Diver at my will to add to the structure others infos like parent namespace or version, so i reinvented that wheel evaluating everything by myself.

    Surprisingly it worked.

    This is the usage and the navigation commands available during the navigation:
    USAGE: cpannn.pl [02packages.details.txt] NAVIGATION: . simple list of contained namespaces .. move one level up + detailed list of contained namespaces * read the readme file of current namespace ** download the current namespace's package ? print this help TAB completion enabled on all sub namespaces cpannn.pl by Discipulus as found at perlmonks.org
    And here you have the code, finally crafted after 37 steps of development.


    HtH
    L*

    update: take a look also at Re: Autocomplete in perl console application
    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.

Add your CUFP
Title:
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.
  • 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 examining the Monastery: (10)
    As of 2015-03-29 07:29 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      When putting a smiley right before a closing parenthesis, do you:









      Results (630 votes), past polls