File-AptFetch

 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.

t/0.t  view on Meta::CPAN


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],

t/v-method  view on Meta::CPAN


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,



( run in 1.631 second using v1.01-cache-2.11-cpan-71847e10f99 )