view release on metacpan or  search on metacpan

lib/Simple.pm  view on Meta::CPAN

B<([cs]UM)>
Something wrong.
A message just came in and it has no I<$uri>
(it has I<$status> (C<%s>)).
It's surprise,
I've never seen messages without that identification.
B<(bug)>
Should dump the damn message.

=back

=cut

my %stat = ( mark => time, trace => [ ] );
sub request {
    my( $class, $args, @subj ) = @_;
    my $self;
    if( $class->isa( q|File::AptFetch| ) && !ref $class ) {
        defined $args  or croak q|either {$method} or {%options} is required|;
        !ref $args || q|HASH| eq ref $args                            or croak
          q|first must be either {$method} or {%options}|;
        $args = { method => $args }               unless q|HASH| eq ref $args;
        defined $args->{method}    or croak q|{$options{method}} is required|;
        $self->{force_file} = !!$args->{force_file}                         if
          defined $args->{force_file};
        my $method = $args->{method} eq q|file| && !$self->{force_file}      ?
          q|copy| : $args->{method};
        $self = File::AptFetch->init( $method );
        ref $self                                              or croak $self;
        bless $self, $class;
        $self->{wink} = !!$args->{wink}              if defined $args->{wink};
        $self->{beat} = !!$args->{beat}              if defined $args->{beat};
# FIXME:201405040354:whynot: Here F<0> has to be handled too.
        $self->{location} = $args->{location} || '.'              }
    else                                                  {
        $self = $class;
        if( $args && q|HASH| ne ref $args )  {
            unshift @subj, $args; $args = { } }
        elsif( !$args )                      {
            $args = { }                       }            }

# FIXME:201404012258:whynot: Must handle F<0> specially.
    my $loc = abs_path $args->{location} || $self->{location};
# TODO:201405020116:whynot: I<v5.12> is just behind the corner, you know.
# TODO:201405120124:whynot: Both should check for C<-t STDERR>.
    my $wink =
      defined $args->{wink} ? $args->{wink} :
      defined $self->{wink} ? $self->{wink} :
      File::AptFetch::ConfigData->config( q|wink| );
    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.
            carp qq|got ($self->{status}) without {URI:}|;        next }
        elsif( !$self->{trace}{$fn} )                                 {
# TODO:201403221929:whynot: Not in test-suite.
            carp qq|got ($self->{status}) for ($fn) without [request]| }
        my $fnm = elide $fn, 25, { truncate => q|left| };
        if( grep $self->{Status} == $_, qw| 201 400 401 402 403 |) {
            delete $self->{trace}{$fn};
            print STDERR "\n"                              if $wink }
        elsif( $self->{Status} == 200                            ) {}
# TODO:201406121825:whynot: Be more infomative, plz.
        printf STDERR qq|%s(%s): (%s)\n|,
          $self->{cheat_beat}, $fnm, $self->{status} if $wink }
    delete $self->{cheat_beat};
       $self }

=item B<_gain_callback()>

This finishes size sampling for L</B<_select_callback()>> (if applicable).
Also does a significant number of assertions (most probably useless).

=cut

sub _gain_callback           {
    my $slf = shift;
    defined $slf->{message}{uri}                                    or return;
    my $fn = $slf->{message}{uri};
    $slf->{trace}{$fn} && defined $slf->{message}{size}             or return;
# NOTE:201408010056:whynot: There're two points where I<Size:> appears: C<200> and C<201>/C<400>/...  Even if sizes mismatch it's too late to update.
    $slf->{message}{size} =~ tr/0-9//c                             and return;
    $slf->{trace}{$fn}{final_size} = $slf->{message}{size}      unless defined
      $slf->{trace}{$fn}{final_size};
    $slf->{pending} = 0;
    $slf->{pending} += $_ || 0                   foreach map $_->{final_size},
      values %{$slf->{trace}} }

=item B<_read_callback()>

This does all required sampling for L</B<_select_callback()>>.
Routine for L<B<_read>|File::AptFetch/_read> is provided by
L<parent's callback|File::AptFetch/_read_callback()>.

=cut

sub _read_callback {
    my $rec = shift;
    my $rv = File::AptFetch::_read_callback $rec;
    if( $rv )            {
        my $diff = defined $rec->{size} && defined $rec->{back} ?
                                    $rec->{size} - $rec->{back} : 0;
        $stat{inc} += $diff                                      if $diff > 0;