[Tue Mar 27 11:33:03 2007] testcore.cgi: install_driver(Oracle) failed: Can't load '/usr/people/chemboy/lib/perl5/site_perl/5.8.1/i586-linux-thread-multi/auto/DBD/Oracle/Oracle.so' for module DBD::Oracle: libclntsh.so.9.0: cannot open shared object file: No such file or directory at /usr/lib/perl5/5.8.1/i586-linux-thread-multi/DynaLoader.pm line 229.
[Tue Mar 27 11:33:03 2007] testcore.cgi: at (eval 27) line 3
[Tue Mar 27 11:33:03 2007] testcore.cgi: Compilation failed in require at (eval 27) line 3.
[Tue Mar 27 11:33:03 2007] testcore.cgi: Perhaps a required shared library or dll isn't installed where expected
####
merge into some_table OLD
using ( select ? "A", ? "B", ? "C", ? "D" from dual ) NEW
on (OLD.A = NEW.A and OLD.B = NEW.B)
when matched then update set
calc_date = sysdate,
C = NEW.C,
D = NEW.D
when not matched then
insert(A,B,C,D,calc_date)
values(NEW.A,NEW.B,NEW.C,NEW.D,sysdate)
####
package AutoRequire;
use 5.006;
use strict;
no strict 'refs';
use warnings;
our $VERSION = substr q$Revision: 1.0$, 9;
my %loadable;
our $AUTOLOAD;
sub import {
my $self = shift;
foreach (@_) {
my $PACKAGE = $_;
$DB::single=1;
(my $pfile = "$PACKAGE.pm") =~ s#::#/#g;
$loadable{$PACKAGE} = 1;
my $full_auto = $PACKAGE . "::AUTOLOAD";
*{$full_auto} = sub {
my $subname = $AUTOLOAD;
my ($pkg,$sub) = $AUTOLOAD =~ /
^ ( \w+ (?: :: \w+)* ) :: ( \w+ ) \z
/x;
if ( delete $loadable{$PACKAGE} ) {
require $pfile;
# commenting out this line removes the segfault
delete ${$PACKAGE."::"}{AUTOLOAD};
if ($PACKAGE eq $pkg) {
print STDERR "This is the branch we execute\n";
goto &$subname;
}
}
}
}
}
1;
####
package SimpleCase;
our @ISA; # not explicitly set
sub new {
return "This is a very simple case";
}
1;
####
#!/usr/local/bin/perl
use lib '.';
use AutoRequire 'SimpleCase';
print STDERR "Still alive...\n";
my $var = SimpleCase->new;
print STDERR "We never get here\n";
####
sub findMagicname {
my @userids = @_;
my ($sth, $dbh,@ret);
$dbh=DBI->connect_cached('DBI:ODBC:CHDDB', 'someid', 'somepass', {RaiseError =>1, PrintError =>0, ShowErrorStatement =>0});
$sth = $dbh->prepare_cached( "SELECT [Last Name] AS Last, [First Name] AS First FROM _SMDBA_.[Support Staff] WHERE [Login ID]=?",{ChopBlanks=>1} );
foreach my $userid (@userids) {
$sth->execute($userid);
my $row = $sth->fetchrow_hashref;
push @ret, "$row->{First} $row->{Last}";
$sth->finish();
}
wantarray ? @ret : $ret[0]
}
sub findMagicname {
my @userids = @_;
my ($sth, $dbh);
#$userid = "l373l8";
$dbh=DBI->connect_cached('DBI:ODBC:CHDDB', 'someid', 'somepass', {RaiseError =>1, PrintError =>0, ShowErrorStatement =>0});
$sth = $dbh->prepare_cached( "SELECT [Last Name] AS Last, [First Name] AS First FROM _SMDBA_.[Support Staff] WHERE [Login ID]=?", {'ChopBlanks' => 1 } );
$sth->execute($userid);
$sth->; #----Removes extra spaces from fixed char fields. See netTools_help.doc.
my $row = $sth->fetchrow_hashref;
$sth->finish();
return $row->{First}. " " .$row->{Last};
}
####
install_unique_constructor($new_child_class,"id");
sub install_unique_constructor {
no strict 'refs';
my ($unique,$class) = @_;
$class ||= caller;
my %singleton;
eval "package $class;" . q|
sub new {
my $class = shift;
# this behavior should be consistent:
my %args = 1 == @_ ? (id=>@_) : @_;
my $key = $args{$unique};
my $self = $singleton{$key};
unless ( $self ) {
$self = $class->SUPER::new(@_);
$singleton{$key} = $self;
}
return $self;
};
1;
|;
}
####
sub scalar_install {
no strict 'refs';
my ($class,$field) = @_;
my %closed;
*{$class . "::$field" } = sub {
my $self = shift;
if (@_) {
$closed{$self} = $_[0];
} else {
$closed{$self}
}
};
1;
}
####
function wwwEncodeObject(o) {
var params = new Array();
for (var f in o) {
var fieldname = escape(f).replace(/\+/g,'%2B');
var value = o[f];
switch(typeof(value)) {
case 'string':
case 'number':
params.push(fieldname + "=" + escape(value).replace(/\+/g,'%2B'));
break;
case 'boolean':
params.push(fieldname + (value ? "=1" : "="));
break;
case 'object':
//Handle arrays logically. Other objects, die
if(value.constructor != Array) throw("Can't handle non-Array objects");
for (var i = 0; i < value.length; i++)
params.push(fieldname + "=" + escape(value[i]).replace(/\+/g,'%2B'));
}
}
return params.join('&')
}
####
mysql> select count(1) from foo where remote in (select remote from bar);
+----------+
| count(1) |
+----------+
| 5750 |
+----------+
1 row in set (0.30 sec)
mysql> select count(1) from foo ;
+----------+
| count(1) |
+----------+
| 94587 |
+----------+
1 row in set (0.01 sec)
mysql> select count(1) from foo where remote not in (select remote from bar);
+----------+
| count(1) |
+----------+
| 56 |
+----------+
1 row in set (0.45 sec)
####
####
$tmpl->param(ROWS =>
[ map +{key =>$_, value => $data{$_} }, keys %data ]
)
####
require subs;
my @autogen = qw(Foo Bar Trope Cliche);
foreach my $thing (@autogen) {
my @subs = map "$_$thing", qw(High Low Middle);
push @EXPORT_OK, @subs;
subs->import(@subs);
}
sub AUTOLOAD {
if ($AUTOLOAD =~ /@{[__PACKAGE__]}::(High|Low|Middle)(\w+)$/
and grep($2 eq $_, @autogen) ) {
my $sub = $dispatch{$1};
my $thing = $2;
*$AUTOLOAD = sub {
$sub->(thing => $thing, args => [@_])
};
goto &$AUTOLOAD;
} else {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD;
}
}
####
$query = $ENV{QUERY_STRING};
if (defined($query) && $query ne '') {
foreach (split (/&/, $query)) { #change to /[&;]/, right?
y/+/ /;
s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
#change above to chr hex $1?
if (/(\S+)=(.*)/) { # change \S to [^=], I'd say
$input{$1} = $2 if ($2 ne ""); #and what if it is?
} else {
$input{$_}++;
}
}
}
####
while (<>) {
push @input, lc =~ /[a-z]/g;
while ( @input > 1 ) {
my ($let1,$let2) = splice @input,0,2;
if ($let2 eq $let1) {
unshift @input, $let2;
$let2 = ($let2 eq 'x') ? 'z': 'x';
}
push @output, transcribe ($let1,$let2);
}
}
if (@input) {
push @output, transcribe ($input[0],($input[0] eq 'x') ? 'z': 'x');
}
####
package Crash;
use 5.006;
use strict;
use warnings;
use Carp;
use overload
'0+' => sub {$_[0]},
'""' => sub {my $self = shift; ref ($self).' => '.$self->getPK},
eq => sub { ref $_[1] eq ref $_[0] ? $_[0] == $_[1] : "$_[0]" eq "$_[1]" },
fallback => 1;
sub new {bless {}, __PACKAGE__}
sub getPK {"Fred"}
1;
####
% perl -MCrash -de1
Default die handler restored.
Loading DB routines from perl5db.pl version 1.07
Editor support available.
Enter h or `h h' for help, or `man perldebug' for more help.
main::(-e:1): 1
DB<1> $a = Crash->new
DB<2> $b = Crash->new
DB<3> s $a eq $b
main::((eval 6)[/usr/local/lib/perl5/5.6.1/perl5db.pl:1521]:3):
3: $a eq $b;
DB<<4>> s
Crash::CODE(0x1021d1b8)(Crash.pm:11):
11: eq => sub { ref $_[1] eq ref $_[0] ? $_[0] == $_[1] : "$_[0]" eq "$_[1]" },
DB<<4>> x $_
Signal BUS at /usr/local/lib/perl5/5.6.1/perl5db.pl line 1399
DB::DB called at Crash.pm line 11
Crash::__ANON__[Crash.pm:11]('Crash => Fred', 'Crash => Fred', '') called at (eval 6)[/usr/local/lib/perl5/5.6.1/perl5db.pl:1521] line 3
eval '($@, $!, $^E, $,, $/, $\\, $^W) = @saved;package main; $^D = $^D | $DB::db_stop;
$DB::single = 1;
$a eq $b;
;' called at /usr/local/lib/perl5/5.6.1/perl5db.pl line 1521
DB::eval called at /usr/local/lib/perl5/5.6.1/perl5db.pl line 1399
DB::DB called at -e line 1
Abort
####
tulip.c:v0.91 4/14/99
eth0: Digital DS21140 Tulip rev 18 at 0xd000, 00:00:C0:31:35:E4, IRQ 12.
eth0: Old format EEPROM on `SMC9332DST` board. Using substitute media control info.
eth0: EEPROM default media type Autosense.
eth0: Index #0 - Media 10baseT (#0) described by a 21140 non-MII (0) block.
eth0: Index #1 - Media 100baseTx (#3) described by a 21140 non-MII (0)
####
Linux Tulip driver version 0.9.15-pre7 (Oct 2, 2001)
PCI: Enabling device 00:0e.0 (0004->0007)
tulip0: Old format EEPROM on 'Asante' board. Using substitute media control info.
eth0: Digital DS21140 Tulip rev 32 at 0xcb937000, , IRQ 24.
####
DB<45> T
$ = XML::ValidWriter::_self called from file `site_perl/XML/ValidWriter.pm' line 1232
$ = XML::ValidWriter::setDoctype(ref(XML::ValidWriter), ref(XML::Doctype)) called from file `site_perl/XML/ValidWriter.pm' line 518
$ = XML::ValidWriter::import('XML::ValidWriter', ':all', ':dtd_tags') called from file `scratch/validwriter_fun' line 18
####
sub setDoctype {
my XML::ValidWriter $self = &_self ;
$self->{DOCTYPE} = shift if @_ ;
return ;
}
sub _self {
## MUST be called as C< &_self ;>
## If it's a reference to anything but a plain old hash, then the
## first param is either an XML::ValidWriter, a reference to a glob
## a reference to a SCALAR, or a reference to an IO::Handle.
return shift if ( @_ && ref $_[0] && isa( $_[0], 'XML::ValidWriter' ) ) ;
my $callpkg = caller(1) ;
croak "No default XML::ValidWriter declared for package '$callpkg'"
unless $pkg_writers{$callpkg} ;
return $pkg_writers{$callpkg} ;
}
####
Benchmarks for method 1:
total: 347 secs (315.12 usr 0.86 sys = 315.98 cpu)
overhead: 0 secs ( 0.00 usr 0.00 sys = 0.00 cpu)
loop: 347 secs (315.12 usr 0.86 sys = 315.98 cpu)
Benchmarks for method 2:
total: 178 secs (166.28 usr 0.65 sys = 166.93 cpu)
overhead: 1 secs ( 0.17 usr 0.01 sys = 0.18 cpu)
loop: 177 secs (166.11 usr 0.64 sys = 166.75 cpu)
Benchmarks for method 3:
total: 157 secs (148.77 usr 0.86 sys = 149.63 cpu)
overhead: 31 secs (29.17 usr 0.36 sys = 29.53 cpu)
loop: 126 secs (119.60 usr 0.50 sys = 120.10 cpu)
Benchmarks for method 4:
total: 95 secs (84.78 usr 0.57 sys = 85.35 cpu)
overhead: 14 secs (13.68 usr 0.16 sys = 13.84 cpu)
loop: 81 secs (71.10 usr 0.41 sys = 71.51 cpu)
####
Benchmarks for method 1:
total: 64 wallclock secs (60.37 usr + 1.82 sys = 62.19 CPU)
overhead: 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)
loop: 64 wallclock secs (60.37 usr + 1.82 sys = 62.19 CPU)
Benchmarks for method 2:
total: 45 wallclock secs (42.75 usr + 1.36 sys = 44.11 CPU)
overhead: 0 wallclock secs ( 0.05 usr + 0.00 sys = 0.05 CPU)
loop: 45 wallclock secs (42.70 usr + 1.36 sys = 44.06 CPU)
Benchmarks for method 3:
total: 56 wallclock secs (53.67 usr + 1.16 sys = 54.83 CPU)
overhead: 17 wallclock secs (16.56 usr + 0.05 sys = 16.61 CPU)
loop: 39 wallclock secs (37.11 usr + 1.11 sys = 38.22 CPU)
Benchmarks for method 4:
total: 35 wallclock secs (32.78 usr + 1.33 sys = 34.11 CPU)
overhead: 8 wallclock secs ( 7.74 usr + 0.01 sys = 7.75 CPU)
loop: 27 wallclock secs (25.04 usr + 1.32 sys = 26.36 CPU)
####
If God had meant us to fly, he would *never* have given us the railroads.
--Michael Flanders