File Coverage

blib/lib/Plack/Middleware/Mirror.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	30	38	78.9
condition	5	7	71.4
subroutine	16	16	100.0
pod	2	4	50.0
total	124	136	91.1

# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
#
# This file is part of Plack-Middleware-Mirror
#
# This software is copyright (c) 2011 by Randy Stauner.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;

package Plack::Middleware::Mirror;
BEGIN {
  $Plack::Middleware::Mirror::VERSION = '0.401';
}
BEGIN {
  $Plack::Middleware::Mirror::AUTHORITY = 'cpan:RWSTAUNER';
}
# ABSTRACT: Save responses to disk to mirror a site

use parent 'Plack::Middleware';
use Plack::Util;
use Plack::Util::Accessor qw( path mirror_dir debug status_codes );
use HTTP::Date ();

use File::Path ();
use File::Spec ();

sub call {
  my ($self, $env) = @_;

  # if we decide not to save fall through to wrapped app
  return $self->_save_response($env) || $self->app->($env);
}

# is there any sort of logger available?
sub debug_log {
  my ($self, $message) = @_;
  print STDERR ref($self) . " $message\n"
    if $self->debug;
}

sub prepare_app {
  my ($self) = @_;
  $self->status_codes([200])
    unless defined $self->status_codes;
}

sub _save_response {
  my ($self, $env) = @_;

  # this path matching stuff stolen straight from Plack::Middleware::Static
  my $path_match = $self->path or return;
  my $path = $env->{PATH_INFO};

  for ($path) {
    my $matched = 'CODE' eq ref $path_match ? $path_match->($_) : $_ =~ $path_match;
    return unless $matched;
  }

  # TODO: should we use Cwd here?
  my $dir = $self->mirror_dir || 'mirror';

  my $file = File::Spec->catfile($dir, split(/\//, $path));
  my $fdir = File::Spec->catdir( (File::Spec->splitpath($file))[0, 1] ); # dirname()

  my $content = '';

  $self->debug_log("preparing to mirror: $path")
    if $self->debug;

  # fall back to normal request, but intercept response and save it
  return $self->response_cb(
    $self->app->($env),
    sub {
      my ($res) = @_;

      return unless $self->should_mirror_status($res->[0]);

      # content filter
      return sub {
        my ($chunk) = @_;

        # end of content
        if ( !defined $chunk ) {

          $self->debug_log("attempting to save: $path => $file")
            if $self->debug;

          # if writing to the file fails, don't kill the request
          # (we'll try again next time anyway)
          local $@;
          eval {
            File::Path::mkpath($fdir, 0, oct(777)) unless -d $fdir;

            open(my $fh, '>', $file)
              or die "Failed to open '$file': $!";
            binmode($fh);
            print $fh $content
              or die "Failed to write to '$file': $!";
            # explicitly close fh so we can set the mtime below
            close($fh)
              or die "Failed to close '$file': $!";

            # copy mtime to file if available
            if ( my $lm = Plack::Util::header_get($$res[1], 'Last-Modified') ) {
              $lm =~ s/;.*//; # strip off any extra (copied from HTTP::Headers)
              # may return undef which we could pass to utime, but why bother?
              # zero (epoch) may be unlikely but is possible
              if ( defined(my $ts = HTTP::Date::str2time($lm)) ) {
                utime( $ts, $ts, $file );
              }
            }
          };
          warn $@ if $@;
        }
        # if called multiple times, concatenate response
        else {
          $content .= $chunk;
        }
        return $chunk;
      }
    }
  );
}

sub should_mirror_status {
  my ( $self, $res_code ) = @_;
  my $codes = $self->status_codes || [ 200 ];

  # if codes is an empty arrayref don't restrict by code, just allow all
  return 1 if ! @$codes;

  # if status code is one of the accepted codes, return true
  foreach my $code ( @$codes ) {
    return 1 if $res_code == $code;
  }

  # if none of the above is true don't mirror
  $self->debug_log("ignoring unwanted status ($res_code)")
    if $self->debug;
  return 0;
}

1;


__END__