Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Cool Uses for Perl

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

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

file age in seconds using M file test
2 direct replies — Read more / Contribute
by FreeBeerReekingMonk
on Apr 15, 2015 at 19:17

    Sometimes you just want to know the age of a file in seconds:

    perl -e 'print (int((-M shift)*60*60*24)||1)' script_file

    The ||1 is to ensure a positive number. You can leave it out. To get the file age in minutes:
    perl -e 'print (int((-M shift)*60*24))' script_file

510 Concurrent/Simultaneous SQL Processes running on Windows O/S Laptop
2 direct replies — Read more / Contribute
by erichansen1836
on Apr 15, 2015 at 11:29

    This script launches 510 simultaneous/concurrent MS-Access database SQL queries, which the database Jet Engine can handle just fine with increased Threads configured to 510, default is 3. The calling script launches the 510 instances, then immediately exits without waiting for them to complete. If you run this from a command prompt, and open Windows Task Manager, you can watch the concurrent processing occuring since I have prints to the screen going on. CPU usage will hit 100%, and my RAM memory usage hit a high of 83% for a split second, then fell back down rapidly. I have a single Intel Celeron processor 2.2GHz, and 3-GIG RAM on my WIndows 7 Home Premium Laptop. The database hit, contains a table of Bible book names: Genesis thru Revelation (66 books). 510 output files are created witht the SQL report output. I used a File Compare routine to verify all the same output. This reporting process produces reliable SQL output every time. Way to go Jet Engine! CALLING SCRIPT

    use Win32; use Win32::Process; $PWD=Win32::GetCwd(); for ($i=1; $i<=510; $i++) { Win32::Process::Create($POBJ,"$PWD\\RptUtl.exe","RptUtl $i",0,DETACH +ED_PROCESS,"."); } exit;

    CALLED SCRIPT i.e. RptUtl.exe <-- compiled

    use Win32::ODBC; use Win32; se IO::Handle; $i=$ARGV[0]; #-- called from another Perl script that launches 1 to +510 Windows O/S "detached" background processes. $PWD=Win32::GetCwd(); $outfile="$PWD\\BibleBooks_$i.txt"; open(OUT,"> $outfile"); OUT->autoflush(1); $USR=Win32::LoginName(); $NODE=Win32::NodeName(); print OUT "Working Directory=\n $PWD\n User=$USR Node=$NODE\n\n"; $FILEDSN="FILEDSN=$PWD\\Bible.dsn; PWD=xYz"; $db = new Win32::ODBC($FILEDSN); if (! $db) { $error = Win32::ODBC::Error(); print OUT "$error\n"; die; } $ret=$db->Sql("SELECT * FROM BibleBook"); if ($ret) { $error = Win32::ODBC::Error(); print OUT "$error\n"; die; } while ($db->FetchRow()) { my(%data) = $db->DataHash(); print OUT $data{'bk'} . " " . $data{'name'} . " " . $data{'shor +t_name'} . "\n"; print $data{'bk'} . " " . $data{'name'} . " " . $data{'short_na +me'} . "\n"; } print OUT "\nGood bye.\n"; exit; END { if ($db) { $db->Close(); undef $db; } close(OUT); }

    CONTENTS of ODBC FILEDSN Bible.dsn which is referenced in the above code

    [[ODBC]] Threads=512 Driver=Microsoft Access Driver (*.mdb) DBQ=.\Bible.mdb
simple Perl script template
3 direct replies — Read more / Contribute
by Dumu
on Apr 09, 2015 at 06:47

    I wrote this script because I just wanted to automate typing two lines of Perl every time I wrote a small test-case script.

    This is dead simple and doesn't really count as 'cool'. However, in the words of the Greek poet Callimachus and E.F. Shumacher, "small is beautiful".

    The script simply prints its own top two lines into every new file specified on the command line, unless the file already exists.

    Any and all feedback will be welcomed.

    #!/usr/bin/env perl use Modern::Perl; while (<@ARGV>) { my $fname = $_; unless (-e $fname) { open my $fh, '>', $fname; say $fh "#!/usr/bin/env perl"; say $fh "use Modern::Perl;\n\n"; say STDOUT "created $fname"; } else { say STDOUT "*** didn't overwrite $fname"; } }
Number functions I have lying around
2 direct replies — 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.

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.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (3)
    As of 2015-04-19 01:13 GMT
    Find Nodes?
      Voting Booth?

      Who makes your decisions?

      Results (357 votes), past polls