blib/lib/Giblog/API.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 331 | 389 | 85.0 |
branch | 86 | 136 | 63.2 |
condition | 7 | 13 | 53.8 |
subroutine | 48 | 52 | 92.3 |
pod | 34 | 36 | 94.4 |
total | 506 | 626 | 80.8 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Giblog::API; | ||||||
2 | |||||||
3 | 2 | 2 | 90905 | use strict; | |||
2 | 15 | ||||||
2 | 66 | ||||||
4 | 2 | 2 | 11 | use warnings; | |||
2 | 4 | ||||||
2 | 67 | ||||||
5 | 2 | 2 | 11 | use File::Find 'find'; | |||
2 | 4 | ||||||
2 | 166 | ||||||
6 | 2 | 2 | 15 | use File::Basename 'dirname', 'basename'; | |||
2 | 3 | ||||||
2 | 223 | ||||||
7 | 2 | 2 | 47 | use File::Path 'mkpath'; | |||
2 | 5 | ||||||
2 | 137 | ||||||
8 | 2 | 2 | 14 | use Carp 'confess'; | |||
2 | 4 | ||||||
2 | 124 | ||||||
9 | 2 | 2 | 587 | use Encode 'encode', 'decode'; | |||
2 | 10948 | ||||||
2 | 158 | ||||||
10 | 2 | 2 | 1032 | use File::Copy 'copy'; | |||
2 | 7545 | ||||||
2 | 11029 | ||||||
11 | |||||||
12 | sub new { | ||||||
13 | 59 | 59 | 1 | 484 | my $class = shift; | ||
14 | |||||||
15 | 59 | 194 | my $self = {@_}; | ||||
16 | |||||||
17 | 59 | 157 | return bless $self, $class; | ||||
18 | } | ||||||
19 | |||||||
20 | 92 | 92 | 1 | 1709 | sub giblog { shift->{giblog} } | ||
21 | |||||||
22 | 9 | 9 | 1 | 69 | sub config { shift->giblog->config } | ||
23 | |||||||
24 | sub get_vars { | ||||||
25 | 1 | 1 | 1 | 8 | my ($self) = @_; | ||
26 | |||||||
27 | 1 | 8 | my $config = $self->giblog->config; | ||||
28 | |||||||
29 | 1 | 50 | 5 | return unless defined $config; | |||
30 | |||||||
31 | 1 | 7 | my $vars = $config->{vars}; | ||||
32 | |||||||
33 | 1 | 7 | return $vars; | ||||
34 | } | ||||||
35 | |||||||
36 | 1 | 1 | 1 | 12 | sub home_dir { shift->giblog->home_dir }; | ||
37 | |||||||
38 | sub read_config { | ||||||
39 | 5 | 5 | 1 | 59450 | my $self = shift; | ||
40 | |||||||
41 | 5 | 30 | my $giblog = $self->giblog; | ||||
42 | |||||||
43 | # Read config | ||||||
44 | 5 | 16 | my $config; | ||||
45 | 5 | 50 | 33 | if (defined $giblog->{config}) { | |||
46 | 0 | 0 | confess "Config is already loaded"; | ||||
47 | } | ||||||
48 | |||||||
49 | 5 | 23 | my $config_file = $self->rel_file('giblog.conf'); | ||||
50 | |||||||
51 | 5 | 22 | my $config_content = $self->slurp_file($config_file); | ||||
52 | |||||||
53 | 5 | 100 | 1 | 604 | $config = eval $config_content | ||
1 | 17 | ||||||
1 | 5 | ||||||
1 | 480 | ||||||
54 | or confess "Can't parse config file \"$config_file\":$@$!"; | ||||||
55 | |||||||
56 | 4 | 100 | 39 | unless (ref $config eq 'HASH') { | |||
57 | 1 | 270 | confess "\"$config_file\" must end with hash reference"; | ||||
58 | } | ||||||
59 | |||||||
60 | 3 | 13 | $giblog->{config} = $config; | ||||
61 | |||||||
62 | 3 | 12 | return $config; | ||||
63 | } | ||||||
64 | |||||||
65 | sub clear_config { | ||||||
66 | 1 | 1 | 1 | 1097 | my $self = shift; | ||
67 | |||||||
68 | 1 | 8 | my $giblog = $self->giblog; | ||||
69 | |||||||
70 | 1 | 7 | $giblog->{config} = undef; | ||||
71 | } | ||||||
72 | |||||||
73 | sub create_dir { | ||||||
74 | 12 | 12 | 1 | 62 | my ($self, $dir) = @_; | ||
75 | 12 | 100 | 1197 | mkdir $dir | |||
76 | or confess "Can't create directory \"$dir\": $!"; | ||||||
77 | } | ||||||
78 | |||||||
79 | sub create_file { | ||||||
80 | 3 | 3 | 1 | 75 | my ($self, $file) = @_; | ||
81 | 3 | 100 | 806 | open my $fh, '>', $file | |||
82 | or confess "Can't create file \"$file\": $!"; | ||||||
83 | } | ||||||
84 | |||||||
85 | sub write_to_file { | ||||||
86 | 23 | 23 | 1 | 2212 | my ($self, $file, $content) = @_; | ||
87 | 23 | 100 | 21070 | open my $fh, '>', $file | |||
88 | or confess "Can't create file \"$file\": $!"; | ||||||
89 | |||||||
90 | 22 | 240 | print $fh encode('UTF-8', $content); | ||||
91 | } | ||||||
92 | |||||||
93 | sub slurp_file { | ||||||
94 | 27 | 27 | 1 | 1977 | my ($self, $file) = @_; | ||
95 | |||||||
96 | 27 | 100 | 1387 | open my $fh, '<', $file | |||
97 | or confess "Can't read file \"$file\": $!"; | ||||||
98 | |||||||
99 | 26 | 114 | my $content = do { local $/; <$fh> }; | ||||
26 | 202 | ||||||
26 | 864 | ||||||
100 | 26 | 172 | $content = decode('UTF-8', $content); | ||||
101 | |||||||
102 | 26 | 2330 | return $content; | ||||
103 | } | ||||||
104 | |||||||
105 | sub _get_proto_dir { | ||||||
106 | 13 | 13 | 47 | my ($self, $module_name) = @_; | |||
107 | |||||||
108 | 13 | 51 | my $proto_dir = $self->_module_rel_file($module_name, 'proto'); | ||||
109 | |||||||
110 | 10 | 26 | return $proto_dir; | ||||
111 | } | ||||||
112 | |||||||
113 | sub create_website_from_proto { | ||||||
114 | 14 | 14 | 1 | 2644 | my ($self, $home_dir, $module_name) = @_; | ||
115 | |||||||
116 | 14 | 100 | 78 | unless (defined $home_dir) { | |||
117 | 1 | 237 | confess "Home directory must be specified\n"; | ||||
118 | } | ||||||
119 | |||||||
120 | 13 | 50 | 253 | if (-f $home_dir) { | |||
121 | 0 | 0 | confess "Home directory \"$home_dir\" is already exists\n"; | ||||
122 | } | ||||||
123 | |||||||
124 | 13 | 87 | my $proto_dir = $self->_get_proto_dir($module_name); | ||||
125 | |||||||
126 | 10 | 50 | 29 | unless (defined $proto_dir) { | |||
127 | 0 | 0 | confess "proto diretory can't specific\n"; | ||||
128 | } | ||||||
129 | |||||||
130 | 10 | 50 | 201 | unless (-d $proto_dir) { | |||
131 | 0 | 0 | confess "Can't find proto diretory $proto_dir\n"; | ||||
132 | } | ||||||
133 | |||||||
134 | # Create website directory | ||||||
135 | 10 | 70 | $self->create_dir($home_dir); | ||||
136 | |||||||
137 | # Copy command proto files to user directory | ||||||
138 | 9 | 34 | my @files; | ||||
139 | find( | ||||||
140 | { | ||||||
141 | wanted => sub { | ||||||
142 | 297 | 297 | 858 | my $proto_file = $File::Find::name; | |||
143 | |||||||
144 | # Skip directory | ||||||
145 | 297 | 100 | 12523 | return unless -f $proto_file; | |||
146 | |||||||
147 | 180 | 529 | my $rel_file = $proto_file; | ||||
148 | 180 | 1461 | $rel_file =~ s/^\Q$proto_dir\E[\/|\\]//; | ||||
149 | |||||||
150 | 180 | 541 | my $user_file = "$home_dir/$rel_file"; | ||||
151 | 180 | 5747 | my $user_dir = dirname $user_file; | ||||
152 | 180 | 16473 | mkpath $user_dir; | ||||
153 | |||||||
154 | 180 | 50 | 1139 | copy $proto_file, $user_file | |||
155 | or die "Can't copy $proto_file to $user_file: $!"; | ||||||
156 | |||||||
157 | 180 | 64479 | my @stat = stat $proto_file; | ||||
158 | 180 | 1089 | my $permission = substr((sprintf "%03o", $stat[2]), -3); | ||||
159 | 180 | 100 | 762 | if (substr($permission, 0, 1) == 5) { | |||
50 | |||||||
160 | 9 | 27 | substr($permission, 0, 1) = 7; | ||||
161 | } | ||||||
162 | elsif (substr($permission, 0, 1) == 4) { | ||||||
163 | 171 | 754 | substr($permission, 0, 1) = 6; | ||||
164 | } | ||||||
165 | 180 | 50 | 7928 | chmod oct($permission), $user_file | |||
166 | or confess "Can't change permission: $!"; | ||||||
167 | }, | ||||||
168 | 9 | 1461 | no_chdir => 1, | ||||
169 | }, | ||||||
170 | $proto_dir | ||||||
171 | ); | ||||||
172 | |||||||
173 | # git init repository directory | ||||||
174 | 9 | 142 | my @git_init_cmd_rep = ('git', 'init', $home_dir); | ||||
175 | 9 | 50 | 418980 | system(@git_init_cmd_rep) == 0 | |||
176 | or confess "Can't execute command : @git_init_cmd_rep: $!"; | ||||||
177 | |||||||
178 | # git init public directory | ||||||
179 | 9 | 481 | my @git_init_cmd_public = ('git', 'init', "$home_dir/public"); | ||||
180 | 9 | 50 | 297969 | system(@git_init_cmd_public) == 0 | |||
181 | or confess "Can't execute command : @git_init_cmd_public: $!"; | ||||||
182 | } | ||||||
183 | |||||||
184 | sub rel_file { | ||||||
185 | 52 | 52 | 1 | 223 | my ($self, $file) = @_; | ||
186 | |||||||
187 | 52 | 220 | my $home_dir = $self->giblog->home_dir; | ||||
188 | |||||||
189 | 52 | 100 | 146 | if (defined $home_dir) { | |||
190 | 51 | 252 | return "$home_dir/$file"; | ||||
191 | } | ||||||
192 | else { | ||||||
193 | 1 | 3 | return $file; | ||||
194 | } | ||||||
195 | } | ||||||
196 | |||||||
197 | sub _module_rel_file { | ||||||
198 | 13 | 13 | 63 | my ($self, $module_name, $rel_file) = @_; | |||
199 | |||||||
200 | 13 | 32 | my $command_rel_path = $module_name; | ||||
201 | 13 | 162 | $command_rel_path =~ s/::/\//g; | ||||
202 | 13 | 40 | $command_rel_path .= '.pm'; | ||||
203 | |||||||
204 | 13 | 76 | my $command_path = $INC{$command_rel_path}; | ||||
205 | |||||||
206 | 13 | 100 | 54 | unless ($command_path) { | |||
207 | 3 | 582 | confess "Can't get module path because module is not loaded"; | ||||
208 | } | ||||||
209 | |||||||
210 | 10 | 25 | my $command_dir = $command_path; | ||||
211 | 10 | 77 | $command_dir =~ s/\.pm$//; | ||||
212 | |||||||
213 | 10 | 33 | my $file = "$command_dir/$rel_file"; | ||||
214 | |||||||
215 | 10 | 42 | return $file; | ||||
216 | } | ||||||
217 | |||||||
218 | sub copy_static_files_to_public { | ||||||
219 | 1 | 1 | 1 | 429 | my $self = shift; | ||
220 | |||||||
221 | 1 | 31 | my $static_dir = $self->rel_file('templates/static'); | ||||
222 | |||||||
223 | # Get static files | ||||||
224 | 1 | 9 | my @static_rel_files; | ||||
225 | find( | ||||||
226 | { | ||||||
227 | wanted => sub { | ||||||
228 | 11 | 11 | 36 | my $static_file = $File::Find::name; | |||
229 | |||||||
230 | # Skip directory | ||||||
231 | 11 | 431 | my $static_file_base = basename $_; | ||||
232 | |||||||
233 | 11 | 29 | my $static_rel_file = $static_file; | ||||
234 | 11 | 80 | $static_rel_file =~ s/^$static_dir//; | ||||
235 | 11 | 42 | $static_rel_file =~ s/^[\\\/]//; | ||||
236 | |||||||
237 | 11 | 720 | push @static_rel_files, $static_rel_file; | ||||
238 | }, | ||||||
239 | 1 | 311 | no_chdir => 1, | ||||
240 | }, | ||||||
241 | $static_dir | ||||||
242 | ); | ||||||
243 | |||||||
244 | # Copy static content to public | ||||||
245 | 1 | 27 | for my $static_rel_file (@static_rel_files) { | ||||
246 | 11 | 53 | my $static_file = $self->rel_file("templates/static/$static_rel_file"); | ||||
247 | 11 | 37 | my $public_file = $self->rel_file("public/$static_rel_file"); | ||||
248 | |||||||
249 | # Check if the file is needed to be copied | ||||||
250 | 11 | 17 | my $do_copy; | ||||
251 | # Don't copy directries. Copy only normal files. | ||||||
252 | 11 | 100 | 159 | if (-f $static_file) { | |||
253 | 6 | 50 | 108 | if (-f $public_file) { | |||
254 | # Don't copy files if file is latest | ||||||
255 | 0 | 0 | 0 | 0 | if (-s $static_file == -s $public_file && -M $static_file == -M $public_file) { | ||
256 | 0 | 0 | $do_copy = 0; | ||||
257 | } | ||||||
258 | else { | ||||||
259 | 0 | 0 | $do_copy = 1; | ||||
260 | } | ||||||
261 | } | ||||||
262 | else { | ||||||
263 | 6 | 17 | $do_copy = 1; | ||||
264 | } | ||||||
265 | } | ||||||
266 | else { | ||||||
267 | 5 | 12 | $do_copy = 0; | ||||
268 | } | ||||||
269 | 11 | 100 | 34 | next unless $do_copy; | |||
270 | |||||||
271 | 6 | 213 | my $public_dir = dirname $public_file; | ||||
272 | 6 | 650 | mkpath $public_dir; | ||||
273 | |||||||
274 | 6 | 50 | 49 | copy $static_file, $public_file | |||
275 | or confess "Can't copy $static_file to $public_file: $!"; | ||||||
276 | |||||||
277 | 6 | 1985 | my $static_file_last_updated_time = (stat($static_file))[9]; | ||||
278 | 6 | 116 | utime $static_file_last_updated_time, $static_file_last_updated_time, $public_file; | ||||
279 | |||||||
280 | 6 | 117 | my @stat = stat $static_file; | ||||
281 | 6 | 40 | my $permission = substr((sprintf "%03o", $stat[2]), -3); | ||||
282 | 6 | 50 | 121 | chmod oct($permission), $public_file | |||
283 | or confess "Can't change permission: $!"; | ||||||
284 | } | ||||||
285 | } | ||||||
286 | |||||||
287 | sub get_templates_files { | ||||||
288 | 2 | 2 | 1 | 60 | my $self = shift; | ||
289 | |||||||
290 | 2 | 50 | my $templates_dir = $self->rel_file('templates'); | ||||
291 | |||||||
292 | # Get template files | ||||||
293 | 2 | 7 | my @template_rel_files; | ||||
294 | find( | ||||||
295 | { | ||||||
296 | wanted => sub { | ||||||
297 | 43 | 43 | 102 | my $template_file = $File::Find::name; | |||
298 | |||||||
299 | # Skip directory | ||||||
300 | 43 | 100 | 2537 | return unless -f $template_file; | |||
301 | |||||||
302 | # Skip common files | ||||||
303 | 27 | 100 | 314 | return if $template_file =~ /^\Q$templates_dir\/common/; | |||
304 | |||||||
305 | # Skip static files | ||||||
306 | 15 | 100 | 335 | return if $template_file =~ /^\Q$templates_dir\/static/; | |||
307 | |||||||
308 | 5 | 319 | my $template_file_base = basename $_; | ||||
309 | |||||||
310 | # Skip hidden file | ||||||
311 | 5 | 100 | 61 | return if $template_file_base =~ /^\./; | |||
312 | |||||||
313 | 3 | 8 | my $template_rel_file = $template_file; | ||||
314 | 3 | 31 | $template_rel_file =~ s/^$templates_dir//; | ||||
315 | 3 | 21 | $template_rel_file =~ s/^[\\\/]//; | ||||
316 | |||||||
317 | 3 | 187 | push @template_rel_files, $template_rel_file; | ||||
318 | }, | ||||||
319 | 2 | 583 | no_chdir => 1, | ||||
320 | }, | ||||||
321 | $templates_dir | ||||||
322 | ); | ||||||
323 | |||||||
324 | 2 | 38 | return \@template_rel_files; | ||||
325 | } | ||||||
326 | |||||||
327 | sub get_content { | ||||||
328 | 1 | 1 | 1 | 295 | my ($self, $data) = @_; | ||
329 | |||||||
330 | 1 | 9 | my $file = $data->{file}; | ||||
331 | |||||||
332 | 1 | 23 | my $template_file = $self->rel_file("templates/$file"); | ||||
333 | 1 | 11 | my $content = $self->slurp_file($template_file); | ||||
334 | |||||||
335 | 1 | 16 | $data->{content} = $content; | ||||
336 | } | ||||||
337 | |||||||
338 | my $inline_elements_re = qr/^<(span|em|strong|abbr|acronym|dfn|q|cite|sup|sub|code|var|kbd|samp|bdo|font|big|small|b|i|s|strike|u|tt|a|label|object|applet|iframe|button|textarea|select|basefont|img|br|input|map)\b/i; | ||||||
339 | |||||||
340 | sub parse_giblog_syntax { | ||||||
341 | 1 | 1 | 1 | 16 | my ($self, $data) = @_; | ||
342 | |||||||
343 | 1 | 11 | my $giblog = $self->giblog; | ||||
344 | |||||||
345 | 1 | 7 | my $content = $data->{content}; | ||||
346 | |||||||
347 | # Normalize line break; | ||||||
348 | 1 | 31 | $content =~ s/\x0D\x0A|\x0D|\x0A/\n/g; | ||||
349 | |||||||
350 | # Parse Giblog syntax | ||||||
351 | 1 | 21 | my @lines = split /\n/, $content; | ||||
352 | 1 | 7 | my $pre_start; | ||||
353 | 1 | 7 | $content = ''; | ||||
354 | 1 | 3 | my $bread_end; | ||||
355 | 1 | 7 | for my $line (@lines) { | ||||
356 | 17 | 31 | my $original_line = $line; | ||||
357 | |||||||
358 | # Pre end | ||||||
359 | 17 | 100 | 49 | if ($line =~ m|^ | |||
360 | 1 | 3 | $pre_start = 0; | ||||
361 | } | ||||||
362 | |||||||
363 | # Escape >, < in pre tag | ||||||
364 | 17 | 100 | 36 | if ($pre_start) { | |||
365 | 1 | 15 | $line =~ s/&/&/g; | ||||
366 | 1 | 13 | $line =~ s/>/>/g; | ||||
367 | 1 | 6 | $line =~ s/</g; | ||||
368 | 1 | 4 | $content .= "$line\n"; | ||||
369 | } | ||||||
370 | else { | ||||||
371 | # If start with inline tag, wrap p | ||||||
372 | 16 | 100 | 93 | if ($line =~ $inline_elements_re) { | |||
100 | |||||||
373 | 1 | 6 | $content .= " \n $line\n \n"; |
||||
374 | } | ||||||
375 | # If start with space or tab or not inline tag, it is raw line | ||||||
376 | elsif ($line =~ /^[ \t\<]/) { | ||||||
377 | 11 | 25 | $content .= "$line\n"; | ||||
378 | } | ||||||
379 | # If line have length, wrap p | ||||||
380 | else { | ||||||
381 | 4 | 100 | 17 | if (length $line) { | |||
382 | 1 | 5 | $content .= " \n $line\n \n"; |
||||
383 | } | ||||||
384 | } | ||||||
385 | } | ||||||
386 | |||||||
387 | # Pre start | ||||||
388 | 17 | 100 | 78 | if ($original_line =~ m|^ | |||
389 | 1 | 2 | $pre_start = 1 | ||||
390 | } | ||||||
391 | } | ||||||
392 | |||||||
393 | 1 | 6 | $data->{content} = $content; | ||||
394 | } | ||||||
395 | |||||||
396 | sub parse_title { | ||||||
397 | 2 | 2 | 1 | 16 | my ($self, $data) = @_; | ||
398 | |||||||
399 | 2 | 11 | my $config = $self->config; | ||||
400 | |||||||
401 | 2 | 6 | my $content = $data->{content}; | ||||
402 | |||||||
403 | 2 | 100 | 31 | if ($content =~ m|class\s*=\s*"title"[^>]*?>([^<]*?)<|) { | |||
404 | 1 | 9 | my $title = $1; | ||||
405 | 1 | 10 | $data->{title} = $title; | ||||
406 | } | ||||||
407 | else { | ||||||
408 | 1 | 4 | $data->{title} = undef; | ||||
409 | } | ||||||
410 | } | ||||||
411 | |||||||
412 | sub add_base_path_to_content { | ||||||
413 | 0 | 0 | 0 | 0 | my ($self, $data) = @_; | ||
414 | |||||||
415 | # Giblog | ||||||
416 | 0 | 0 | my $giblog = $self->giblog; | ||||
417 | |||||||
418 | # Config | ||||||
419 | 0 | 0 | my $config = $giblog->config; | ||||
420 | |||||||
421 | # Base path | ||||||
422 | 0 | 0 | my $base_path = $config->{base_path}; | ||||
423 | 0 | 0 | 0 | if (defined $base_path) { | |||
424 | 0 | 0 | $self->_check_base_path($base_path); | ||||
425 | |||||||
426 | # Content | ||||||
427 | 0 | 0 | my $content = $data->{content}; | ||||
428 | |||||||
429 | # Add base path | ||||||
430 | 0 | 0 | my @lines = split /\n/, $content; | ||||
431 | 0 | 0 | my $pre_start; | ||||
432 | 0 | 0 | $content = ''; | ||||
433 | 0 | 0 | my $bread_end; | ||||
434 | 0 | 0 | for my $line (@lines) { | ||||
435 | 0 | 0 | my $original_line = $line; | ||||
436 | |||||||
437 | # Pre end | ||||||
438 | 0 | 0 | 0 | if ($line =~ m|^ | |||
439 | 0 | 0 | $pre_start = 0; | ||||
440 | } | ||||||
441 | |||||||
442 | # Don't add base path in pre tag | ||||||
443 | 0 | 0 | 0 | if ($pre_start) { | |||
444 | 0 | 0 | $content .= "$line\n"; | ||||
445 | } | ||||||
446 | # Add base path to absolute path | ||||||
447 | else { | ||||||
448 | # Add base path to href absolute path | ||||||
449 | 0 | 0 | $line =~ s/\bhref\s*=\s*"(\/[^"]*?)"/href="$base_path$1"/g; | ||||
450 | |||||||
451 | # Add base path to src absolute path | ||||||
452 | 0 | 0 | $line =~ s/\bsrc\s*=\s*"(\/[^"]*?)"/src="$base_path$1"/g; | ||||
453 | |||||||
454 | 0 | 0 | $content .= "$line\n"; | ||||
455 | } | ||||||
456 | |||||||
457 | # Pre start | ||||||
458 | 0 | 0 | 0 | if ($original_line =~ m|^ | |||
459 | 0 | 0 | $pre_start = 1 | ||||
460 | } | ||||||
461 | } | ||||||
462 | |||||||
463 | 0 | 0 | $data->{content} = $content; | ||||
464 | } | ||||||
465 | } | ||||||
466 | |||||||
467 | sub add_base_path_to_public_css_files { | ||||||
468 | 0 | 0 | 0 | 0 | my ($self) = @_; | ||
469 | |||||||
470 | # Giblog | ||||||
471 | 0 | 0 | my $giblog = $self->giblog; | ||||
472 | |||||||
473 | # Config | ||||||
474 | 0 | 0 | my $config = $giblog->config; | ||||
475 | |||||||
476 | # Base path | ||||||
477 | 0 | 0 | my $base_path = $config->{base_path}; | ||||
478 | 0 | 0 | 0 | if (defined $base_path) { | |||
479 | |||||||
480 | 0 | 0 | $self->_check_base_path($base_path); | ||||
481 | |||||||
482 | 0 | 0 | my $public_dir = $self->rel_file('public'); | ||||
483 | |||||||
484 | # Add base path to css file | ||||||
485 | find( | ||||||
486 | { | ||||||
487 | wanted => sub { | ||||||
488 | 0 | 0 | 0 | my $public_file = $File::Find::name; | |||
489 | |||||||
490 | # Skip directory | ||||||
491 | 0 | 0 | 0 | return if -d $public_file; | |||
492 | |||||||
493 | # Skip not css file | ||||||
494 | 0 | 0 | 0 | return unless $public_file =~ /\.css$/; | |||
495 | |||||||
496 | # Open read-write mode | ||||||
497 | 0 | 0 | 0 | open my $fh, "+<", $public_file | |||
498 | or confess "Can't open \"$public_file\": $!"; | ||||||
499 | |||||||
500 | # Get content | ||||||
501 | 0 | 0 | my $content = $self->slurp_file($public_file); | ||||
502 | |||||||
503 | # Add base path to href absolute path | ||||||
504 | 0 | 0 | $content =~ s/\burl\s*\(\s*(\/[^\)]*?)\)/url($base_path$1)/g; | ||||
505 | |||||||
506 | 0 | 0 | 0 | print $fh encode('UTF-8', $content) | |||
507 | or confess "Can't write content to $public_file: $!"; | ||||||
508 | |||||||
509 | 0 | 0 | 0 | close $fh | |||
510 | or confess "Can't close file hanlde $public_file: $!"; | ||||||
511 | }, | ||||||
512 | 0 | 0 | no_chdir => 1, | ||||
513 | }, | ||||||
514 | $public_dir | ||||||
515 | ); | ||||||
516 | } | ||||||
517 | } | ||||||
518 | |||||||
519 | sub _check_base_path { | ||||||
520 | 0 | 0 | 0 | my ($self, $base_path) = @_; | |||
521 | |||||||
522 | # Check base path | ||||||
523 | 0 | 0 | 0 | unless ($base_path =~ /^\//) { | |||
524 | 0 | 0 | confess "base_path must start /"; | ||||
525 | } | ||||||
526 | 0 | 0 | 0 | if ($base_path =~ /\/$/) { | |||
527 | 0 | 0 | confess "base_path must end not /"; | ||||
528 | } | ||||||
529 | } | ||||||
530 | |||||||
531 | sub parse_title_from_first_h_tag { | ||||||
532 | 3 | 3 | 1 | 32 | my ($self, $data) = @_; | ||
533 | |||||||
534 | 3 | 8 | my $config = $self->config; | ||||
535 | |||||||
536 | 3 | 7 | my $content = $data->{content}; | ||||
537 | |||||||
538 | 3 | 100 | 35 | if ($content =~ m|<\s*h[1-6]\b[^>]*?>([^<]*?)<|i) { | |||
539 | 2 | 7 | my $title = $1; | ||||
540 | 2 | 8 | $data->{title} = $title; | ||||
541 | } | ||||||
542 | else { | ||||||
543 | 1 | 4 | $data->{title} = undef; | ||||
544 | } | ||||||
545 | } | ||||||
546 | |||||||
547 | sub add_page_link { | ||||||
548 | 3 | 3 | 1 | 30 | my ($self, $data, $opt) = @_; | ||
549 | |||||||
550 | 3 | 100 | 26 | $opt ||= {}; | |||
551 | |||||||
552 | 3 | 13 | my $giblog = $self->giblog; | ||||
553 | |||||||
554 | 3 | 6 | my $content = $data->{content}; | ||||
555 | |||||||
556 | # Add page link | ||||||
557 | 3 | 6 | my $file = $data->{file}; | ||||
558 | 3 | 5 | my $path; | ||||
559 | 3 | 5 | my $root = $opt->{root}; | ||||
560 | 3 | 100 | 7 | if (defined $root) { | |||
561 | 2 | 100 | 6 | if ($file eq $root) { | |||
562 | 1 | 2 | $path = "/"; | ||||
563 | } | ||||||
564 | else { | ||||||
565 | 1 | 3 | $path = "/$file"; | ||||
566 | } | ||||||
567 | } | ||||||
568 | else { | ||||||
569 | 1 | 4 | $path = "/$file"; | ||||
570 | } | ||||||
571 | |||||||
572 | 3 | 36 | $content =~ s|class="title"[^>]*?>([^<]*?)<|class="title">$1<|; | ||||
573 | |||||||
574 | 3 | 12 | $data->{'content'} = $content; | ||||
575 | } | ||||||
576 | |||||||
577 | sub add_page_link_to_first_h_tag { | ||||||
578 | 3 | 3 | 1 | 34 | my ($self, $data, $opt) = @_; | ||
579 | |||||||
580 | 3 | 100 | 24 | $opt ||= {}; | |||
581 | |||||||
582 | 3 | 7 | my $giblog = $self->giblog; | ||||
583 | |||||||
584 | 3 | 8 | my $content = $data->{content}; | ||||
585 | |||||||
586 | # Add page link | ||||||
587 | 3 | 4 | my $file = $data->{file}; | ||||
588 | 3 | 4 | my $path; | ||||
589 | 3 | 7 | my $root = $opt->{root}; | ||||
590 | 3 | 100 | 7 | if (defined $root) { | |||
591 | 1 | 50 | 4 | if ($file eq $root) { | |||
592 | 1 | 3 | $path = "/"; | ||||
593 | } | ||||||
594 | else { | ||||||
595 | 0 | 0 | $path = "/$file"; | ||||
596 | } | ||||||
597 | } | ||||||
598 | else { | ||||||
599 | 2 | 9 | $path = "/$file"; | ||||
600 | } | ||||||
601 | |||||||
602 | 3 | 39 | $content =~ s|(<\s*h[1-6]\b[^>]*?>)([^<]*?)<|$1$2<|i; | ||||
603 | |||||||
604 | 3 | 12 | $data->{'content'} = $content; | ||||
605 | } | ||||||
606 | |||||||
607 | sub add_content_after_first_p_tag { | ||||||
608 | 1 | 1 | 1 | 10 | my ($self, $data, $opt) = @_; | ||
609 | |||||||
610 | 1 | 50 | 5 | $opt ||= {}; | |||
611 | |||||||
612 | 1 | 2 | my $content = $data->{content}; | ||||
613 | |||||||
614 | 1 | 3 | my $added_content = $opt->{content}; | ||||
615 | |||||||
616 | 1 | 50 | 5 | unless (defined $added_content) { | |||
617 | 0 | 0 | confess "\"content\" option is needed"; | ||||
618 | } | ||||||
619 | |||||||
620 | # Add contents after first h1-6 tag | ||||||
621 | 1 | 18 | $data->{content} =~ s||\n$added_content|i; | ||||
622 | } | ||||||
623 | |||||||
624 | sub add_content_after_first_h_tag { | ||||||
625 | 6 | 6 | 1 | 67 | my ($self, $data, $opt) = @_; | ||
626 | |||||||
627 | 6 | 50 | 24 | $opt ||= {}; | |||
628 | |||||||
629 | 6 | 10 | my $content = $data->{content}; | ||||
630 | |||||||
631 | 6 | 9 | my $added_content = $opt->{content}; | ||||
632 | |||||||
633 | 6 | 50 | 13 | unless (defined $added_content) { | |||
634 | 0 | 0 | confess "\"content\" option is needed"; | ||||
635 | } | ||||||
636 | |||||||
637 | # Add contents after first h1-6 tag | ||||||
638 | 6 | 72 | $data->{content} =~ s||\n$added_content|i; | ||||
639 | } | ||||||
640 | |||||||
641 | sub replace_vars { | ||||||
642 | 1 | 1 | 1 | 19 | my ($self, $data, $opt) = @_; | ||
643 | |||||||
644 | 1 | 50 | 20 | $opt ||= {}; | |||
645 | |||||||
646 | 1 | 6 | my $vars = $self->get_vars; | ||||
647 | 1 | 50 | 5 | if ($vars) { | |||
648 | 1 | 4 | my @var_names = keys %$vars; | ||||
649 | 1 | 4 | for my $var_name (@var_names) { | ||||
650 | 1 | 50 | 12 | unless ($var_name =~ /^[a-zA-Z]\w*/a) { | |||
651 | 0 | 0 | confess "Variable name \"$var_name\" must be valid variable name"; | ||||
652 | } | ||||||
653 | |||||||
654 | 1 | 8 | my $value = $vars->{$var_name}; | ||||
655 | |||||||
656 | 1 | 48 | $data->{content} =~ s/\<\%\= *\$\Q$var_name\E *\%\>/$value/g; | ||||
657 | } | ||||||
658 | } | ||||||
659 | } | ||||||
660 | |||||||
661 | sub parse_description { | ||||||
662 | 2 | 2 | 1 | 17 | my ($self, $data) = @_; | ||
663 | |||||||
664 | 2 | 6 | my $giblog = $self->giblog; | ||||
665 | |||||||
666 | 2 | 4 | my $content = $data->{content}; | ||||
667 | |||||||
668 | 2 | 100 | 30 | if ($content =~ m|class="description"[^>]*?>([^<]*?)<|s) { | |||
669 | 1 | 5 | my $description = $1; | ||||
670 | |||||||
671 | # trim space | ||||||
672 | 1 | 6 | $description =~ s/^\s+//; | ||||
673 | 1 | 13 | $description =~ s/\s+$//; | ||||
674 | |||||||
675 | 1 | 11 | $data->{'description'} = $description; | ||||
676 | } | ||||||
677 | else { | ||||||
678 | 1 | 3 | $data->{'description'} = undef; | ||||
679 | } | ||||||
680 | } | ||||||
681 | |||||||
682 | sub parse_description_from_first_p_tag { | ||||||
683 | 3 | 3 | 1 | 51 | my ($self, $data) = @_; | ||
684 | |||||||
685 | 3 | 8 | my $giblog = $self->giblog; | ||||
686 | |||||||
687 | 3 | 7 | my $content = $data->{content}; | ||||
688 | |||||||
689 | # Create description from first p tag | ||||||
690 | 3 | 100 | 30 | if ($content =~ m|<\s?p\b[^>]*?>(.*?)<\s?/\s?p\s?>|si) { | |||
691 | 2 | 6 | my $description = $1; | ||||
692 | |||||||
693 | # remove tag | ||||||
694 | 2 | 12 | $description =~ s/<[^<]*?>//g; | ||||
695 | |||||||
696 | # trim space | ||||||
697 | 2 | 23 | $description =~ s/^\s+//; | ||||
698 | 2 | 26 | $description =~ s/\s+$//; | ||||
699 | |||||||
700 | # remove new lines | ||||||
701 | 2 | 12 | $description =~ s/\n//g; | ||||
702 | |||||||
703 | 2 | 9 | $data->{'description'} = $description; | ||||
704 | } | ||||||
705 | else { | ||||||
706 | 1 | 4 | $data->{'description'} = undef; | ||||
707 | } | ||||||
708 | } | ||||||
709 | |||||||
710 | sub parse_keywords { | ||||||
711 | 2 | 2 | 1 | 17 | my ($self, $data) = @_; | ||
712 | |||||||
713 | 2 | 6 | my $giblog = $self->giblog; | ||||
714 | |||||||
715 | 2 | 5 | my $content = $data->{content}; | ||||
716 | |||||||
717 | # keywords | ||||||
718 | 2 | 100 | 30 | if ($content =~ m|class="keywords"[^>]*?>([^<]*?)<|) { | |||
719 | 1 | 6 | my $keywords = $1; | ||||
720 | 1 | 4 | $data->{'keywords'} = $1; | ||||
721 | } | ||||||
722 | } | ||||||
723 | |||||||
724 | sub parse_first_img_src { | ||||||
725 | 2 | 2 | 1 | 15 | my ($self, $data) = @_; | ||
726 | |||||||
727 | 2 | 6 | my $giblog = $self->giblog; | ||||
728 | |||||||
729 | 2 | 4 | my $content = $data->{content}; | ||||
730 | |||||||
731 | # image | ||||||
732 | 2 | 100 | 35 | if ($content =~ /<\s*img\b.*?\bsrc\s*=\s*"([^"]*?)"/s) { | |||
733 | 1 | 5 | my $image = $1; | ||||
734 | 1 | 5 | $data->{'img_src'} = $image; | ||||
735 | } | ||||||
736 | } | ||||||
737 | |||||||
738 | sub build_entry { | ||||||
739 | 2 | 2 | 1 | 5918 | my ($self, $data) = @_; | ||
740 | |||||||
741 | 2 | 15 | my $giblog = $self->giblog; | ||||
742 | |||||||
743 | 2 | 25 | my $content = <<"EOS"; | ||||
744 | |
||||||
745 | |
||||||
746 | $data->{top} | ||||||
747 | |||||||
748 | |
||||||
749 | $data->{content} | ||||||
750 | |||||||
751 | |
||||||
752 | $data->{bottom} | ||||||
753 | |||||||
754 | |||||||
755 | EOS | ||||||
756 | |||||||
757 | 2 | 16 | $data->{content} = $content; | ||||
758 | } | ||||||
759 | |||||||
760 | sub build_html { | ||||||
761 | 1 | 1 | 1 | 19 | my ($self, $data) = @_; | ||
762 | |||||||
763 | 1 | 9 | my $giblog = $self->giblog; | ||||
764 | |||||||
765 | 1 | 11 | my $content = <<"EOS"; | ||||
766 | |||||||
767 | |||||||
768 | |||||||
769 | $data->{meta} | ||||||
770 | |||||||
771 | |||||||
772 | |
||||||
773 | |
||||||
774 | $data->{header} | ||||||
775 | |||||||
776 | |
||||||
777 | |
||||||
778 | $data->{content} | ||||||
779 | |||||||
780 | |
||||||
781 | $data->{side} | ||||||
782 | |||||||
783 | |||||||
784 | |||||||
785 | $data->{footer} | ||||||
786 | |||||||
787 | |||||||
788 | |||||||
789 | |||||||
790 | EOS | ||||||
791 | |||||||
792 | 1 | 9 | $data->{content} = $content; | ||||
793 | } | ||||||
794 | |||||||
795 | sub add_meta_title { | ||||||
796 | 1 | 1 | 1 | 25 | my ($self, $data) = @_; | ||
797 | |||||||
798 | 1 | 5 | my $giblog = $self->giblog; | ||||
799 | |||||||
800 | 1 | 4 | my $meta = $data->{meta}; | ||||
801 | |||||||
802 | # Title | ||||||
803 | 1 | 2 | my $title = $data->{title}; | ||||
804 | 1 | 50 | 5 | if (defined $title) { | |||
805 | 1 | 10 | $meta .= "\n |
||||
806 | } | ||||||
807 | |||||||
808 | 1 | 5 | $data->{meta} = $meta; | ||||
809 | } | ||||||
810 | |||||||
811 | sub add_meta_description { | ||||||
812 | 1 | 1 | 1 | 10 | my ($self, $data) = @_; | ||
813 | |||||||
814 | 1 | 3 | my $giblog = $self->giblog; | ||||
815 | |||||||
816 | 1 | 2 | my $meta = $data->{meta}; | ||||
817 | |||||||
818 | # Title | ||||||
819 | 1 | 3 | my $description = $data->{description}; | ||||
820 | 1 | 50 | 8 | if (defined $description) { | |||
821 | 1 | 8 | $meta .= qq(\n); | ||||
822 | } | ||||||
823 | |||||||
824 | 1 | 4 | $data->{meta} = $meta; | ||||
825 | } | ||||||
826 | |||||||
827 | sub read_common_templates { | ||||||
828 | 3 | 3 | 1 | 446 | my ($self, $data) = @_; | ||
829 | |||||||
830 | 3 | 35 | my $common_meta_file = $self->rel_file('templates/common/meta.html'); | ||||
831 | 3 | 28 | my $common_meta_content = $self->slurp_file($common_meta_file); | ||||
832 | 3 | 30 | $data->{meta} = $common_meta_content; | ||||
833 | |||||||
834 | 3 | 22 | my $common_header_file = $self->rel_file('templates/common/header.html'); | ||||
835 | 3 | 13 | my $common_header_content = $self->slurp_file($common_header_file); | ||||
836 | 3 | 31 | $data->{header} = $common_header_content; | ||||
837 | |||||||
838 | 3 | 17 | my $common_footer_file = $self->rel_file('templates/common/footer.html'); | ||||
839 | 3 | 19 | my $common_footer_content = $self->slurp_file($common_footer_file); | ||||
840 | 3 | 31 | $data->{footer} = $common_footer_content; | ||||
841 | |||||||
842 | 3 | 19 | my $common_side_file = $self->rel_file('templates/common/side.html'); | ||||
843 | 3 | 10 | my $common_side_content = $self->slurp_file($common_side_file); | ||||
844 | 3 | 17 | $data->{side} = $common_side_content; | ||||
845 | |||||||
846 | 3 | 11 | my $common_top_file = $self->rel_file('templates/common/top.html'); | ||||
847 | 3 | 21 | my $common_top_content = $self->slurp_file($common_top_file); | ||||
848 | 3 | 29 | $data->{top} = $common_top_content; | ||||
849 | |||||||
850 | 3 | 17 | my $common_bottom_file = $self->rel_file('templates/common/bottom.html'); | ||||
851 | 3 | 8 | my $common_bottom_content = $self->slurp_file($common_bottom_file); | ||||
852 | 3 | 35 | $data->{bottom} = $common_bottom_content; | ||||
853 | } | ||||||
854 | |||||||
855 | sub write_to_public_file { | ||||||
856 | 1 | 1 | 1 | 74 | my ($self, $data) = @_; | ||
857 | |||||||
858 | 1 | 28 | my $content = $data->{content}; | ||||
859 | 1 | 6 | my $file = $data->{file}; | ||||
860 | |||||||
861 | # public file | ||||||
862 | 1 | 22 | my $public_file = $self->rel_file("public/$file"); | ||||
863 | 1 | 138 | my $public_dir = dirname $public_file; | ||||
864 | 1 | 104 | mkpath $public_dir; | ||||
865 | |||||||
866 | # Need update public file | ||||||
867 | 1 | 3 | my $is_need_update_public_file; | ||||
868 | 1 | 50 | 51 | if (!-f $public_file) { | |||
869 | 1 | 9 | $is_need_update_public_file = 1; | ||||
870 | } | ||||||
871 | else { | ||||||
872 | # Get original content | ||||||
873 | 0 | 0 | my $original_content = $self->slurp_file($public_file); | ||||
874 | 0 | 0 | 0 | unless ($content eq $original_content) { | |||
875 | 0 | 0 | $is_need_update_public_file = 1; | ||||
876 | } | ||||||
877 | } | ||||||
878 | |||||||
879 | # Write to public file | ||||||
880 | 1 | 50 | 12 | if ($is_need_update_public_file) { | |||
881 | 1 | 21 | $self->write_to_file($public_file, $content); | ||||
882 | } | ||||||
883 | } | ||||||
884 | |||||||
885 | 1; | ||||||
886 | |||||||
887 | =head1 NAME | ||||||
888 | |||||||
889 | Giblog::API - Giblog API | ||||||
890 | |||||||
891 | =head1 DESCRIPTION | ||||||
892 | |||||||
893 | Giblog::API defines sevral methods to manipulate HTML contents. | ||||||
894 | |||||||
895 | =head1 METHODS | ||||||
896 | |||||||
897 | =head2 new | ||||||
898 | |||||||
899 | my $api = Giblog::API->new(%params); | ||||||
900 | |||||||
901 | Create L |
||||||
902 | |||||||
903 | B |
||||||
904 | |||||||
905 | =over 4 | ||||||
906 | |||||||
907 | =item * giblog | ||||||
908 | |||||||
909 | Set L |
||||||
910 | |||||||
911 | By C |
||||||
912 | |||||||
913 | my $giblog = $api->giblog; | ||||||
914 | |||||||
915 | =back | ||||||
916 | |||||||
917 | =head2 giblog | ||||||
918 | |||||||
919 | my $giblog = $api->giblog; | ||||||
920 | |||||||
921 | Get L |
||||||
922 | |||||||
923 | =head2 config | ||||||
924 | |||||||
925 | my $config = $api->config; | ||||||
926 | |||||||
927 | Get Giblog config. This is hash reference. | ||||||
928 | |||||||
929 | Config is loaded by C |
||||||
930 | |||||||
931 | If config is not loaded, this method return undef. | ||||||
932 | |||||||
933 | =head2 get_vars | ||||||
934 | |||||||
935 | my $vars = $api->get_vars; | ||||||
936 | |||||||
937 | Get a Giblog variables that are defined in C |
||||||
938 | |||||||
939 | # giblog.conf | ||||||
940 | use strict; | ||||||
941 | use warnings; | ||||||
942 | use utf8; | ||||||
943 | |||||||
944 | { | ||||||
945 | site_title => 'mysite・', | ||||||
946 | site_url => 'http://somesite.example', | ||||||
947 | # Variables | ||||||
948 | vars => { | ||||||
949 | '$giblog_test_variable' => 'Giblog Test Variable', | ||||||
950 | }, | ||||||
951 | } | ||||||
952 | |||||||
953 | Before using this method, C |
||||||
954 | |||||||
955 | If config is not loaded, this method return undef. | ||||||
956 | |||||||
957 | If C |
||||||
958 | |||||||
959 | B |
||||||
960 | |||||||
961 | # Get a Giblog variable | ||||||
962 | my $vars = $api->get_vars; | ||||||
963 | my $giblog_test_variable = $vars->{'$giblog_test_variable'}; | ||||||
964 | |||||||
965 | =head2 home_dir | ||||||
966 | |||||||
967 | my $home_dir = $api->home_dir; | ||||||
968 | |||||||
969 | Get home directory. | ||||||
970 | |||||||
971 | =head2 read_config | ||||||
972 | |||||||
973 | my $config = $api->read_config; | ||||||
974 | |||||||
975 | Parse "giblog.conf" in home directory and return hash reference. | ||||||
976 | |||||||
977 | "giblog.conf" must end with correct hash reference. Otherwise exception occur. | ||||||
978 | |||||||
979 | # giblog.conf | ||||||
980 | { | ||||||
981 | site_title => 'mysite', | ||||||
982 | site_url => 'http://somesite.example', | ||||||
983 | } | ||||||
984 | |||||||
985 | After calling "read_config", You can also get config by C |
||||||
986 | |||||||
987 | =head2 clear_config | ||||||
988 | |||||||
989 | $api->clear_config; | ||||||
990 | |||||||
991 | Clear config. Set undef to config. | ||||||
992 | |||||||
993 | =head2 create_dir | ||||||
994 | |||||||
995 | $api->create_dir($dir); | ||||||
996 | |||||||
997 | Create directory. | ||||||
998 | |||||||
999 | If Creating directory fail, exception occur. | ||||||
1000 | |||||||
1001 | =head2 create_file | ||||||
1002 | |||||||
1003 | $api->create_file($file); | ||||||
1004 | |||||||
1005 | Create file. | ||||||
1006 | |||||||
1007 | If Creating file fail, exception occur. | ||||||
1008 | |||||||
1009 | =head2 write_to_file | ||||||
1010 | |||||||
1011 | $api->write_to_file($file, $content); | ||||||
1012 | |||||||
1013 | Write content to file. Content is encoded to UTF-8. | ||||||
1014 | |||||||
1015 | If file is not exists, file is created automatically. | ||||||
1016 | |||||||
1017 | If Creating file fail, exception occur. | ||||||
1018 | |||||||
1019 | =head2 slurp_file | ||||||
1020 | |||||||
1021 | my $content = $api->slurp_file($file); | ||||||
1022 | |||||||
1023 | Get file content. Content is decoded from UTF-8. | ||||||
1024 | |||||||
1025 | If file is not exists, exception occur. | ||||||
1026 | |||||||
1027 | =head2 rel_file | ||||||
1028 | |||||||
1029 | my $file = $api->rel_file('foo/bar'); | ||||||
1030 | |||||||
1031 | Get combined path of home directory and specific relative path. | ||||||
1032 | |||||||
1033 | If home directory is not set, return specific path. | ||||||
1034 | |||||||
1035 | =head2 create_website_from_proto | ||||||
1036 | |||||||
1037 | $api->create_website_from_proto($home_dir, $module_name); | ||||||
1038 | |||||||
1039 | Create website home directory and copy files from prototype directory. | ||||||
1040 | |||||||
1041 | Prototype directory is automatically detected from module name. | ||||||
1042 | |||||||
1043 | If module name is "Giblog::Command::new_foo" and the loading path is "lib/Giblog/Command/new_foo.pm", path of prototype directory is "lib/Giblog/Command/new_foo/proto". | ||||||
1044 | |||||||
1045 | lib/Giblog/Command/new_foo.pm | ||||||
1046 | /new_foo/proto | ||||||
1047 | |||||||
1048 | Module must be loaded before calling "create_website_from_proto". otherwise exception occur. | ||||||
1049 | |||||||
1050 | The web site directry is initialized by git and C |
||||||
1051 | |||||||
1052 | git init foo | ||||||
1053 | git init foo/public | ||||||
1054 | |||||||
1055 | If home directory is not specific, a exception occurs. | ||||||
1056 | |||||||
1057 | If home directory already exists, a exception occurs. | ||||||
1058 | |||||||
1059 | If creating directory fail, a exception occurs. | ||||||
1060 | |||||||
1061 | If proto directory corresponding to module name is not specific, a exception occurs. | ||||||
1062 | |||||||
1063 | If proto direcotry corresponding to module name is not found, a exception occurs. | ||||||
1064 | |||||||
1065 | If git command is not found, a exception occurs. | ||||||
1066 | |||||||
1067 | =head2 copy_static_files_to_public | ||||||
1068 | |||||||
1069 | $api->copy_static_files_to_public; | ||||||
1070 | |||||||
1071 | Copy static files in "templates/static" directory to "public" directory. | ||||||
1072 | |||||||
1073 | =head2 get_templates_files | ||||||
1074 | |||||||
1075 | my $files = $api->get_templates_files; | ||||||
1076 | |||||||
1077 | Get file names in "templates" directory in home directory. | ||||||
1078 | |||||||
1079 | Files in "templates/common" directory and "templates/static" directory and hidden files(which start with ".") is not contained. | ||||||
1080 | |||||||
1081 | Got file name is relative name from "templates" directory. | ||||||
1082 | |||||||
1083 | For example, | ||||||
1084 | |||||||
1085 | index.html | ||||||
1086 | blog/20190312121345.html | ||||||
1087 | blog/20190314452341.html | ||||||
1088 | |||||||
1089 | =head2 get_content | ||||||
1090 | |||||||
1091 | $api->get_content($data); | ||||||
1092 | |||||||
1093 | Get content from relative file name from "templates" directory. Content is decoded from UTF-8. | ||||||
1094 | |||||||
1095 | B |
||||||
1096 | |||||||
1097 | $data->{file} | ||||||
1098 | |||||||
1099 | B |
||||||
1100 | |||||||
1101 | $data->{content} | ||||||
1102 | |||||||
1103 | B |
||||||
1104 | |||||||
1105 | # Get content from templates/index.html | ||||||
1106 | $data->{file} = 'index.html'; | ||||||
1107 | $api->get_content($data); | ||||||
1108 | my $content = $data->{content}; | ||||||
1109 | |||||||
1110 | =head2 parse_giblog_syntax | ||||||
1111 | |||||||
1112 | $api->parse_giblog_syntax($data); | ||||||
1113 | |||||||
1114 | Parse input text as "Giblog syntax", and return output. | ||||||
1115 | |||||||
1116 | B |
||||||
1117 | |||||||
1118 | $data->{content} | ||||||
1119 | |||||||
1120 | B |
||||||
1121 | |||||||
1122 | $data->{content} | ||||||
1123 | |||||||
1124 | B |
||||||
1125 | |||||||
1126 | # Parse input as giblog syntax | ||||||
1127 | $data->{content} = <<'EOS'; | ||||||
1128 | Hello World! | ||||||
1129 | |||||||
1130 | Hi, Yuki | ||||||
1131 | |||||||
1132 | |
||||||
1133 | OK | ||||||
1134 | |||||||
1135 | |||||||
1136 | |
||||||
1137 | my $foo = 1 > 3 && 2 < 5; | ||||||
1138 | |||||||
1139 | EOS | ||||||
1140 | |||||||
1141 | $api->parse_giblog_syntax($data); | ||||||
1142 | my $content = $data->{content}; | ||||||
1143 | |||||||
1144 | B |
||||||
1145 | |||||||
1146 | Giblog syntax is simple syntax to write content easily. | ||||||
1147 | |||||||
1148 | =over 4 | ||||||
1149 | |||||||
1150 | =item 1. Add p tag automatically | ||||||
1151 | |||||||
1152 | Add p tag to inline element starting from the beginning of line. | ||||||
1153 | |||||||
1154 | # Input | ||||||
1155 | Hello World! | ||||||
1156 | |||||||
1157 | Hi, Yuki | ||||||
1158 | |||||||
1159 | |
||||||
1160 | OK | ||||||
1161 | |||||||
1162 | |||||||
1163 | # Output | ||||||
1164 |
|
||||||
1165 | Hello World! | ||||||
1166 | |||||||
1167 |
|
||||||
1168 | Hi, Yuki | ||||||
1169 | |||||||
1170 | |
||||||
1171 | OK | ||||||
1172 | |||||||
1173 | |||||||
1174 | Empty line is deleted. | ||||||
1175 | |||||||
1176 | =item 2. Escape E |
||||||
1177 | |||||||
1178 | If pre tag starts at the beginning of the line and its end tag starts at the beginning of the line, execute HTML escapes ">" and "<" between them. | ||||||
1179 | |||||||
1180 | # Input | ||||||
1181 | |
||||||
1182 | my $foo = 1 > 3 && 2 < 5; | ||||||
1183 | |||||||
1184 | |||||||
1185 | # Output | ||||||
1186 | |
||||||
1187 | my $foo = 1 > 3 && 2 < 5; | ||||||
1188 | |||||||
1189 | |||||||
1190 | =back | ||||||
1191 | |||||||
1192 | =head2 parse_title | ||||||
1193 | |||||||
1194 | $api->parse_title($data); | ||||||
1195 | |||||||
1196 | Get title from text of tag which class name is "title". | ||||||
1197 | |||||||
1198 | If parser can't get title, title become undef. | ||||||
1199 | |||||||
1200 | B |
||||||
1201 | |||||||
1202 | $data->{content} | ||||||
1203 | |||||||
1204 | B |
||||||
1205 | |||||||
1206 | $data->{title} | ||||||
1207 | |||||||
1208 | B |
||||||
1209 | |||||||
1210 | # Get title | ||||||
1211 | $data->{content} = <<'EOS'; | ||||||
1212 | Perl Tutorial |
||||||
1213 | EOS | ||||||
1214 | $api->parse_title($data); | ||||||
1215 | my $title = $data->{title}; | ||||||
1216 | |||||||
1217 | =head2 parse_title_from_first_h_tag | ||||||
1218 | |||||||
1219 | $api->parse_title_from_first_h_tag($data); | ||||||
1220 | |||||||
1221 | Get title from text of first h1, h2, h3, h4, h5, h6 tag. | ||||||
1222 | |||||||
1223 | If parser can't get title, title become undef. | ||||||
1224 | |||||||
1225 | B |
||||||
1226 | |||||||
1227 | $data->{content} | ||||||
1228 | |||||||
1229 | B |
||||||
1230 | |||||||
1231 | $data->{title} | ||||||
1232 | |||||||
1233 | B |
||||||
1234 | |||||||
1235 | # Get title | ||||||
1236 | $data->{content} = <<'EOS'; | ||||||
1237 | Perl Tutorial |
||||||
1238 | EOS | ||||||
1239 | $api->parse_title_from_first_h_tag($data); | ||||||
1240 | my $title = $data->{title}; | ||||||
1241 | |||||||
1242 | =head2 add_page_link | ||||||
1243 | |||||||
1244 | $api->add_page_link($data); | ||||||
1245 | $api->add_page_link($data, $opt); | ||||||
1246 | |||||||
1247 | Add page link to text of tag which class name is "title". | ||||||
1248 | |||||||
1249 | If parser can't get title, content is not changed. | ||||||
1250 | |||||||
1251 | B |
||||||
1252 | |||||||
1253 | $data->{file} | ||||||
1254 | $data->{content} | ||||||
1255 | |||||||
1256 | B |
||||||
1257 | |||||||
1258 | $data->{content} | ||||||
1259 | |||||||
1260 | "file" is relative path from "templates" directory. | ||||||
1261 | |||||||
1262 | If added link is the path which combine "/" and value of "file". | ||||||
1263 | |||||||
1264 | if $opt->{root} is specifed and this match $data->{file}, added link is "/". | ||||||
1265 | |||||||
1266 | B |
||||||
1267 | |||||||
1268 | # Add page link | ||||||
1269 | $data->{file} = 'blog/20181012123456.html'; | ||||||
1270 | $data->{content} = <<'EOS'; | ||||||
1271 | Perl Tutorial |
||||||
1272 | EOS | ||||||
1273 | $api->add_page_link($data); | ||||||
1274 | my $content = $data->{content}; | ||||||
1275 | |||||||
1276 | Content is changed to | ||||||
1277 | |||||||
1278 | |||||||
1279 | |||||||
1280 | B |
||||||
1281 | |||||||
1282 | # Add page link | ||||||
1283 | $data->{file} = 'index.html'; | ||||||
1284 | $data->{content} = <<'EOS'; | ||||||
1285 | Perl Tutorial |
||||||
1286 | EOS | ||||||
1287 | $api->add_page_link($data); | ||||||
1288 | my $content = $data->{content}; | ||||||
1289 | |||||||
1290 | Content is changed to | ||||||
1291 | |||||||
1292 | |||||||
1293 | |||||||
1294 | =head2 add_page_link_to_first_h_tag | ||||||
1295 | |||||||
1296 | $api->add_page_link_to_first_h_tag($data); | ||||||
1297 | $api->add_page_link_to_first_h_tag($data, $opt); | ||||||
1298 | |||||||
1299 | Add page link to text of first h1, h2, h3, h4, h5, h6 tag. | ||||||
1300 | |||||||
1301 | If parser can't get title, content is not changed. | ||||||
1302 | |||||||
1303 | B |
||||||
1304 | |||||||
1305 | $data->{file} | ||||||
1306 | $data->{content} | ||||||
1307 | |||||||
1308 | B |
||||||
1309 | |||||||
1310 | $data->{content} | ||||||
1311 | |||||||
1312 | "file" is relative path from "templates" directory. | ||||||
1313 | |||||||
1314 | If added link is the path which combine "/" and value of "file". | ||||||
1315 | |||||||
1316 | if $opt->{root} is specifed and this match $data->{file}, added link is "/". | ||||||
1317 | |||||||
1318 | B |
||||||
1319 | |||||||
1320 | # Add page link | ||||||
1321 | $data->{file} = 'blog/20181012123456.html'; | ||||||
1322 | $data->{content} = <<'EOS'; | ||||||
1323 | Perl Tutorial |
||||||
1324 | EOS | ||||||
1325 | $api->add_page_link_to_first_h_tag($data); | ||||||
1326 | my $content = $data->{content}; | ||||||
1327 | |||||||
1328 | Content is changed to | ||||||
1329 | |||||||
1330 | Perl Tutorial |
||||||
1331 | |||||||
1332 | B |
||||||
1333 | |||||||
1334 | # Add page link | ||||||
1335 | $data->{file} = 'index.html'; | ||||||
1336 | $data->{content} = <<'EOS'; | ||||||
1337 | Perl Tutorial |
||||||
1338 | EOS | ||||||
1339 | $api->add_page_link_to_first_h_tag($data); | ||||||
1340 | my $content = $data->{content}; | ||||||
1341 | |||||||
1342 | Content is changed to | ||||||
1343 | |||||||
1344 | Perl Tutorial |
||||||
1345 | |||||||
1346 | =head2 add_content_after_first_p_tag | ||||||
1347 | |||||||
1348 | $api->add_content_after_first_p_tag($data, $opt); | ||||||
1349 | |||||||
1350 | Add contents after the first C tag. |
||||||
1351 | |||||||
1352 | B |
||||||
1353 | |||||||
1354 | $data->{content} | ||||||
1355 | $opt->{content} | ||||||
1356 | |||||||
1357 | B |
||||||
1358 | |||||||
1359 | $data->{content} | ||||||
1360 | |||||||
1361 | $data->{content} is the current content. $opt->{content} is the added content. | ||||||
1362 | |||||||
1363 | B |
||||||
1364 | |||||||
1365 | # Add contents after the first p tag. | ||||||
1366 | $data->{content} = <<'EOS'; | ||||||
1367 | Perl Tutorial |
||||||
1368 |
|
||||||
1369 | Foo | ||||||
1370 | |||||||
1371 |
|
||||||
1372 | Bar | ||||||
1373 | |||||||
1374 | EOS | ||||||
1375 | $api->add_content_after_first_p_tag($data, {content => " Added Contents "); |
||||||
1376 | my $content = $data->{content}; | ||||||
1377 | |||||||
1378 | Content is changed to | ||||||
1379 | |||||||
1380 | Perl Tutorial |
||||||
1381 |
|
||||||
1382 | Foo | ||||||
1383 | |||||||
1384 | Added Contents |
||||||
1385 |
|
||||||
1386 | Bar | ||||||
1387 | |||||||
1388 | |||||||
1389 | =head2 add_content_after_first_h_tag | ||||||
1390 | |||||||
1391 | $api->add_content_after_first_h_tag($data, $opt); | ||||||
1392 | |||||||
1393 | Add contents after the first C, C, C, C |
||||||
1394 | |||||||
1395 | B |
||||||
1396 | |||||||
1397 | $data->{content} | ||||||
1398 | $opt->{content} | ||||||
1399 | |||||||
1400 | B |
||||||
1401 | |||||||
1402 | $data->{content} | ||||||
1403 | |||||||
1404 | $data->{content} is the current content. $opt->{content} is the added content. | ||||||
1405 | |||||||
1406 | B |
||||||
1407 | |||||||
1408 | # Add contents after the first p tag. | ||||||
1409 | $data->{content} = <<'EOS'; | ||||||
1410 | Perl Tutorial |
||||||
1411 | Perl Tutorial |
||||||
1412 | EOS | ||||||
1413 | $api->add_content_after_first_h_tag($data, {content => " Added Contents "); |
||||||
1414 | my $content = $data->{content}; | ||||||
1415 | |||||||
1416 | Content is changed to | ||||||
1417 | |||||||
1418 | Perl Tutorial |
||||||
1419 | Added Contents |
||||||
1420 | Perl Tutorial |
||||||
1421 | |||||||
1422 | =head2 replace_vars | ||||||
1423 | |||||||
1424 | $api->replace_vars($data); | ||||||
1425 | |||||||
1426 | Replace a Giblog variables in the content with the values of C |
||||||
1427 | |||||||
1428 | # giblog.conf | ||||||
1429 | use strict; | ||||||
1430 | use warnings; | ||||||
1431 | use utf8; | ||||||
1432 | |||||||
1433 | { | ||||||
1434 | site_title => 'mysite・', | ||||||
1435 | site_url => 'http://somesite.example', | ||||||
1436 | # Variables | ||||||
1437 | vars => { | ||||||
1438 | '$giblog_test_variable' => 'Giblog Test Variable', | ||||||
1439 | }, | ||||||
1440 | } | ||||||
1441 | |||||||
1442 | B |
||||||
1443 | |||||||
1444 | $data->{content} | ||||||
1445 | |||||||
1446 | B |
||||||
1447 | |||||||
1448 | $data->{content} | ||||||
1449 | |||||||
1450 | $data->{content} is the current content. | ||||||
1451 | |||||||
1452 | B |
||||||
1453 | |||||||
1454 | # Replace a Giblog variables | ||||||
1455 | $data->{content} = <<'EOS'; | ||||||
1456 | <%= $giblog_test_variable %> |
||||||
1457 | <%= $giblog_test_variable %> |
||||||
1458 | EOS | ||||||
1459 | $api->replace_vars($data); | ||||||
1460 | my $content = $data->{content}; | ||||||
1461 | |||||||
1462 | Content is changed to | ||||||
1463 | |||||||
1464 | Giblog Test Variable |
||||||
1465 | Giblog Test Variable |
||||||
1466 | |||||||
1467 | =head2 parse_description | ||||||
1468 | |||||||
1469 | $api->parse_description($data); | ||||||
1470 | |||||||
1471 | Get description from text of tag which class name is "description". | ||||||
1472 | |||||||
1473 | Both of left spaces and right spaces are removed. This is Unicode space. | ||||||
1474 | |||||||
1475 | If parser can't get description, description become undef. | ||||||
1476 | |||||||
1477 | B |
||||||
1478 | |||||||
1479 | $data->{content} | ||||||
1480 | |||||||
1481 | B |
||||||
1482 | |||||||
1483 | $data->{description} | ||||||
1484 | |||||||
1485 | B |
||||||
1486 | |||||||
1487 | # Get description | ||||||
1488 | $data->{content} = <<'EOS'; | ||||||
1489 | |
||||||
1490 | Perl Tutorial is site for beginners of Perl | ||||||
1491 | |||||||
1492 | EOS | ||||||
1493 | $api->parse_description($data); | ||||||
1494 | my $description = $data->{description}; | ||||||
1495 | |||||||
1496 | Output description is "Perl Tutorial is site for beginners of Perl". | ||||||
1497 | |||||||
1498 | =head2 parse_description_from_first_p_tag | ||||||
1499 | |||||||
1500 | $api->parse_description_from_first_p_tag($data); | ||||||
1501 | |||||||
1502 | Get description from text of first p tag. | ||||||
1503 | |||||||
1504 | HTML tag is removed. | ||||||
1505 | |||||||
1506 | Both of left spaces and right spaces is removed. This is Unicode space. | ||||||
1507 | |||||||
1508 | If parser can't get description, description become undef. | ||||||
1509 | |||||||
1510 | B |
||||||
1511 | |||||||
1512 | $data->{content} | ||||||
1513 | |||||||
1514 | B |
||||||
1515 | |||||||
1516 | $data->{description} | ||||||
1517 | |||||||
1518 | B |
||||||
1519 | |||||||
1520 | # Get description | ||||||
1521 | $data->{content} = <<'EOS'; | ||||||
1522 |
|
||||||
1523 | Perl Tutorial is site for beginners of Perl | ||||||
1524 | |||||||
1525 |
|
||||||
1526 | Foo, Bar | ||||||
1527 | |||||||
1528 | EOS | ||||||
1529 | $api->parse_description_from_first_p_tag($data); | ||||||
1530 | my $description = $data->{description}; | ||||||
1531 | |||||||
1532 | Output description is "Perl Tutorial is site for beginners of Perl". | ||||||
1533 | |||||||
1534 | =head2 parse_keywords | ||||||
1535 | |||||||
1536 | $api->parse_keywords($data); | ||||||
1537 | |||||||
1538 | Get keywords from text of tag which class name is "keywords". | ||||||
1539 | |||||||
1540 | If parser can't get keywords, keywords become undef. | ||||||
1541 | |||||||
1542 | B |
||||||
1543 | |||||||
1544 | $data->{content} | ||||||
1545 | |||||||
1546 | B |
||||||
1547 | |||||||
1548 | $data->{keywords} | ||||||
1549 | |||||||
1550 | B |
||||||
1551 | |||||||
1552 | # Get keywords | ||||||
1553 | $data->{content} = <<'EOS'; | ||||||
1554 | Perl,Tutorial |
||||||
1555 | EOS | ||||||
1556 | $api->parse_keywords($data); | ||||||
1557 | my $keywords = $data->{keywords}; | ||||||
1558 | |||||||
1559 | =head2 parse_first_img_src | ||||||
1560 | |||||||
1561 | $api->parse_first_img_src($data); | ||||||
1562 | |||||||
1563 | Get image src from src attribute of first img tag. | ||||||
1564 | |||||||
1565 | If parser can't get image src, image src become undef. | ||||||
1566 | |||||||
1567 | B |
||||||
1568 | |||||||
1569 | $data->{content} | ||||||
1570 | |||||||
1571 | B |
||||||
1572 | |||||||
1573 | $data->{img_src} | ||||||
1574 | |||||||
1575 | B |
||||||
1576 | |||||||
1577 | # Get first_img_src | ||||||
1578 | $data->{content} = <<'EOS'; | ||||||
1579 | |||||||
1580 | EOS | ||||||
1581 | $api->parse_first_img_src($data); | ||||||
1582 | my $img_src = $data->{img_src}; | ||||||
1583 | |||||||
1584 | Output img_src is "/path". | ||||||
1585 | |||||||
1586 | =head2 read_common_templates | ||||||
1587 | |||||||
1588 | $api->read_common_templates($data); | ||||||
1589 | |||||||
1590 | Read common templates in "templates/common" directory. | ||||||
1591 | |||||||
1592 | The follwoing templates is loaded. Content is decoded from UTF-8. | ||||||
1593 | |||||||
1594 | "meta.html", "header.html", "footer.html", "side.html", "top.html", "bottom.html" | ||||||
1595 | |||||||
1596 | B |
||||||
1597 | |||||||
1598 | $data->{meta} | ||||||
1599 | $data->{header} | ||||||
1600 | $data->{footer} | ||||||
1601 | $data->{side} | ||||||
1602 | $data->{top} | ||||||
1603 | $data->{bottom} | ||||||
1604 | |||||||
1605 | =head2 add_meta_title | ||||||
1606 | |||||||
1607 | Add title tag to meta section. | ||||||
1608 | |||||||
1609 | B |
||||||
1610 | |||||||
1611 | $data->{title} | ||||||
1612 | $data->{meta} | ||||||
1613 | |||||||
1614 | B |
||||||
1615 | |||||||
1616 | $data->{meta} | ||||||
1617 | |||||||
1618 | If value of "meta" is "foo" and "title" is "Perl Tutorial", output value of "meta" become "foo\n |
||||||
1619 | |||||||
1620 | =head2 add_meta_description | ||||||
1621 | |||||||
1622 | Add meta description tag to meta section. | ||||||
1623 | |||||||
1624 | B |
||||||
1625 | |||||||
1626 | $data->{description} | ||||||
1627 | $data->{meta} | ||||||
1628 | |||||||
1629 | B |
||||||
1630 | |||||||
1631 | $data->{meta} | ||||||
1632 | |||||||
1633 | If value of "meta" is "foo" and "description" is "Perl is good", output value of "meta" become "foo\n" | ||||||
1634 | |||||||
1635 | =head2 build_entry | ||||||
1636 | |||||||
1637 | Build entry HTML by "content" and "top", "bottom". | ||||||
1638 | |||||||
1639 | B |
||||||
1640 | |||||||
1641 | $data->{content} | ||||||
1642 | $data->{top} | ||||||
1643 | $data->{bottom} | ||||||
1644 | |||||||
1645 | B |
||||||
1646 | |||||||
1647 | $data->{content} | ||||||
1648 | |||||||
1649 | Output is the following HTML. | ||||||
1650 | |||||||
1651 | |
||||||
1652 | |
||||||
1653 | $data->{top} | ||||||
1654 | |||||||
1655 | |
||||||
1656 | $data->{content} | ||||||
1657 | |||||||
1658 | |
||||||
1659 | $data->{bottom} | ||||||
1660 | |||||||
1661 | |||||||
1662 | |||||||
1663 | =head2 build_html | ||||||
1664 | |||||||
1665 | Build whole HTML by "content" and "header", "bottom", "side", "footer". | ||||||
1666 | |||||||
1667 | B |
||||||
1668 | |||||||
1669 | $data->{content} | ||||||
1670 | $data->{header} | ||||||
1671 | $data->{bottom} | ||||||
1672 | $data->{side} | ||||||
1673 | $data->{footer} | ||||||
1674 | |||||||
1675 | B |
||||||
1676 | |||||||
1677 | $data->{content} | ||||||
1678 | |||||||
1679 | Output is the following HTML. | ||||||
1680 | |||||||
1681 | |||||||
1682 | |||||||
1683 | |||||||
1684 | $data->{meta} | ||||||
1685 | |||||||
1686 | |||||||
1687 | |
||||||
1688 | |
||||||
1689 | $data->{header} | ||||||
1690 | |||||||
1691 | |
||||||
1692 | |
||||||
1693 | $data->{content} | ||||||
1694 | |||||||
1695 | |
||||||
1696 | $data->{side} | ||||||
1697 | |||||||
1698 | |||||||
1699 | |||||||
1700 | $data->{footer} | ||||||
1701 | |||||||
1702 | |||||||
1703 | |||||||
1704 | |||||||
1705 | |||||||
1706 | =head2 write_to_public_file | ||||||
1707 | |||||||
1708 | Write content to file in "public" directory. Content is encoded to UTF-8. | ||||||
1709 | |||||||
1710 | If value of "file" is "index.html", write path become "public/index.html" | ||||||
1711 | |||||||
1712 | B |
||||||
1713 | |||||||
1714 | $data->{content} | ||||||
1715 | $data->{file} | ||||||
1716 | |||||||
1717 | If the original content of the file is same as the new content of the file is same, this method don't write to public file. This means file time stamp is not be updated. |