view release on metacpan or search on metacpan
lib/AptFetch.pm view on Meta::CPAN
waitpid delete $self->{pid}, 0 if $self->{pid};
$self->{ALRM_error} and return
qq|($self->{method}): (apt-config): timeouted|;
# XXX:201405122039:whynot: I<$CHLD_error> is C<0> here. But we don't care.
$self->{CHLD_error} and return
qq|($self->{method}): (apt-config) died: ($self->{CHLD_error})|;
@{$self->{log}} or return
qq|($self->{method}): (apt-config): failed to output anything|;
my @cache;
while( my $line = shift @{$self->{log}} ) {
my( $name, $value ) = split m{ }, $line, 2;
$name !~ m{^[\w/:.+-]+$} ||
$name =~ m{(?<!:)(?:::)*:(?!:)} ||
!$value || $value !~ m{^"([^"]*)";$} and return
qq|($self->{method}): ($line): that's unparsable|;
($value = $1) eq '' and next;
undef while $name =~ s{::::$}{::};
$value =~ s{ }{%20}g;
$value =~ s{=}{%3d}g;
push @cache, qq|$name=$value| }
unless( File::AptFetch::ConfigData->config( q|lib_method| )) {
lib/AptFetch.pm view on Meta::CPAN
my $rc;
$rc +=
$_read_callback->( $_ ) || 0 foreach values %{$self->{trace}};
if( $rc ) { $timeout = $self->{timeout} }
elsif( $timeout < 0 ) { $self->{ALRM_error} = 1; last }}
elsif( not defined( my $flag =
$self->{me}->sysread( my $buffer, 4096 )) ) {
die qq|[sysread] ($self->{method}) $!| }
elsif( $flag ) {
$buffer = $$leftover . $buffer;
my @prelog = split m{\n}, $buffer, -1;
# WORKAROUND:202301052252:whynot: If C<chop $buffer> is C<\n> then B<split()> spews in one more trailing empty string (that empty string will break fscking everything).
## XXX:202301062317:whynot: Correctness of log entry processing lacks explicit testing. Sorry about that.
# XXX:202301070412:whynot: Here's the deal. If C<chop $buffer> is C<\n> then surprise empty string resets I<$leftover>. If C<chop> isn't then I<$leftover> is refilled. Neat :)
$$leftover = pop @prelog;
push @{$self->{log}}, @prelog;
# WORKAROUND:201404232105:whynot: If method goes insane and bursts in one+ properly empty line separated messages then the separating empty line could got lost between.
# XXX:201404232106:whynot: That's F<t/v-method> what does it, AAMF.
# http://www.cpantesters.org/cpan/report/b19908e8-c870-11e3-aee5-9ca1c294a800
grep $_ eq '', @prelog and last }
elsif( !$flag ) {
lib/AptFetch.pm view on Meta::CPAN
sub _read_callback {
my $st = shift;
defined $st->{filename} or return undef;
$st->{tick} =
File::AptFetch::ConfigData->config( q|tick| ) unless $st->{tick};
$st->{flag} = 5 unless defined $st->{flag};
$st->{tmp} = ( glob qq|$st->{filename}*| )[0] unless defined $st->{tmp};
unless( defined $st->{tmp} ) {
# TODO:201403040310:whynot: Here comes diagnostics.
# warn sprintf qq|(%s) (%i): missing, ticks left\n|, ( split m{/}, $st->{filename} )[-1], $st->{flag} - 1
}
elsif( !-f $st->{tmp} ) {
# TODO:201403040310:whynot: Here could be diagnostics too.
# warn sprintf qq|(%s): disappeared, forcing sync\n|, ( split m{/}, $st->{filename} )[-1];
undef $st->{tmp} }
else {
@$st{qw| size back |} = ( -s $st->{tmp}, $st->{size} || 0 );
$st->{factor} = $st->{size} / ( $st->{tick} * 15 * 1024 * 1024 );
$st->{factor} = 1 if 1 > $st->{factor};
$st->{flag} = 5 * $st->{factor} if $st->{size} - $st->{back} }
0 < $st->{flag}-- }
set_callback read => \&_read_callback;
lib/Simple.pm view on Meta::CPAN
my $beat =
defined $args->{beat} ? $args->{beat} :
defined $self->{beat} ? $self->{beat} :
File::AptFetch::ConfigData->config( q|beat| );
# XXX:201405112010:whynot: That's just going to blow in your face.
$self->{cheat_beat} = $beat ? "\r" : '';
my $rv = $self->SUPER::request( map {
my $src = $_;
$src =~ s{^file:}{copy:} unless $self->{force_file};
my $bnam = ( split m{/} )[-1];
qq|$loc/$bnam| => { uri => $src } } @subj );
$rv and croak $rv;
while( %{$self->{trace}} ) {
$rv = $self->SUPER::gain;
$rv and croak $rv;
my $fn = $self->{message}{uri};
unless( $fn ) {
# TODO:201403302300:whynot: Not in test-suite.
# TODO:201403302300:whynot: Additional diagnostics is missing.
my @fails;
while( -1 != ( my $pid = wait )) { push @fails, $pid }
FAFTS_diag join ' ', map qq|[$_]|, @fails if @fails;
ok !@fails, @fails . q| zombies found| or BAIL_OUT q|zombies|;
my $serr = t::TestSuite::FAFTS_get_file $stderr;
is $serr, qq|{{{TERM}}}\n|, qq|{STDERR} isn't empty| or
BAIL_OUT q|no {STDERR}|;
unless( -t STDOUT || -f q|Changes.pod| ) {
$serr = [ split m{\n}, $serr ];
print STDERR qq|# $_\n| foreach @$serr }
# vim: syntax=perl
t/0/9raCtd.t view on Meta::CPAN
FAFTS_diag q|+++ STDOUT +++|;
$sout = FAFTS_get_file $sout;
FAFTS_diag q|+++ method STDERR +++|;
FAFTS_get_file $mthd_serr;
FAFTS_diag q|+++ source STDERR +++|;
FAFTS_get_file $src_serr;
if( $check == $pid && $cerr == 0xff00 && $serr =~ m{ 2 tests but ran 1\.} ) {
plan tests => 1; ok 1, qq|($^V) is| }
else {
plan skip_all =>
sprintf q|(%vd): %s # %x|, $^V, ( split m{\n}, $serr )[0], $cerr }
# vim: syntax=perl
t/0/EmMn8o.t view on Meta::CPAN
my $cerr = $?;
FAFTS_diag q|+++ STDERR +++|;
$serr = FAFTS_get_file $serr;
FAFTS_diag q|+++ STDOUT +++|;
$sout = FAFTS_get_file $sout;
if( $check == $pid && $cerr == 0xff00 && $serr =~ m{ 2 tests but ran 1\.} ) {
plan tests => 1; ok 1, qq|($^V) is| }
else {
plan skip_all =>
sprintf q|(%vd): %s # %x|, $^V, ( split m{\n}, $serr )[0], $cerr }
# vim: syntax=perl
t/ReadCallback.pm view on Meta::CPAN
[{ tag => q|tag+3551|, eval => [qw| filename tmp |]},
sub { t::TestSuite::FAFTS_set_file( $main::file, qq|tag+e6c3\n| ) },
[ 1, '',
{ filename => q|$file|, tmp => q|$file|, size => 9, back => 9,
flag => 2, factor => 1, tick => 5 } ] ],
[{ tag => q|tag+c909|, eval => [qw| filename tmp |]},
sub {
$main::file = t::TestSuite::FAFTS_tempfile(
nick => q|ftag56c6|, dir => $main::dsrc, unlink => !0 );
$main::faux = ( File::Temp::tempfile(
sprintf( q|%s.XXXX|, ( split m{/}, $main::file)[-1]),
DIR => $main::dsrc ) )[-1];
t::TestSuite::FAFTS_diag( qq|\$faux: $main::faux| );
t::TestSuite::FAFTS_set_file( $main::faux, qq|tag+e94a\n| );
$main::fdat = { filename => $main::file } },
[ 1, '',
{ filename => q|$file|, tmp => q|$faux|, size => 9, back => 0,
flag => 4, factor => 1, tick => 5 } ] ],
[{ tag => q|tag+9f0f|, eval => [qw| filename tmp |]},
sub { t::TestSuite::FAFTS_append_file( $main::faux, qq|tag+9930\n| ) },
[ 1, '',
t/TestSuite.pm view on Meta::CPAN
probably canonicalized.
A filehandle is implicitly closed.
=cut
my @Tempfiles = ( $$ );
sub FAFTS_tempfile ( % ) {
my %args = @_;
my $fn =
sprintf q|skip_%s_%s_XXXX|,
$args{caller} || ( split m{/}, ( caller )[1])[-1],
$args{nick} || q|void|;
my $fh;
( $fh, $fn ) = tempfile $fn,
DIR => $args{dir} || cwd, SUFFIX => $args{suffix} || '';
push @Tempfiles, $fn;
print $fh $args{content} if $args{content};
unlink $fn or croak qq|[unlink] ($fn): $!| if $args{unlink};
return $fn }
END { unlink @Tempfiles if $$ == shift @Tempfiles }
t/TestSuite.pm view on Meta::CPAN
Returns dirname.
If I<$args{dir}> is set, then dirname is expanded to be fully qualified;
no canonicalization.
=cut
sub FAFTS_tempdir ( % ) {
my %args = @_;
my $dn = sprintf q|skip_%s_%s_XXXX|,
$args{caller} || ( split m{/}, ( caller )[1])[-1],
$args{nick} || q|void|;
$dn = tempdir $dn,
DIR => $args{dir}, SUFFIX => $args{suffix}, CLEANUP => 1;
$dn = sprintf q|%s/%s|, cwd, $dn unless $args{dir};
return $dn }
=item B<FAFTS_cat_fn()>
use t::TestSuite qw/ :temp /;
$new_file = FAFTS_cat_fn $new_dir, $old_file;
A helper routine.
Assists with a target filename preparation.
Returns a basename of I<$old_file> concatenated with I<$new_dir>.
B<(note)> Stolen from DFS (should've been done years ago).
=cut
sub FAFTS_cat_fn ( $$ ) { sprintf q|%s/%s|, shift, ( split m{/}, shift )[-1] }
=item B<FAFTS_get_file()>
use t::TestSuite qw/ :file /;
$content = FAFTS_get_file $filename;
Simple file content retriever.
Whatever has been retrieved is passed to L</B<FAFTS_diag()>>.
=cut
t/TestSuite.pm view on Meta::CPAN
# XXX:201403151708:whynot: Can't use B<FAFTS_get_file()> because it will B<diag()> retrieved. And it's not going to change.
open my $fhi, q|<|, qq|t/$method|;
read $fhi, my $buf, -s $fhi;
FAFTS_set_file $fh, <<END_OF_METHOD . join '', map qq|$_\n|, @cmds;
$buf;
__DATA__
$stderr
END_OF_METHOD
chmod 0755, $fh or croak qq|[chmod] ($fh): $!|;
( split m{/}, $fh )[-1] }
=item B<FAFTS_wrap()>
use t::TestSuite qw/ :mthd /;
( $rv, $stderr, $stdout ) = FAFTS_wrap { die q|gotch ya| };
Safety wrapper around code that could B<die> or B<fork>-and-B<die>.
Returns whatever I<code>.
If I<code> fails, then I<$@> is returned.
In list context also returns whatever has been printed
t/gain-callback/simple.t view on Meta::CPAN
my $Apt_Lib = t::TestSuite::FAFTS_discover_lib;
plan !defined $Apt_Lib ?
( skip_all => q|not *nix, or misconfigured| ) : ( tests => scalar @units );
while( my $unit = shift @units ) {
$t::TestSuite::Diag_Tag = $unit->[0]{tag};
$unit->[1]->();
if( $unit->[0]{init} ) {
( $faf, $serr ) = FAFTS_wrap {
t::TestSuite::FAFS->request( { map {
$unit->[0]{tag} . (split m{_})[-2] => { filename => $_ } }
@file }) };
ok !$serr, $unit->[0]{tag} }
elsif( $unit->[0]{fail} ) {
( $rv, $serr ) = FAFTS_wrap { $faf->tick };
$sdat = [ $unit->[0]{stderr} ? $serr =~ m($unit->[0]{stderr}) : ( ) ];
is_deeply [ $rv =~ m|$unit->[0]{fail}|, scalar @$sdat ], $unit->[2],
$unit->[0]{tag} }
else {
( $rv, $serr ) = FAFTS_wrap { $faf->tick };
$sdat = [ $unit->[0]{stderr} ? $serr =~ m($unit->[0]{stderr}) : ( ) ];
t/select-callback/simple.t view on Meta::CPAN
my $msgb = qr{\Atag-b29c\x5b([ \d.]+b/s)\x5d};
my $msgk = qr{\Atag-b29c\x5b([ \d.]+K/s)\x5d};
my $msgm = qr{\Atag-b29c\x5b([ \d.]+M/s)\x5d};
@units =
([{ tag => q|tag+3413|, init => !0 },
sub {
@file = ( FAFTS_tempfile
nick => q|ftag87c0|, dir => $dsrc, unlink => !0 );
@faux = ( (File::Temp::tempfile
+(split m{/}, $file[0])[-1] . q|_XXXX|, DIR => $dsrc)[-1] );
unlink @faux } ],
[{ tag => q|tag+b835|, stderr => qr{^$} }, sub { }, [ '', 1 ] ],
[{ tag => q|tag+d742|, stderr => $msgv },
sub { FAFTS_set_file $faux[0] => '' },
[ '', 1 ] ],
[{ tag => q|tag+875b|, stderr => $msgv }, sub { }, [ '', 1 ] ],
[{ tag => q|tag+23a7|, stderr => $msgv },
sub { FAFTS_append_file $faux[0] => q|tag+f332| },
[ '', 1 ] ],
[{ tag => q|tag+c140|, stderr => $msgb },
t/select-callback/simple.t view on Meta::CPAN
[{ tag => q|tag+81d0|, stderr => $msgk }, sub { }, [ '', 1 ] ],
[{ tag => q|tag+fe6a|, stderr => $msgv }, sub { }, [ '', 1 ] ],
[{ tag => q|tag+cc16|, stderr => $msgv }, sub { }, [ '', 1 ] ],
[{ tag => q|tag+9325|, init => !0 },
sub {
@file =
( FAFTS_tempfile( nick => q|ftag979b|, dir => $dsrc, unlink => !0 ),
FAFTS_tempfile( nick => q|ftagf21d|, dir => $dsrc, unlink => !0 ) );
@faux =
( (File::Temp::tempfile
+(split m{/}, $file[0])[-1] . q|_XXXX|, DIR => $dsrc)[-1],
(File::Temp::tempfile
+(split m{/}, $file[1])[-1] . q|_XXXX|, DIR => $dsrc)[-1] );
unlink @faux } ],
[{ tag => q|tag+0021|, stderr => $msgv }, sub { }, [ '', 1 ] ],
[{ tag => q|tag+9086|, stderr => $msgv },
sub { FAFTS_append_file $faux[0] => q|tag+d1c8| x 100 },
[ '', 1 ] ],
[{ tag => q|tag+385d|, stderr => $msgk },
sub { FAFTS_append_file $faux[1] => q|tag+7463| x 10 },
[ '', 1 ] ],
[{ tag => q|tag+3225|, stderr => $msgb },
sub {
t/select-callback/simple.t view on Meta::CPAN
$dsrc = FAFTS_tempdir nick => q|dtag4080|;
while( my $unit = shift @units ) {
$t::TestSuite::Diag_Tag = $unit->[0]{tag};
$unit->[1]->();
FAFTS_show_message %$_ foreach @$fdat;
if( $unit->[0]{init} ) {
( $faf, $serr ) = FAFTS_wrap {
t::TestSuite::FAFS->request( { map {
$unit->[0]{tag} . (split m{_})[-2] => { filename => $_ } }
@file }) };
$fdat = [ values %{$faf->{trace}} ];
ok !$serr, $unit->[0]{tag} }
else {
unless( exists $unit->[0]{sleep} ) { sleep 1 }
elsif( !$unit->[0]{sleep} ) { }
else { sleep $unit->[0]{sleep} }
( $rv, $serr ) = FAFTS_wrap { $faf->tick };
$sdat = [ $unit->[0]{stderr} ? $serr =~ m($unit->[0]{stderr}) : ( ) ];
is_deeply [ $rv, scalar @$sdat ], $unit->[2],
use IO::Handle;
STDOUT->autoflush( 1 );
my $fn = DATA->getline;
chomp $fn;
open STDERR, q|>>|, $fn or die qq|[open] (STDERR): $!|;
my $tout = DATA->getline;
chomp $tout;
$tout = [ split m{:}, $tout, 2 ];
my $rv = $tout->[1] || 0;
$tout = $tout->[0];
my $mark = time;
$SIG{ALRM} = sub { exit $rv };
alarm $tout;
# http://www.cpantesters.org/cpan/report/a89a6424-f5bd-11e3-a67d-9fe3ee8e7edf
# http://www.cpantesters.org/cpan/report/b6730998-f5e0-11e3-a67d-9fe3ee8e7edf
# http://www.cpantesters.org/cpan/report/fc49f1c6-f477-11e3-a67d-9fe3ee8e7edf
# http://www.cpantesters.org/cpan/report/eaf540be-f437-11e3-a67d-9fe3ee8e7edf
# http://www.cpantesters.org/cpan/report/8b275224-f7cc-11e3-a67d-9fe3ee8e7edf
# http://www.cpantesters.org/cpan/report/287848b4-f771-11e3-a67d-9fe3ee8e7edf
# http://www.cpantesters.org/cpan/report/63bbe4ac-f5ab-11e3-a67d-9fe3ee8e7edf
my $data = [ DATA->getlines ];
chomp @$data;
unshift @$data, split m{\n}, <<"END_OF_HEADER";
100 Capabilities
Single-Instance: true
Version: $VERSION
___
END_OF_HEADER
my $self = ( split m{/}, $0 )[-1] . ':';
for(;;) {
while( defined( my $line = shift @$data )) {
$line eq q|___| and last;
$line =~ s{\Q+++\E}{$self}g;
print STDERR qq|[$line]\n|;
print STDOUT qq|$line\n|;
$line or last }
while( my $line = STDIN->getline ) {
chomp $line;
t/void/handshake.t view on Meta::CPAN
( $rv, $serr ) = FAFTS_wrap { File::AptFetch->init( q|void| ) };
like $rv, qr{^\Q(void): (\E\d+\): died without handshake}sm,
q|F::AF->init fails with broken I<lib_method>|;
File::AptFetch::ConfigData->set_config(lib_method => $arena );
( $rv, $serr ) = FAFTS_wrap { File::AptFetch->init( q|void| ) };
like $rv, qr{^\Q(void): (\E\d+\): died without handshake}sm,
q|F::AF->init fails with empty I<lib_method>|;
my $method =
( split m{/}, FAFTS_tempfile nick => q|mtag163b|, dir => $arena )[-1];
( $rv, $serr ) = FAFTS_wrap { File::AptFetch->init( $method ) };
like $rv, qr{^\Q($method): (\E\d+\): died without handshake}sm,
q|F::AF->init fails with unexecutable method|;
$method = FAFTS_tempfile nick => q|mtag6d9d|, dir => $arena;
chmod 0755, $method;
$method = ( split m{/}, $method )[-1];
$rv = FAFTS_wrap { File::AptFetch->init( $method ) };
like $rv, qr{^\Q($method): (0): died without handshake}sm,
q|F::AF->init fails with empty executable|;
FAFTS_prepare_method
FAFTS_tempfile( nick => q|mtag798e|, dir => $arena ),
q|x-method|, $stderr, q|25|;
$method = ( split qr{/}, $method )[-1];
( $rv, $serr ) = FAFTS_wrap { File::AptFetch->init( $method ) };
like $rv, qr{^\Q($method): (0): died without handshake}sm,