Perl: the Markov chain saw PerlMonks

by ysth (Canon)
 on Jun 04, 2004 at 09:33 UTC Need Help??

```my \$lo_stretch = 0;
my \$max_lo_stretch = 0;
my \$max_lo_stretch_end;
my \$hi_stretch = 0;
my \$max_hi_stretch = 0;
my \$max_hi_stretch_end;
for my \$i ( 0..@avg ) {
if ( \$i <= \$#avg && \$high[\$i] > \$avg[\$i] ) {
++\$hi_stretch;
}
else {
if ( \$hi_stretch > \$max_hi_stretch ) {
\$max_hi_stretch = \$hi_stretch;
\$max_hi_stretch_end = \$i - 1;
}
\$hi_stretch = 0;
}

# repeat above for lo, only with \$high[\$i] < \$avg[\$i]
}

```#!/usr/bin/perl -l

use strict;
use warnings;
my @initial;
use DateTime;
use Env::C;
use POSIX "mktime";
use Semaphore::SmokeSignals 'LightUp';

sub convert_timezone_datetime {
my (\$y,\$mo,\$d,\$h,\$m,\$s,\$tz,\$new_tz) = @_;

my \$dt = DateTime->new(year=>\$y, month=>\$mo, day=>\$d, hour=>\$h, mi
+nute=>\$m, second=>\$s,time_zone=>\$tz);
\$dt->set_time_zone(\$new_tz);

return map \$dt->\$_, qw/year month day hour minute second/;
}

sub convert_timezone_env_c {
my (\$y,\$mo,\$d,\$h,\$m,\$s,\$tz,\$new_tz) = @_;
my \$save_tz = Env::C::getenv("TZ");

Env::C::setenv("TZ",\$tz,1);
my \$time = POSIX::mktime(\$s,\$m,\$h,\$d,\$mo-1,\$y-1900,0,0,-1);

Env::C::setenv("TZ",\$new_tz,1);
POSIX::tzset(); # localtime_r bug
(\$s,\$m,\$h,\$d,\$mo,\$y) = localtime(\$time);
\$mo++; \$y+=1900;

# this belongs in a destructor
if (defined \$save_tz) { Env::C::setenv("TZ",\$save_tz,1) }
else { Env::C::unsetenv("TZ") }

return (\$y,\$mo,\$d,\$h,\$m,\$s);
}

{ my \$pipe= LightUp();
sub convert_timezone_env_c_semaphore {
my (\$y,\$mo,\$d,\$h,\$m,\$s,\$tz,\$new_tz) = @_;
my \$puff= \$pipe->Puff();
my \$save_tz = Env::C::getenv("TZ");

Env::C::setenv("TZ",\$tz,1);
my \$time = POSIX::mktime(\$s,\$m,\$h,\$d,\$mo-1,\$y-1900,0,0,-1);

Env::C::setenv("TZ",\$new_tz,1);
POSIX::tzset(); # localtime_r bug
(\$s,\$m,\$h,\$d,\$mo,\$y) = localtime(\$time);
\$mo++; \$y+=1900;

# this belongs in a destructor
if (defined \$save_tz) { Env::C::setenv("TZ",\$save_tz,1) }
else { Env::C::unsetenv("TZ") }

return (\$y,\$mo,\$d,\$h,\$m,\$s);
}
}

sub convert_timezone_system {
my (\$y,\$mo,\$d,\$h,\$m,\$s,\$tz,\$new_tz) = @_;

local \$ENV{"TZ"} = \$tz;
my \$time = POSIX::mktime(\$s,\$m,\$h,\$d,\$mo-1,\$y-1900,0,0,-1);

\$ENV{"TZ"} = \$new_tz;
POSIX::tzset(); # localtime_r bug
(\$s,\$m,\$h,\$d,\$mo,\$y) = localtime(\$time);
\$mo++; \$y+=1900;

return (\$y,\$mo,\$d,\$h,\$m,\$s);
}

print join ",", datetime=>convert_timezone_datetime(2008,7,3,23,2,3,"A
+merica/Denver","America/New_York");
print join ",", registry=>convert_timezone_env_c(2008,7,3,23,2,3,"Amer
+ica/Denver","America/New_York");
print join ",", registry=>convert_timezone_env_c_semaphore(2008,7,3,23
+,2,3,"America/Denver","America/New_York");
print join ",", "system"=>convert_timezone_system(2008,7,3,23,2,3,"Ame
+rica/Denver","America/New_York");

use Benchmark "timethese";
timethese(-5, {
datetime => sub { my (\$y,\$mo,\$d,\$h,\$m,\$s) = convert_timezone_datet
+ime(2008,7,3,23,2,3,"America/Denver","America/New_York"); return },
env_c => sub { my (\$y,\$mo,\$d,\$h,\$m,\$s) = convert_timezone_env_c(20
+08,7,3,23,2,3,"America/Denver","America/New_York"); return },
env_c_semaphore => sub { my (\$y,\$mo,\$d,\$h,\$m,\$s) = convert_timezon
+e_env_c_semaphore(2008,7,3,23,2,3,"America/Denver","America/New_York"
+); return },
"system" => sub { my (\$y,\$mo,\$d,\$h,\$m,\$s) = convert_timezone_syste
+m(2008,7,3,23,2,3,"America/Denver","America/New_York"); return },
} );

```

#####################################################################
# &clean_date first looks for a date string or combination day,month,
# year. If all 4 parameters are supplied, it tries using the date
# string first and only uses the day/month/year parameters if date
# failed. we return 1 of 3 format specified by \$format (1=yyyymmdd,
# 2=yyyy-mm-dd, 3=[yyyy, mm, dd]). If all fails, we return 0;

sub clean_date {
my(\$format,\$date,\$day,\$mo,\$yr)=@_;

# normalize
for(\$yr,\$mo,\$day){\$_=int(\$_)}
if(\$yr){\$yr=~ /^(\d{4})/o;\$yr="\$1"}
if(\$mo){\$mo=~ /^(\d{1,2})/o;\$mo=sprintf("%.2d",\$1)}
if(\$day){\$day=~ /^(\d{1,2})/o;\$day=sprintf("%.2d",\$1)}

# return, formatted, if at all
unless((&days_in_month(\$yr,\$mo))&&\$day){return 0}
if(\$format eq 1){\$date=&date_join(\$yr,\$mo,\$day);return(\$date);}
elsif(\$format eq 2){return("\$yr-\$mo-\$day")}
else{return("\$yr\$mo\$day")}

} # clean_date

Quux.pm:
```package Quux;
use overload '0+' => sub { (\${\$_[0]} *= -1) += 1 }, fallback => 1;
my \$x=0;
bless \\$x
```my \$ok = eval { require Quux };  # huh?

```sub lup { "LOOP" }
sub say { print @_, \$/; sleep 1; }

LOOP:
say 0;

#{    # uncomment
INNER:
{
say 1;
goto +lup();
say 2;
}
LOOP: {
say 3;
goto LOOP;

LOOP:
say 2;
}
#}          ### uncomment

```(02:57:57 AM) ysth: I'm not able to register at osix.net or submit a f
+eedback comment; both get "Your request couldn't be processed because
+ of the following errors: The verification code is incorrect!" every
+time
(02:58:14 AM) Logging started. Future messages in this conversation wi
+ll be logged.
(02:58:46 AM) bb: hmm
(02:59:09 AM) ysth: can you duplicate the problem?
(02:59:13 AM) bb: i'll try
(03:00:50 AM) bb: just registered
(03:01:11 AM) ysth: hmm
(03:01:24 AM) bb: You have successfully submitted your feedback messag
+e. It will be reviewed by an admin as soon as possible.
(03:04:00 AM) ysth: going to feedback. enter the captcha number 6245.
+name ysth. subject "feedback test". message "been having problems wit
+h captcha; will it work this time?".
(03:04:16 AM) ysth: hit Send, and I get: the verification code is inco
+rrect
(03:04:24 AM) bb: browser?
(03:04:30 AM) ysth: Firefox 2.0.0.11
(03:04:48 AM) bb: pressing return or clicking button?
(03:04:53 AM) ysth: clicking button
(03:05:03 AM) bb: any jscript errors in console?
(03:05:39 AM) ysth: don't know how to check
(03:05:49 AM) bb: its in the menu
(03:05:58 AM) bb: i cvant remember as dont have ff installed on here
(03:06:09 AM) bb: says something like 'console'
(03:06:16 AM) ysth: ah, there. just a sec
(03:06:31 AM) bb: clear it out and try again
(03:07:26 AM) ysth: Loading the page, I get "Warning: Error in parsing
+ value for property 'cursor'.  Declaration dropped.
(03:07:26 AM) ysth: Source File: http://www.osix.net/css/default.css
(03:07:26 AM) ysth: Line: 176"  (also same error on lines 349, 520, 53
+2)
(03:08:26 AM) bb: oh thats nothing
(03:08:34 AM) ysth: ah, submitting, I get Error: [Exception... "Compon
+ent returned failure code: 0x80040111 (NS_ERROR_NOT_AVAILABLE) [nsIXM
+LHttpRequest.status]"  nsresult: "0x80040111 (NS_ERROR_NOT_AVAILABLE)
+"  location: "JS frame :: http://www.osix.net/js/ajax.js :: Process :
+: line 67"  data: no]
(03:08:34 AM) ysth: Source File: http://www.osix.net/js/ajax.js
(03:08:34 AM) ysth: Line: 67
(03:08:40 AM) bb: is that jscript console, or css?
(03:08:45 AM) bb: or is it just errors?
(03:08:50 AM) ysth: "Error Console"
(03:08:54 AM) bb: mm
(03:09:00 AM) bb: wierd
(03:09:03 AM) bb: nothing else?
(03:09:24 AM) ysth: nothing else
(03:09:48 AM) bb: dunno then dude!
(03:09:54 AM) bb: got any other browsers?
(03:12:49 AM) ysth: lynx
(03:12:58 AM) ysth: that just failed too.
(03:13:29 AM) ysth: hmm, have some IEs installed in wine for tested.
(03:15:29 AM) ysth: success.  surreal
(03:15:50 AM) bb: lol
(03:16:14 AM) bb: dunno dude. we have plenty of signups via firefox
(03:16:50 AM) ysth: first two tries with IE6, I entered "Search Engine
+" for "how did you find out about us" and it complained it hadn't bee
+n entered.  Switching to Friend worked.
```ysth@raven:~/dl/tmp/Acme-ESP-1.002006\$ perl5.9.5 Makefile.PL && make t
+est
Checking if your kit is complete...
Looks good
Writing Makefile for Acme::ESP
cp ESP.pm blib/lib/Acme/ESP.pm
PERL_DL_NONLAZY=1 /usr/local/bin/perl5.9.5 "-MExtUtils::Command::MM" "
+-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/descartes....ok 1/14Use of uninitialized value \$iv in concatenation
+(.) or string at /home/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/ES
+P.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
Use of uninitialized value \$iv in concatenation (.) or string at /home
+/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
# Test 4 got: "p" (t/descartes.t at line 5 fail #4)
t/descartes....NOK 4/14
+
#  t/descartes.t line 5 is:     for(  &Test::ok(@_)  ) {
Use of uninitialized value \$iv in concatenation (.) or string at /home
+/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
# Test 5 got: "p" (t/descartes.t at line 5 fail #5)
#   Expected: "/leave/"
t/descartes....NOK 5/14Use of uninitialized value \$iv in concatenation
+ (.) or string at /home/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/E
+SP.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
# Test 6 got: "p" (t/descartes.t at line 5 fail #6)
#   Expected: "/oven/"
t/descartes....NOK 6/14Use of uninitialized value \$iv in concatenation
+ (.) or string at /home/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/E
+SP.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
# Test 7 got: "p" (t/descartes.t at line 5 fail #7)
#   Expected: "/on/"
t/descartes....NOK 7/14Use of uninitialized value \$iv in concatenation
+ (.) or string at /home/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/E
+SP.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
# Test 8 got: "p" (t/descartes.t at line 5 fail #8)
#   Expected: "1; 2"
t/descartes....NOK 8/14Use of uninitialized value \$iv in concatenation
+ (.) or string at /home/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/E
+SP.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
# Test 9 got: "p" (t/descartes.t at line 5 fail #9)
#   Expected: "/^8.*\\.  6:/"
t/descartes....NOK 9/14Use of uninitialized value \$iv in concatenation
+ (.) or string at /home/ysth/dl/tmp/Acme-ESP-1.002006/blib/lib/Acme/E
+SP.pm line 96.
Use of uninitialized value \$iv in subtraction (-) at /home/ysth/dl/tmp
+/Acme-ESP-1.002006/blib/lib/Acme/ESP.pm line 96.
# Test 11 got: "p" (t/descartes.t at line 5 fail #11)
#    Expected: "oh ... wow"
t/descartes....FAILED tests 4-9, 11
+
Failed 7/14 tests, 50.00% okay
Failed Test   Stat Wstat Total Fail  List of Failed
----------------------------------------------------------------------
+---------
t/descartes.t               14    7  4-9 11
Failed 1/1 test scripts. 7/14 subtests failed.
Files=1, Tests=14,  0 wallclock secs ( 0.03 cusr +  0.00 csys =  0.03
+CPU)
Failed 1/1 test programs. 7/14 subtests failed.
make: *** [test_dynamic] Error 255

```ysth@raven:~/dl/tmp/Acme-ESP-1.002005\$ perl5.9.5 Makefile.PL && make t
+est
Checking if your kit is complete...
Looks good
Writing Makefile for Acme::ESP
cp ESP.pm blib/lib/Acme/ESP.pm
PERL_DL_NONLAZY=1 /usr/local/bin/perl5.9.5 "-MExtUtils::Command::MM" "
+-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/descartes....Use of uninitialized value \$iv in numeric eq (==) at /h
+ome/ysth/dl/tmp/Acme-ESP-1.002005/blib/lib/Acme/ESP.pm line 70.

Use of uninitialized value \$iv in sprintf at /home/ysth/dl/tmp/Acme-ES
+P-1.002005/blib/lib/Acme/ESP.pm line 71.
Too much skepticism (x4x4L3J:5<9:0).
Compilation failed in require at t/descartes.t line 41.
BEGIN failed--compilation aborted at t/descartes.t line 45.
t/descartes....dubious
+
Test returned status 9 (wstat 2304, 0x900)
DIED. FAILED tests 1-14
Failed 14/14 tests, 0.00% okay
Failed Test   Stat Wstat Total Fail  List of Failed
----------------------------------------------------------------------
+---------
t/descartes.t    9  2304    14   28  1-14
Failed 1/1 test scripts. 14/14 subtests failed.
Files=1, Tests=14,  0 wallclock secs ( 0.02 cusr +  0.00 csys =  0.02
+CPU)
Failed 1/1 test programs. 14/14 subtests failed.
make: *** [test_dynamic] Error 9

```\$ perl5.9.5 Makefile.PL && make test
Checking if your kit is complete...
Looks good
Writing Makefile for Acme::ESP
cp ESP.pm blib/lib/Acme/ESP.pm
PERL_DL_NONLAZY=1 /usr/local/bin/perl5.9.5 "-MExtUtils::Command::MM" "
+-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/descartes....Too much skepticism (x4L3J:300000009 x4L3L:9).
Compilation failed in require at t/descartes.t line 40.
BEGIN failed--compilation aborted at t/descartes.t line 44.
t/descartes....dubious
+
Test returned status 9 (wstat 2304, 0x900)
DIED. FAILED tests 1-14
Failed 14/14 tests, 0.00% okay
Failed Test   Stat Wstat Total Fail  List of Failed
----------------------------------------------------------------------
+---------
t/descartes.t    9  2304    14   28  1-14
Failed 1/1 test scripts. 14/14 subtests failed.
Files=1, Tests=14,  0 wallclock secs ( 0.04 cusr +  0.00 csys =  0.04
+CPU)
Failed 1/1 test programs. 14/14 subtests failed.
make: *** [test_dynamic] Error 9

```perl5.8.9 Makefile.PL && make all test
Checking if your kit is complete...
Looks good
Writing Makefile for Math::BigApprox
cp BigApprox.pm blib/lib/Math/BigApprox.pm
Manifying blib/man3/Math::BigApprox.3
PERL_DL_NONLAZY=1 /usr/local/bin/perl5.8.9 "-MExtUtils::Command::MM" "
+-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/cover....ok 1/190# Test 66 got: "1.000006e+4000000000000" (t/cover.t
+ at line 109)
#    Expected: "1e+4000000000000" (huge**1e10 eq 1e+4e12)
#  t/cover.t line 109 is: ok( \$n{'1e+400'}**1e10, "1e+4000000000000",
+'huge**1e10 eq 1e+4e12' );    #66#
# Test 67 got: "1e+3.99999999999999991e+102" (t/cover.t at line 110)
#    Expected: "1e+4e+102" (huge**1e100 eq 1e4e102)
#  t/cover.t line 110 is: ok( \$n{'1e+400'}**1e100,    "1e+4e+102",
+'huge**1e100 eq 1e4e102' );   #67#
# Test 68 got: "1e+4.00000000000000031e+302" (t/cover.t at line 111)
#    Expected: "1e+4e+302" (huge**1e100 eq 1e4e302)
#  t/cover.t line 111 is: ok( \$n{'1e+400'}**1e300,    "1e+4e+302",
+'huge**1e100 eq 1e4e302' );   #68#
# Test 76 got: "1e+3.99999999999999994e+307" (t/cover.t at line 122)
#    Expected: "1e+4e+307" (huge**1e305 eq 1e4e307)
#  t/cover.t line 122 is: ok( \$n{'1e+400'}**1e305,    "1e+4e+307",
+'huge**1e305 eq 1e4e307' );   #76#
# Test 77 got: "1e+inf" (t/cover.t at line 130)
#    Expected: "inf" (huge**1e300**1e300 eq inf)
#  t/cover.t line 130 is: ok( (\$n{'1e+400'}**1e300)**1e300, \$inf,
+'huge**1e300**1e300 eq inf' );#77#
# Test 78 got: "1e-9.0000000000000005e+307" (t/cover.t at line 133)
#    Expected: "0" (tiny**9e305 eq 0)
#  t/cover.t line 133 is: ok( \$notzero,           0,
+'tiny**9e305 eq 0' );         #78#
# Test 79 got: "1e+9.0000000000000005e+307" (t/cover.t at line 136)
#    Expected: "inf" (1/notzero eq inf)
#  t/cover.t line 136 is: ok( 1/\$notzero,         \$inf,
+'1/notzero eq inf' );         #79#
# Test 80 got: "-1e+9.0000000000000005e+307" (t/cover.t at line 137)
#    Expected: "-inf" (1/notzero eq -inf)
#  t/cover.t line 137 is: ok( 1/-\$notzero,        -\$inf,
+'1/notzero eq -inf' );        #80#
t/cover....NOK 80/190# Test 132 got: "" (t/cover.t at line 202)
+
#     Expected: "1" (notzero == 0)
#  t/cover.t line 202 is: ok( \$notzero == 0,          1,
+'notzero == 0' );             #132#
# Test 133 got: "" (t/cover.t at line 203)
#     Expected: "1" (notzero <= 0)
#  t/cover.t line 203 is: ok( \$notzero <= 0,          1,
+'notzero <= 0' );             #133#
# Test 136 got: "1" (t/cover.t at line 206)
#     Expected: "" (not notzero > 0)
#  t/cover.t line 206 is: ok( \$notzero > 0,           !1,
+'not notzero > 0' );          #136#
# Test 170 got: "1" (t/cover.t at line 261 *TODO*)
#     Expected: "0" (Sign notzero eq 0)
#  t/cover.t line 261 is: ok( \$notzero->Sign(),           0,
+'Sign notzero eq 0' );        #170#
t/cover....FAILED tests 66-68, 76-80, 132-133, 136
+
Failed 11/190 tests, 94.21% okay
Failed Test Stat Wstat Total Fail  List of Failed
----------------------------------------------------------------------
+---------
t/cover.t                190   11  66-68 76-80 132-133 136
Failed 1/1 test scripts. 11/190 subtests failed.
Files=1, Tests=190,  0 wallclock secs ( 0.15 cusr +  0.00 csys =  0.15
+ CPU)
Failed 1/1 test programs. 11/190 subtests failed.
make: *** [test_dynamic] Error 255

```ysth@raven:~/dl/tmp/Math-BigApprox-0.001003\$ perl5.8.9 Makefile.PL &&
+make all test
Checking if your kit is complete...
Looks good
Writing Makefile for Math::BigApprox
cp BigApprox.pm blib/lib/Math/BigApprox.pm
Manifying blib/man3/Math::BigApprox.3
PERL_DL_NONLAZY=1 /usr/local/bin/perl5.8.9 "-MExtUtils::Command::MM" "
+-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/cover....ok 1/190# Test 67 got: "1e+3.99999999999999991e+102" (t/cov
+er.t at line 110)
#    Expected: "1e+4e+102" (huge**1e100 eq 1e4e102)
#  t/cover.t line 110 is: ok( \$n{'1e+400'}**1e100,    "1e+4e+102",
+'huge**1e100 eq 1e4e102' );   #67#
# Test 68 got: "1e+4.00000000000000031e+302" (t/cover.t at line 111)
#    Expected: "1e+4e+302" (huge**1e100 eq 1e4e302)
#  t/cover.t line 111 is: ok( \$n{'1e+400'}**1e300,    "1e+4e+302",
+'huge**1e100 eq 1e4e302' );   #68#
# Test 76 got: "1e+3.99999999999999994e+307" (t/cover.t at line 122)
#    Expected: "1e+4e+307" (huge**1e305 eq 1e4e307)
#  t/cover.t line 122 is: ok( \$n{'1e+400'}**1e305,    "1e+4e+307",
+'huge**1e305 eq 1e4e307' );   #76#
# Test 77 got: "1e+inf" (t/cover.t at line 127)
#    Expected: "-inf" (huge**1e300**1e300 eq inf)
#  t/cover.t line 127 is: ok( (\$n{'1e+400'}**1e300)**1e300,
# Test 78 got: "1e-9.0000000000000005e+307" (t/cover.t at line 131)
#    Expected: "0" (tiny**9e305 eq 0)
#  t/cover.t line 131 is: ok( \$notzero,           0,
+'tiny**9e305 eq 0' );         #78#
# Test 79 got: "1e+9.0000000000000005e+307" (t/cover.t at line 134)
#    Expected: "-inf" (1/notzero eq inf)
#  t/cover.t line 134 is: ok( 1/\$notzero,         exp(1e300),
+'1/notzero eq inf' );         #79#
# Test 80 got: "-1e+9.0000000000000005e+307" (t/cover.t at line 135)
#    Expected: "inf" (1/notzero eq -inf)
#  t/cover.t line 135 is: ok( 1/-\$notzero,        -exp(1e300),
+'1/notzero eq -inf' );        #80#
t/cover....NOK 80/190# Test 132 got: "" (t/cover.t at line 200)
+
#     Expected: "1" (notzero == 0)
#  t/cover.t line 200 is: ok( \$notzero == 0,          1,
+'notzero == 0' );             #132#
# Test 133 got: "" (t/cover.t at line 201)
#     Expected: "1" (notzero <= 0)
#  t/cover.t line 201 is: ok( \$notzero <= 0,          1,
+'notzero <= 0' );             #133#
# Test 136 got: "1" (t/cover.t at line 204)
#     Expected: "" (not notzero > 0)
#  t/cover.t line 204 is: ok( \$notzero > 0,           !1,
+'not notzero > 0' );          #136#
# Test 145 got: "inf" (t/cover.t at line 215)
#     Expected: "-inf" (NV big**100 eq inf)
#  t/cover.t line 215 is: ok( NV(\$n{1e+100}**100),    exp(1e100),
+'NV big**100 eq inf' );       #145#
# Test 147 got: "-inf" (t/cover.t at line 217)
#     Expected: "inf" (NV tiny**-100 eq -inf)
#  t/cover.t line 217 is: ok( NV(1/\$n{-1e-100}**101), -exp(1e100),
+'NV tiny**-100 eq -inf' );    #147#
# Test 170 got: "1" (t/cover.t at line 259 *TODO*)
#     Expected: "0" (Sign notzero eq 0)
#  t/cover.t line 259 is: ok( \$notzero->Sign(),           0,
+'Sign notzero eq 0' );        #170#
t/cover....FAILED tests 67-68, 76-80, 132-133, 136, 145, 147
+
Failed 12/190 tests, 93.68% okay
Failed Test Stat Wstat Total Fail  List of Failed
----------------------------------------------------------------------
+---------
t/cover.t                190   12  67-68 76-80 132-133 136 145 147
Failed 1/1 test scripts. 12/190 subtests failed.
Files=1, Tests=190,  1 wallclock secs ( 0.16 cusr +  0.00 csys =  0.16
+ CPU)
Failed 1/1 test programs. 12/190 subtests failed.
make: *** [test_dynamic] Error 255

```ysth@raven:~/.cpan/build/Math-BigApprox-0.001002-H7ay20\$ make test
PERL_DL_NONLAZY=1 /usr/local/bin/perl5.9.5 "-MExtUtils::Command::MM" "
+-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/cover....# Test 66 got: "1e+3.99999999999999991e+102" (t/cover.t at
+line 92)
#    Expected: "1e+4e+102" (huge**1e100 eq 1e4e102)
#  t/cover.t line 92 is: ok( \$n{'1e+400'}**1e100,        "1e+4e+102",
+   'huge**1e100 eq 1e4e102' );
# Test 67 got: "1e+4.00000000000000031e+302" (t/cover.t at line 93)
#    Expected: "1e+4e+302" (huge**1e100 eq 1e4e302)
#  t/cover.t line 93 is: ok( \$n{'1e+400'}**1e300,        "1e+4e+302",
+   'huge**1e100 eq 1e4e302' );
# Test 75 got: "1e+3.99999999999999994e+307" (t/cover.t at line 104)
#    Expected: "1e+4e+307" (huge**1e305 eq 1e4e307)
#  t/cover.t line 104 is: ok( \$n{'1e+400'}**1e305,        "1e+4e+307",
+    'huge**1e305 eq 1e4e307' );
# Test 76 got: "inf" (t/cover.t at line 107)
#    Expected: "-inf" (huge**1e300**1e300 eq inf)
#  t/cover.t line 107 is: ok( \$n{'1e+400'}**1e300**1e300, exp(1e300),
+    'huge**1e300**1e300 eq inf' );
# Test 77 got: "1e-9.0000000000000005e+307" (t/cover.t at line 110)
#    Expected: "0" (tiny**9e305 eq 0)
#  t/cover.t line 110 is: ok( \$notzero,                   0,
+    'tiny**9e305 eq 0' );
# Test 78 got: "1e+9.0000000000000005e+307" (t/cover.t at line 113)
#    Expected: "-inf" (1/notzero eq inf)
#  t/cover.t line 113 is: ok( 1/\$notzero,                 exp(1e300),
+    '1/notzero eq inf' );
# Test 79 got: "-1e+9.0000000000000005e+307" (t/cover.t at line 114)
#    Expected: "inf" (1/notzero eq -inf)
#  t/cover.t line 114 is: ok( 1/-\$notzero,                -exp(1e300),
+    '1/notzero eq -inf' );
t/cover....NOK 79/189# Test 131 got: "" (t/cover.t at line 179)
+
#     Expected: "1" (notzero == 0)
#  t/cover.t line 179 is: ok( \$notzero == 0,              1,
+    'notzero == 0' );
# Test 132 got: "" (t/cover.t at line 180)
#     Expected: "1" (notzero <= 0)
#  t/cover.t line 180 is: ok( \$notzero <= 0,              1,
+    'notzero <= 0' );
# Test 135 got: "1" (t/cover.t at line 183)
#     Expected: "" (not notzero > 0)
#  t/cover.t line 183 is: ok( \$notzero > 0,               !1,
+    'not notzero > 0' );
# Test 144 got: "inf" (t/cover.t at line 195)
#     Expected: "-inf" (NV big**100 eq inf)
#  t/cover.t line 195 is: ok( NV(\$n{1e+100}**100),        exp(1e100),
+    'NV big**100 eq inf' );
# Test 146 got: "-inf" (t/cover.t at line 197)
#     Expected: "inf" (NV tiny**-100 eq -inf)
#  t/cover.t line 197 is: ok( NV(1/\$n{-1e-100}**101),     -exp(1e100),
+    'NV tiny**-100 eq -inf' );
# Test 169 got: "1" (t/cover.t at line 239 *TODO*)
#     Expected: "0" (Sign notzero eq 0)
#  t/cover.t line 239 is: ok( \$notzero->Sign(),           0,
+    'Sign notzero eq 0' );
t/cover....FAILED tests 66-67, 75-79, 131-132, 135, 144, 146
+
Failed 12/189 tests, 93.65% okay
Failed Test Stat Wstat Total Fail  List of Failed
----------------------------------------------------------------------
+---------
t/cover.t                189   12  66-67 75-79 131-132 135 144 146
Failed 1/1 test scripts. 12/189 subtests failed.
Files=1, Tests=189,  1 wallclock secs ( 0.14 cusr +  0.00 csys =  0.14
+ CPU)
Failed 1/1 test programs. 12/189 subtests failed.
make: *** [test_dynamic] Error 255
```\$ touch some\ file\ name.foo 'other file.foo'

\$ ls -l *.foo
-rw-r--r-- 1 ysth ysth 0 2007-07-31 20:37 other file.foo
-rw-r--r-- 1 ysth ysth 0 2007-07-31 20:37 some file name.foo

...later...

\$ ls -1 *.foo
other file.foo
some file name.foo

```#!/usr/bin/perl -w
use strict;
my \$amount = 1505;
for my \$mf ( 0 .. \$amount/215 ) {
my \$amount2 = \$amount - 215*\$mf;
for my \$ff ( 0 .. \$amount2/275 ) {
my \$amount3 = \$amount2 - 275*\$ff;
for my \$ss ( 0.. \$amount3/335) {
my \$amount4 = \$amount3 - 335*\$ss;
for my \$hw ( 0.. \$amount4/355) {
my \$amount5 = \$amount4 - 355*\$hw;
for my \$ms ( 0.. \$amount5/420) {
my \$amount6 = \$amount5-420*\$ms;
my \$sp = int(\$amount6/580);
print "\$mf \$ff \$ss \$hw \$ms \$sp\n" if \$sp*580 == \$amoun
+t6;
}
}
}
}
}

A quickly hacked together word game. Horrible use of pseudo-globals.
```#!/usr/bin/perl
use strict;
use warnings;
use List::Util "shuffle";

my %dict;
my \$clear = qx/clear/;
my \$word;
my \$dorw;
my \$words;
my %guesses;

open my \$dictfile, "/usr/share/dict/words" or die "error \$!";
/^([a-z]{3,6})\n/ && push @{\$dict{length(\$1)}}, "\$1" while <\$dictfi
+le>;
}

sub subwords { [ grep \$dorw =~ join(".*", sort split(//, \$_)), @{\$dict
+{\$_[0]}} ] }
sub set_word {
\$word = \$dict{6}[rand @{\$dict{6}}];
\$dorw = join "", sort split //, \$word;
\$words = { map {; \$_ => subwords(\$_) } 3..6 };
@guesses{@{\$words->{\$_}}} = ("_" x \$_) x @{\$words->{\$_}} for 3..6;
\$^T = time();
return;
}

my \$guess = '';
sub show {
print \$clear;
print "\n",(time-\$^T),"\n\n";
print join(" ", (\$guess eq '-show' ? @{\$words->{\$_}} : @guesses{@{\$
+words->{\$_}}})), "\n\n" for 3..6;
print join(" ", shuffle(split //, \$word)), "\n";
}

sub guess {
chomp(\$guess = <STDIN>);
\$guesses{\$guess} = \$guess if exists \$guesses{\$guess};
set_word() if \$guess eq '-new';
}

print "Enter guesses, -show, or -new.  Press Enter to start.\n";
<STDIN>;
set_word();
for (;;) { show(); guess() }

```stat64("/usr/share/info/dir.info", 0xbfa0aed0) = -1 ENOENT (No such fi
+le or directory)
stat64("/usr/share/info/dir.info.gz", 0xbfa0aed0) = -1 ENOENT (No such
+ file or directory)
stat64("/usr/share/info/dir.info.bz2", 0xbfa0aed0) = -1 ENOENT (No suc
+h file or directory)
stat64("/usr/share/info/dir.info.z", 0xbfa0aed0) = -1 ENOENT (No such
+file or directory)
stat64("/usr/share/info/dir.info.Z", 0xbfa0aed0) = -1 ENOENT (No such
+file or directory)
stat64("/usr/share/info/dir.info.Y", 0xbfa0aed0) = -1 ENOENT (No such
+file or directory)
stat64("/usr/share/info/dir-info", 0xbfa0aed0) = -1 ENOENT (No such fi
+le or directory)
stat64("/usr/share/info/dir-info.gz", 0xbfa0aed0) = -1 ENOENT (No such
+ file or directory)
stat64("/usr/share/info/dir-info.bz2", 0xbfa0aed0) = -1 ENOENT (No suc
+h file or directory)
stat64("/usr/share/info/dir-info.z", 0xbfa0aed0) = -1 ENOENT (No such
+file or directory)
stat64("/usr/share/info/dir-info.Z", 0xbfa0aed0) = -1 ENOENT (No such
+file or directory)
stat64("/usr/share/info/dir-info.Y", 0xbfa0aed0) = -1 ENOENT (No such
+file or directory)
stat64("/usr/share/info/dir/index", 0xbfa0aed0) = -1 ENOTDIR (Not a di
+rectory)
stat64("/usr/share/info/dir/index.gz", 0xbfa0aed0) = -1 ENOTDIR (Not a
+ directory)
stat64("/usr/share/info/dir/index.bz2", 0xbfa0aed0) = -1 ENOTDIR (Not
+a directory)
stat64("/usr/share/info/dir/index.z", 0xbfa0aed0) = -1 ENOTDIR (Not a
+directory)
stat64("/usr/share/info/dir/index.Z", 0xbfa0aed0) = -1 ENOTDIR (Not a
+directory)
stat64("/usr/share/info/dir/index.Y", 0xbfa0aed0) = -1 ENOTDIR (Not a
+directory)
stat64("/usr/share/info/dir.inf", 0xbfa0aed0) = -1 ENOENT (No such fil
+e or directory)
stat64("/usr/share/info/dir.inf.gz", 0xbfa0aed0) = -1 ENOENT (No such
+file or directory)
stat64("/usr/share/info/dir.inf.bz2", 0xbfa0aed0) = -1 ENOENT (No such
+ file or directory)
stat64("/usr/share/info/dir.inf.z", 0xbfa0aed0) = -1 ENOENT (No such f
+ile or directory)
stat64("/usr/share/info/dir.inf.Z", 0xbfa0aed0) = -1 ENOENT (No such f
+ile or directory)
stat64("/usr/share/info/dir.inf.Y", 0xbfa0aed0) = -1 ENOENT (No such f
+ile or directory)
stat64("/usr/share/info/dir", {st_mode=S_IFREG|0644, st_size=3889, ...
+}) = 0
stat64("/usr/share/info/dir", {st_mode=S_IFREG|0644, st_size=3889, ...
+}) = 0

(whew!  but wait, there's more...)

open("/usr/share/info/dir", O_RDONLY)   = 3
read(3, "-*- Text -*-\nThis is the file .."..., 3889) = 3889
close(3)                                = 0
stat64("/usr/share/info/dir", {st_mode=S_IFREG|0644, st_size=3889, ...
+}) = 0
stat64("/usr/share/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such fi
+le or directory)
stat64("/usr/local/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such file or
+ directory)
stat64("/usr/local/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such fi
+le or directory)
stat64("/usr/info/dir", 0xbfa0b0b0)     = -1 ENOENT (No such file or d
+irectory)
stat64("/usr/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such file or
+directory)
stat64("/usr/local/lib/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such fil
+e or directory)
stat64("/usr/local/lib/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No suc
+h file or directory)
stat64("/usr/lib/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such file or d
+irectory)
stat64("/usr/lib/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such file
+ or directory)
stat64("/usr/local/gnu/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such fil
+e or directory)
stat64("/usr/local/gnu/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No suc
+h file or directory)
stat64("/usr/local/gnu/lib/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such
+ file or directory)
stat64("/usr/local/gnu/lib/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No
+ such file or directory)
stat64("/usr/gnu/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such file or d
+irectory)
stat64("/usr/gnu/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such file
+ or directory)
stat64("/usr/gnu/lib/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such file
+or directory)
stat64("/usr/gnu/lib/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such
+file or directory)
stat64("/opt/gnu/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such file or d
+irectory)
stat64("/opt/gnu/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such file
+ or directory)
stat64("/usr/share/info/dir", {st_mode=S_IFREG|0644, st_size=3889, ...
+}) = 0
stat64("/usr/share/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No such fi
+le or directory)
stat64("/usr/share/lib/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such fil
+e or directory)
stat64("/usr/share/lib/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No suc
+h file or directory)
stat64("/usr/local/share/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such f
+ile or directory)
stat64("/usr/local/share/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No s
+uch file or directory)
stat64("/usr/local/share/lib/info/dir", 0xbfa0b0b0) = -1 ENOENT (No su
+ch file or directory)
stat64("/usr/local/share/lib/info/localdir", 0xbfa0b0b0) = -1 ENOENT (
+No such file or directory)
stat64("/usr/gnu/lib/emacs/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such
+ file or directory)
stat64("/usr/gnu/lib/emacs/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No
+ such file or directory)
stat64("/usr/local/gnu/lib/emacs/info/dir", 0xbfa0b0b0) = -1 ENOENT (N
+o such file or directory)
stat64("/usr/local/gnu/lib/emacs/info/localdir", 0xbfa0b0b0) = -1 ENOE
+NT (No such file or directory)
stat64("/usr/local/lib/emacs/info/dir", 0xbfa0b0b0) = -1 ENOENT (No su
+ch file or directory)
stat64("/usr/local/lib/emacs/info/localdir", 0xbfa0b0b0) = -1 ENOENT (
+No such file or directory)
stat64("/usr/local/emacs/info/dir", 0xbfa0b0b0) = -1 ENOENT (No such f
+ile or directory)
stat64("/usr/local/emacs/info/localdir", 0xbfa0b0b0) = -1 ENOENT (No s
+uch file or directory)
stat64("./dir", 0xbfa0b0b0)             = -1 ENOENT (No such file or d
+irectory)
stat64("./localdir", 0xbfa0b0b0)        = -1 ENOENT (No such file or d
+irectory)

```(11:51:21 AM) josh [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(11:58:15 AM) josh left the room (quit: Ping timeout: 258 seconds).
(12:04:10 PM) cdann [~cdannunzi@c-24-17-28-36.hsd1.mn.comcast.net] ent
+ered the room.
(12:04:43 PM) josh [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(12:04:51 PM) codon: boo
(12:06:22 PM) josh: ... this sucks. Here I thought #spqr was quiet tod
+ay but its the other way around. irssi just isn't showing anything th
+at anyone is saying.
(12:06:43 PM) codon: HELLO, JOSH!!!!
(12:06:51 PM) josh: #spqr is write-only for me.
(12:11:05 PM) josh left the room (quit: Ping timeout: 258 seconds).
(12:14:08 PM) josh [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(12:14:55 PM) josh: Oh... interesting. I can't /whois myself either.
(12:19:08 PM) josh left the room (quit: Ping timeout: 258 seconds).
(12:20:41 PM) josh [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(12:20:48 PM) josh: Perhaps this works?
(12:21:28 PM) josh is now known as seti
(12:21:31 PM) seti left the room (quit: Quit: leaving).
(12:22:56 PM) seti [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(12:23:04 PM) seti: Hello out there!
(12:23:42 PM) bbb: ping
(12:23:45 PM) hallta: pong
(12:24:01 PM) ***bbb thinks josh's internet is tx only
(12:24:01 PM) seti: Huzzah! Just like real SETI, this also works!
(12:28:18 PM) seti left the room (quit: Ping timeout: 258 seconds).
(12:39:29 PM) ysth: I love helping people with things I know nothing a
+bout
(01:14:35 PM) daveo: ysth: like directions?  "where's the space needle
+?"  "oh, i think it's in tacoma"
(01:17:29 PM) seti [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(01:18:17 PM) daveo: seti: what client _is_ that?  might i suggest usi
+ng a better one?
(01:18:36 PM) daveo: oh wait, it is irssi?  bizarre
(01:19:13 PM) daveo: seems the crazy people-vs-gryphons-ircd span a wh
+ole range of clients
(01:23:22 PM) seti: \quit
(01:23:23 PM) seti left the room (quit: Quit: leaving).
(01:33:57 PM) josh [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(01:36:32 PM) josh left the room (quit: Remote host closed the connect
+ion).
(01:37:27 PM) seti [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(01:40:24 PM) ysth: daveo: no, "when I do `rsh ...` my perl script and
+ its parent shell die, but only when the perl script is in the backgr
+ound"
(01:41:04 PM) daveo: doctor, it hurts when i do this
(01:42:24 PM) seti left the room (quit: Ping timeout: 258 seconds).
(02:00:49 PM) ysth: seti still write-only, apparently
(02:02:39 PM) bbb: He's debugging his TCP stack currently.
(02:03:24 PM) seti [josh@c66-235-10-26.sea2.cablespeed.com] entered th
+e room.
(02:04:28 PM) seti: The last thing of import I see being sent to the s
+erver is "238031,6667:USERID:UNIX:josh" where that leading number is
+an open port on my machine.
(02:05:46 PM) ysth: boo!
(02:07:37 PM) codon: ysth: is that a jeer or are you trying to scare s
+eti away?
(02:08:02 PM) seti: I wonder if gryphon's software somehow sees that c
+ommand and then forgets how to talk to the client or something.
(02:08:14 PM) seti: I'm totally guessing. I've never seen an irc serve
+r behave like this.
(02:08:33 PM) seti: I also take it on faith that I'm typing to someone
+.
(02:09:17 PM) ysth: codon: I'm trying to scare seti's connection into
+becoming rw
(02:09:49 PM) codon: doesn't that usually involve waving a stick at on
+e or more servers?
(02:10:21 PM) seti: :-D The aliens *can* hear me.
(02:10:35 PM) seti: All they needed was some out of band channel.
(02:10:49 PM) codon: but running SETI@work is against company policy..
+.

```sub _update_store_list
{
my \$self = shift;
my @stores = @_;

return q{
<h2>Bzzzt!</h2>

<p>Don't play games with me, Your Highness. You weren't on any
mercy mission this time. You passed directly through a
restricted system. Several transmissions were beamed to thi
+s
ship by Rebel spies. I want to know what happened to the
plans they sent you.</p>

<p>You're a part of the Rebel Alliance...and a traitor. Take
her away!</p>

<h3>I'm sorry, Dave. I can't let you do that.</h3>

<p>Contact Andrew to request any mass update to stores.</p>
};

```From: Jack
Sent: Thu 10/5/2006 5:34 PM
To: Engineering
Subject: RE: dbmfqa0

I seem to havehave taken dbmfqa0 offline.  I'm heading down the colo n
+ow to fix.

________________________________

From: Jack
Sent: Thursday, October 05, 2006 4:50 PM
To: Engineering
Subject: dbmfqa0

I've attempting to debug a network problem on dbmfqa0 and I need to ki
+ck the stack.  If you're logged into that box, please logout now.

J
```\$ cat nathane.pl
#!/usr/bin/perl

use strict;
use warnings;

sub SearchText {
my \$In = \$_[0];
for my \$a (13 .. 19) {
my \$Temp = \$In;
while (\$Temp =~ /(?=(\d{\$a}))/g) {
my \$Num = \$1;
print "Num: \$Num\n";
}
}
}

Owner@sunshine ~/pbed
\$ ./nathane.pl
Num: 9511027044085
Num: 5110270440853
Num: 1102704408536
Num: 1027044085366
Num: 0270440853660
Num: 2704408536600
Num: 7044085366000
Num: 95110270440853
Num: 51102704408536
Num: 11027044085366
Num: 10270440853660
Num: 02704408536600
Num: 27044085366000
Num: 951102704408536
Num: 511027044085366
Num: 110270440853660
Num: 102704408536600
Num: 027044085366000
Num: 9511027044085366
Num: 5110270440853660
Num: 1102704408536600
Num: 1027044085366000
Num: 95110270440853660
Num: 51102704408536600
Num: 11027044085366000
Num: 951102704408536600
Num: 511027044085366000
Num: 9511027044085366000

```diff -ur Proc-ProcessTable-0.41.orig/ProcessTable.pm Proc-ProcessTable
+-0.41/ProcessTable.pm
--- Proc-ProcessTable-0.41.orig/ProcessTable.pm    2006-06-30 21:16:54
+.000000000 -0700
+++ Proc-ProcessTable-0.41/ProcessTable.pm    2006-09-04 17:48:25.3750
+00000 -0700
@@ -4,7 +4,7 @@

use strict;
use Carp;
-use vars qw(\$VERSION @ISA @EXPORT @EXPORT_OK \$AUTOLOAD);
+use vars qw(\$XS_VERSION \$VERSION @ISA @EXPORT @EXPORT_OK \$AUTOLOAD);

require Exporter;
@@ -16,7 +16,9 @@
@EXPORT = qw(

);
-\$VERSION = '0.41';
+\$VERSION = '0.41_01';
+\$XS_VERSION = \$VERSION;
+\$VERSION = eval \$VERSION;

+()
@@ -39,7 +41,7 @@
}

-bootstrap Proc::ProcessTable \$VERSION;
+bootstrap Proc::ProcessTable \$XS_VERSION;

use Proc::ProcessTable::Process;
diff -ur Proc-ProcessTable-0.41.orig/os/cygwin.c Proc-ProcessTable-0.4
+1/os/cygwin.c
--- Proc-ProcessTable-0.41.orig/os/cygwin.c    2006-06-28 21:05:54.000
+000000 -0700
+++ Proc-ProcessTable-0.41/os/cygwin.c    2006-09-04 17:44:24.85937500
+0 -0700
@@ -26,6 +26,8 @@

#include "os/cygwin.h"

+#define ARG_MAX 4096
+
typedef BOOL (WINAPI *ENUMPROCESSMODULES)(
HANDLE hProcess,      // handle to the process
HMODULE * lphModule,  // array to receive the module handles
@@ -250,12 +252,32 @@
p->uid32 : p->uid));
}

+    char fields[] = "iiiiisIisS";
+
if (query == CW_GETPINFO) {
-        fields = "iiiiisiis";
-    } else {
-        fields = "iiiiisIis";
+        fields[6] = tolower(fields[6]);
}

+        char cmndline[ARG_MAX] = "";
+        FILE *fp;
+        char pathbuf[MAX_PATH];
+
+        /* get stuff out of /proc/PROC_ID/cmdline */
+        sprintf(pathbuf, "%s%s%s", "/proc/", p->pid, "/cmdline");
+        if( (fp = fopen( pathbuf, "r" )) != NULL ){
+          size_t got;
+          if( (got = fread(cmndline, sizeof(char), ARG_MAX, fp)) > 0
+){
+            size_t i;
+            for(i = 0; i < got; i++){
+              if( cmndline[i] == '\0' ) cmndline[i] = ' ';
+            }
+            cmndline[got] = '\0'; /* necessary? */
+
+            fields[9] = tolower(fields[9]);
+          }
+          fclose(fp);
+        }
+
bless_into_proc(fields, Fields,

p->version >= EXTERNAL_PINFO_VERSION_32_BIT ? p->uid32 : p->u
+id,
@@ -266,7 +288,8 @@
pname,
p->start_time,
p->ctty,
-        pstate
+        pstate,
+        cmndline
);

}
@@ -280,4 +303,3 @@

return NULL;
}
-
diff -ur Proc-ProcessTable-0.41.orig/os/cygwin.h Proc-ProcessTable-0.4
+1/os/cygwin.h
--- Proc-ProcessTable-0.41.orig/os/cygwin.h    2003-05-19 09:35:17.000
+000000 -0700
+++ Proc-ProcessTable-0.41/os/cygwin.h    2006-09-04 17:01:39.32812500
+0 -0700
@@ -8,4 +8,5 @@
"start",
"ttynum",
"state",
+    "cmndline",
};

```package Foo;

sub new {
my (\$conn) = @_;
return bless { CONN => \$conn };
}

my (\$self, @args) = @_;
my (\$class, \$method) = (our \$AUTOLOAD) =~ /(.*)::(.*)/s;
return \$self->{CONN}->\$method(@args);
}

1;
```package Common::DBI::st::timeout;

# magic to support getting/setting attributes on the returned statemen
+t handle
use overload fallback => 1, '%{}' => sub { \$_[0]->sth };

use base 'Common::Thing';

__PACKAGE__->make_attributes( qw( timeout sth ) );

sub _init {
my ( \$self, %parms ) = @_;

\$self->SUPER::_init();
\$self->seed( \%parms );
}
# redispatch methods to DBI::st, applying timeout if so requested
my (\$self, @args) = @_;
my (\$class, \$method) = (our \$AUTOLOAD) =~ /(.*)::(.*)/s;

my \$timeout = \$self->timeout();
my @results;
my \$wantarray = wantarray;
my \$sth = \$self->sth();
my \$timed_out = Common::DBI::_timeout_call( \$timeout, sub {
if (\$wantarray) {
@results = \$sth->\$method(@args);
}
elsif (defined \$wantarray) {
\$results[0] = \$sth->\$method(@args);
}
else {
\$sth->\$method(@args);
}
} );

if (\$timed_out) {
my \$dbh = \$sth->{'Database'};
my \$driver = \$dbh->{'Driver'}{'Name'};

# Oracle 9i blows up if you try accessing it after a t
+imeout
if (\$driver eq 'Oracle') {
\$dbh->{'Active'} = 0;
\$sth->{'Active'} = 0;
}

die Common::Exception->new(
'Common::DBI::StatementTimeout',
{
'driver' => \$driver,
'database' => \$dbh->{'Name'},
'method' => \$method,
}
);
}

return( \$wantarray ? @results : \$results[0] );
}

1;

Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (1)
As of 2018-01-22 06:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
How did you see in the new year?

Results (232 votes). Check out past polls.

Notices?