Private Utilities

[Ovid]

One of the reasons so many of us love Perl is how easy it is to hack out a quick utility that does exactly what we need. However, sharing these utilities doesn't always make sense because the utility is either custom to your needs (I had a precursor to Module::Starter which was dependent on my personal setup) or is so limited that posting it is sure to draw quick replies of "yeah, but that doesn't do X!"

So here's one of mine. I type subs PerlFileName and it dumps out a list of the subroutines. If I type subs -p PerlFileName it will include the "private" subs (those that begin with an underscore).

#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Long;

GetOptions( "private" => \my $private );

my $file = shift or die "Usage: subs ProgramName";

my @subs;

open my $fh, '<', $file or die "Cannot open ($file) for reading: $!";

while ( defined( my $line = <$fh> ) ) {
    if ( $line =~ /^\s*sub\s+([[:word:]]+)/ ) {
        my $sub = $1;
        next if ! $private && '_' eq substr $sub, 0, 1;
        push @subs, $sub;
    }
}

print join "\n", sort @subs;

It's pretty simple, will break on a lot of code and pretty much guarantees that posting it as a utility here won't meet with the best response. However, if I need a quick refresher on a module's interface, it's great. What private utilities do you have which might meet your needs but not be "general" enough to post elsewhere?

[Old_Gray_Bear]

I have built a number of 'SA utilities' by the expedient of tracking the requests I issue in the course of a day. If I find that I am doing a particular, complex, query more than three times a day, it becomes a candidate for a utility code, and I add it to my little list. When I find myself at loose ends (boring meetings, 45 minutes until the car-pool leaves, etc), I pop the top item of the list and write the script for it. The resulting code works in my current environment, but will probably never get ported outside the Company. It would take a fair amount of work to produce portable and general enough code for posting to CPAN.

Over the past six months I have written utilities to:

• Check each member in a server-cloud and report back on the percent running over 75% CPU busy
• Check each member in a server-cloud and report which boxes are under 'environmental stress', defined as mother-board temperatures over 85F. (Far too many. This particular script was turned over to the Hardware folks the week we had three boxes go thermal in one day.)
• Check a server-cloud and report on how many members have a particular configuration set active
• Check a server cloud and report on the number of open HTTP conversations
• Check the status of a load-balancer: how "hot" is it running? How many servers is it fronting? What is the five minute trend?
• Check on the status of machines in the test lab; who is up and who is idle
• Wander through the last five minutes of the Apache logs in a server cloud and report on the most popular source and destination IPs. Ditto for the most popular errors.

Most of these were a couple of hour projects, nothing fancy, no seriously strange code involved, not particularly well documented (blush).

I have a couple of bigger problems on the list, associated with walking through SNMP trees of MIBs. I can get the Network usage information from the Network logs, but it will be 8+ hours old. I want to be able to look at the servers and routers that I Care About in a shorter time frame, say the last fifteen minutes. The Network Manager, would love to have the tool, too, but she doesn't have the body to assign to it. So I have an over-the-Christmas-break project.

[xdg]

What private utilities do you have which might meet your needs but not be "general" enough to post elsewhere?

Well, a quick scan of my ~/utility-scripts/ directory shows:

• coremodule-history.pl -- a level of detail between 'corelist' and 'corelist -a'
• cpanget -- grabs a CPAN dist from search.cpan.org (before I knew about 'cpanp -d')
• findrequires -- scans for module dependencies and outputs in a Module::Build ready format (annotated with core-module history, if available)
• pod2htmleasy -- output to Pod::HtmlEasy
• rebuild-album.pl -- regenerate thumbnails for my photo album CGI
• release-dist -- download a module from my SVN repository, extract it, build it, and if all tests pass, upload it to CPAN
• set-version -- sets "$VERSION = x.yy.zz" recursively in appropriate files in a distribution directory
• tag-svk -- create a tag branch from within an svk directory
• tag-svn -- ditto from within an svn directory

Some are shell wrappers around perl one-liners, but it's still perl doing most of the work. I keep these in a subversion repository so I can shuffle them around between machines I use and propogate little changes as I make them.

[belg4mit]

That's similar in utility to something I spoke about in the CB awhile back, bart said he'd like it and I started but haven't finished... It was aplopos, an apropos for your installed module base.

I have this, quotemeta for pipes e.g; find -name *.pl | quotemeta | xargs grep foo

#perl -p
s/([ '"$*?()\[\]])/\\$1/g;

And this icky URIgrep:

#perl -l -O777
$_=<>;while(m/(\w+:\/\/[-a-zA-Z0-9\$_.+!*'(),?\/\%\&=~:]+)/g){print$1;
+}

[Eimi Metamorphoumai]

I can see some uses for your quotemeta for pipes, but the use you mentioned is more easily written as

find -name \*.pl -print0 | xargs -0 grep foo

which has the advantage of quoting all nasty filename characters (for instance, new lines, tabs, etc).

[thor]

Except that not all finds and xargss have this feature. The ones included with Solaris, for example.

[belg4mit]

If you have newlines in your filenames you've issues IMHO. As for "more easily" well, I don't find your idiom particularly intuitive (it relies upon two arcane swtiches and you're sort of repeating yourself). Besides, I don't use the tool as much as I could because it always slips my mind, the more I use it the more I'll use it :-P

It's interesting to know there's an option, maybe I'll include some variant as the default when I get around to writing the trivial wrapper that accepts arguments in the right order. POSIX be damned, find is grep-ing the filesystem and it ought to be find EXPR PATH

[jonix]

Well, you have asked for it. Here is the script I update my gentoo box with for some months now. It is a smarter replacement of the bash alias in the first comment. I procrastinate finishing it since as it just does what I need though. No guarantees if you dare to try it!
Read more... (7 kB)

[graff]

Seems like just about every day I have to pull something out of an oracle or mysql database, or do some sort of alteration to table data. But leaving the shell command line behind to use the oracle or mysql native CLI just causes too much constraint and discomfort.

So I have two generic Perl/DBI utilities -- one to run "select/describe/show" type queries, one to run "update/insert/delete" type queries -- that just take the query text as a command-line arg, or take a file name that contains the query text. Here's the usage message for the mysql version of the "select" tool:

Usage: mdbget -db database -s 'select sql' [options] [query_param.list
+]
        or:  [-db database] -f sql.file    [options] [query_param.list
+]

  options:
    -l : label columns (print list of column names as first line of ou
+tput)

    -d delim : set field delimiter to 'delim' (default delim is tab)
       "-d sp" and "-d ' '" both work to produce single-space delimite
+d data
       "-d csv" will produce "true CSV" output, adding double-quotes a
+s needed
       NOTE: only "-d csv" will quote fields containing the delimiter 
+character
             (csv also turns on "-l", so column names are listed on fi
+rst line)

    -w {norm|mark|keep} : control the treatment of whitespace within f
+ields:
       "-w norm" (default) convert all whitespace strings to single sp
+ace
       "-w mark" keep spaces as-is, convert newline to '\n', tab to '\
+t'
       "-w keep" make no alterations to white space at all

 query_param.list is needed if sql contains "?" placeholder(s) for par
+am(s)

The tools both use a special "DBI-wrapper" module I cooked up, that maps the "database" name to an appropriate user-id and password for connecting to the server, so both utils can be used with all the different databases I have to deal with.

The placeholder support for the sql statements means I can pipe a list of field data from any other shell command or data file, which saves me tons of time. (update: and of course the big win for me is the ability to pipe query output to other shell commands)

But it's definitely the sort of thing I tend to keep to myself and just a few trusted colleagues (especially the update/insert/delete tool).

Read more... (9 kB)

[TimButterfield]

Here are some scripts I find useful in our environment.

• grepXXlog - perform a grep on the same log file name across multiple servers shares looking for a text string. We have multiple servers, each running the same process or set of processes. If there is a problem, we have to find out which server processed that item and look in that particular log file to see what happened. The default log file name is for the current date, but the script has parameters for -# (# of days old) and -note (open the log file in notepad if the text is found). The XX in the script name is for the specific process/share where the files are.
• stripcr - modify a text file in place to replace whatever combination of \r \n with the \n for the current platform. This makes a great 'send to' shortcut on Windows.
• binwords - open a binary file and look for combinations of ascii characters of a minimum specified length and output those strings. This is handy for seeing what calls an executable may be making.

[Aristotle]

This is sm, short for Slackware make. I use it to build Slackware packages out of autoconf-based source tarballs, but half its raison d’être is to provide some defaults to the configure script, so non-Slackers might get some use out of it.

Read more... (8 kB)

This is rat – because “tar” is backwards –, which attempts to make dealing with tarballs (and zipfiles) a little saner:

Read more... (5 kB)

I’m rather unhappy with the state of both; rat has at least one annoying bug. But they work sufficiently well for me that I don’t get irritated enough to actually fix them. And that’s why they’ve remained private…

[wazoox]

Do you know checkinstall? It's a neat package building utility, and it can build Slack, Debian and RPM packages, though it's primarily a Slackware utility (it comes on slackware CDs in the /extra directory IIRC).

[Aristotle]

Yes. It needs to be run as root, so any files created in the source tree during make install as well as the resultant package tarball are owned by root, which means I can’t move the package, and sometimes cannot blow away the source tree, without root permissions. It also knows nothing of DESTDIR, so you cannot run it with fakeroot, which means make install can wreak havoc at will. (Makefiles that try to register schemata with GConf are always great fun… grr.)

[samtregar]

In my ~/bin is, among other things:
• choose-x: a curses script which asks me whether I want to load the x.org config for the LCD panel or the external CRT. My poorly supported graphics chip makes me choose before X starts if I want to be able to play movies.
• find-and-raise.pl: a script which uses wmcrtl to find and raise a window in X. I bind keypresses and icons to invocations of this script - for example, clicking the email icon finds and raises my email window or opens it if none is found.
• senddisc.pl: a script which sends a set of MP3s to my Dell-pod and creates a playlist for them.

-sam

[Anonymous Monk]

A quick and dirty rename command for UNIX: it looks simple, but is quite handy. Also, similar little utilities for deleting all the empty files (including empty gzipped files) in a directory, copying with rename, and so forth...

%cat rename.pl
#!/usr/bin/perl

=head1 SYNOPSIS

rename.pl '<pattern from>/<pattern to>' <filenames>

=head1 DESCRIPTION

Renames the files listed as <filenames> after performing the substitut
+ion using the standard perl regular expression pattern from and to.

=head1 EXAMPLES

rename.pl 'ready/done' file1-ready file2-ready_to_go

renames "file1-ready" to "file1-done" and
        "file2-ready_to_go" to "file2-done_to_go"

=cut

use strict;
use warnings;

my $file;
my $old;
my $pattern;
my $command;
unless( @ARGV >= 2) {
        print "Usage: rename \"patternfrom/to\" <filenames>\n";
        exit(1);
} # end argument check

$pattern = shift(@ARGV);

foreach $file (@ARGV) {
        $old=$file;

        $pattern .= "/" unless( $pattern =~ m#.*?/.*?/$# );
        $command = "\$file =~ s/$pattern";

        eval $command;
        if ( $@ ) {
                print STDERR "$@";
        } # end eval failed check

        rename($old,$file);
} # end rename loop

[eyepopslikeamosquito]

See also Unix rename faq (a version of Larry's famous rename script is given at the end). It's also discussed in Perl Cookbook, recipe 9.9.

Update: Note that Larry's original famous rename script is now a broken link. See instead Aristotle's improved version: rename 0.3 - now with two extra cupholders

[Aristotle]

Note also my improvements on it: rename 0.3 - now with two extra cupholders

(The version on my disk is a bit better in some ways, but has grown messily, and I have no clear idea about how to clean it up…)

[duelafn]

How about a module (docs, Dean::Util) that removes dependency on itself from other modules. For example:

# In some script/module
use Dean::Util qw/map_pair nsign min_max/;
# other code ...

Then later to send the script to other machines:

perl -MDean::Util -we insert_Dean_Util_functions the_script.pl

This replaces the use Dean::Util line with the code for the subs requested (and optionally documentation).

[SolidState]

One little utility I wrote which others in my workplace have found useful is called 'fp', for "Full Path":

use strict;
use warnings;
use Cwd qw(abs_path);
my $file = $ARGV[0] || ".";
die "Error - couldn't find (or read) '$file': $!\n" if !(-e $file);
print abs_path($file) , "\n";

The reason for writing it was that I frequently found myself copying file names from the terminal to email as a pointer to someone and it was getting annoying to write "pwd", copy the output, then copy the filename and paste it after the "pwd" output.

[philcrow]

I have a couple of oddities. One, called incgrep, works like recursive grep except for two features. First, it reports one line for each file that has the search string with the line numbers after like this:

search_string:
  some_file 4 12 189
  other_file 29 283

This is very useful for quickly seeing which files are calling a certain sub, etc.

The second feature is odder yet. If the search string is a directory name, then instead of looking for the string itself, it uses the file names in that directory as search strings looking for each of them. This was supposed to be useful for looking for all the templates used in a project:

shell-prompt: incgrep global/template/dir
form.tt:
  App/Main.pm 24 114
  App/Modules/Name.pm 41

error.tt:
  App/Main.pm 181

I don't actually use it that way much.

Another script is showsub. It usually takes a sub name and a module file name. It dumps out the whole sub from that module. (It's not very smart, it looks for 'sub name' at the left margin and dumps from there to the first closing brace at the margin.) It can also take the output from incgrep. Then it looks in all the files mentioned there for the sub provided.

Another one is searchinc. It takes a regex, a starting perl file and (optionally) a list of directories which could be part of @INC. It looks for the regex in the starting file and in anything it uses recursively. Again, its not overly smart and only looks for easy to spot use statements. I also have a version for C, since I once spent a bit of time digesting a large code base in C. The C version is more useful, Perl doesn't hide as many symbols.

My most useful little tools are the ones the move me to the directories where our different projects live. I can type cdb AppName to move the build directory for an app and cda AppName to move to the lib path for it. These are my most typed commands.

Phil

[holli]

This is a little helper named ncopy. It copies files from one place to another.

Syntax:

ncopy <files(s)> <target>

<files(s)> is just a filename (wildcards possible) and <target> is an expression for the target of the copy operation. So far there is nothing new. Here comes the interesting part:

In the target expression you can use the following to refer to parts of the source path and name:

*0   first directory after root
*1   second directory after root
...

*-1  first directory above sourcefile
*-2  second directory above sourcefile
...

*n   name of the sourcefile

*s0  first suffix of the sourcefile
*s1  second suffix oft the sourcefile

So given the files a.txt and b.txt in c:\temp\foo\bar" and calling the script:

C:\temp\foo\bar>ncopy.pl *.txt .\*1\*n\*-1\t.*s0

mkpath C:\temp\foo\bar\foo\a\bar
a.txt -> C:\temp\foo\bar\foo\a\bar\t.txt
mkpath C:\temp\foo\bar\foo\b\bar
b.txt -> C:\temp\foo\bar\foo\b\bar\t.txt

As you can see you can easily transform file names while copying.

It's only tested under Windows, but should be cross platform.

[cees]

Here is a dirt simple one that just loads up the source of a perl module in vi. It is a shell script, but if you really wanted to, could be re-written in perl...

#!/bin/sh

DOC=`perldoc -l $1`

if [ -n "$DOC" ] && [ -f "$DOC" ]; then
    vim $DOC
fi

I got tired of writing vi `perldoc -l <module-name>`, and thought pvi <module-name> saved me some key strokes.

Cheers, Cees

[radiantmatrix]

I use Windows at work, and use my Desktop as a workspace. However, I often am too lazy to clean my desktop off (which really just involves moving documents into a directory, archives into an 'Apps' directory {they are usually downloads}, and shortcuts off to a 'Shortcuts' directory). So, I let Perl do the heavy lifting for me:

package main;
use strict; use warnings;
our $VERSION = '0.01';
our $BUILD   = 'Oct 24, 2005';

#__modules__
use POSIX qw[_exit];
use Win32::TieRegistry;
use File::Spec::Functions ('catdir','catfile');
use File::Copy;

main( \@ARGV );

#_____________________________________________________________________
+__ main()_
sub main {
    # main ( \@argv )
    my $argv = shift;
    $Registry->Delimiter('/');
    
    my $sh_fold = $Registry->{'HKEY_CURRENT_USER/Software/Microsoft/Wi
+ndows/CurrentVersion/Explorer/Shell Folders'};
    my $desk = $sh_fold->{'Desktop'};
    my $docs = $sh_fold->{'Personal'};
    
    chdir $desk;
    opendir my $DESK, $desk or die ('Opening Desktop: '.$!);
    my (@doc, @dir, @exe, @lnk);
    for (readdir $DESK) {
        next if /^\.{1,2}$/; # skip . and ..
        
        if ( -d $_ ) { push @dir, $_ and next }
        next unless -f $_;
        
        # executable and other "non-document" types
        if ( /\.(?:exe|zip|tgz|tar|gz|com|msi|ini)$/i ) {
            push @exe, $_;
        }
        elsif (/\.lnk$/i) {
            next if /^CleanDesk/i;
            push @lnk, $_;    
        }
        else {
            push @doc, $_;
        }
    }
    
    my $newdir = catdir($docs, 'Cleaned');
    
    mkdir $newdir; 
    $|=1;
    
    for (@doc) {
        print $_,' => ';
        my $new = catfile($newdir,$_);
        copy($_, $new) or do {
            warn "Skipping $_: $!";
            next;
        };
        print $new,"\n";
        unlink($_);    
    }
    
    mkdir catdir($newdir,'Apps');
    for (@exe) {
        print $_,' => ';
        my $new = catfile($newdir,'Apps',$_);

        copy($_, $new) or do {
            warn "Skipping $_: $!";
            next;
        };
        print $new,"\n";
        unlink($_);
    }
    
    for (@dir) {
        print $_,' => ';
        system('move',$_,$newdir);
        print catdir($newdir,$_),"\n";
    }
    
    mkdir catdir($newdir,'Shortcuts');
    for (@lnk) {
        print $_,' => ';
        my $new = catfile($newdir,'Shortcuts',$_);

        copy($_, $new) or do {
            warn "Skipping $_: $!";
            next;
        };
        
        print $new,"\n";
        unlink($_);
    }
    
    _exit(0);
}

#_____________________________________________________________________
+_____ END_
_exit(250); ## unknown exit code.  Should *never* happen;


__END__
=head1 cleandesk.pl

Cleans Desktop items into the My Documents folder

=cut

[hv]

Here is the one I use more than any other: open a vi session in a new xterm. At any one time I usually have between 20 and 200 of such sessions open.

Usage:

  vix [ -i ] [ -r ] [ -s ] [ filenames ... ]
  -i: create minimised (useful when opening many in one go)
  -r: readonly edit session
  -s: open all files in a single vi session

The code:

#!/usr/bin/perl -w
my $xterm = '/usr/X11R6/bin/xterm';
my $vi = '/bin/vi';
my $single = 0;
my @xopts = qw/ -cm +cn -dc -j -s +sb -sl 0 -wf -fg white -bg black /;
my @vopts = ();

while (@ARGV && $ARGV[0] =~ /^-/) {
    my $arg = shift;
    last if $arg eq '--';
    push(@xopts, '-iconic'), next if $arg eq '-i';
    push(@vopts, '-R'), next if $arg eq '-r';
    $single = 1, next if $arg eq '-s';
    die "unknown option '$arg'\n";
}

@ARGV = '' unless @ARGV;
for ($single ? \@ARGV : @ARGV) {
    my $pid = fork;
    die "fork: $!\n" unless defined $pid;
    next if $pid;
    my $name = $single ? "vix session" : $_;
    $name =~ s/lock\z/lock /;   # avoid fwvm trickery
    exec $xterm, @xopts,
            -name => $name,
            -title => $name,
            -e => $vi, @vopts, $single ? @$_ : $_;
}

Update 2006/04/06: added hack to dodge 'lock' trickery.

Hugo

[gaal]

200

Goodness! If your vi is actually vim, you might consider using minibufexpl.vim.

[sand_]

You can also use the new "tab pages" implemented in vim 7 (still beta) :)

[l3v3l]

Perfect! I have been looking for just such a solution this morn and appreciate your post - here is one I just put together really quick ... to chunk up a given fasta file (unaligned sequences) in to N files for submission of multiple smaller jobs on a cluster:

#!/usr/bin/perl -w
use strict;
my $num_ch  = $ARGV[0] or die "must pass the # of chunks $!";
open (FH,"<$ARGV[1]")  or die "must pass the file name to make chunks 
+of $!";
my @lines = ();
$/ = ">";
while (<FH>){
        chomp;
        next if /^$/; # get rid of blank lines
        push @lines,">$_";
}
close FH;
my $num_rec = scalar(@lines);
print "number of records : $num_rec\n";
#die "Chunks exceed records!!" unless ($num_rec >= $num_ch);
sub write_em {
        my $output = shift()."_chunk.fa";
        my $ar_ref = shift;
        open (QRTR,">$output") or die "Cannot open $output : $!";
        print QRTR @$ar_ref;
        close (QRTR) or die "cannot close $output : $!";
}
my $cnt = 0;
my $rng = int($num_rec/$num_ch) + ($num_rec%$num_ch ? 1 : 0);
for (1..$num_ch) {
        write_em($_,[@lines[$cnt..($_ == $num_ch ? $#lines : ($cnt+($r
+ng-1)))]]);
        $cnt += $rng;
}

Feel free to comment or point me in the right direction where I have gone astray - this just scratched a specific itch ...

[thor]

From what I understand, these files can be large. I also see that you're essentially reading the whole file into memory. The combination of those two could be bad. Before I propose a better solution, is it okay to put adjacent lines in different files? That is, let's say that I have a file that contains the following:

AAA
BBB
CCC
DDD
EEE
FFF

Is it okay to split into two files like so:

AAA
CCC
EEE
---
BBB
DDD
FFF

If so, I may have a really slick solution floating in my head...

[l3v3l]

no problem!! round robin is fine - here is a way I have done it in a liner without having to read the entire file into mem (just an example) :

# Choose first N FASTA records
perl -ne 'BEGIN {$/=">";$o=0}{chomp;$o<N?(/^$/?next:print">$_"):last;$
+o++}' EXAMPLE.fa

example usage:

 perl -ne 'BEGIN{$/=">";$o=0}{chomp;$o<22?(/^$/?next:print">$_"):last;
+$o++}' b4x_est100.fa # print the first 22 records

[Spidy]

I wrote an FTP script, because I was getting sick of the nag screen on my FTP manager...it's under the code section, as ftp.pl. Not massively feature-rich, but it gets the job done for me, and is easy enough to fix up if there are issues.

[neilwatson]

I have all types of scripts both Perl and otherwise. They range in purposes: user management, log parsing, CISCO work, database queries and others.

While it is true that many scripts may not be useful for future jobs, one can never be sure. That's why I keep all this work in my Subversion repository.

[Anonymous Monk]

i use this (way to often) to renumber image files so they'll sort in order.

#!/usr/bin/perl
#
# renum.pl blah*.jpg
# blah1.jpg .. blah9.jpg blah10.jpg .. blah99.jpg blah100.jpg
# -> blah001.jpg .. blah010.jpg .. blah100.jpg

foreach ( @ARGV ) {
        next unless ($stem, $digits, $ext) = /(.*?)(\d+)\.([^\.]+)$/;
        $max = $len if ($len = length( $digits )) > $max;
        print "$_ $1\n";
}
$fmt = "$stem\%0${max}d.$ext";
foreach ( @ARGV ) {
        next unless ($stem, $digits, $ext) = /(.*?)(\d+)\.([^\.]+)$/;
        $new = sprintf $fmt, $digits;
        rename $_, $new or warn $!;
}

[Intrepid]

<UPDATE> prompted by a reaction in the chatterbox

If you get upset by things like seeing the company name "Microsoft" rendered in various creative / implicitly critical ways, please stop reading now; I don't want to inadvertantly help you even to a tiny degree with this code! Making even one of your days a tiny bit easier might distract you from the important recognition that you've got far worse problems than doskey macros to deal with (problems of an cognitive sort), and it would thus be uncompassionate of me. Shoo.

</UPDATE>

I was just looking at how impoverished* my Windo$e CMD.exe prompt seemed (I go months without using one, but building Perl under Win32(native) a little while ago made me get re-acquainted with it). I decided to pull together a few doskey macros that could be loaded into a CMD session at any point (by running a batch *.cmd file). Here they are.

* compared with my Cygwin shell

Read more... (5 kB)