File Coverage

blib/lib/AnyEvent/HTTP/MXHR.pm

Criterion	Covered	Total	%
statement	53	66	80.3
branch	8	16	50.0
condition	2	4	50.0
subroutine	9	11	81.8
pod	1	1	100.0
total	73	98	74.4

package AnyEvent::HTTP::MXHR;
use strict;
use AnyEvent '6.01';
use AnyEvent::HTTP;
use AnyEvent::Util qw(guard);
use base qw(Exporter);
our @EXPORT = qw(mxhr_get);
our $VERSION = '0.00007';

sub mxhr_get ($@) {
    my $cb = pop;
    my ($uri, %args) = @_;

    my $on_error = delete $args{on_error} || sub {
        require Carp;
        Carp::confess("@_");
    };
    my $on_eof   = delete $args{on_eof} || sub { };
    my %state;
    $state{guard} = http_get $uri, %args,
        want_body_handle => 1,
        on_error  => $on_error,
        on_header => sub {
            my ($headers) = @_;

            if ($headers->{"content-type"} =~ m{^multipart/mixed\s*;\s*boundary="([^"]+)"}) {
                $state{boundary} = $1;
                $state{boundary_re} = qr!(?:^|\r?\n)--$state{boundary}\n?!;
                return 1;
            } else {
                %state = ();
                $on_error->("Header not found");
                return ();
            }
        },
        sub {
            my $handle = shift;
            if (! $handle) {
                undef $state{guard};
                %state = ();
                $on_error->("Connection failed") if $on_error;
                return ();
            }

            $state{handle} = $handle;

            my $callback; $callback = sub {
                my ($handle, $data) = @_;

                return unless %state;
                $data =~ s/^\s+//;
                if ($data !~ s/(?:^|\r?\n)--$state{boundary}\n?$// ) {
                    # shouldn't even get here
                    if ($handle->{on_error}) {
                        $handle->{on_error}->("No boundary found");
                    }
                    return;
                }

                if ($data !~ s/^(.+?)\015?\012\015?\012// ) {
                    # XXX opting to ignore the data, but should we?
                    $handle->push_read(regex => $state{boundary_re}, $callback);
                    return 1;
                }
                my $headers = $1;

                my %headers = map {
                    my ($n, $v) = split(/:\s*/, $_, 2);
                    # lower case it to align with the rest of AE::HTTP
                    $n = lc $n;
                    ($n, $v);
                } split(/\r?\n/, $headers);
                if (! eval { $cb->($data, \%headers, $handle) }) {
                    %state = ();
                    return;
                }

                $handle->push_read(regex => $state{boundary_re}, $callback);
                return 1;
            };

            $handle->push_read(regex => $state{boundary_re}, $callback );
            return 1;
        }
    ;

    return guard { %state = () };

}

1;

__END__