handy_scripts/0000755000076500007650000000000011071035263013204 5ustar damiandamianhandy_scripts/calc0000744000076500007650000000364311071035263014040 0ustar damiandamian#!/usr/local/bin/perl -w use strict; use IO::Prompt; use List::Util qw( max ); my $INDENT = 25; my $IDENT = qr/ [^\W\d] \w* /xms; # Cache for all results and aliases... my %res; # Input counter... my $n = 0; INPUT: while (my $expr = prompt "[r$n] ", -nl=>q{}) { # Help will always be provided to those who ask for it... if ($expr =~ /^ \s* (?: help | \? ) \s* $/) { print "\n\tEnter a Perl expression and hit return.\n" . "\tUse r0, r1, etc to refer to previous results.\n" . "\tEnter: '= ' to rename the previous result\n" . "\t(then you can refer to it by that identifier too)."; next INPUT; } # Make a copy so we can convert input to a proper Perl expression... my $expr_munged = $expr; for ($expr_munged) { # Create an alias to any existing result... if (m{\A \s* = \s* ($IDENT) \s* \z}xms) { $res{$1} = $res{'r'.($n-1)}; print "\n"; next INPUT; } # Look for identifiers and replace them with the corresonding values... if (my @vars = reverse sort keys %res) { my $var = join '|', @vars; s/($var)/$res{$1}/gxms; } s{ \A \s* (?=[^\w.]) }{$res{'r'.($n-1)}}exms; } # Evaluate and store the expression, or report that it's invalid... my $new_key = 'r'.$n; $res{$new_key} = eval $expr_munged; # Format, align, and print the result... my $outdent = 3 + length $n; my $indent = max(0,$INDENT-length($expr)-$outdent); print q{.} x $indent; print "\n", q{ }x$outdent, q{.}x($INDENT-$outdent) if !$indent; print ': '; if (!defined($res{$new_key})) { print "is not a valid expression\n"; next INPUT; } elsif (ref $res{"r$n"} eq 'ARRAY') { print '[', join(q{, }, @{$res{$new_key}}), ']'; } else { print $res{$new_key}; } print "\n"; $n++; } handy_scripts/column0000700000076500007650000000553311071035263014423 0ustar damiandamian#! /opt/local/bin/perl5.10.0 use v5.10; use warnings; use Getopt::Declare <<'EOARGS' => $args, -tabs=>4; - Specify number of columns (default: -2) -hor[izontally] Fill columns across first then down -ver[t[ically]] Fill columns down first then across (default) -t[abbed] [] Separate columns with exactly N tabs (default: N=1) { $N ||= 1 } -s[paced] [] Separate columns with a minimum of N spaces (default: N=3) { $N ||= 3 } -sep[arator] Separate columns with [mutex: -t -s ] -start Begin each row with -end Terminate each row with EOARGS # Extract command line flags... my $spaced = exists $args->{'-s'} ? $args->{'-s'}{''} : undef; my $sep = exists $args->{'-sep'} ? $args->{'-sep'}{''} : exists $args->{'-t'} ? "\t" x $args->{'-t'}{''} : !defined $spaced ? "\t" : ""; # Grab items to be put in columns (one per line) chomp(my @lines = <>); # Work out the size of the table... use POSIX 'ceil'; my $cols = $args->{'-'} || 2; my $rows = ceil(@lines/$cols); # If horizontal layout requested, build rows until everything consumed.. if (exists $args->{'-hor'}) { ROW: for my $r (0..$rows-1) { for my $c (0..$cols-1) { my $next = shift(@lines)||""; $table[$r][$c] = $next; $max[$c] = length $next if !defined($max[$c]) || $max[$c] < length $next; last ROW unless @lines; } } } else { # Vertical layout requested... # Work out which (if any) columns will end up shorter by one row... my $firstshortcol = $cols - ($rows*$cols-@lines); # Then build columns till everything consumed... COL: for my $c (0..$cols-1) { for my $r (0..$rows-($c>=$firstshortcol?2:1)) { my $next = shift(@lines) || ""; $table[$r][$c] = $next; $max[$c] = length $next if !defined($max[$c]) || $max[$c] < length $next; last COL unless @lines; } } } # Insert appropriate inter-column spaces, if spaced columns requested... if (defined $spaced) { for my $c (0..$cols-2) { for my $r (0..$rows-1) { next unless defined $table[$r][$c]; $table[$r][$c] .= " " x ($spaced+$max[$c]-length $table[$r][$c]); } } } # Extract line beginners and enders (if any)... my $sol = exists $args->{-start} ? $args->{-start} : ""; my $eol = exists $args->{-end} ? $args->{-end} : ""; # Print row-by-row, with line delimiters... for my $r (0..$rows-1) { print "$sol"; for my $c (0..$cols-1) { print $table[$r][$c]||"", ($c == $cols-1 ? "" : $sep); } print "$eol\n"; } handy_scripts/entar0000700000076500007650000001005611071035263014233 0ustar damiandamian#! /usr/local/bin/perl -w use IO::Prompt; use Getopt::Euclid; use Carp; my $new_tar_file = $ARGV{''}; my @contents = @{$ARGV{''}}; my $bundledir; # Auto-bundle multiple files so they unpack cleanly... if (@contents > 1) { # Directory name is tar file name minus suffixes... $new_tar_file =~ m{ (.*?) (?:[.]tar)? (?:[.]gz)? (?:[.]uu)? $ | (.*?) [.]?}xms; $bundledir = $+; # Is the directory already there? if (-e $bundledir) { prompt(-y1, "Bundle directory '$bundledir' already exists. Overwrite? ") or exit; system "rm -rf $bundledir/*"; @contents = grep { $_ ne $bundledir } @contents; } else { mkdir($bundledir, 0777); } # Then populate it and just tar the directory... system "cp -r @contents $bundledir"; @contents = ( $bundledir ); print "Bundling files in directory '$bundledir'...\n"; } # Are we already done? if (-e $new_tar_file) { prompt(-y1, "$new_tar_file already exists. Overwrite? ") or exit; } # Check for optional encodings... my $uu = $new_tar_file =~ s{.uu$}{}; my $zip = $new_tar_file =~ s{.gz$}{}; # Tar contents first... print "tar'ing [@contents] to produce $new_tar_file...\n"; system "tar cf $new_tar_file @contents"; # Gzip if requested... print "gzip'ing $new_tar_file to produce $new_tar_file.gz...\n" if $zip; system "gzip $new_tar_file" if $zip; # UUencode if requested... $new_tar_file .= ".gz" if $zip; print "uuencoding $new_tar_file to produce $new_tar_file.uu...\n" if $uu; system "uuencode $new_tar_file $new_tar_file > $new_tar_file.uu" if $uu; # Clean up... unlink $new_tar_file if $uu; if (-e $bundledir) { system "/bin/rm -rf $bundledir"; } __END__ =head1 NAME entar - Bundle up a set of files into a tar file and optionally compress it =head1 VERSION This documentation refers to entar version 0.0.1 =head1 USAGE entar ... =head1 REQUIRED ARGUMENTS =over =item The name of the tar file you wish to be created. It must end in C<.tar>, C<.tar.gz>, or C<.tar.gz.uu> =item ... The names of one or more files to be incorporated in the tar file. =back =head1 DIAGNOSTICS None =head1 CONFIGURATION AND ENVIRONMENT Requires no configuration files or environment variables. =head1 DEPENDENCIES Requires the C and C modules. Requires system utilities: C, C, C, and C. =head1 BUGS None reported. Bug reports and other feedback are most welcome. =head1 AUTHOR Damian Conway C<< DCONWAY@cpan.org >> =head1 COPYRIGHT Copyright (c) 2007, Damian Conway C<< >>. All rights reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. handy_scripts/findword0000744000076500007650000000043511071035263014746 0ustar damiandamian#!/usr/local/bin/perl -w my $DICT = "/usr/share/dict/words"; $pat = shift or die "Usage: $0 ''\n"; print {*STDERR} "...$pat\n\n"; open my $DICT_FH, $DICT or die "Can't open dictionary file: $!\n"; use IO::Page; while (<$DICT_FH>) { /$pat/o and print; } handy_scripts/ruler0000744000076500007650000000114211071035263014257 0ustar damiandamian#! /usr/local/bin/perl -w # Usage: $0 [] [] my $max = shift || 80; my $lines = shift; my @prev = ("")x3; # Rotate digits of numbers horizontally into three arrays... for my $n (1..$max) { @digits = split //, sprintf "%3s", $n; $ruler[$_] .= $digits[$_] eq $prev[$_] ? " " : ($prev[$_]=$digits[$_]) for 0..2; } # Join each array to generate string of digits... print join("\n", @ruler, ""), "-"x$max, "\n"; exit unless $lines; # If height also requested, generate rows of line numbers... my $len = length($lines); if (defined $lines) { printf "%${max}s|%s\n"," ", $_ for 1..$lines; } handy_scripts/uniq0000744000076500007650000000332611071035263014110 0ustar damiandamian#! /opt/local/bin/perl5.10.0 use v5.10; use warnings; # Defaults... BEGIN { $in = '-'; $out = '-'; $reps = 0; } use Getopt::Declare <<'EOARGS'; -c Count how many times each line is repeated { $::count=1 } -d Output only duplicated lines { $::reps=2 } -u Output only unrepeated lines { $::reps=1 } [mutex: -d -u] -f Skip first N fields when comparing { $::fields = $N } -s Skip first N chars when comparing { $::chars = $N } -w Ignore differences in whitespace { $::ws = 1 } Input file { $::in = $in } Output file { $::out = $out } EOARGS # Acquire I/O streams open IN, "<$in" or die "Can't open input file '$in': $!\n"; open OUT, ">$out" or die "Can't open output file '$out': $!\n"; # Work out what to ignore... my $skip = ""; $skip .= "(?:\\s*\\S+\\s+){$fields}" if $fields; $skip .= ".{$chars}" if $chars; my $maxcount = 0; # Acquire and remember lines... while () { push @lines, $_; # Standardize whitespace if whitespace to be ignored... if ($ws) { s/[^\S\n]+/ /g; s/^ | $//g; } # Match and count each line, skipping whatever... /$skip(.*)/o; $count{$1}++; $maxcount = $count{$1} if $maxcount < $count{$1}; } my $format = $count ? "%0".length($maxcount)."s %s" : "%n%s"; my %seen; my $reprange = $reps==2 ? sub { $count{$_[0]} >= 2 } : $reps==1 ? sub { $count{$_[0]} == 1 } : sub { 1 }; # Process the lines, as requested... print OUT map { sprintf $format, $count{$_->[0]}, $_->[1] } grep { $reprange->($_->[0]) && !$seen{$_->[0]}++ } map { my $orig = $_; if ($ws) { s/[^\S\n]+/ /g; s/^ | $//g; } /^$skip(.*)/o||/(.*)/; [$1,$orig] } @lines;