use strict;
use warnings;
my %codons;
my %aas;
my $previous_file = '';
while (<>) {
if ( $previous_file ne $ARGV ) {
open OUTPUT, '>', "$ARGV.aa"
or die "Can't open $ARGV.aa for writing: $!";
$previous_file = $ARGV;
}
tr/t/u/;
if ( exists $codons{$_} ) {
my $codon = $codons{$_};
if ( exists $aas{$codon} ) {
print OUTPUT $aas{$codon};
print $aas{$codon};
}
}
}
####
#!/opt/perl-5.10.0/bin/perl
use strict;
use warnings;
use feature ':5.10';
use Text::Table;
for ( my $width = 15; $width == 15; ++$width ) {
my $table = Text::Table->new;
my $nth = 0;
my $total = ( $width**2 - $width ) / 2;
for my $III ( 1 .. $width ) {
my @row = ('.') x $III;
for my $JJJ ( $III + 1 .. $width ) {
my $aha = $width + .5 - sqrt( 2 * ( $total - $nth ) );
my $row = int $aha;
my $col = $row + 1 + int( ( $aha - $row ) * ( $width - $row ) );
push @row, "${row}x$col";
++$nth;
}
$table->load( \@row );
}
say "${width}x$width\n$table";
}
####
. 1x2 1x3 1x4 1x5 1x6 1x7 1x8 1x9 1x10 1x11 1x12 1x13 1x14 1x15
. . 2x3 2x4 2x5 2x6 2x7 2x8 2x9 2x10 2x11 2x12 2x13 2x14 2x15
. . . 3x4 3x5 3x6 3x7 3x8 3x9 3x10 3x11 3x12 3x13 3x14 3x15
. . . . 4x5 4x6 4x7 4x8 4x9 4x10 4x11 4x12 4x13 4x14 4x15
. . . . . 5x6 5x7 5x8 5x9 5x10 5x11 5x12 5x13 5x14 5x15
. . . . . . 6x7 6x8 6x9 6x10 6x11 6x12 6x13 6x14 6x15
. . . . . . . 7x8 7x9 7x10 7x11 7x12 7x13 7x14 7x15
. . . . . . . . 8x9 8x10 8x11 8x12 8x13 8x14 8x15
. . . . . . . . . 9x10 9x11 9x12 9x13 9x14 9x15
. . . . . . . . . . 10x11 10x12 10x13 10x14 10x15
. . . . . . . . . . . 11x12 11x13 11x14 11x15
. . . . . . . . . . . . 12x13 12x14 12x15
. . . . . . . . . . . . . 13x14 13x15
. . . . . . . . . . . . . . 14x15
. . . . . . . . . . . . . . .
####
sub EVAL {
my ( $try, $catch ) = @_;
my( $ok, $e );
$ok = eval { $try->(); 1 };
$e = $@;
return 1 if $ok and not( defined( blessed( $e ) ) and $e );
return unless $catch;
$catch->( $e );
}
####
Welcome to SWI-Prolog (Multi-threaded, Version 5.6.14)
Copyright (c) 1990-2006 University of Amsterdam.
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to redistribute it under certain conditions.
Please visit http://www.swi-prolog.org for details.
For help, use ?- help(Topic). or ?- apropos(Word).
?- The_Question.
% ... 1,000,000 ............ 10,000,000 years later
%
% >> 42 << (last release gives the question)
####
package pragma;
use strict;
use warnings;
sub import {
my $pragma = shift @_;
$pragma = shift @_ if $pragma eq __PACKAGE__;
my $value = shift @_;
$^H{$pragma} = $value;
return;
}
sub unimport {
my $pragma = shift @_;
$pragma = shift @_ if $pragma eq __PACKAGE__;
delete $^H{$pragma} if exists $^H{$pragma};
return;
}
sub in_effect {
my $pragma = shift @_;
$pragma = shift @_ if $pragma eq __PACKAGE__;
return $^H{$pragma};
}
1;
####
use strict;
use warnings;
use constant CHROMOSOMES => 30;
use constant TARGET => scalar <>;
use constant TARGET_BITS => 8 * length TARGET;
use constant P_MUTATION => 0.5;
use constant OK_ENOUGH => 1; # Too much is just enough
sub say {
my $say = join '', @_;
$say =~ s/([^[:print:]])/sprintf '\x%02x', ord $1/ge;
print "$say\n";
}
# Birth.
my @population = map { random_chromosome() } 1 .. CHROMOSOMES;
my $result;
while ( not defined $result ) {
# Test the fitness of every chromosome.
my @fitness;
CHROMOSOME:
for my $chromosome ( @population ) {
my $fitness = fitness( $chromosome );
if ( $fitness >= OK_ENOUGH ) {
$result = $chromosome;
last CHROMOSOME;
}
push @fitness, $fitness;
}
my @order
= sort { $fitness[$b] <=> $fitness[$a] }
0 .. $#fitness;
say "$fitness[$order[0]]: $population[$order[0]]";
# Trial by foxes.
splice @order, @order / 3;
@population = @population[ @order ];
# Sex.
my @children
= map {
sex( @population ) }
1 .. CHROMOSOMES - @population;
push @population, @children;
}
say $result;
sub sex {
my @parents = @_;
my $child = '';
for ( 0 .. TARGET_BITS - 1 ) {
vec( $child, $_, 1 ) = vec( $parents[ rand @parents ], $_, 1 );
}
if ( P_MUTATION < rand ) {
my $bit = int rand TARGET_BITS;
vec( $child, $bit, 1 ) = not vec( $child, $bit, 1 );
}
return $child;
}
sub fitness {
my $chromosome = shift @_;
my $matches = 0;
for ( 0 .. TARGET_BITS - 1 ) {
$matches++ if vec( TARGET, $_, 1 ) == vec( $chromosome, $_, 1 );
}
my $fitness = $matches / TARGET_BITS;
return $fitness;
}
sub random_chromosome {
my $chromosome = '';
for ( 0 .. TARGET_BITS - 1 ) {
vec( $chromosome, $_, 1 ) = rand 2;
}
return $chromosome;
}
####
INIT {
# Print the code before __DATA__ and pretend nothing happened...
if ( defined fileno *main::DATA ) {
# Fetch code or abort...
eval {
my $pos = tell *main::DATA;
seek *main::DATA, 0, 0 or return;
my $code;
read *main::DATA, $code, $pos or return;
print $code or return;
};
}
}
####
while() {
print lc;
}
__DATA__
server database ADD_DT ENT_ID PMT_ID PMT_AM
KERMIT MISS_PIGGY Dec 22 2004 9:30AM 1304 21190 -30.81
KERMIT MISS_PIGGY Dec 22 2004 9:30AM 1314 21189 -358.46
KERMIT MISS_PIGGY Jan 12 2005 3:07PM 1096 21585 -495.72
KERMIT MISS_PIGGY Jan 12 2005 3:07PM 1096 21933 495.72
KERMIT MISS_PIGGY Jan 12 2005 3:07PM 1098 21586 -16.65
KERMIT MISS_PIGGY Mar 3 2005 6:34AM 985 22546 -496.36
KERMIT MISS_PIGGY Mar 3 2005 6:34AM 1003 22547 -841.17
KERMIT MISS_PIGGY Mar 9 2005 9:56AM 1005 22745 -110.53
####
(defun perl-other-buffer (script)
(interactive "bProgram:")
(let ((script-file (make-temp-file "perl-other-buffer")))
(save-excursion
(set-buffer (get-buffer script))
(write-region (point-min) (point-max) script-file))
(let ((ok (zerop
(shell-command-on-region
(point-min) (point-max)
(concat "perl -x " (shell-quote-argument script-file))))))
(delete-file script-file)
ok)))
####
use strict;
use WWW::Mechanize;
>> my $agent = WWW::Mechanize->new( autocheck => 1 );
> > $agent->get('http://cgi.darwinawards.com/cgi/random.pl');
> >> my $content = $agent->content( format => "text" );
| >my $cr = chr 169;
> |$content =~ s/.*\d\d\s+Urban Legend//s;
> |$content =~ s/.*\d\d\s+Personal Account//s;
> |$content =~ s/.*Reader Submission\s+Pending Acceptance//s;
> >$content =~ s/\s*DarwinAwards\.com\s*$cr.*//s;
> $content =~ s/.*?\([^\)]*?\d{2}[^\)]*\) //s;
> $content =~ s/.*Darwin\s?Award\s?Nominee//si;
> $content =~ s/.*Confirmed \S+\s?by Darwin//si;
> $content =~ s/.*Honorable Mentions//s;
> $content =~ s/submitted by.*//si;
> $content =~ s/109876543210.*//s;
> $content =~ s/^\s+//;
|
> print $content;
####
(defun b-xref ()
(interactive)
(fundamental-mode)
(save-excursion
(save-restriction
(widen)
(mapcar
'b-xref-do-jots
(b-xref-buffer (current-buffer)))))
nil)
(defvar b-xref-bin "perl")
(defvar b-xref-jot ">")
(defvar b-xref-fill "|")
(defvar b-xref-fill-space " ")
(require 'cl)
(defsubst min-list (list) (reduce 'min list))
(defsubst max-list (list) (reduce 'max list))
(defsubst line->point (line)
(goto-line line)
(point))
(defun b-xref-do-jots (pair)
"Make space for jots and call `b-xref-jot-line' to place them."
(string-rectangle (point-min)
(progn (goto-char (point-max))
(beginning-of-line)
(point))
b-xref-fill-space)
(let ((lines (cdr pair)))
(let ((min-line (min-list lines))
(max-line (max-list lines)))
(delete-rectangle (line->point min-line)
(+ 1 (line->point max-line)))
(string-rectangle (line->point min-line)
(line->point max-line)
b-xref-fill)
(mapcar 'b-xref-jot-line lines))))
(defun b-xref-jot-line (line)
"Jot a note on LINE."
(goto-char (line->point line))
(delete-char 1)
(insert b-xref-jot))
(defun b-xref-buffer (buffer)
"Runs a buffer through 'perl -MO=Xref,-raw' and returns the parsed data."
(save-excursion
(save-restriction
(set-buffer buffer)
(widen)
(goto-char (point-min))
(let ((perl (if (looking-at auto-mode-interpreter-regexp)
(match-string 2)
(or b-xref-bin "perl")))
(infile (if (buffer-modified-p)
(error "TODO: Copy modified buffer to temp file.")
(buffer-file-name)))
(buffer (generate-new-buffer "*b-xref-raw*")))
(let ((rc (call-process perl infile buffer nil "-MO=Xref,-raw")))
(or (zerop rc)
(error "%s exited with %d" perl rc)))
(let ((xref-output (b-xref-read-raw buffer "-")))
(kill-buffer buffer)
xref-output)))))
(defun b-xref-list-> (a b)
"Sorts a list so larger numbers go first, then shorter lists."
(if (and (numberp (car a))
(numberp (car b)))
(or (> (car a) (car b))
(and (= (car a) (car b))
(b-xref-list-> (cdr a) (cdr b))))
(and (null a)
(not (null b)))))
(defun b-xref-alist-> (a b)
"Sorts the elements of an alist with `b-xref-list->'"
(b-xref-list-> (cdr a) (cdr b)))
(defun trim (str) (rtrim (ltrim str)))
(defun ltrim (str) (replace-regexp-in-string "^ +" "" str))
(defun rtrim (str) (replace-regexp-in-string " +$" "" str))
(defun b-xref-read-raw (buffer filename)
"Reads the output from 'perl -MO=Xref,-raw'."
(save-excursion
(save-restriction
(set-buffer buffer)
(widen)
(goto-char (point-min))
(let ((xref-regexp (concat "^"
(regexp-quote filename)
(let ((pad (- 16 (length filename))))
(if (> pad 0)
(make-string pad ? )
""))
" ............[^ \n]*"
" \\(.....[^ \n]*\\)"
" \\(............[^ \n]*\\)"
" ....[^ \n]*"
" \\(................[^ \n]*\\)"
" \\([^\n]+\\)\n"))
(xref-output ()))
(while (re-search-forward xref-regexp nil t)
(or (bolp) (forward-line))
(let ((line (string-to-number (trim (match-string 1))))
(pack (trim (match-string 2)))
(name (trim (match-string 3))))
(if (zerop line)
nil
(let ((key (list pack name)))
(let ((pair (assoc key xref-output)))
(if pair
(let ((lines (cdr pair)))
(or (member line lines)
(nconc lines (list line))))
(push (cons key (list line)) xref-output)))))))
(sort xref-output 'b-xref-alist->)))))
####
use Regexp::Common 'number';
my $NUMBER = "(?x:
\\( \\$? (?: $RE{num}{real}
| $RE{num}{int}
| $RE{num}{real}{-sep => ','}{-group => 3}
| $RE{num}{int} {-sep => ','}{-group => 3} ) \\)
| \\$? -? (?: $RE{num}{real}
| $RE{num}{int}
| $RE{num}{real}{-sep => ','}{-group => 3}
| $RE{num}{int} {-sep => ','}{-group => 3} )
)";
####
### Installing the multi-method hook.
*$method_name = sub {
my ($self) = shift;
if (wantarray) {
return map $self->$_(@_), @$methods_to_call;
}
elsif ( defined wantarray ) {
return join( ' ', map $_->$_(@_), @$methods_to_call );
}
else {
$self->$_(@_) for @$methods_to_call;
return;
}
};
### Installing the multi-method hook.
eval 'sub $method_name {
my ($self) = shift;
my @results;
if (wantarray) {
' . join( '', map "#line $_->{line} \"$_->{filename}\"
push \@results, \$self->\$methods_to_call[$_->{index}]( \@_ );
" ) . '#line ' . __LINE__ . ' "' . __FILE__ . '"
return @results;
}
elsif ( defined wantarray ) {
' . join( '', map "#line $_->{line} \"$_->{filename}\"
push \@results, \$self->\$methods_to_call[$_->{index}]( \@_ );
" ) . '#line ' . __LINE__ . ' "' . __FILE__ .'"
return join( " ", @results );
}
else {
' . join( '', map "#line $_->{line} \"$_->{filename}\"
\$self->\$methods_to_call[$_->{index}]( \@_ );
" ) . '#line ' . __LINE__ . ' "' . __FILE__ .'"
return join( " ", @results );
}
}';
####
sub ideal
# Everything must be declared before use or at definition
while INPUT
$accumulator .= $obj->do_something( $_ )
return $result
sub reality
# Allow the use of things prior to declaring or defining them: one pass
# looks for all declarations and the next pass proceeds as normal.
@input = INPUT
$obj->examine( @input )
while @input
$accumulator .= $obj->do_something( $_ )
return $result
sub surreality
# Just like reality() except that post-facto declarations might change
# how previous results in $accumulator occurred.
while INPUT
$accumulator .= $obj->do_something( $_ )
return $result
####
use IO::Socket;
my $ticker = IO::Socket::INET->new( PeerAddr => 'web6...',
PeerPort => 8081 );
while ( my $msg = read_record( $ticker ) ) {
print "$msg->{msgtext}\n";
}
sub read_record {
# Reads a single record from the streaming ticker
my $sock = shift;
local $/ = "";
my %record =
map( /^([^=]+)=?([^\r\n]*)/
? ( $1, $2 )
: (),
readline( $sock ) =~ /([^\r\n]+)/g );
for ( values %record ) {
s/\\\\/\\/g;
s/\\\r/\r/g;
s/\\\n/\n/g;
}
}
####
CX=0
package=BAR
filename=aaa.pl
line=2
subroutine=(eval)
hasargs=0
wantarray=0
evaltext=bbb.pm
is_require=1
hints=0
bitmask=\000\000\000\000\000\000\000\000\000\000\000\000
CX=1
package=main
filename=bbb.pm
line=0
subroutine=BAR::BEGIN
hasargs=1
wantarray=0
evaltext=undef
is_require=undef
hints=0
bitmask=\000\000\000\000\000\000\000\000\000\000\000\000
ARGS=
CX=2
package=main
filename=bbb.pm
line=0
subroutine=(eval)
hasargs=0
wantarray=0
evaltext=undef
is_require=undef
hints=0
bitmask=\000\000\000\000\000\000\000\000\000\000\000\000
####
package BAR;
use bbb;
####
package bbb;
use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Indent = 0;
my @params = qw( package filename line subroutine hasargs
wantarray evaltext is_require hints bitmask );
for ( my $cx = 0;
caller $cx;
++ $cx ) {
my %caller;
@caller{@params}
= map +( defined() ? $_ : 'undef' ),
do { package DB; # see perldebguts for this magic.
caller $cx };
print( "CX=$cx\n",
join( '',
map " $_=$caller{$_}\n",
@params ),
$caller{hasargs} ? " ARGS=" . Dumper( @DB::args ) . "\n" : () );
}
1;
####
package Text::Table::Squish;
use strict;
use warnings;
use Exporter;
use vars qw( @EXPORT_OK %EXPORT_TAGS );
use subs qw( transpose squishtable );
BEGIN {
*import = \&Exporter::import;
@EXPORT_OK = qw( squishtable squishtable_emacs squishtable_sql squishtable_spaces squishtable_dwim );
%EXPORT_TAGS = ( all => \ @EXPORT_OK );
}
use Algorithm::Loops qw( MapCarU Filter );
sub squishtable_dwim {
# Attempts to squish on anything potentially reasonable.
# 1 |22 |333 |4444
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
squishtable $_[0],
"^([^\\w\r\n])\\1+[\r\n]+",
"^ +[\r\n]+";
}
sub squishtable_emacs {
# Squishes emacs tables.
# +---+---+---+
# | | | |
# +---+---+---+
# | | | |
# +---+---+---+
squishtable $_[0],
"^\\+(?:\\|\\+)+[\r\n]+",
"^-(?: -)+[\r\n]+";
}
sub squishtable_sql {
# 1 |22 |333 |4444
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
# . |.. |... |....
squishtable $_[0],
"^\\|+[\r\n]+",
"^ +[\r\n]+";
}
sub squishtable_spaces {
# Squishes to space delimited columns. Stuff that was printed in fixed width columns is also handled here.
# 1 22 333 4444
# . .. ... ....
# . .. ... ....
# . .. ... ....
# . .. ... ....
# . .. ... ....
# . .. ... ....
squishtable $_[0],
"^ +[\r\n]+",
"^ +[\r\n]+",
}
my %CompiledPatterns;
sub squishtable {
# Removes extra trailing space at the end of columns in a
# table.
my ( $table, $column_separator, $empty_column ) = @_;
if ( not( defined $column_separator
and defined $empty_column ) ) {
# If I was not given a spec to squish by, use dwimmery to get what I want.
$column_separator = "^([^\\w\r\n])\\1+[\r\n]+";
$empty_column = "^ +[\r\n]+";
}
# Compile and cache this pattern.
my $pattern = "(?m)(?:$empty_column)+(?=$column_separator)";
$pattern = $CompiledPatterns{$pattern} || qr/$pattern/m;
return
transpose
Filter { s/$pattern//mg }
transpose
$table;
}
sub transpose {
my ( $table ) = @_;
return join( '',
map join( '', @$_ ) . "\n",
MapCarU( sub { [@_] },
map( [ split // ],
split( /[\r\n]+/, $table ) ) ) );
}
1;
__END__
=head1 NAME
=head1 DESCRIPTION
=head1 SYNOPSIS
=head1 FUNCTIONS
=over 4
=item $table = squishtable( $table )
=item $table = squishtable_dwim( $table )
=item $table = squishtable_spaces( $table )
=item $table = squishtable_sql( $table )
=item $table = squishtable_emacs( $table )
=item $table = squishtable( $table, $column_separator, $empty_column )
=back
=cut
####
/* Comfortable editing regions */
textarea { width: 100%; height: 25em; }
/* Form-fit everything to even-more dark than darktheme */
* {
color: white !important;
background-color: black !important;
FONT-FAMILY: sans-serif;
FONT-SIZE: 13px;
FONT-WEIGHT: normal;
}
a { text-decoration: underline; }
a:link { background-color: #000; }
a:visited { background-color: #131; }
form { display: inline; }
pre { font-family: monospace; }
tt * {
font-family: monospace;
color: green !important;
}
/* NodeReaper in small caps */
.chatfrom_52855 { font-variant: small-caps; }
.borgism { font-variant: small-caps; }
/* Hide all signatures - ugly things */
.pmsig { display: none; }
/* Anonymize all notes */
.attribution { display: none; }
/* Shun Anonymous Monk */
/* .pmnote-961 { display: none; } */
/* Shun Wassercrats */
.pmnote-152520 { display: none; }
/* pmdev code */
nodelet.new-patch { font-weight: twinkling; }
.diff_inserted {
font-family: monospace;
color: green !important;
}
.diff_deleted {
font-family: monospace;
color: green !important ;
text-decoration: strikethrough !important;
}
.diff_match {
font-family: monospace;
}
####
#!/usr/bin/perl
main( @ARGV );
exit;
sub main {
$DEBUG = grep /-d/, @ARGV;
my $user = ( scalar grep !/^-/,
@ARGV )
? ( ( grep !/^-/, @ARGV )[0] )
: $ENV{'USER'};
my $ps = user_ps( $user );
unlink "/home/$user/.gnome/session";
my @to_kill;
do {
for ( [ zombies => sub { grep $_->{'status'} =~ /Z/, @_ } ],
[ firefox => sub { grep $_->{'command'} =~ /firefox/, @_ } ] ) {
my ( $name, $filter ) = @$_;
@to_kill = $filter->( @$ps );
killall( \ @to_kill, $ps );
}
} until not @to_kill;
1;
}
sub killall {
my @to_find = @{ shift() };
my @ps = @{ shift() };
my %pids;
my %rel;
for ( @ps ) {
$pids{$->{'pid'}} = 1;
$rel{$_->{'pid' }}{$_->{'ppid'}} = 1;
$rel{$_->{'ppid'}}{$_->{'pid' }} = 1;
}
my %seen;
my @to_kill = map $_->{pid}, @to_find;
{
my $changed = 0;
do {
my @n = grep !$seen{$_}++,
grep $pids{$_},
map keys(%$_),
grep ref(),
delete @rel{ @to_kill };
push @to_kill, @n;
$changed = scalar @n;
} while $changed;
}
for my $sig ( qw[ INT TERM KILL ] ) {
if ( @to_kill ) {
my $cmd = "kill -$sig @to_kill";
if ( $DEBUG ) {
print STDERR "$cmd\n";
}
system $cmd;
@to_kill = grep kill(0,$_), @to_kill;
}
if ( @to_kill ) {
sleep 5;
}
}
return 1;
}
sub all_user_ps {
[ map { ! /(\S+)\s+(\S+)\s+(\S+)\s+(.+)/
? ()
: +{ pid => $1,
ppid => $2,
status => $3,
command => $4 } }
split /[\r\n]+/,
`ps a
}
sub user_ps {
my $user = shift;
[ map { ! /(\S+)\s+(\S+)\s+(\S+)\s+(.+)/
? ()
: +{ pid => $1,
ppid => $2,
status => $3,
command => $4 } }
split /[\r\n]+/,
`ps -U $user -o pid=,ppid=,s=,comm= --sort=pid,ppid` ];
}
####
#!/home/josh/perl5.8.3/bin/perl use strict;
use warnings;
use DBI;
use MatchDB qw(add_source match);
# Cam Gordon's city council campaign db
add_source( name => 'camgordon',
dbh => DBI->connect('DBI:CSV:'),
table => 'camgordon.csv',
id => sub { join( ' ',
@{$_[0]}{qw( id
no_sos )} ) },
map => [ [ qw[FIRST_NAME first_name] ],
[ qw[LAST_NAME last_name] ],
[ qw[HOUSE_NUMBER house_number] ],
[ STREET_NAME =>
sub { join( ' ',
@{$_[0]}{qw( street_name
street_type
street_direction )} ) } ],
[ qw[CITY city] ] ] );
# Green Party of Minnesota
add_source( name => 'gpm',
dbh => DBI->connect('dbi:Pg:dbname=gpm'),
table => 'contacts',
id => 'contact_id',
map => [ [ qw[FIRST_NAME first_name] ],
[ qw[LAST_NAME last_name] ],
[ qw[HOUSE_NUMBER house_number] ],
[ qw[STREET_NAME address] ],
[ qw[CITY city] ] ] );
# ACORN member roster
add_source( name => 'acorn',
dbh => DBI->connect('dbi:Pg:dbname=acorn'),
table => 'acorn',
id => 'id',
map => [ [ qw[FIRST_NAME first_name] ],
[ qw[LAST_NAME last_name] ],
[ qw[HOUSE_NUMBER house_number] ],
[ qw[STREET_NAME street_name] ],
[ qw[CITY city] ] ] );
# State of Minnesota voter roster
add_source( name => 'sosvr',
dbh => DBI->connect('dbi:Pg:dbname=sosvr'),
table => 'roster',
id => 'id_gnumber',
map => [ [ qw[FIRST_NAME first_gname] ],
[ qw[LAST_NAME last_gname] ],
[ qw[HOUSE_NUMBER house_g] ],
[ qw[STREET_NAME street_gname] ],
[ qw[CITY city] ] ] );
match( qw[HOUSE_NUMBER ==] );
####
my $keys = '('
. join( '|',
map quotemata(),
( 'R&R Part',
'In Process',
'On Hand (05)',
'Loan Qty',
'Back Order Qty (14)',
'Ord Resvd',
'Min Qty' ) )
. ')';
my %matches = $input =~
/$keys.+?\e\[[\d;]*m\s*(\d+)/sig;
####
library(RODBC)
pm <- odbcConnect("perlmonks")
nodes.all <- list(Su00=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 0 AND EXTRACT('year'
FROM createtime) = 2000 GROUP BY createtime::date) AS o"),
Su01=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 0 AND EXTRACT('year'
FROM createtime) = 2001 GROUP BY createtime::date) AS o"),
Su02=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 0 AND EXTRACT('year'
FROM createtime) = 2002 GROUP BY createtime::date) AS o"),
Su03=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 0 AND EXTRACT('year'
FROM createtime) = 2003 GROUP BY createtime::date) AS o"),
Su04=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 0 AND EXTRACT('year'
FROM createtime) = 2004 GROUP BY createtime::date) AS o"),
Mo00=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 1 AND EXTRACT('year'
FROM createtime) = 2000 GROUP BY createtime::date) AS o"),
Mo01=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 1 AND EXTRACT('year'
FROM createtime) = 2001 GROUP BY createtime::date) AS o"),
Mo02=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 1 AND EXTRACT('year'
FROM createtime) = 2002 GROUP BY createtime::date) AS o"),
Mo03=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 1 AND EXTRACT('year'
FROM createtime) = 2003 GROUP BY createtime::date) AS o"),
Mo04=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 1 AND EXTRACT('year'
FROM createtime) = 2004 GROUP BY createtime::date) AS o"),
Tu00=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 2 AND EXTRACT('year'
FROM createtime) = 2000 GROUP BY createtime::date) AS o"),
Tu01=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 2 AND EXTRACT('year'
FROM createtime) = 2001 GROUP BY createtime::date) AS o"),
Tu02=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 2 AND EXTRACT('year'
FROM createtime) = 2002 GROUP BY createtime::date) AS o"),
Tu03=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 2 AND EXTRACT('year'
FROM createtime) = 2003 GROUP BY createtime::date) AS o"),
Tu04=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 2 AND EXTRACT('year'
FROM createtime) = 2004 GROUP BY createtime::date) AS o"),
We00=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 3 AND EXTRACT('year'
FROM createtime) = 2000 GROUP BY createtime::date) AS o"),
We01=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 3 AND EXTRACT('year'
FROM createtime) = 2001 GROUP BY createtime::date) AS o"),
We02=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 3 AND EXTRACT('year'
FROM createtime) = 2002 GROUP BY createtime::date) AS o"),
We03=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 3 AND EXTRACT('year'
FROM createtime) = 2003 GROUP BY createtime::date) AS o"),
We04=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 3 AND EXTRACT('year'
FROM createtime) = 2004 GROUP BY createtime::date) AS o"),
Th00=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 4 AND EXTRACT('year'
FROM createtime) = 2000 GROUP BY createtime::date) AS o"),
Th01=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 4 AND EXTRACT('year'
FROM createtime) = 2001 GROUP BY createtime::date) AS o"),
Th02=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 4 AND EXTRACT('year'
FROM createtime) = 2002 GROUP BY createtime::date) AS o"),
Th03=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 4 AND EXTRACT('year'
FROM createtime) = 2003 GROUP BY createtime::date) AS o"),
Th04=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 4 AND EXTRACT('year'
FROM createtime) = 2004 GROUP BY createtime::date) AS o"),
Fr00=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 5 AND EXTRACT('year'
FROM createtime) = 2000 GROUP BY createtime::date) AS o"),
Fr01=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 5 AND EXTRACT('year'
FROM createtime) = 2001 GROUP BY createtime::date) AS o"),
Fr02=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 5 AND EXTRACT('year'
FROM createtime) = 2002 GROUP BY createtime::date) AS o"),
Fr03=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 5 AND EXTRACT('year'
FROM createtime) = 2003 GROUP BY createtime::date) AS o"),
Fr04=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 5 AND EXTRACT('year'
FROM createtime) = 2004 GROUP BY createtime::date) AS o"),
Sa00=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 6 AND EXTRACT('year'
FROM createtime) = 2000 GROUP BY createtime::date) AS o"),
Sa01=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 6 AND EXTRACT('year'
FROM createtime) = 2001 GROUP BY createtime::date) AS o"),
Sa02=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 6 AND EXTRACT('year'
FROM createtime) = 2002 GROUP BY createtime::date) AS o"),
Sa03=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 6 AND EXTRACT('year'
FROM createtime) = 2003 GROUP BY createtime::date) AS o"),
Sa04=sqlQuery(pm,"SELECT count FROM
(SELECT createtime::date, count(*) FROM node_times WHERE
EXTRACT('dow' FROM createtime::date) = 6 AND EXTRACT('year'
FROM createtime) = 2004 GROUP BY createtime::date) AS o"))
boxplot(nodes_all)