#!perl
BEGIN {
eval
"use Event;"
; }
use
POE
qw(Component::CPAN::YACSmoke Wheel::ReadWrite)
;
$|=1;
my
(
$perl
,
$jobs
,
$appdata
,
$indices
,
$version
,
$reverse
,
$package
,
$author
,
$nogrpkill
,
$logdir
);
my
$debug
= 0;
GetOptions(
'perl=s'
=> \
$perl
,
'jobs=s'
=> \
$jobs
,
'debug'
=> \
$debug
,
'appdata'
=> \
$appdata
,
'indices'
=> \
$indices
,
'version'
=> \
$version
,
'reverse'
=> \
$reverse
,
'author=s'
=> \
$author
,
'package=s'
=> \
$package
,
'nogrpkill'
=> \
$nogrpkill
,
'logdir=s'
=> \
$logdir
);
if
(
$version
) {
print
"$0 - version "
,
$POE::Component::CPAN::YACSmoke::VERSION
,
"\n"
;
exit
0;
}
die
"'$logdir' doesn\'t exist or isn't a directory\n"
if
$logdir
and not -d
$logdir
;
$ENV
{APPDATA} =
$appdata
if
$appdata
;
my
@pending
;
if
(
$jobs
) {
open
my
$fh
,
"<$jobs"
or
die
"$jobs: $!\n"
;
while
(<
$fh
>) {
chomp
;
push
@pending
,
$_
;
}
close
(
$fh
);
}
my
$smoker
= POE::Component::CPAN::YACSmoke->spawn(
alias
=>
'smoker'
,
debug
=>
$debug
,
options
=> {
trace
=> 0 },
perl
=>
$perl
,
no_grp_kill
=>
$nogrpkill
);
POE::Session->create(
package_states
=> [
'main'
=> [
qw(_start _start_smoking _stop _results _recent _check _indices _search _kill_log _kill_flush _kill_error)
],
],
heap
=> {
perl
=>
$perl
,
pending
=> \
@pending
,
indices
=>
$indices
},
);
$poe_kernel
->run();
exit
0;
sub
_start {
my
(
$kernel
,
$heap
) =
@_
[KERNEL,HEAP];
$kernel
->post(
'smoker'
,
'check'
, {
event
=>
'_check'
,
debug
=>
$debug
} );
undef
;
}
sub
_check {
my
(
$kernel
,
$heap
,
$job
) =
@_
[KERNEL,HEAP,ARG0];
unless
(
$job
->{status} == 0 ) {
my
$perl
=
$heap
->{perl} || $^X;
warn
"$perl doesn't have CPAN::YACSmoke installed. Aborting\n"
;
return
;
}
if
(
$heap
->{indices} ) {
$kernel
->post(
'smoker'
,
'indices'
, {
event
=>
'_indices'
,
debug
=>
$debug
} );
return
;
}
$kernel
->yield(
'_start_smoking'
);
undef
;
}
sub
_indices {
$poe_kernel
->yield(
'_start_smoking'
);
return
;
}
sub
_start_smoking {
my
(
$kernel
,
$heap
) =
@_
[KERNEL,HEAP];
$heap
->{_start_time} =
time
();
if
( @{
$heap
->{pending} } ) {
$kernel
->post(
'smoker'
,
'submit'
, {
event
=>
'_results'
,
module
=>
$_
,
debug
=>
$debug
} )
for
@{
$heap
->{pending} };
}
elsif
(
$author
) {
$kernel
->post(
'smoker'
,
'author'
, {
event
=>
'_search'
,
search
=>
$author
,
debug
=>
$debug
} );
}
elsif
(
$package
) {
$kernel
->post(
'smoker'
,
'package'
, {
event
=>
'_search'
,
search
=>
$package
,
debug
=>
$debug
} );
}
else
{
$kernel
->post(
'smoker'
,
'recent'
, {
event
=>
'_recent'
,
debug
=>
$debug
} );
}
undef
;
}
sub
_stop {
my
$heap
=
$_
[HEAP];
my
$finish
=
time
();
my
$cumulative
=
$finish
-
$heap
->{_start_time};
my
@stats
=
$smoker
->statistics;
eval
{
};
unless
($@) {
$cumulative
= Time::Duration::duration_exact(
$cumulative
);
$stats
[
$_
] = Time::Duration::duration_exact(
$stats
[
$_
] )
for
2 .. 4;
}
$poe_kernel
->call(
'smoker'
,
'shutdown'
);
print
STDOUT
"$0 started at: \t"
,
scalar
localtime
(
$heap
->{_start_time}),
"\n"
;
print
STDOUT
"$0 finished at: \t"
,
scalar
localtime
(
$finish
),
"\n"
;
print
STDOUT
"$0 ran for: \t"
,
$cumulative
,
"\n"
;
print
STDOUT
"$0 tot jobs:\t"
,
$stats
[1],
"\n"
;
print
STDOUT
"$0 avg run: \t"
,
$stats
[2],
"\n"
;
print
STDOUT
"$0 min run: \t"
,
$stats
[3],
"\n"
;
print
STDOUT
"$0 max run: \t"
,
$stats
[4],
"\n"
;
undef
;
}
sub
_results {
my
$job
=
$_
[ARG0];
$poe_kernel
->yield(
'_kill_log'
,
$job
->{
log
} )
if
$logdir
and (
$job
->{excess_kill} or
$job
->{idle_kill} );
return
if
$debug
;
print
STDOUT
"Module: "
,
$job
->{module},
"\n"
;
print
STDOUT
"$_\n"
for
@{
$job
->{
log
} };
undef
;
}
sub
_search {
my
(
$kernel
,
$heap
,
$job
) =
@_
[KERNEL,HEAP,ARG0];
$kernel
->post(
'smoker'
,
'submit'
, {
event
=>
'_results'
,
module
=>
$_
,
debug
=>
$debug
} )
for
@{
$job
->{results} };
undef
;
}
sub
_recent {
my
(
$kernel
,
$heap
,
$job
) =
@_
[KERNEL,HEAP,ARG0];
if
(
$reverse
) {
$kernel
->post(
'smoker'
,
'submit'
, {
event
=>
'_results'
,
module
=>
$_
,
debug
=>
$debug
} )
for
reverse
@{
$job
->{recent} };
}
else
{
$kernel
->post(
'smoker'
,
'submit'
, {
event
=>
'_results'
,
module
=>
$_
,
debug
=>
$debug
} )
for
@{
$job
->{recent} };
}
undef
;
}
sub
_kill_log {
my
(
$heap
,
$log
) =
@_
[HEAP,ARG0];
my
@data
= @{
$log
};
my
$filename
= File::Spec->catfile(
$logdir
,
join
(
''
,
time
(), $$,
'.log'
) );
open
my
$fh
,
'>'
,
$filename
or
die
"$!\n"
;
my
$wheel
= POE::Wheel::ReadWrite->new(
Handle
=>
$fh
,
FlushedEvent
=>
'_kill_flush'
,
ErrorEvent
=>
'_kill_error'
,
);
$heap
->{kill_logs}->{
$wheel
->ID() } = {
wheel
=>
$wheel
,
log
=> \
@data
};
$wheel
->put(
shift
@data
);
return
;
}
sub
_kill_flush {
my
(
$heap
,
$wheel_id
) =
@_
[HEAP,ARG0];
my
$wheel
=
$heap
->{kill_logs}->{
$wheel_id
}->{wheel};
my
$data
=
shift
@{
$heap
->{kill_logs}->{
$wheel_id
}->{
log
} };
unless
(
$data
) {
$wheel
->shutdown_input();
$wheel
->shutdown_output();
delete
$heap
->{kill_logs}->{
$wheel_id
};
return
;
}
$wheel
->put(
$data
);
return
;
}
sub
_kill_error {
my
(
$heap
,
$operation
,
$errnum
,
$errstr
,
$wheel_id
) =
@_
[HEAP,ARG0..ARG3];
warn
"Wheel $wheel_id generated $operation error $errnum: $errstr\n"
;
delete
$heap
->{kill_logs}->{
$wheel_id
};
return
;
}