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