view release on metacpan or  search on metacpan

lib/Wallflower.pm  view on Meta::CPAN

    $segments[-1] = $self->index if $segments[-1] eq '';

    # generate target file name
    return Path::Tiny->new( $self->destination, grep length, @segments );
}

# Wallflower::NULL drops the streamed data
for (qw( write close )) {
    no strict 'refs';
    *{"Wallflower::NULL::$_"} = sub { };
}

sub _build_handle {
    my ($file) = @_;

    # get a file to save the content in
    my $dir = $file->parent;
    eval { $dir->mkpath; 1; } or die "$@\n"
      if !-e $dir;
    open my $fh, '> :raw', $file    # no stinky crlf on Win32
      or die "Can't open $file for writing: $!\n";

    return $fh;
}

# save the URL to a file
sub get {
    my ( $self, $uri ) = @_;
    $uri = URI->new($uri) if !ref $uri;

    # absolute paths have the empty string as their first path_segment
    croak "$uri is not an absolute URI"
        if $uri->path && length +( $uri->path_segments )[0];

    # setup the environment
    my $env = {

        # current environment
        %ENV,

        # overridable defaults
        'psgi.errors' => \*STDERR,

        # current instance defaults
        %{ $self->env },
        ('psgi.url_scheme' => $self->url->scheme )x!! $self->url->scheme,

        # request-related environment variables
        REQUEST_METHOD => 'GET',

        # request attributes
        SCRIPT_NAME     => '',
        PATH_INFO       => $uri->path,
        REQUEST_URI     => $uri->path,
        QUERY_STRING    => '',
        SERVER_NAME     => $self->url->host,
        SERVER_PORT     => $self->url->port,
        SERVER_PROTOCOL => "HTTP/1.0",

        # wallflower defaults
        'psgi.streaming' => 1,
    };

    # add If-Modified-Since headers if the target file exists
    my $target = $self->target($uri);
    $env->{HTTP_IF_MODIFIED_SINCE} = time2str( ( stat _ )[9] ) if -e $target;

    # fixup URI (needed to resolve relative URLs in retrieved documents)
    $uri->scheme( $env->{'psgi.url_scheme'} ) if !$uri->scheme;
    $uri->host( $env->{SERVER_NAME} ) if !$uri->host;

    # get the content
    my ( $status, $headers, $file, $content ) = ( 500, [], '', '' );
    my $res = Plack::Util::run_app( $self->application, $env );

    if ( ref $res eq 'ARRAY' ) {
        ( $status, $headers, $content ) = @$res;
    }
    elsif ( ref $res eq 'CODE' ) {

        # https://metacpan.org/pod/PSGI#Delayed-Response-and-Streaming-Body
        $res->( sub {
            my $response = shift;

            # delayed response
            ( $status, $headers, $content ) = @$response;

            # streaming
            if ( !defined $content ) {
                return bless {}, 'Wallflower::NULL'
                  if $status ne '200';    # we don't care about the body
                return _build_handle( $file = $target );
            }
            return;
        } );
    }
    else { croak "Unknown response from application: $res"; }

    # save the content to a file
    if ( $status == 200 ) {
        my $fh = defined $content && do {
            eval { _build_handle( $file = $target ) }
              or do { warn $@; return [ 999, [], '' ]; };
        };

        # copy content to the file
        if ( ref $content eq 'ARRAY' ) {
            print $fh @$content;
        }
        elsif ( ref $content eq 'GLOB' ) {
            local $/ = \8192;
            print {$fh} $_ while <$content>;
            close $content;
        }
        elsif ( eval { $content->can('getline') } ) {
            local $/ = \8192;
            while ( defined( my $line = $content->getline ) ) {
                print {$fh} $line;
            }
            $content->close;
        }
        elsif ( !defined $content ) { }    # already streamed
        else {
            croak "Don't know how to handle body: $content";
        }

        # finish
        close $fh;

        # if the app sent Last-Modified, set the local file date to that
        if ( my $last_modified = HTTP::Headers::Fast->new(@$headers)
             ->header('Last-Modified') ) {
            my $epoch = str2time( $last_modified );
            utime $epoch, $epoch, $file;
        }
    }
    elsif ( $status == 304 ) {
        $file = $target;
    }

    return [ $status, $headers, $file ];
}

1;

__END__

=pod