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


line stmt bran cond sub pod time code
1             package Plack::Middleware::AutoRefresh;
2              
3             # ABSTRACT: Reload pages in browsers when files are modified
4              
5 3     3   48995 use strict;
  3         5  
  3         79  
6 3     3   12 use warnings;
  3         3  
  3         78  
7 3     3   389 use parent qw( Plack::Middleware );
  3         276  
  3         15  
8              
9             our $VERSION = '0.09';
10              
11 3     3   1255550 use Plack::Util;
  3         4  
  3         59  
12 3     3   11 use Plack::Util::Accessor qw( dirs filter wait );
  3         3  
  3         10  
13              
14 3     3   3705 use AnyEvent;
  3         13027  
  3         78  
15 3     3   1388 use AnyEvent::Filesys::Notify;
  3         419980  
  3         98  
16 3     3   1481 use JSON::Any;
  3         7139  
  3         33  
17 3     3   11239 use File::Slurp;
  3         29409  
  3         208  
18 3     3   1370 use File::ShareDir qw(dist_file);
  3         13459  
  3         203  
19 3     3   21 use File::Basename;
  3         5  
  3         184  
20 3     3   12 use Carp;
  3         4  
  3         115  
21 3     3   1420 use Readonly;
  3         8072  
  3         2589  
22              
23             Readonly my $URL => '/_plackAutoRefresh';
24             Readonly my $JS => 'js/plackAutoRefresh.min.js';
25             Readonly my $JS_DEV => 'js/plackAutoRefresh.js';
26              
27             sub prepare_app {
28 1     1 1 40 my $self = shift;
29              
30             # Setup config params: filter, wait, dirs
31              
32 1   50 0   34 $self->{filter} ||= sub { $_[0] !~ qr/\.(swp|bak)$/ };
  0         0  
33 0     0   0 $self->{filter} = sub { $_[0] !~ $self->filter }
34 1 50       3 if ref( $self->filter ) eq 'Regexp';
35 1 50       8 croak "AutoRefresh: filter must be a regex or code ref"
36             unless ref( $self->filter ) eq 'CODE';
37              
38 1   50     9 $self->{wait} ||= 5;
39              
40 1   50     5 $self->{dirs} ||= ['.'];
41 1   33     1 -d $_ or carp "AutoRefresh: can't find directory $_" for @{ $self->dirs };
  1         3  
42              
43             # Create the filesystem watcher
44             $self->{watcher} = AnyEvent::Filesys::Notify->new(
45             dirs => $self->dirs,
46             interval => 0.5,
47             cb => sub {
48 0     0   0 my @events = grep { $self->filter->( $_->path ) } @_;
  0         0  
49 0 0       0 return unless @events;
50              
51 0         0 warn "detected change: ", substr( $_->path, -60 ), "\n" for @events;
52 0         0 $self->_change_handler(@events);
53             },
54 1         16 );
55              
56             # Setup an hash to hold the condition vars, record the load time as
57             # the last change to deal with restarts, and get the raw js script
58 1         17303 $self->{condvars} = {};
59 1         5 $self->{last_change} = time;
60 1         4 $self->{_script} = $self->_get_script;
61              
62 1         78 return;
63             }
64              
65             sub call {
66 1     1 1 13072 my ( $self, $env ) = @_;
67              
68             carp "AutoRefresh middleware doesn't work if psgi.nonblocking is false.\n",
69             "Servers that are known to work: AnyEvent and Coro\n"
70 1 50       164 unless $env->{'psgi.nonblocking'};
71              
72             # Client is looking for changed files
73 1 50       54 if ( $env->{PATH_INFO} =~ m{^/_plackAutoRefresh(?:/(\d+)/(\d+))?} ) {
74 0         0 my ( $uid, $timestamp ) = ( $1, $2 );
75              
76             # If a change has already happened return immediately,
77             # otherwise make the browser block while we wait for change events
78 0 0 0     0 if ( defined $timestamp && $timestamp < $self->{last_change} ) {
79 0         0 return $self->_respond( { changed => $self->{last_change} } );
80             } else {
81              
82             # Unblock any connections with the same uid.
83             # This should close the tcp session to avoid using up
84             # all the tcp ports. RT#56119
85 0 0       0 if ( my $old_connection = $self->{condvars}->{$uid} ) {
86             # The connection has already been dropped by the
87             # client, so it doesn't matter what we return.
88 0         0 $old_connection->send( [ 500, [], [] ] );
89             }
90              
91             # Add this connection to the list
92 0         0 my $cv = AE::cv;
93 0         0 $self->{condvars}->{$uid} = $cv;
94              
95             # Finish up
96             return sub {
97 0     0   0 my $respond = shift;
98 0         0 $cv->cb( sub { $respond->( $_[0]->recv ) } );
  0         0  
99 0         0 };
100             }
101             }
102              
103             # Client wants something from the real app.
104             # Insert our script if it is an html file
105 1         7 my $response = $self->app->($env);
106             return $self->response_cb(
107             $response,
108             sub {
109 1     1   13 my $res = shift;
110 1         4 my $ct = Plack::Util::header_get( $res->[1], 'Content-Type' );
111              
112 1 50       16 if ( $ct =~ m!^(?:text/html|application/xhtml\+xml)! ) {
113             return sub {
114 2         26 my $chunk = shift;
115 2 100       5 return unless defined $chunk;
116 1         5 $chunk =~ s{}{'' . $self->_insert}ei;
  1         3  
117 1         5 $chunk;
118             }
119 1         3 }
120 1         16 } );
121             }
122              
123             # Return the js script updating the time and adding config params
124             sub _insert {
125 1     1   1 my ($self) = @_;
126              
127 1         7 my %var = (
128             wait => $self->wait * 1000,
129             url => $URL,
130             uid => $self->_uid,
131             now => time,
132             );
133              
134 1         11 ( my $script = $self->{_script} ) =~ s/\{\{([^}]*)}}/$var{$1}/eg;
  5         14  
135 1         8 return $script;
136             }
137              
138             sub _uid {
139 1     1   5 my $self = shift;
140 1         7 return ++$self->{_uid};
141             }
142              
143             # AFN saw a change, respond to each blocked client
144             sub _change_handler {
145 0     0   0 my $self = shift;
146              
147 0         0 my $now = $self->{last_change} = time;
148 0         0 for my $uid ( keys %{ $self->{condvars} } ) {
  0         0  
149 0         0 my $condvar = delete $self->{condvars}->{$uid};
150 0         0 $condvar->send( $self->_respond( { changed => $now } ) );
151             }
152              
153 0         0 return 1;
154             }
155              
156             # Generate the plack response and encode any arguments as json
157             sub _respond {
158 0     0   0 my ( $self, $resp ) = @_;
159             ## TODO: check that resp is a hash ref
160              
161             return [
162 0         0 200,
163             [ 'Content-Type' => 'application/json' ],
164             [ JSON::Any->new->encode($resp) ] ];
165             }
166              
167             # Return the js script from ShareDir unless we are developing/testing PMA.
168             # This is a bit hack-ish
169             sub _get_script {
170 1     1   1 my $self = shift;
171              
172             my $script =
173 1         49 File::Spec->catfile( dirname( $INC{'Plack/Middleware/AutoRefresh.pm'} ),
174             qw( .. .. .. share ), $JS_DEV );
175              
176 1 50       43 $script = dist_file( 'Plack-Middleware-AutoRefresh', $JS )
177             unless -r $script;
178              
179 1         140 return '';
180             }
181              
182             1;
183              
184             __END__