Mercurial > hg > chronicle
comparison bin/chronicle-spooler @ 194:4004fa368f64
Added as simple proof of concept
author | Steve Kemp <steve@steve.org.uk> |
---|---|
date | Mon, 14 Apr 2008 18:50:54 +0100 |
parents | |
children | 889827a88e34 |
comparison
equal
deleted
inserted
replaced
193:e8b2a9e81beb | 194:4004fa368f64 |
---|---|
1 #!/usr/bin/perl -w | |
2 | |
3 =head1 NAME | |
4 | |
5 chronicle-spooler - Automatically post pre-written entries. | |
6 | |
7 =cut | |
8 | |
9 =head1 SYNOPSIS | |
10 | |
11 | |
12 Path Options: | |
13 | |
14 --config Specify a configuration file to read. | |
15 --spool-dir Specify where pending entries are located. | |
16 --live-dir Specify where the entries should be moved to. | |
17 | |
18 | |
19 Post-Spool Commands: | |
20 | |
21 --post-move Specify a command to execute once entries have been moved. | |
22 | |
23 Optional Features: | |
24 | |
25 --test Only report on what would be executed. | |
26 | |
27 Help Options: | |
28 | |
29 --help Show the help information for this script. | |
30 --manual Read the manual for this script. | |
31 | |
32 =cut | |
33 | |
34 | |
35 =head1 ABOUT | |
36 | |
37 chronicle-spooler is a companion scrip to the chronicle blog compiler. | |
38 | |
39 It is designed to facilitate posting new entries automatically upon | |
40 particular dates. (ie. If you have ten written blog entries in a spool | |
41 directory it will move them into place upon the date you've specified.) | |
42 | |
43 =cut | |
44 | |
45 | |
46 =head1 DATE SPECIFICATION | |
47 | |
48 To specify the date a particular entry should be made live you | |
49 must add another psuedo-header to your blog entry files, as follows: | |
50 | |
51 =for example begin | |
52 | |
53 Title: This is the title of the blog post | |
54 Date: 2nd March 2007 | |
55 Publish: 15th April 2008 | |
56 Tags: one, two, three, long tag | |
57 | |
58 The text of your entry goes here. | |
59 | |
60 =for example end | |
61 | |
62 In this example we know that this entry will be made live upon the | |
63 15th April 2008, and not before. | |
64 | |
65 =cut | |
66 | |
67 =head1 AUTHOR | |
68 | |
69 Steve | |
70 -- | |
71 http://www.steve.org.uk/ | |
72 | |
73 =cut | |
74 | |
75 =head1 LICENSE | |
76 | |
77 Copyright (c) 2008 by Steve Kemp. All rights reserved. | |
78 | |
79 This module is free software; | |
80 you can redistribute it and/or modify it under | |
81 the same terms as Perl itself. | |
82 The LICENSE file contains the full text of the license. | |
83 | |
84 =cut | |
85 | |
86 | |
87 use strict; | |
88 use warnings; | |
89 | |
90 | |
91 use Date::Parse; | |
92 use File::Copy; | |
93 use Getopt::Long; | |
94 use Pod::Usage; | |
95 | |
96 | |
97 # | |
98 # Release number | |
99 # | |
100 # NOTE: Set by 'make release'. | |
101 # | |
102 my $RELEASE = 'UNRELEASED'; | |
103 | |
104 | |
105 # | |
106 # Our configuration options. | |
107 # | |
108 my %CONFIG; | |
109 | |
110 | |
111 # | |
112 # Read the global and per-user configuration files, if they exist. | |
113 # | |
114 readConfigurationFile("/etc/chroniclerc"); | |
115 readConfigurationFile( $ENV{ 'HOME' } . "/.chroniclerc" ); | |
116 | |
117 | |
118 # | |
119 # Parse the command line arguments. | |
120 # | |
121 parseCommandLineArguments(); | |
122 | |
123 | |
124 # | |
125 # Another configuration file? | |
126 # | |
127 readConfigurationFile( $CONFIG{ 'config' } ) if ( defined $CONFIG{ 'config' } ); | |
128 | |
129 | |
130 # | |
131 # Make sure we have arguments which are sane. | |
132 # | |
133 # Specifically we need an input directory and an output directory. | |
134 # | |
135 # | |
136 sanityCheckArguments(); | |
137 | |
138 | |
139 # | |
140 # Find the potentially pending entries. | |
141 # | |
142 my @files = findPendingPosts( $CONFIG{ 'spool-dir' } ); | |
143 | |
144 | |
145 # | |
146 # Process each entry | |
147 # | |
148 my $live = 0; | |
149 foreach my $entry ( sort(@files) ) | |
150 { | |
151 if ( shouldBeLive($entry) ) | |
152 { | |
153 if ( $CONFIG{ 'test' } ) | |
154 { | |
155 print "test: make entry live: $entry\n"; | |
156 } | |
157 else | |
158 { | |
159 makeEntryLive($entry); | |
160 $live += 1; | |
161 } | |
162 } | |
163 } | |
164 | |
165 | |
166 # | |
167 # If we should run our command do so. | |
168 # | |
169 if ( $CONFIG{ 'post-move' } ) | |
170 { | |
171 if ( $CONFIG{ 'test' } ) | |
172 { | |
173 print "test: should run: $CONFIG{'post-move'}\n"; | |
174 } | |
175 else | |
176 { | |
177 system( $CONFIG{ 'post-move' } ); | |
178 } | |
179 } | |
180 | |
181 | |
182 | |
183 # | |
184 # All done. | |
185 # | |
186 exit; | |
187 | |
188 | |
189 | |
190 =begin doc | |
191 | |
192 Parse the command line arguments this script was given. | |
193 | |
194 =end doc | |
195 | |
196 =cut | |
197 | |
198 sub parseCommandLineArguments | |
199 { | |
200 my $HELP = 0; | |
201 my $MANUAL = 0; | |
202 my $VERSION = 0; | |
203 | |
204 # | |
205 # Parse options. | |
206 # | |
207 GetOptions( | |
208 | |
209 # input / output | |
210 "spool-dir=s", \$CONFIG{ 'spool-dir' }, | |
211 "live-dir=s", \$CONFIG{ 'live-dir' }, | |
212 | |
213 # testing? | |
214 "test", \$CONFIG{ 'test' }, | |
215 | |
216 # command? | |
217 "post-move=s", \$CONFIG{ 'post-move' }, | |
218 | |
219 # Help options | |
220 "help", \$HELP, | |
221 "manual", \$MANUAL, | |
222 "verbose", \$CONFIG{ 'verbose' }, | |
223 "version", \$VERSION, | |
224 | |
225 ); | |
226 | |
227 pod2usage(1) if $HELP; | |
228 pod2usage( -verbose => 2 ) if $MANUAL; | |
229 | |
230 if ($VERSION) | |
231 { | |
232 print("chronicle release $RELEASE\n"); | |
233 exit; | |
234 } | |
235 } | |
236 | |
237 | |
238 | |
239 =begin doc | |
240 | |
241 Read the specified configuration file if it exists. | |
242 | |
243 =end doc | |
244 | |
245 =cut | |
246 | |
247 sub readConfigurationFile | |
248 { | |
249 my ($file) = (@_); | |
250 | |
251 # | |
252 # If it doesn't exist ignore it. | |
253 # | |
254 return if ( !-e $file ); | |
255 | |
256 | |
257 my $line = ""; | |
258 | |
259 open( FILE, "<", $file ) or die "Cannot read file '$file' - $!"; | |
260 while ( defined( $line = <FILE> ) ) | |
261 { | |
262 chomp $line; | |
263 if ( $line =~ s/\\$// ) | |
264 { | |
265 $line .= <FILE>; | |
266 redo unless eof(FILE); | |
267 } | |
268 | |
269 # Skip lines beginning with comments | |
270 next if ( $line =~ /^([ \t]*)\#/ ); | |
271 | |
272 # Skip blank lines | |
273 next if ( length($line) < 1 ); | |
274 | |
275 # Strip trailing comments. | |
276 if ( $line =~ /(.*)\#(.*)/ ) | |
277 { | |
278 $line = $1; | |
279 } | |
280 | |
281 # Find variable settings | |
282 if ( $line =~ /([^=]+)=([^\n]+)/ ) | |
283 { | |
284 my $key = $1; | |
285 my $val = $2; | |
286 | |
287 # Strip leading and trailing whitespace. | |
288 $key =~ s/^\s+//; | |
289 $key =~ s/\s+$//; | |
290 $val =~ s/^\s+//; | |
291 $val =~ s/\s+$//; | |
292 | |
293 # command expansion? | |
294 if ( $val =~ /(.*)`([^`]+)`(.*)/ ) | |
295 { | |
296 | |
297 # store | |
298 my $pre = $1; | |
299 my $cmd = $2; | |
300 my $post = $3; | |
301 | |
302 # get output | |
303 my $output = `$cmd`; | |
304 chomp($output); | |
305 | |
306 # build up replacement. | |
307 $val = $pre . $output . $post; | |
308 } | |
309 | |
310 # Store value. | |
311 $CONFIG{ $key } = $val; | |
312 } | |
313 } | |
314 | |
315 close(FILE); | |
316 } | |
317 | |
318 | |
319 | |
320 =begin doc | |
321 | |
322 Sanity check our arguments, and setup to make sure there is nothing | |
323 obviously broken. | |
324 | |
325 =end doc | |
326 | |
327 =cut | |
328 | |
329 sub sanityCheckArguments | |
330 { | |
331 if ( ( !$CONFIG{ 'spool-dir' } ) | |
332 || ( !-d $CONFIG{ 'spool-dir' } ) ) | |
333 { | |
334 print <<EOF; | |
335 | |
336 Please specify the spool directory, which contains the entries which | |
337 are to be moved into the live directory in the future. | |
338 | |
339 EOF | |
340 exit; | |
341 } | |
342 | |
343 if ( ( !$CONFIG{ 'live-dir' } ) | |
344 || ( !-d $CONFIG{ 'live-dir' } ) ) | |
345 { | |
346 print <<EOF; | |
347 | |
348 Please specify the output directory into which entries should be | |
349 moved to make them live. | |
350 | |
351 EOF | |
352 exit; | |
353 } | |
354 } | |
355 | |
356 | |
357 | |
358 =begin doc | |
359 | |
360 Find any files that might be in the pending directory. | |
361 | |
362 =end doc | |
363 | |
364 =cut | |
365 | |
366 sub findPendingPosts | |
367 { | |
368 my ($dir) = (@_); | |
369 | |
370 my $pattern = "*"; | |
371 my @files; | |
372 | |
373 foreach my $file ( sort( glob("$dir/$pattern") ) ) | |
374 { | |
375 push( @files, $file ) unless ( -d $file ); | |
376 } | |
377 | |
378 return (@files); | |
379 } | |
380 | |
381 | |
382 =begin doc | |
383 | |
384 Read the given file and see if it should be published now. | |
385 That means that the file containes a "Publish:" psuedo-header | |
386 which is either in the past, or equal to todays date. | |
387 | |
388 =end doc | |
389 | |
390 =cut | |
391 | |
392 sub shouldBeLive | |
393 { | |
394 my ($file) = (@_); | |
395 | |
396 # | |
397 # If the file doesn't exist we don't publish it. Huh? | |
398 # | |
399 return 0 if ( !-e $file ); | |
400 | |
401 # | |
402 # Look for a header | |
403 # | |
404 my $header = ""; | |
405 | |
406 open( FILE, "<", $file ) | |
407 or die "Failed to read file $file - $!"; | |
408 | |
409 foreach my $line (<FILE>) | |
410 { | |
411 if ( ( $line =~ /^Publish:(.*)/i ) | |
412 && ( !length($header) ) ) | |
413 { | |
414 $header = $1; | |
415 | |
416 # Strip leading and trailing whitespace. | |
417 $header =~ s/^\s+//; | |
418 $header =~ s/\s+$//; | |
419 } | |
420 } | |
421 close(FILE); | |
422 | |
423 # | |
424 # No header? Not to be published | |
425 # | |
426 return 0 if ( length($header) < 1 ); | |
427 | |
428 # | |
429 # OK we got a header - is it current / past? | |
430 # | |
431 my $today = time; | |
432 if ( !defined( $today ) ) | |
433 { | |
434 print "FAILED TO FIND TODAY\n"; | |
435 return 0; | |
436 } | |
437 | |
438 # | |
439 # Date of entry | |
440 # | |
441 my $ent = str2time($header); | |
442 if ( !defined( $ent ) ) | |
443 { | |
444 print "FAILED TO PARSE: '$header'\n"; | |
445 return 0; | |
446 } | |
447 | |
448 | |
449 # | |
450 # Do the date test. | |
451 # | |
452 if ( $ent < $today ) | |
453 { | |
454 return 1; | |
455 } | |
456 else | |
457 { | |
458 return 0; | |
459 } | |
460 } | |
461 | |
462 | |
463 | |
464 =begin doc | |
465 | |
466 Move the specified file into our "live" directory. | |
467 | |
468 =end doc | |
469 | |
470 =cut | |
471 | |
472 sub makeEntryLive | |
473 { | |
474 my ($file) = (@_); | |
475 | |
476 | |
477 if ( -d $CONFIG{ 'live-dir' } ) | |
478 { | |
479 | |
480 # | |
481 # Is there already a file there with that name? | |
482 # | |
483 # If so don't truncate it. | |
484 # | |
485 my $dir = $file; | |
486 my $base = $file; | |
487 if ( $base =~ /^(.*)[\\\/](.*)$/ ) | |
488 { | |
489 $dir = $1; | |
490 $base = $2; | |
491 } | |
492 | |
493 while ( -e "$CONFIG{'live-dir'}/$base" ) | |
494 { | |
495 $base = "x$base"; | |
496 } | |
497 | |
498 # | |
499 # Moving | |
500 # | |
501 File::Copy::move( $file, | |
502 $CONFIG{ 'live-dir' } . "/" . $base ); | |
503 } | |
504 else | |
505 { | |
506 print "Weirdness $CONFIG{'live-dir'} is not a directory!\n"; | |
507 exit; | |
508 } | |
509 } |