line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mojolicious::Plugin::Export; |
2
|
|
|
|
|
|
|
our $VERSION = '0.005'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Export a Mojolicious website to static files |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
#pod =head1 SYNOPSIS |
6
|
|
|
|
|
|
|
#pod |
7
|
|
|
|
|
|
|
#pod use Mojolicious::Lite; |
8
|
|
|
|
|
|
|
#pod get '/' => 'index'; |
9
|
|
|
|
|
|
|
#pod get '/secret' => 'secret'; |
10
|
|
|
|
|
|
|
#pod plugin Export => { |
11
|
|
|
|
|
|
|
#pod paths => [qw( / /secret )], |
12
|
|
|
|
|
|
|
#pod }; |
13
|
|
|
|
|
|
|
#pod app->start; |
14
|
|
|
|
|
|
|
#pod |
15
|
|
|
|
|
|
|
#pod =head1 DESCRIPTION |
16
|
|
|
|
|
|
|
#pod |
17
|
|
|
|
|
|
|
#pod Export a Mojolicious webapp to static files. |
18
|
|
|
|
|
|
|
#pod |
19
|
|
|
|
|
|
|
#pod =head2 Configuration |
20
|
|
|
|
|
|
|
#pod |
21
|
|
|
|
|
|
|
#pod Default values for the command's options can be specified in the |
22
|
|
|
|
|
|
|
#pod configuration using one of Mojolicious's configuration plugins. |
23
|
|
|
|
|
|
|
#pod |
24
|
|
|
|
|
|
|
#pod # myapp.conf |
25
|
|
|
|
|
|
|
#pod { |
26
|
|
|
|
|
|
|
#pod export => { |
27
|
|
|
|
|
|
|
#pod # Configure the default paths to export |
28
|
|
|
|
|
|
|
#pod paths => [ '/', '/hidden' ], |
29
|
|
|
|
|
|
|
#pod # The directory to export to |
30
|
|
|
|
|
|
|
#pod to => '/var/www/html', |
31
|
|
|
|
|
|
|
#pod # Rewrite URLs to include base directory |
32
|
|
|
|
|
|
|
#pod base => '/', |
33
|
|
|
|
|
|
|
#pod } |
34
|
|
|
|
|
|
|
#pod } |
35
|
|
|
|
|
|
|
#pod |
36
|
|
|
|
|
|
|
#pod =head1 HELPERS |
37
|
|
|
|
|
|
|
#pod |
38
|
|
|
|
|
|
|
#pod =head2 export |
39
|
|
|
|
|
|
|
#pod |
40
|
|
|
|
|
|
|
#pod The C helper returns the L object. |
41
|
|
|
|
|
|
|
#pod |
42
|
|
|
|
|
|
|
#pod =head1 EVENTS |
43
|
|
|
|
|
|
|
#pod |
44
|
|
|
|
|
|
|
#pod =head2 before_write |
45
|
|
|
|
|
|
|
#pod |
46
|
|
|
|
|
|
|
#pod Emitted after all the content has been loaded and prepared for export. |
47
|
|
|
|
|
|
|
#pod The event is given two arguments: The Mojolicious::Plugin::Export object |
48
|
|
|
|
|
|
|
#pod and a hashref of paths mapped to content to be exported. The content can |
49
|
|
|
|
|
|
|
#pod be either a Mojo::DOM object for HTML pages or the content to be |
50
|
|
|
|
|
|
|
#pod exported. This event may modify the hashref or the DOM objects to change |
51
|
|
|
|
|
|
|
#pod the content before it is written. |
52
|
|
|
|
|
|
|
#pod |
53
|
|
|
|
|
|
|
#pod app->export->on( before_write => sub { |
54
|
|
|
|
|
|
|
#pod my ( $export, $pages ) = @_; |
55
|
|
|
|
|
|
|
#pod for my $path ( keys %$pages ) { |
56
|
|
|
|
|
|
|
#pod my $content = $pages->{ $path }; |
57
|
|
|
|
|
|
|
#pod # ... |
58
|
|
|
|
|
|
|
#pod } |
59
|
|
|
|
|
|
|
#pod } ); |
60
|
|
|
|
|
|
|
#pod |
61
|
|
|
|
|
|
|
#pod =head1 SEE ALSO |
62
|
|
|
|
|
|
|
#pod |
63
|
|
|
|
|
|
|
#pod L, L |
64
|
|
|
|
|
|
|
#pod |
65
|
|
|
|
|
|
|
#pod =cut |
66
|
|
|
|
|
|
|
|
67
|
2
|
|
|
2
|
|
19324
|
use Mojo::Base 'Mojolicious::Plugin'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
13
|
|
68
|
2
|
|
|
2
|
|
262
|
use Mojo::Base 'Mojo::EventEmitter'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
6
|
|
69
|
2
|
|
|
2
|
|
215
|
use Mojo::File qw( path ); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
90
|
|
70
|
2
|
|
|
2
|
|
10
|
use Mojo::Util qw( encode decode ); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
2687
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#pod =attr pages |
73
|
|
|
|
|
|
|
#pod |
74
|
|
|
|
|
|
|
#pod The pages to export by default. This can be overridden by the arguments to |
75
|
|
|
|
|
|
|
#pod L. |
76
|
|
|
|
|
|
|
#pod |
77
|
|
|
|
|
|
|
#pod # Add pages to export by default |
78
|
|
|
|
|
|
|
#pod push @{ $app->export->pages }, '/blog'; |
79
|
|
|
|
|
|
|
#pod |
80
|
|
|
|
|
|
|
#pod =cut |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
has pages => sub { [] }; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
#pod =attr to |
85
|
|
|
|
|
|
|
#pod |
86
|
|
|
|
|
|
|
#pod The path to export to by default. |
87
|
|
|
|
|
|
|
#pod |
88
|
|
|
|
|
|
|
#pod =cut |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
has to => '.'; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
#pod =attr base |
93
|
|
|
|
|
|
|
#pod |
94
|
|
|
|
|
|
|
#pod The base URL, if URLs need to be rewritten. |
95
|
|
|
|
|
|
|
#pod |
96
|
|
|
|
|
|
|
#pod =cut |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
has base => ''; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
#pod =attr quiet |
101
|
|
|
|
|
|
|
#pod |
102
|
|
|
|
|
|
|
#pod If true, will not report every action taken by the plugin. Defaults to true. |
103
|
|
|
|
|
|
|
#pod |
104
|
|
|
|
|
|
|
#pod =cut |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
has quiet => 1; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
has _app =>; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub register { |
111
|
8
|
|
|
8
|
1
|
440
|
my ( $self, $app, $plugin_conf ) = @_; |
112
|
8
|
|
|
|
|
28
|
$self->_app( $app ); |
113
|
8
|
|
|
9
|
|
86
|
$app->helper( export => sub { $self } ); |
|
9
|
|
|
|
|
3159
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# Config file overrides plugin config |
116
|
8
|
50
|
|
|
|
508
|
my $config = $app->can( 'config' ) ? $app->config->{export} : {}; |
117
|
8
|
|
|
|
|
211
|
for my $key ( keys %$config ) { |
118
|
3
|
|
33
|
|
|
22
|
$self->$key( $config->{ $key } // $plugin_conf->{ $key } ); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
8
|
|
|
|
|
28
|
return $self; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#pod =method export |
125
|
|
|
|
|
|
|
#pod |
126
|
|
|
|
|
|
|
#pod app->export->export( $override ); |
127
|
|
|
|
|
|
|
#pod |
128
|
|
|
|
|
|
|
#pod Export the site. C<$override> is a hash reference to override the object |
129
|
|
|
|
|
|
|
#pod attributes (keys are attribute names, values are the overridden value). |
130
|
|
|
|
|
|
|
#pod |
131
|
|
|
|
|
|
|
#pod =cut |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub export { |
134
|
8
|
|
|
8
|
1
|
30
|
my ( $self, $opt ) = @_; |
135
|
8
|
|
|
|
|
20
|
for my $key ( qw( pages to base quiet ) ) { |
136
|
32
|
|
100
|
|
|
165
|
$opt->{ $key } //= $self->$key; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
8
|
50
|
66
|
|
|
38
|
if ( $opt->{base} && $opt->{base} =~ m{^[^/]} ) { |
140
|
0
|
|
|
|
|
0
|
$opt->{base} = '/' . $opt->{base}; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
8
|
|
|
|
|
24
|
my $root = path( $opt->{ to } ); |
144
|
|
|
|
|
|
|
my @pages |
145
|
8
|
50
|
|
|
|
81
|
= @{ $opt->{pages} } ? map { m{^/} ? $_ : "/$_" } @{ $opt->{pages} } |
|
8
|
100
|
|
|
|
24
|
|
|
5
|
|
|
|
|
26
|
|
|
5
|
|
|
|
|
14
|
|
146
|
|
|
|
|
|
|
: ( '/' ); |
147
|
|
|
|
|
|
|
|
148
|
8
|
|
|
|
|
44
|
my $ua = Mojo::UserAgent->new; |
149
|
8
|
|
|
|
|
79
|
$ua->server->app( $self->_app ); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# A hash of path => knowledge about the path |
152
|
|
|
|
|
|
|
# link_from => a hash of path -> array of DOM elements linking to original path |
153
|
|
|
|
|
|
|
# res => The response from the request for this page |
154
|
|
|
|
|
|
|
# redirect_to => The redirect location, if it was a redirect |
155
|
8
|
|
|
|
|
299
|
my %history; |
156
|
|
|
|
|
|
|
|
157
|
8
|
|
|
|
|
29
|
while ( my $page = shift @pages ) { |
158
|
40
|
50
|
|
|
|
104
|
next if $history{ $page }{ res }; |
159
|
40
|
|
|
|
|
115
|
my $tx = $ua->get( $page ); |
160
|
40
|
|
|
|
|
409530
|
my $res = $tx->res; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# Do not try to write error messages |
163
|
40
|
100
|
|
|
|
191
|
if ( $res->is_error ) { |
164
|
5
|
50
|
|
|
|
78
|
if ( !$opt->{quiet} ) { |
165
|
5
|
|
|
|
|
13
|
say sprintf " [ERROR] %s - %s %s", |
166
|
|
|
|
|
|
|
$page, $res->code, $res->message; |
167
|
|
|
|
|
|
|
} |
168
|
5
|
|
|
|
|
227
|
next; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# Rewrite links to redirects |
172
|
35
|
100
|
|
|
|
539
|
if ( $res->is_redirect ) { |
173
|
5
|
|
|
|
|
91
|
my $loc = $history{ $page }{ redirect_to } = $res->headers->location; |
174
|
5
|
|
|
|
|
81
|
for my $link_from ( keys %{ $history{ $page }{ link_from } } ) { |
|
5
|
|
|
|
|
22
|
|
175
|
5
|
|
|
|
|
9
|
for my $el ( @{ $history{ $page }{ link_from }{ $link_from } } ) { |
|
5
|
|
|
|
|
15
|
|
176
|
5
|
|
|
|
|
26
|
$el->attr( href => $loc ); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
5
|
|
|
|
|
124
|
next; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
30
|
|
|
|
|
349
|
my $type = $res->headers->content_type; |
183
|
30
|
100
|
66
|
|
|
574
|
if ( $type and $type =~ m{^text/html} and my $dom = $res->dom ) { |
|
|
|
66
|
|
|
|
|
184
|
25
|
|
|
|
|
11815
|
my $dir = path( $page )->dirname; |
185
|
25
|
|
|
|
|
1186
|
for my $attr ( qw( href src ) ) { |
186
|
50
|
|
|
|
|
1277
|
for my $el ( $dom->find( "[$attr]" )->each ) { |
187
|
53
|
|
|
|
|
8313
|
my $url = $el->attr( $attr ); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# Don't analyze full URLs |
190
|
53
|
100
|
|
|
|
736
|
next if $url =~ m{^(?:[a-zA-Z]+:)?//}; |
191
|
|
|
|
|
|
|
# Don't analyze in-page fragments |
192
|
42
|
100
|
|
|
|
98
|
next if $url =~ m{^#}; |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# Fix relative paths |
195
|
37
|
100
|
|
|
|
107
|
my $path = $url =~ m{^/} ? $url : $dir->child( $url ).""; |
196
|
|
|
|
|
|
|
# Remove fragment |
197
|
37
|
|
|
|
|
314
|
$path =~ s/#.+//; |
198
|
|
|
|
|
|
|
|
199
|
37
|
50
|
|
|
|
105
|
if ( my $loc = $history{ $path }{ redirect_to } ) { |
200
|
0
|
|
|
|
|
0
|
$el->attr( $attr => $loc ); |
201
|
0
|
|
|
|
|
0
|
next; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
else { |
204
|
37
|
|
|
|
|
46
|
push @{ $history{ $path }{ link_from }{ $page } }, $el; |
|
37
|
|
|
|
|
114
|
|
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
37
|
100
|
|
|
|
90
|
if ( !$history{ $path }{ res } ) { |
208
|
32
|
|
|
|
|
81
|
push @pages, $path; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
30
|
|
|
|
|
3404
|
$history{ $page }{ res } = $res; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Event for checking the status of everything we're about to export. |
219
|
|
|
|
|
|
|
# We do this before rewriting the base URLs to make it easier to |
220
|
|
|
|
|
|
|
# check for broken links. |
221
|
|
|
|
|
|
|
my %to_export = |
222
|
30
|
100
|
|
|
|
439
|
map { $_->[0] => $_->[1] =~ m{^text/html} ? $_->[2]->dom : $_->[2]->body } |
223
|
30
|
|
|
|
|
326
|
map { [ $_, $history{ $_ }{ res }->headers->content_type, $history{ $_ }{ res } ] } |
224
|
8
|
|
|
|
|
36
|
grep { $history{ $_ }{ res } } |
|
40
|
|
|
|
|
80
|
|
225
|
|
|
|
|
|
|
keys %history; |
226
|
|
|
|
|
|
|
|
227
|
8
|
|
|
|
|
173
|
$self->emit( before_write => \%to_export ); |
228
|
|
|
|
|
|
|
|
229
|
8
|
|
|
|
|
292
|
for my $page ( keys %to_export ) { |
230
|
31
|
|
|
|
|
2677
|
my $content = $to_export{ $page }; |
231
|
31
|
100
|
|
|
|
129
|
if ( ref $content eq 'Mojo::DOM' ) { |
232
|
25
|
|
|
|
|
65
|
my $dir = path( $page )->dirname; |
233
|
25
|
|
|
|
|
1042
|
for my $attr ( qw( href src ) ) { |
234
|
50
|
|
|
|
|
1240
|
for my $el ( $content->find( "[$attr]" )->each ) { |
235
|
53
|
|
|
|
|
7743
|
my $url = $el->attr( $attr ); |
236
|
|
|
|
|
|
|
# Rewrite absolute paths |
237
|
53
|
100
|
100
|
|
|
752
|
if ( $opt->{base} && $url =~ m{^/} ) { |
238
|
5
|
100
|
|
|
|
38
|
my $base_url = $url eq '/' ? $opt->{base} : $opt->{base} . $url; |
239
|
5
|
|
|
|
|
12
|
$el->attr( $attr => $base_url ); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
} |
244
|
31
|
|
|
|
|
3129
|
$self->_write( $root, $page, $content, $opt->{quiet} ); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub _write { |
249
|
31
|
|
|
31
|
|
81
|
my ( $self, $root, $page, $content, $quiet ) = @_; |
250
|
31
|
100
|
|
|
|
79
|
if ( ref $content eq 'Mojo::DOM' ) { |
251
|
|
|
|
|
|
|
# Mojolicious automatically decodes using the response content |
252
|
|
|
|
|
|
|
# type, so all we need to do is encode it into the file content |
253
|
|
|
|
|
|
|
# type that we want |
254
|
|
|
|
|
|
|
# TODO: Allow configuring the destination encoding |
255
|
|
|
|
|
|
|
# TODO: Ensure all text/* MIME types use the destination |
256
|
|
|
|
|
|
|
# encoding |
257
|
25
|
|
|
|
|
67
|
$content = encode 'utf8', $content; |
258
|
|
|
|
|
|
|
} |
259
|
31
|
|
|
|
|
4401
|
my $to = $root->child( $page ); |
260
|
31
|
100
|
|
|
|
554
|
if ( $to !~ m{[.][^/.]+$} ) { |
261
|
25
|
|
|
|
|
189
|
$to = $to->child( 'index.html' ); |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
31
|
|
|
|
|
340
|
my $dir = $to->dirname; |
265
|
31
|
100
|
|
|
|
947
|
if ( !-d $dir ) { |
266
|
15
|
|
|
|
|
391
|
$dir->make_path; |
267
|
15
|
100
|
|
|
|
2088
|
say " [mkdir] $dir" unless $quiet; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
else { |
270
|
16
|
100
|
|
|
|
321
|
say " [exist] $dir" unless $quiet; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
31
|
100
|
|
|
|
1149
|
say " [write] $to" unless $quiet; |
274
|
31
|
|
|
|
|
369
|
$to->spurt( $content ); |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
1; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
__END__ |