grinder's scratchpad

use File::Watch;

my $w = File::Watch->new(
    file => '/var/run/foo',
    open = sub {
        use YAML;
        return LoadFile( $_->[0] )
    }
};

my $data = $w->get;

while( 1 ) {
    # uses the same $data forever
    do_something( $data );
    sleep 10;
}

while( 1 ) {
    # may the same $data forever, unless /var/run/foo changes
    # during the process's lifetime
    do_something( $w->get );
    sleep 10;
}

[download]

#! /usr/local/bin/perl -w

use Regexp::Assemble;

my $re = Regexp::Assemble->new->add(
    10..374,
    376..379,
    382..385,
    388..499,
    530..534,
    541..543,
    618,
    619,
    700..704,
    707..709
);

% ./ra

(?:3(?:7[012346789]?|8[234589]?|0\d?|1\d?|2\d?|3\d?|4\d?|5\d?|6\d?|9\d
+?)|1(?:0\d?|1\d?|2\d?|3\d?|4\d?|5\d?|6\d?|7\d?|8\d?|9\d?)|2(?:0\d?|1\
+d?|2\d?|3\d?|4\d?|5\d?|6\d?|7\d?|8\d?|9\d?)|4(?:0\d?|1\d?|2\d?|3\d?|4
+\d?|5\d?|6\d?|7\d?|8\d?|9\d?)|5(?:[01256789]|3[01234]?|4[123]?)|7(?:[
+123456789]|0[01234789]?)|6(?:[023456789]|1[89]?)|8\d|9\d)
% ./ra | wc -c
     335

[download]

my $foo = [
  1,
  [2, 3],
  [4, [5, 6, 7]],
];

my $path = Thing->new($foo);
while( defined( my $p = $path->next )) {
    print join( ' ' => @$p ), "\n";
}

__PRDDUCES__

1 2 4 5
1 2 4 6
1 2 4 7
1 3 4 5
1 3 4 6
1 3 4 7

[download]

<head>
<script language="javascript">
function refresh_thumbs() {
   if (!document.images) return;
   var now = new Date();
   document.images['oleane-th'].src    = 'oleane-thumb.png?' + now.get
+Time();
   document.images['completel-th'].src = 'completel-thumb.png?' + now.
+getTime();
   setTimeout('refresh_thumbs()',5000);
}
</script>
</head>
<body onLoad=" setTimeout('refresh_thumbs()',5000)" bgcolor="#ffffff">
<img border="0" name="oleane-th" src="oleane-thumb.png"/><br />
<img border="0" name="completel-th" src="completel-thumb.png" />
</body></html>

[download]

#! /usr/bin/perl -w

use strict;
use DBI;
use constant DBI_AGR => 'dbi:Oracle:agrtest';

my $table = shift;

my $dbo = DBI->connect( DBI_AGR, 'foo', 'bar', {PrintError => 1} )
        or die "Couldn't connect to @{[DBI_AGR]}\n";

#foreach( $dbo->tables ) {
#       print "$_\n";
#}
#print "\n";

my $typeinfo = $dbo->type_info_all;;

my $tnames = shift @$typeinfo;
my %typenames;
foreach( %$tnames ) {
        $typenames{$tnames->{$_}} = $_;
        # print "$_ => $tnames->{$_}\n";
}

if( !defined $table ) {
        print join( "\t" => @typenames{sort {$a<=>$b} keys %typenames}
+ ), "\n";
        my $nr = 0;
        foreach my $ti( @$typeinfo ) {
                print $nr++;
                foreach my $t( @$ti ) {
                        print "\t", $t ? $t : 'undef';
                }
                print "\n";
        }
}

my $sth = $dbo->table_info;

while( my $d = $sth->fetchrow_hashref ) {

        if( defined $table ) {
                next unless uc $table eq uc $d->{TABLE_NAME};
        }
        print "$d->{TABLE_NAME}\t$d->{TABLE_TYPE}\n";
        my $sdump = $dbo->prepare( "select * from $d->{TABLE_NAME}" );
        if( $sdump->execute ) {
                my $names = $sdump->{NAME};
                my $types = $sdump->{TYPE};
                my $nr = $sdump->{NUM_OF_FIELDS};
                for( my $n = 0; $n < $nr; ++$n ) {
                        print "\t$n\t$names->[$n]\t$types->[$n]\n";
                }
        }
        $sdump->finish;
        print "\n";
}

[download]

my @friends = ("merlyn","nate", "vroom", "neshura", "chromatic", "seta
+ntae", "btrott","stephen","lhoward","ZZamboni","kudra","tilly","cogen
+t");
my $friend;
$friend ||= $friends[rand(@friends)];
$query->textfield("usersearch", $friend);

[download]

grinder's scratchpad

Better than Regex::PreSuf

Mystery package

Auto-refreshing an image (or two) in an HTML page

Scanning Oracle user tables

User search trickery

Using syslog

Murphy's law, the fitness of evolving species, and the limits of software reliability

A whole mess of Perl Monks links


Perl Monk, Perl Meditation
	PerlMonks