File Coverage

blib/lib/Plack/Middleware/AutoRefresh.pm

Criterion	Covered	Total	%
statement	77	104	74.0
branch	8	20	40.0
condition	4	12	33.3
subroutine	19	25	76.0
pod	2	2	100.0
total	110	163	67.4

package Plack::Middleware::AutoRefresh;
use strict;
use warnings;
use parent qw( Plack::Middleware );

our $VERSION = '0.08';

use Plack::Util;
use Plack::Util::Accessor qw( dirs filter wait );

use AnyEvent;
use AnyEvent::Filesys::Notify;
use JSON::Any;
use File::Slurp;
use File::ShareDir qw(dist_file);
use File::Basename;
use Carp;
use Readonly;

Readonly my $URL    => '/_plackAutoRefresh';
Readonly my $JS     => 'js/plackAutoRefresh.min.js';
Readonly my $JS_DEV => 'js/plackAutoRefresh.js';

sub prepare_app {
    my $self = shift;

    # Setup config params: filter, wait, dirs

    $self->{filter} ||= sub { $_[0] !~ qr/\.(swp|bak)$/ };
    $self->{filter} = sub { $_[0] !~ $self->filter }
      if ref( $self->filter ) eq 'Regexp';
    croak "AutoRefresh: filter must be a regex or code ref"
      unless ref( $self->filter ) eq 'CODE';

    $self->{wait} ||= 5;

    $self->{dirs} ||= ['.'];
    -d $_ or carp "AutoRefresh: can't find directory $_" for @{ $self->dirs };

    # Create the filesystem watcher
    $self->{watcher} = AnyEvent::Filesys::Notify->new(
        dirs     => $self->dirs,
        interval => 0.5,
        cb       => sub {
            my @events = grep { $self->filter->( $_->path ) } @_;
            return unless @events;

            warn "detected change: ", substr( $_->path, -60 ), "\n" for @events;
            $self->_change_handler(@events);
        },
    );

    # Setup an hash to hold the condition vars, record the load time as
    # the last change to deal with restarts, and get the raw js script
    $self->{condvars}    = {};
    $self->{last_change} = time;
    $self->{_script}     = $self->_get_script;

    return;
}

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

    carp "AutoRefresh middleware doesn't work if psgi.nonblocking is false.\n",
      "Servers that are known to work: AnyEvent and Coro\n"
      unless $env->{'psgi.nonblocking'};

    # Client is looking for changed files
    if ( $env->{PATH_INFO} =~ m{^/_plackAutoRefresh(?:/(\d+)/(\d+))?} ) {
        my ( $uid, $timestamp ) = ( $1, $2 );

        # If a change has already happened return immediately,
        # otherwise make the browser block while we wait for change events
        if ( defined $timestamp && $timestamp < $self->{last_change} ) {
            return $self->_respond( { changed => $self->{last_change} } );
        } else {

            # Unblock any connections with the same uid.
            # This should close the tcp session to avoid using up
            # all the tcp ports. RT#56119
            if ( my $old_connection = $self->{condvars}->{$uid} ) {
                # The connection has already been dropped by the
                # client, so it doesn't matter what we return.
                $old_connection->send( [ 500, [], [] ] );
            }

            # Add this connection to the list
            my $cv = AE::cv;
            $self->{condvars}->{$uid} = $cv;

            # Finish up
            return sub {
                my $respond = shift;
                $cv->cb( sub { $respond->( $_[0]->recv ) } );
            };
        }
    }

    # Client wants something from the real app.
    # Insert our script if it is an html file
    my $response = $self->app->($env);
    return $self->response_cb(
        $response,
        sub {
            my $res = shift;
            my $ct = Plack::Util::header_get( $res->[1], 'Content-Type' );

            if ( $ct =~ m!^(?:text/html|application/xhtml\+xml)! ) {
                return sub {
                    my $chunk = shift;
                    return unless defined $chunk;
                    $chunk =~ s{}{'' . $self->_insert}ei;
                    $chunk;
                  }
            }
        } );
}

# Return the js script updating the time and adding config params
sub _insert {
    my ($self) = @_;

    my %var = (
        wait => $self->wait * 1000,
        url  => $URL,
        uid  => $self->_uid,
        now  => time,
    );

    ( my $script = $self->{_script} ) =~ s/{{([^}]*)}}/$var{$1}/eg;
    return $script;
}

sub _uid {
    my $self = shift;
    return ++$self->{_uid};
}

# AFN saw a change, respond to each blocked client
sub _change_handler {
    my $self = shift;

    my $now = $self->{last_change} = time;
    for my $uid ( keys %{ $self->{condvars} } ) {
        my $condvar = delete $self->{condvars}->{$uid};
        $condvar->send( $self->_respond( { changed => $now } ) );
    }

    return 1;
}

# Generate the plack response and encode any arguments as json
sub _respond {
    my ( $self, $resp ) = @_;
    ## TODO: check that resp is a hash ref

    return [
        200,
        [ 'Content-Type' => 'application/json' ],
        [ JSON::Any->new->encode($resp) ] ];
}

# Return the js script from ShareDir unless we are developing/testing PMA.
# This is a bit hack-ish
sub _get_script {
    my $self = shift;

    my $script =
      File::Spec->catfile( dirname( $INC{'Plack/Middleware/AutoRefresh.pm'} ),
        qw( .. .. .. share ), $JS_DEV );

    $script = dist_file( 'Plack-Middleware-AutoRefresh', $JS )
      unless -r $script;

    return '' . read_file($script) . '';
}

1;

__END__