lib/Perlbal/ChunkedUploadState.pm

   1 package Perlbal::ChunkedUploadState;
   2 use strict;
   3
   4 sub new {
   5     my ($pkg, %args) = @_;
   6     my $self = bless {
   7         'buf' => '',
   8         'bytes_remain' => 0,  # remaining in chunk (ignoring final 2 byte CRLF)
   9     }, $pkg;
  10     foreach my $k (qw(on_new_chunk on_disconnect on_zero_chunk)) {
  11         $self->{$k} = (delete $args{$k}) || sub {};
  12     }
  13     die "bogus args" if %args;
  14     return $self;
  15 }
  16
  17 sub on_readable {
  18     my ($self, $ds) = @_;
  19     my $rbuf = $ds->read(131072);
  20     unless (defined $rbuf) {
  21         $self->{on_disconnect}->();
  22         return;
  23     }
  24
  25     $self->{buf} .= $$rbuf;
  26
  27     while ($self->drive_machine) {}
  28 }
  29
  30 # returns 1 if progress was made parsing buffer
  31 sub drive_machine {
  32     my $self = shift;
  33
  34     my $buflen = length($self->{buf});
  35     return 0 unless $buflen;
  36
  37     if (my $br = $self->{bytes_remain}) {
  38         my $extract = $buflen > $br ? $br : $buflen;
  39         my $ch = substr($self->{buf}, 0, $extract, '');
  40         $self->{bytes_remain} -= $extract;
  41         die "assert" if $self->{bytes_remain} < 0;
  42         $self->{on_new_chunk}->(\$ch);
  43         return 1;
  44     }
  45
  46     return 0 unless $self->{buf} =~ s/^(?:\r\n)?([0-9a-fA-F]+)(?:;.*)?\r\n//;
  47     $self->{bytes_remain} = hex($1);
  48
  49     if ($self->{bytes_remain} == 0) {
  50         # FIXME: new state machine state for trailer parsing/discarding.
  51         # (before we do on_zero_chunk).  for now, though, just assume
  52         # no trailers and throw away the extra post-trailer \r\n that
  53         # is probably in this packet.  hacky.
  54         $self->{buf} =~ s/^\r\n//;
  55         $self->{hit_zero} = 1;
  56         $self->{on_zero_chunk}->();
  57         return 0;
  58     }
  59     return 1;
  60 }
  61
  62 sub hit_zero_chunk { $_[0]{hit_zero} }
  63
  64 1;