|
1
|
1 #!/usr/bin/perl -w
|
|
|
2
|
|
|
3 =head1 NAME
|
|
|
4
|
|
|
5 chronicle - A blog compiler.
|
|
|
6
|
|
|
7 =cut
|
|
|
8
|
|
|
9 =head1 SYNOPSIS
|
|
|
10
|
|
|
11
|
|
36
|
12 Path Options:
|
|
|
13
|
|
61
|
14 --config Specify a configuration file to read.
|
|
|
15 --input Specify the input directory to use.
|
|
|
16 --output Specify the directory to write output to.
|
|
|
17 --theme-dir Specify the path to the theme templates.
|
|
|
18 --theme Specify the theme to use.
|
|
|
19 --pattern Specify the pattern of files to work with.
|
|
|
20 --url-prefix Specify the prefix to the live blog.
|
|
36
|
21
|
|
|
22
|
|
|
23 Pre & Post-Build Commands:
|
|
|
24
|
|
|
25 --pre-build Specify a command to execute prior to building the blog.
|
|
|
26 --post-build Specify a command to execute once the blog has been built.
|
|
|
27
|
|
44
|
28 Blog Entry Options:
|
|
|
29
|
|
|
30 --format Specify the format of your entries, HTML/textile/markdown.
|
|
36
|
31
|
|
|
32 Optional Features:
|
|
|
33
|
|
46
|
34 --force Force the copying of static files from the blog theme.
|
|
36
|
35 --no-archive Don't create an archive page.
|
|
|
36 --no-cache Don't use the optional memcached features, even if available.
|
|
|
37 --no-tags Don't produce any tag pages.
|
|
|
38 --lower-case Lower-case all filenames which are output.
|
|
|
39
|
|
|
40
|
|
1
|
41 Help Options:
|
|
|
42
|
|
|
43 --help Show the help information for this script.
|
|
|
44 --manual Read the manual for this script.
|
|
|
45 --verbose Show useful debugging information.
|
|
|
46 --version Show the version number and exit.
|
|
|
47
|
|
|
48 =cut
|
|
|
49
|
|
|
50
|
|
|
51 =head1 ABOUT
|
|
|
52
|
|
|
53 Chronicle is a simple tool to convert a collection of text files,
|
|
33
|
54 located within a single directory, into a blog consisting of static
|
|
|
55 HTML files.
|
|
1
|
56
|
|
|
57 It supports only the bare minimum of features which are required
|
|
|
58 to be useful:
|
|
|
59
|
|
|
60 * Tagging support.
|
|
|
61
|
|
|
62 * RSS support.
|
|
|
63
|
|
|
64 * Archive support.
|
|
|
65
|
|
|
66 The obvious deficiencies are:
|
|
|
67
|
|
|
68 * Lack of support for commenting.
|
|
|
69
|
|
|
70 * Lack of pingback/trackback support.
|
|
|
71
|
|
|
72 Having said that it is a robust, stable, and useful system.
|
|
|
73
|
|
|
74 =cut
|
|
|
75
|
|
46
|
76
|
|
44
|
77 =head1 BLOG FORMAT
|
|
|
78
|
|
|
79 The format of the text files we process is critical to the output
|
|
|
80 pages. Each entry should look something like this:
|
|
|
81
|
|
|
82 =for example begin
|
|
|
83
|
|
|
84 Title: This is the title of the blog post
|
|
|
85 Date: 2nd March 2007
|
|
|
86 Tags: one, two, three, long tag
|
|
|
87
|
|
|
88 The text of your entry goes here.
|
|
|
89
|
|
|
90 =for example end
|
|
|
91
|
|
|
92 In this example we can see that the entry itself has been prefaced
|
|
60
|
93 with a small header. An entry header is contains three optional lines,
|
|
|
94 if these are not present then there are sensible defaults as described
|
|
|
95 below:
|
|
|
96
|
|
|
97 =over 8
|
|
|
98
|
|
|
99 =item Title:
|
|
|
100 Describes the title of the post. If not present the filename of the entry
|
|
|
101 is used instead.
|
|
|
102
|
|
|
103 =item Date:
|
|
|
104 The date the post was written. If not present the creation time of the
|
|
|
105 file is used instead.
|
|
|
106
|
|
|
107 =item Tags:
|
|
|
108 Any tags which should be associated with the entry, separated by commas.
|
|
|
109
|
|
|
110 =back
|
|
44
|
111
|
|
|
112 The text of the entry itself is assumed to be HTML, however if you
|
|
|
113 have the optional modules installed you may write it in Markdown or
|
|
60
|
114 Textile formats - if they are not present you will receive a message
|
|
|
115 informing you of the names of the required modules.
|
|
44
|
116
|
|
60
|
117 You may specify the format of your entries either in the configuration
|
|
|
118 file, or via the command line flag B<--format>.
|
|
44
|
119
|
|
46
|
120 =cut
|
|
|
121
|
|
|
122
|
|
|
123 =head1 CONFIGURATION
|
|
|
124
|
|
|
125 The configuration of the software is minimal, and generally performed
|
|
|
126 via the command line arguments. However it is possible to save settings
|
|
60
|
127 either in the file global /etc/chroniclerc or the per-user ~/.chroniclerc
|
|
46
|
128 file.
|
|
|
129
|
|
60
|
130 If you wish you may pass the name of another configuration file to
|
|
|
131 the script with the B<--config> flag. This will be read after the
|
|
|
132 previous two files, and may override any settings which are present.
|
|
|
133
|
|
|
134 The configuration file contains lines like these:
|
|
46
|
135
|
|
|
136 =for example begin
|
|
|
137
|
|
|
138 input = /home/me/blog
|
|
|
139
|
|
|
140 output = /var/www/blog
|
|
|
141
|
|
|
142 format = markdown
|
|
|
143
|
|
|
144 =for example end
|
|
|
145
|
|
|
146 Keys which are unknown are ignored.
|
|
44
|
147
|
|
|
148 =cut
|
|
|
149
|
|
|
150
|
|
|
151 =head1 OPTIONAL CACHING
|
|
|
152
|
|
60
|
153 To speed the rebuilding of a large blog the compiler may use a local
|
|
|
154 Memcached deaemon, if installed and available.
|
|
44
|
155
|
|
|
156 To install this, under a Debian GNU/Linux system please run:
|
|
|
157
|
|
|
158 =for example begin
|
|
|
159
|
|
|
160 apt-get update
|
|
|
161 apt-get install memcached libcache-memcached-perl
|
|
|
162
|
|
|
163 =for example end
|
|
|
164
|
|
|
165 You may disable this caching behaviour with --no-cache, and see the
|
|
|
166 effect with --verbose.
|
|
|
167
|
|
|
168 =cut
|
|
|
169
|
|
1
|
170
|
|
|
171 =head1 AUTHOR
|
|
|
172
|
|
|
173 Steve
|
|
|
174 --
|
|
|
175 http://www.steve.org.uk/
|
|
|
176
|
|
|
177 =cut
|
|
|
178
|
|
|
179 =head1 LICENSE
|
|
|
180
|
|
|
181 Copyright (c) 2007 by Steve Kemp. All rights reserved.
|
|
|
182
|
|
|
183 This module is free software;
|
|
|
184 you can redistribute it and/or modify it under
|
|
|
185 the same terms as Perl itself.
|
|
|
186 The LICENSE file contains the full text of the license.
|
|
|
187
|
|
|
188 =cut
|
|
|
189
|
|
|
190
|
|
|
191 use strict;
|
|
|
192 use warnings;
|
|
45
|
193
|
|
|
194
|
|
1
|
195 use Date::Parse;
|
|
39
|
196 use Date::Format;
|
|
1
|
197 use File::Copy;
|
|
|
198 use File::Path;
|
|
|
199 use Getopt::Long;
|
|
|
200 use HTML::Template;
|
|
|
201 use Pod::Usage;
|
|
45
|
202 use Time::Local;
|
|
1
|
203
|
|
|
204
|
|
23
|
205 #
|
|
|
206 # Release number
|
|
|
207 #
|
|
|
208 # NOTE: Set by 'make release'.
|
|
|
209 #
|
|
|
210 my $RELEASE = 'UNRELEASED';
|
|
1
|
211
|
|
|
212
|
|
49
|
213 #
|
|
|
214 # The names of the months. Posted early to allow i18n users.
|
|
|
215 #
|
|
|
216 my @names = qw( January February March April May June July August September October November December );
|
|
18
|
217
|
|
1
|
218 #
|
|
|
219 # Setup default options.
|
|
|
220 #
|
|
33
|
221 my %CONFIG = setupDefaultOptions();
|
|
1
|
222
|
|
|
223
|
|
|
224 #
|
|
7
|
225 # Read the global and per-user configuration files, if they exist.
|
|
1
|
226 #
|
|
7
|
227 readConfigurationFile( "/etc/chroniclerc" );
|
|
|
228 readConfigurationFile( $ENV{'HOME'} . "/.chroniclerc" );
|
|
1
|
229
|
|
|
230
|
|
|
231 #
|
|
|
232 # Parse the command line arguments.
|
|
|
233 #
|
|
|
234 parseCommandLineArguments();
|
|
|
235
|
|
|
236
|
|
|
237 #
|
|
59
|
238 # Another configuration file?
|
|
|
239 #
|
|
|
240 readConfigurationFile( $CONFIG{'config'} ) if ( defined $CONFIG{'config'} );
|
|
|
241
|
|
|
242
|
|
|
243 #
|
|
61
|
244 # Make sure we have arguments which are sane.
|
|
|
245 #
|
|
|
246 # Specifically we want to cope with the "new" 'theme-dir', and 'theme'
|
|
|
247 # arguments.
|
|
|
248 #
|
|
|
249 #
|
|
|
250 sanityCheckArguments();
|
|
|
251
|
|
|
252
|
|
|
253 #
|
|
|
254 # Listing themes?
|
|
|
255 #
|
|
|
256 if ( $CONFIG{'list-themes'} )
|
|
|
257 {
|
|
|
258 listThemes( $CONFIG{'theme-dir'} );
|
|
|
259 exit;
|
|
|
260 }
|
|
|
261
|
|
1
|
262 # Should we run something before we start?
|
|
|
263 #
|
|
|
264 if ( $CONFIG{'pre-build'} )
|
|
|
265 {
|
|
|
266 $CONFIG{'verbose'} && print "Running command: $CONFIG{'pre-build'}\n";
|
|
|
267
|
|
|
268 system($CONFIG{'pre-build'});
|
|
|
269 }
|
|
|
270
|
|
|
271
|
|
|
272 #
|
|
|
273 # Parse each of the given text files, and build up a datastructure
|
|
|
274 # we can use to create our pages.
|
|
|
275 #
|
|
|
276 # The data-structure is a hash of arrays. The hash key is the blog
|
|
|
277 # entry's filename, and the array stored as the hash's value has
|
|
|
278 # keys such as:
|
|
|
279 #
|
|
|
280 # tags => [ 'test', 'testing' ]
|
|
|
281 # date => '1st july 2007'
|
|
|
282 # title => 'Some title'
|
|
|
283 #
|
|
|
284 #
|
|
|
285 my %data = createDataStructure();
|
|
|
286
|
|
18
|
287
|
|
1
|
288 #
|
|
18
|
289 # Find each unique tag used within our entries.
|
|
1
|
290 #
|
|
|
291 my %all_tags;
|
|
|
292 %all_tags = findAllTags() unless( $CONFIG{'no-tags'} );
|
|
|
293
|
|
|
294
|
|
|
295 #
|
|
|
296 # Find each unique month + year we've used.
|
|
|
297 #
|
|
39
|
298 my %all_dates;
|
|
1
|
299 %all_dates = findAllMonths() unless( $CONFIG{'no-archive'} );
|
|
|
300
|
|
|
301
|
|
|
302 #
|
|
|
303 # Now create the global tag + date loops which are used for our
|
|
|
304 # sidebar.
|
|
|
305 #
|
|
|
306 my %CLOUD;
|
|
|
307 $CLOUD{'tag'} = createTagCloud( %all_tags ) unless( $CONFIG{'no-tags'} );
|
|
|
308 $CLOUD{'archive'} = createDateCloud( %all_dates ) unless( $CONFIG{'no-archive'} );;
|
|
|
309
|
|
|
310
|
|
18
|
311
|
|
|
312 #
|
|
39
|
313 # Create the output directories.
|
|
18
|
314 #
|
|
|
315 mkpath( $CONFIG{'output'}, 0, 0755 ) if ( ! -d $CONFIG{'output'} );
|
|
39
|
316 foreach my $tag ( keys %all_tags )
|
|
|
317 {
|
|
|
318 mkpath( "$CONFIG{'output'}/tags/$tag", 0, 0755 );
|
|
|
319 }
|
|
|
320 foreach my $date ( keys %all_dates )
|
|
|
321 {
|
|
|
322 next unless ( $date =~ /^([0-9]{4})-([0-9]{2})/ );
|
|
|
323 mkpath( "$CONFIG{'output'}/archive/$1/$2", 0, 0755 );
|
|
|
324 }
|
|
18
|
325
|
|
|
326
|
|
1
|
327 #
|
|
|
328 # Output each static page.
|
|
|
329 #
|
|
|
330 $CONFIG{'verbose'} && print "Creating static pages:\n";
|
|
|
331 foreach my $file ( keys %data )
|
|
|
332 {
|
|
|
333 outputStaticPage( $file );
|
|
|
334 }
|
|
|
335
|
|
|
336
|
|
|
337
|
|
|
338 #
|
|
60
|
339 # Build an output page for every tag which has ever been used.
|
|
1
|
340 #
|
|
|
341 foreach my $tagName ( sort keys %all_tags )
|
|
|
342 {
|
|
|
343 $CONFIG{'verbose'} && print "Creating tag page: $tagName\n";
|
|
|
344
|
|
|
345 outputTagPage( $tagName );
|
|
|
346 }
|
|
|
347
|
|
|
348
|
|
|
349
|
|
|
350 #
|
|
60
|
351 # Now build the archive pages.
|
|
1
|
352 #
|
|
|
353 foreach my $date ( keys( %all_dates ) )
|
|
|
354 {
|
|
|
355 $CONFIG{'verbose'} && print "Creating archive page: $date\n";
|
|
|
356
|
|
|
357 outputArchivePage( $date );
|
|
|
358 }
|
|
|
359
|
|
|
360
|
|
|
361
|
|
|
362 #
|
|
18
|
363 # Finally out the most recent entries for the front-page.
|
|
1
|
364 #
|
|
|
365 outputIndexPage();
|
|
|
366
|
|
|
367
|
|
|
368
|
|
|
369 #
|
|
12
|
370 # Copy any static files into place.
|
|
1
|
371 #
|
|
12
|
372 copyStaticFiles();
|
|
1
|
373
|
|
|
374
|
|
|
375 #
|
|
|
376 # Post-build command?
|
|
|
377 #
|
|
|
378 if ( $CONFIG{'post-build'} )
|
|
|
379 {
|
|
|
380 $CONFIG{'verbose'} && print "Running command: $CONFIG{'post-build'}\n";
|
|
|
381
|
|
|
382 system($CONFIG{'post-build'});
|
|
|
383 }
|
|
|
384
|
|
18
|
385
|
|
1
|
386 #
|
|
|
387 # All done.
|
|
|
388 #
|
|
|
389 exit;
|
|
|
390
|
|
|
391
|
|
|
392
|
|
|
393
|
|
|
394
|
|
18
|
395
|
|
|
396
|
|
1
|
397 =begin doc
|
|
|
398
|
|
|
399 Setup the default options we'd expect into our global configuration hash.
|
|
|
400
|
|
|
401 =end doc
|
|
|
402
|
|
|
403 =cut
|
|
|
404
|
|
|
405 sub setupDefaultOptions
|
|
|
406 {
|
|
33
|
407 my %CONFIG;
|
|
|
408
|
|
18
|
409 #
|
|
|
410 # Text directory.
|
|
|
411 #
|
|
1
|
412 $CONFIG{'input'} = "./blog";
|
|
18
|
413
|
|
|
414 #
|
|
|
415 # Output directory.
|
|
|
416 #
|
|
1
|
417 $CONFIG{'output'} = "./output";
|
|
18
|
418
|
|
|
419 #
|
|
61
|
420 # Theme setup
|
|
18
|
421 #
|
|
61
|
422 $CONFIG{'theme-dir'} = "./themes/";
|
|
|
423 $CONFIG{'theme'} = "default";
|
|
18
|
424
|
|
|
425 #
|
|
|
426 # prefix for all links.
|
|
|
427 #
|
|
1
|
428 $CONFIG{'url-prefix'} = "";
|
|
18
|
429
|
|
|
430 #
|
|
|
431 # Default input format
|
|
|
432 #
|
|
16
|
433 $CONFIG{'format'} = 'html';
|
|
18
|
434
|
|
|
435 #
|
|
|
436 # Entries per-page for the index.
|
|
|
437 #
|
|
|
438 $CONFIG{'entry-count'} = 10;
|
|
|
439
|
|
46
|
440 #
|
|
|
441 # Don't overwrite files by default
|
|
|
442 #
|
|
|
443 $CONFIG{'force'} = 0;
|
|
|
444
|
|
33
|
445 return( %CONFIG );
|
|
1
|
446 }
|
|
|
447
|
|
|
448
|
|
|
449
|
|
18
|
450
|
|
1
|
451 =begin doc
|
|
|
452
|
|
|
453 Parse the command line arguments this script was given.
|
|
|
454
|
|
|
455 =end doc
|
|
|
456
|
|
|
457 =cut
|
|
|
458
|
|
|
459 sub parseCommandLineArguments
|
|
|
460 {
|
|
|
461 my $HELP = 0;
|
|
|
462 my $MANUAL = 0;
|
|
|
463 my $VERSION = 0;
|
|
|
464
|
|
|
465 #
|
|
|
466 # Parse options.
|
|
|
467 #
|
|
|
468 GetOptions(
|
|
|
469 # Help options
|
|
|
470 "help", \$HELP,
|
|
|
471 "manual", \$MANUAL,
|
|
|
472 "verbose", \$CONFIG{'verbose'},
|
|
|
473 "version", \$VERSION,
|
|
61
|
474 "list-themes", \$CONFIG{'list-themes'},
|
|
1
|
475
|
|
|
476 # paths
|
|
59
|
477 "config=s", \$CONFIG{'config'},
|
|
1
|
478 "input=s", \$CONFIG{'input'},
|
|
|
479 "output=s", \$CONFIG{'output'},
|
|
61
|
480 "theme-dir=s", \$CONFIG{'theme-dir'},
|
|
|
481 "theme=s", \$CONFIG{'theme'},
|
|
36
|
482 "pattern=s", \$CONFIG{'pattern'},
|
|
1
|
483
|
|
|
484 # optional
|
|
46
|
485 "force", \$CONFIG{'force'},
|
|
1
|
486 "no-tags", \$CONFIG{'no-tags'},
|
|
33
|
487 "no-cache", \$CONFIG{'no-cache'},
|
|
1
|
488 "no-archive", \$CONFIG{'no-archive'},
|
|
34
|
489 "lower-case", \$CONFIG{'lower-case'},
|
|
1
|
490
|
|
44
|
491 # input format.
|
|
|
492 "format=s", \$CONFIG{'format'},
|
|
|
493
|
|
27
|
494 # prefix
|
|
|
495 "url-prefix=s", \$CONFIG{'url_prefix'},
|
|
|
496
|
|
1
|
497 # commands
|
|
|
498 "pre-build=s", \$CONFIG{'pre-build'},
|
|
|
499 "post-build=s", \$CONFIG{'post-build'},
|
|
|
500
|
|
|
501 );
|
|
|
502
|
|
|
503 pod2usage(1) if $HELP;
|
|
|
504 pod2usage(-verbose => 2 ) if $MANUAL;
|
|
|
505
|
|
|
506 if ( $VERSION )
|
|
|
507 {
|
|
62
|
508 my $REVISION = '$Revision: 1.28 $';
|
|
1
|
509 if ( $REVISION =~ /1.([0-9.]+) / )
|
|
|
510 {
|
|
|
511 $REVISION = $1;
|
|
|
512 }
|
|
|
513
|
|
23
|
514 print( "chronicle release $RELEASE\n" );
|
|
1
|
515 exit;
|
|
|
516 }
|
|
|
517 }
|
|
|
518
|
|
|
519
|
|
|
520
|
|
|
521 =begin doc
|
|
|
522
|
|
|
523 Create our global datastructure, by reading each of the blog
|
|
|
524 files and extracting:
|
|
|
525
|
|
|
526 1. The title of the entry.
|
|
|
527
|
|
|
528 2. Any tags which might be present.
|
|
|
529
|
|
|
530 3. The date upon which it was made.
|
|
|
531
|
|
|
532 =end doc
|
|
|
533
|
|
|
534 =cut
|
|
|
535
|
|
|
536 sub createDataStructure
|
|
|
537 {
|
|
|
538 my %results;
|
|
|
539
|
|
|
540 if ( ! -d $CONFIG{'input'} )
|
|
|
541 {
|
|
|
542 print <<EOF;
|
|
|
543
|
|
|
544 The blog input directory $CONFIG{'input'} does not exist.
|
|
|
545
|
|
|
546 Aborting.
|
|
|
547 EOF
|
|
|
548
|
|
|
549 exit
|
|
|
550 }
|
|
|
551
|
|
|
552 #
|
|
|
553 # Did the user override the default pattern?
|
|
|
554 #
|
|
|
555 my $pattern = $CONFIG{'pattern'} || "*";
|
|
|
556 my $count = 0;
|
|
|
557
|
|
|
558 foreach my $file ( sort( glob( $CONFIG{'input'} . "/" . $pattern ) ) )
|
|
|
559 {
|
|
7
|
560 #
|
|
|
561 # Ignore directories.
|
|
|
562 #
|
|
|
563 next if ( -d $file );
|
|
|
564
|
|
62
|
565 my $tags = '';
|
|
1
|
566 my $title = '';
|
|
|
567 my $date = '';
|
|
|
568 my $private = 0;
|
|
|
569
|
|
|
570 my @tags;
|
|
|
571
|
|
|
572 open( INPUT, "<", $file ) or die "Failed to open blog file $file - $!";
|
|
|
573 while( my $line = <INPUT> )
|
|
|
574 {
|
|
62
|
575 #
|
|
|
576 # Get the tags
|
|
|
577 #
|
|
|
578 if ( ( $line =~ /^tags:(.*)/i ) && !length($tags) )
|
|
1
|
579 {
|
|
62
|
580 $tags = $1;
|
|
|
581 foreach my $t ( split( /,/, $tags ) )
|
|
1
|
582 {
|
|
|
583 # strip leading and trailing space.
|
|
|
584 $t =~ s/^\s+//;
|
|
|
585 $t =~ s/\s+$//;
|
|
|
586
|
|
|
587 # skip empty tags.
|
|
|
588 next if ( !length($t) );
|
|
|
589
|
|
|
590 # lowercase and store the tags.
|
|
62
|
591 $t = lc($t);
|
|
1
|
592 push ( @tags, $t );
|
|
|
593 }
|
|
|
594 }
|
|
11
|
595 elsif (( $line =~ /^title:(.*)/i ) && !length($title) )
|
|
1
|
596 {
|
|
62
|
597 #
|
|
|
598 # Get the title.
|
|
|
599 #
|
|
1
|
600 $title = $1;
|
|
11
|
601
|
|
|
602 # strip leading and trailing space.
|
|
|
603 $title =~ s/^\s+// if ( length $title );
|
|
|
604 $title =~ s/\s+$// if ( length $title );
|
|
1
|
605 }
|
|
11
|
606 elsif (( $line =~ /^date:(.*)/i ) && !length($date) )
|
|
1
|
607 {
|
|
62
|
608 #
|
|
|
609 # Get the date.
|
|
|
610 #
|
|
1
|
611 $date = $1;
|
|
11
|
612
|
|
|
613 # strip leading and trailing space.
|
|
|
614 $date =~ s/^\s+// if ( $date );
|
|
|
615 $date =~ s/\s+$// if ( $date );
|
|
|
616
|
|
1
|
617 }
|
|
11
|
618 elsif ( $line =~ /^status:(.*)/i )
|
|
1
|
619 {
|
|
62
|
620 #
|
|
|
621 # The security level.
|
|
|
622 #
|
|
|
623
|
|
1
|
624 my $level = $1;
|
|
11
|
625
|
|
|
626 # strip leading and trailing space.
|
|
|
627 $level =~ s/^\s+// if ( $level );
|
|
|
628 $level =~ s/\s+$// if ( $level );
|
|
|
629
|
|
1
|
630 $private = 1 if ( $level =~ /private/i);
|
|
|
631 }
|
|
|
632 }
|
|
|
633 close( INPUT );
|
|
|
634
|
|
|
635 $results{$file} = { tags => \@tags,
|
|
|
636 title => $title,
|
|
|
637 date => $date } unless( $private );
|
|
|
638
|
|
|
639 $count += 1;
|
|
|
640 }
|
|
|
641
|
|
|
642 #
|
|
|
643 # Make sure we found some entries.
|
|
|
644 #
|
|
|
645 if ( $count < 1 )
|
|
|
646 {
|
|
|
647 print <<EOF;
|
|
|
648
|
|
|
649 There were no text files found in the input directory
|
|
|
650 $CONFIG{'input'} which matched the pattern '$pattern'.
|
|
|
651
|
|
|
652 Aborting.
|
|
|
653
|
|
|
654 EOF
|
|
|
655 exit;
|
|
|
656 }
|
|
|
657
|
|
|
658 return %results;
|
|
|
659 }
|
|
|
660
|
|
|
661
|
|
|
662
|
|
|
663 =begin doc
|
|
|
664
|
|
|
665 Find each distinct tag which has been used within blog entries,
|
|
|
666 and the number of times each one has been used.
|
|
|
667
|
|
|
668 =end doc
|
|
|
669
|
|
|
670 =cut
|
|
|
671
|
|
|
672 sub findAllTags
|
|
|
673 {
|
|
|
674 my %allTags;
|
|
|
675
|
|
|
676 foreach my $f ( keys %data )
|
|
|
677 {
|
|
|
678 my $h = $data{$f};
|
|
|
679 my $tags = $h->{'tags'} || undef;
|
|
|
680 foreach my $t ( @$tags )
|
|
|
681 {
|
|
|
682 $allTags{$t}+=1;
|
|
|
683 }
|
|
|
684 }
|
|
|
685
|
|
|
686 return( %allTags );
|
|
|
687 }
|
|
|
688
|
|
|
689
|
|
|
690
|
|
|
691 =begin doc
|
|
|
692
|
|
|
693 Create a structure for a tag cloud.
|
|
|
694
|
|
|
695 =end doc
|
|
|
696
|
|
|
697 =cut
|
|
|
698
|
|
|
699 sub createTagCloud
|
|
|
700 {
|
|
|
701 my( %unique ) = ( @_ );
|
|
|
702
|
|
|
703 my $results;
|
|
|
704
|
|
|
705 foreach my $key ( sort keys( %unique ) )
|
|
|
706 {
|
|
60
|
707 # count.
|
|
27
|
708 my $count = $unique{$key};
|
|
60
|
709
|
|
|
710 # size for the HTML.
|
|
27
|
711 my $size = 10 + ( $count * 5 );
|
|
60
|
712 $size = 40 if ( $size >= 40 );
|
|
27
|
713
|
|
1
|
714 push( @$results,
|
|
27
|
715 { tag => $key,
|
|
|
716 count => $count,
|
|
34
|
717 size => $size } );
|
|
1
|
718 }
|
|
|
719 return $results;
|
|
|
720
|
|
|
721 }
|
|
|
722
|
|
|
723
|
|
|
724
|
|
|
725 =begin doc
|
|
|
726
|
|
|
727 Find each of the distinct Month + Year pairs for entries which
|
|
|
728 have been created.
|
|
|
729
|
|
|
730 =end doc
|
|
|
731
|
|
|
732 =cut
|
|
|
733
|
|
|
734 sub findAllMonths
|
|
|
735 {
|
|
|
736 my %allDates;
|
|
|
737 foreach my $f ( keys %data )
|
|
|
738 {
|
|
60
|
739 my $h = $data{$f};
|
|
1
|
740 next if ( !$h );
|
|
|
741
|
|
55
|
742 my $date = $h->{'date'};
|
|
|
743
|
|
|
744 #
|
|
60
|
745 # Not a date? Use the ctime of the file.
|
|
55
|
746 #
|
|
|
747 if ( !defined( $date ) || !length($date) )
|
|
|
748 {
|
|
|
749 #
|
|
|
750 # Test the file for creation time.
|
|
|
751 #
|
|
|
752 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
|
|
753 $atime,$mtime,$ctime,$blksize,$blocks)
|
|
|
754 = stat($f);
|
|
|
755
|
|
|
756 $date = localtime( $ctime );
|
|
|
757 }
|
|
|
758
|
|
|
759 $date = time2str("%Y-%m", str2time($date));
|
|
1
|
760
|
|
|
761 $allDates{$date}+=1;
|
|
|
762 }
|
|
|
763
|
|
|
764 return( %allDates );
|
|
|
765 }
|
|
|
766
|
|
|
767
|
|
|
768
|
|
|
769 =begin doc
|
|
|
770
|
|
|
771 Create a data structure which can be used for our archive layout.
|
|
|
772
|
|
|
773 This is a little messy too. It mostly comes because we want to
|
|
|
774 have a nested loop so that we can place our entries in a nice manner.
|
|
|
775
|
|
|
776 =end doc
|
|
|
777
|
|
|
778 =cut
|
|
|
779
|
|
|
780 sub createDateCloud
|
|
|
781 {
|
|
39
|
782 my( %entry_dates ) = ( @_ );
|
|
1
|
783
|
|
|
784 my $results;
|
|
39
|
785 my $year;
|
|
|
786 my $months;
|
|
1
|
787
|
|
39
|
788 foreach my $date ( sort keys %entry_dates )
|
|
1
|
789 {
|
|
39
|
790 next unless ( $date =~ /^([0-9]{4})-([0-9]{2})/ );
|
|
|
791
|
|
|
792 if ( $year and $1 ne $year )
|
|
1
|
793 {
|
|
39
|
794 push( @$results, { year => $year,
|
|
|
795 months => $months } );
|
|
|
796 undef $months;
|
|
1
|
797 }
|
|
39
|
798 $year = $1;
|
|
|
799
|
|
|
800 push( @$months, { month => $2,
|
|
|
801 month_name => $names[$2-1],
|
|
|
802 count => $entry_dates{$date} } );
|
|
|
803
|
|
1
|
804 }
|
|
|
805
|
|
39
|
806 push( @$results, { year => $year,
|
|
|
807 months => $months } );
|
|
1
|
808
|
|
|
809 return $results;
|
|
|
810 }
|
|
|
811
|
|
|
812
|
|
|
813
|
|
|
814 =begin doc
|
|
|
815
|
|
|
816 Sort by date.
|
|
|
817
|
|
|
818 =end doc
|
|
|
819
|
|
|
820 =cut
|
|
|
821
|
|
|
822 sub bywhen
|
|
|
823 {
|
|
37
|
824 #
|
|
|
825 # Parse and return the date
|
|
|
826 #
|
|
|
827 my ($ss1,$mm1,$hh1,$day1,$month1,$year1,$zone1) = strptime($a->{'date'});
|
|
1
|
828 my ($ss2,$mm2,$hh2,$day2,$month2,$year2,$zone2) = strptime($b->{'date'});
|
|
|
829
|
|
37
|
830 #
|
|
|
831 # Abort if we didn't work.
|
|
|
832 #
|
|
|
833 die "Couldn't find first year" unless defined($year1);
|
|
|
834 die "Couldn't find second year" unless defined($year2);
|
|
1
|
835
|
|
37
|
836 #
|
|
|
837 # Convert to compare
|
|
|
838 #
|
|
|
839 my $c = timelocal(0,0,0,$day1,$month1,$year1 + 1900);
|
|
|
840 my $d = timelocal(0,0,0,$day2,$month2,$year2 + 1900);
|
|
|
841
|
|
|
842 return $d <=> $c;
|
|
1
|
843 }
|
|
|
844
|
|
|
845
|
|
|
846
|
|
|
847
|
|
|
848 =begin doc
|
|
|
849
|
|
|
850 Output the index page + index RSS feed.
|
|
|
851
|
|
|
852 =end doc
|
|
|
853
|
|
|
854 =cut
|
|
|
855
|
|
|
856 sub outputIndexPage
|
|
|
857 {
|
|
|
858
|
|
|
859 #
|
|
|
860 # Holder for the blog entries.
|
|
|
861 #
|
|
|
862 my $entries;
|
|
|
863
|
|
|
864 #
|
|
|
865 # Find all the entries and sort them to be most recent first.
|
|
|
866 #
|
|
|
867 my $tmp;
|
|
|
868 foreach my $file ( keys ( %data ) )
|
|
|
869 {
|
|
|
870 my $blog = readBlogEntry( $file );
|
|
|
871 push( @$tmp, $blog ) if (keys( %$blog ) );
|
|
|
872 }
|
|
|
873 my @tmp2 = sort bywhen @$tmp;
|
|
|
874
|
|
|
875
|
|
|
876 #
|
|
|
877 # The number of entries to display upon the index.
|
|
|
878 #
|
|
18
|
879 my $max = $CONFIG{'entry-count'};
|
|
1
|
880 foreach my $f ( @tmp2 )
|
|
|
881 {
|
|
|
882 push( @$entries, $f ) if ( $max > 0 );
|
|
|
883 $max -= 1;
|
|
|
884 }
|
|
|
885
|
|
|
886 #
|
|
|
887 # Open the index template.
|
|
|
888 #
|
|
21
|
889 my $template = loadTemplate( "index.template",
|
|
|
890 die_on_bad_params => 0 );
|
|
|
891
|
|
|
892 #
|
|
|
893 # The entries.
|
|
|
894 #
|
|
|
895 $template->param( entries => $entries )
|
|
|
896 if ( $entries );
|
|
1
|
897
|
|
21
|
898 #
|
|
|
899 # The clouds
|
|
|
900 #
|
|
|
901 $template->param( tagcloud => $CLOUD{'tag'} )
|
|
|
902 if ( $CLOUD{'tag'} );
|
|
|
903 $template->param( datecloud => $CLOUD{'archive'} )
|
|
|
904 if ( $CLOUD{'archive'} );
|
|
|
905
|
|
|
906 #
|
|
|
907 # Blog title and subtitle, if present.
|
|
|
908 #
|
|
|
909 $template->param( blog_title => $CONFIG{'blog_title'} )
|
|
|
910 if ( $CONFIG{'blog_title'} );
|
|
|
911 $template->param( blog_subtitle => $CONFIG{'blog_subtitle'} )
|
|
|
912 if ( $CONFIG{'blog_subtitle'} );
|
|
23
|
913 $template->param( release => $RELEASE );
|
|
|
914
|
|
1
|
915
|
|
|
916 #
|
|
|
917 # Page to use
|
|
|
918 #
|
|
|
919 my $index = $CONFIG{'filename'} || "index.html";
|
|
|
920
|
|
39
|
921 outputTemplate( $template, $index );
|
|
1
|
922
|
|
|
923 #
|
|
|
924 # Output the RSS feed
|
|
|
925 #
|
|
|
926 $template = loadTemplate( "index.xml.template",
|
|
|
927 die_on_bad_params => 0 );
|
|
|
928 $template->param( entries => $entries ) if ( $entries );
|
|
39
|
929 outputTemplate( $template, "index.rss" );
|
|
1
|
930 }
|
|
|
931
|
|
|
932
|
|
|
933
|
|
|
934 =begin doc
|
|
|
935
|
|
|
936 Write out a /tags/$foo/index.html containing each blog entry which has the
|
|
|
937 tag '$foo'.
|
|
|
938
|
|
|
939 =end doc
|
|
|
940
|
|
|
941 =cut
|
|
|
942
|
|
|
943 sub outputTagPage
|
|
|
944 {
|
|
|
945 my ( $tagName ) = ( @_ );
|
|
|
946
|
|
39
|
947 my $dir = "tags/$tagName";
|
|
1
|
948
|
|
|
949 my %allTags;
|
|
|
950 my %tagEntries;
|
|
|
951 foreach my $f ( keys %data )
|
|
|
952 {
|
|
|
953 my $h = $data{$f};
|
|
|
954 my $tags = $h->{'tags'} || undef;
|
|
|
955 foreach my $t ( @$tags )
|
|
|
956 {
|
|
|
957 $allTags{$t}+=1;
|
|
|
958 my $a = $tagEntries{$t};
|
|
|
959 push @$a, $f ;
|
|
|
960 $tagEntries{$t}= $a;
|
|
|
961 }
|
|
|
962 }
|
|
|
963
|
|
|
964 my $matching = $tagEntries{$tagName};
|
|
|
965
|
|
|
966 my $entries;
|
|
|
967
|
|
|
968 #
|
|
|
969 # Now read the matching entries.
|
|
|
970 #
|
|
|
971 foreach my $f ( sort @$matching )
|
|
|
972 {
|
|
|
973 my $blog = readBlogEntry( $f );
|
|
|
974 if (keys( %$blog ) )
|
|
|
975 {
|
|
|
976 $CONFIG{'verbose'} && print "\tAdded: $f\n";
|
|
|
977 push( @$entries, $blog );
|
|
|
978 }
|
|
|
979 }
|
|
|
980
|
|
|
981 #
|
|
|
982 # Now write the output as a HTML page.
|
|
|
983 #
|
|
21
|
984 my $template = loadTemplate( "tags.template",
|
|
|
985 die_on_bad_params => 0 );
|
|
|
986
|
|
|
987 #
|
|
|
988 # The entries.
|
|
|
989 #
|
|
1
|
990 $template->param( entries => $entries ) if ( $entries );
|
|
|
991 $template->param( tagname => $tagName );
|
|
21
|
992
|
|
|
993 #
|
|
|
994 # The clouds
|
|
|
995 #
|
|
|
996 $template->param( tagcloud => $CLOUD{'tag'} )
|
|
|
997 if ( $CLOUD{'tag'} );
|
|
|
998 $template->param( datecloud => $CLOUD{'archive'} )
|
|
|
999 if ( $CLOUD{'archive'} );
|
|
|
1000
|
|
|
1001 #
|
|
|
1002 # Blog title and subtitle, if present.
|
|
|
1003 #
|
|
|
1004 $template->param( blog_title => $CONFIG{'blog_title'} )
|
|
|
1005 if ( $CONFIG{'blog_title'} );
|
|
|
1006 $template->param( blog_subtitle => $CONFIG{'blog_subtitle'} )
|
|
|
1007 if ( $CONFIG{'blog_subtitle'} );
|
|
|
1008
|
|
1
|
1009
|
|
|
1010 #
|
|
|
1011 # Page to use
|
|
|
1012 #
|
|
|
1013 my $index = $CONFIG{'filename'} || "index.html";
|
|
|
1014
|
|
39
|
1015 outputTemplate( $template, "$dir/$index" );
|
|
1
|
1016
|
|
|
1017 #
|
|
|
1018 # Now output the .xml file
|
|
|
1019 #
|
|
|
1020 $template = loadTemplate( "tags.xml.template", die_on_bad_params => 0 );
|
|
|
1021 $template->param( entries => $entries ) if ( $entries );
|
|
|
1022 $template->param( tagname => $tagName ) if ( $tagName );
|
|
39
|
1023 outputTemplate( $template, "$dir/$tagName.rss" );
|
|
1
|
1024 }
|
|
|
1025
|
|
|
1026
|
|
|
1027
|
|
|
1028 =begin doc
|
|
|
1029
|
|
|
1030 Output the archive page for the given Month + Year.
|
|
|
1031
|
|
|
1032 This function is a *mess* and iterates over the data structure much
|
|
|
1033 more often than it needs to.
|
|
|
1034
|
|
|
1035 =end doc
|
|
|
1036
|
|
|
1037 =cut
|
|
|
1038
|
|
|
1039 sub outputArchivePage
|
|
|
1040 {
|
|
|
1041 my( $date ) = ( @_ );
|
|
|
1042
|
|
|
1043 #
|
|
|
1044 # Should we abort?
|
|
|
1045 #
|
|
|
1046 if ( $CONFIG{'no-archive'} )
|
|
|
1047 {
|
|
|
1048 $CONFIG{'verbose'} && print "Ignoring archive page, as instructed.\n";
|
|
|
1049 return;
|
|
|
1050 }
|
|
|
1051
|
|
|
1052
|
|
|
1053 my $year = '';
|
|
|
1054 my $month = '';
|
|
39
|
1055 if ( $date =~ /^([0-9]{4})-([0-9]{2})/ )
|
|
1
|
1056 {
|
|
39
|
1057 $year = $1;
|
|
|
1058 $month = $2;
|
|
1
|
1059 }
|
|
|
1060
|
|
|
1061 #
|
|
|
1062 # Make the directory
|
|
|
1063 #
|
|
39
|
1064 my $dir = "archive/$year/$month";
|
|
1
|
1065
|
|
|
1066 my $entries;
|
|
|
1067
|
|
|
1068
|
|
|
1069 my %dateEntries;
|
|
|
1070 foreach my $f ( keys %data )
|
|
|
1071 {
|
|
|
1072 my $h = $data{$f};
|
|
55
|
1073 my $date = $h->{'date'};
|
|
|
1074
|
|
|
1075 #
|
|
|
1076 # Not a date? Use the file.
|
|
|
1077 #
|
|
|
1078 if ( !defined( $date ) || !length($date) )
|
|
|
1079 {
|
|
|
1080 #
|
|
|
1081 # Test the file for creation time.
|
|
|
1082 #
|
|
|
1083 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
|
|
1084 $atime,$mtime,$ctime,$blksize,$blocks)
|
|
|
1085 = stat($f);
|
|
|
1086
|
|
|
1087 $date = localtime( $ctime );
|
|
|
1088 }
|
|
|
1089
|
|
|
1090 $date = time2str("%Y-%m", str2time($date));
|
|
1
|
1091
|
|
39
|
1092 push @{$dateEntries{$date}}, $f ;
|
|
1
|
1093 }
|
|
|
1094
|
|
|
1095
|
|
|
1096 my $matching = $dateEntries{$date};
|
|
|
1097 foreach my $f ( reverse @$matching )
|
|
|
1098 {
|
|
|
1099 $CONFIG{'verbose'} && print "\tAdded: $f\n";
|
|
|
1100
|
|
|
1101 my $blog = readBlogEntry( $f );
|
|
|
1102 if (keys( %$blog ) )
|
|
|
1103 {
|
|
|
1104 push( @$entries, $blog );
|
|
|
1105 }
|
|
|
1106 }
|
|
|
1107
|
|
|
1108 #
|
|
|
1109 # Now write the output as a HTML page.
|
|
|
1110 #
|
|
21
|
1111 my $template = loadTemplate( "month.template",
|
|
|
1112 die_on_bad_params => 0 );
|
|
|
1113
|
|
48
|
1114
|
|
21
|
1115 #
|
|
48
|
1116 # The entries
|
|
21
|
1117 #
|
|
1
|
1118 $template->param( entries => $entries ) if ( $entries );
|
|
48
|
1119
|
|
|
1120 #
|
|
|
1121 # Output the month + year.
|
|
|
1122 #
|
|
1
|
1123 $template->param( year => $year, month => $month );
|
|
48
|
1124 $template->param( month_name => $names[$month - 1 ] );
|
|
21
|
1125
|
|
|
1126 #
|
|
|
1127 # The clouds
|
|
|
1128 #
|
|
|
1129 $template->param( tagcloud => $CLOUD{'tag'} )
|
|
|
1130 if ( $CLOUD{'tag'} );
|
|
|
1131 $template->param( datecloud => $CLOUD{'archive'} )
|
|
|
1132 if ( $CLOUD{'archive'} );
|
|
|
1133
|
|
|
1134 #
|
|
|
1135 # Blog title and subtitle, if present.
|
|
|
1136 #
|
|
|
1137 $template->param( blog_title => $CONFIG{'blog_title'} )
|
|
|
1138 if ( $CONFIG{'blog_title'} );
|
|
|
1139 $template->param( blog_subtitle => $CONFIG{'blog_subtitle'} )
|
|
|
1140 if ( $CONFIG{'blog_subtitle'} );
|
|
1
|
1141
|
|
|
1142 #
|
|
|
1143 # Page to use
|
|
|
1144 #
|
|
|
1145 my $index = $CONFIG{'filename'} || "index.html";
|
|
39
|
1146 outputTemplate( $template, "$dir/$index" );
|
|
1
|
1147
|
|
|
1148 #
|
|
|
1149 # Now the RSS page.
|
|
|
1150 #
|
|
|
1151 $template = loadTemplate( "month.xml.template", die_on_bad_params => 0 );
|
|
|
1152 $template->param( entries => $entries ) if ( $entries );
|
|
|
1153 $template->param( month => $month, year => $year );
|
|
48
|
1154 $template->param( month_name => $names[$month - 1 ] );
|
|
39
|
1155 outputTemplate( $template, "$dir/$month.rss" );
|
|
1
|
1156 }
|
|
|
1157
|
|
|
1158
|
|
|
1159
|
|
|
1160
|
|
|
1161 =begin doc
|
|
|
1162
|
|
|
1163 Output static page.
|
|
|
1164
|
|
|
1165 =end doc
|
|
|
1166
|
|
|
1167 =cut
|
|
|
1168
|
|
|
1169 sub outputStaticPage
|
|
|
1170 {
|
|
|
1171 my ( $filename ) = ( @_ );
|
|
|
1172
|
|
|
1173 #
|
|
|
1174 # Load the template
|
|
|
1175 #
|
|
21
|
1176 my $template = loadTemplate( "entry.template",
|
|
|
1177 die_on_bad_params => 0 );
|
|
1
|
1178
|
|
|
1179 #
|
|
|
1180 # Just the name of the file.
|
|
|
1181 #
|
|
|
1182 my $basename = $filename;
|
|
|
1183 if ( $basename =~ /(.*)\/(.*)/ )
|
|
|
1184 {
|
|
|
1185 $basename=$2;
|
|
|
1186 }
|
|
57
|
1187 if ( $basename =~ /^(.*)\.(.*)$/ )
|
|
|
1188 {
|
|
|
1189 $basename = $1;
|
|
|
1190 }
|
|
34
|
1191
|
|
1
|
1192 #
|
|
|
1193 # Read the entry
|
|
|
1194 #
|
|
|
1195 my $static = readBlogEntry( $filename );
|
|
|
1196
|
|
34
|
1197 #
|
|
|
1198 # Get the pieces of information.
|
|
|
1199 #
|
|
1
|
1200 my $title = $static->{'title'} || $basename;
|
|
|
1201 my $tags = $static->{'tags'};
|
|
|
1202 my $body = $static->{'body'};
|
|
55
|
1203 my $date = $static->{'date'};
|
|
|
1204
|
|
|
1205 if ( !defined($date) )
|
|
|
1206 {
|
|
|
1207 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
|
|
1208 $atime,$mtime,$ctime,$blksize,$blocks)
|
|
|
1209 = stat($filename);
|
|
|
1210
|
|
|
1211 $date = localtime( $ctime );
|
|
|
1212
|
|
|
1213 }
|
|
1
|
1214
|
|
|
1215 $CONFIG{'verbose'} && print "\t$filename\n";
|
|
|
1216
|
|
|
1217 #
|
|
|
1218 # Convert to suitable filename.
|
|
|
1219 #
|
|
|
1220 my $file = fileToTitle($title);
|
|
|
1221
|
|
21
|
1222 #
|
|
|
1223 # The entry.
|
|
|
1224 #
|
|
1
|
1225 $template->param( title => $title );
|
|
|
1226 $template->param( tags => $tags ) if ( $tags );
|
|
|
1227 $template->param( date => $date ) if ( $date );
|
|
|
1228 $template->param( body => $body );
|
|
21
|
1229
|
|
|
1230 #
|
|
|
1231 # Our clouds
|
|
|
1232 #
|
|
1
|
1233 $template->param( tagcloud => $CLOUD{'tag'} ) if ( $CLOUD{'tag'} );
|
|
|
1234 $template->param( datecloud => $CLOUD{'archive'} ) if ( $CLOUD{'archive'} );
|
|
21
|
1235
|
|
|
1236 #
|
|
|
1237 # Blog title and subtitle, if present.
|
|
|
1238 #
|
|
|
1239 $template->param( blog_title => $CONFIG{'blog_title'} )
|
|
|
1240 if ( $CONFIG{'blog_title'} );
|
|
|
1241 $template->param( blog_subtitle => $CONFIG{'blog_subtitle'} )
|
|
|
1242 if ( $CONFIG{'blog_subtitle'} );
|
|
|
1243
|
|
39
|
1244 outputTemplate( $template, $file );
|
|
1
|
1245 }
|
|
|
1246
|
|
|
1247
|
|
|
1248
|
|
|
1249 =begin doc
|
|
|
1250
|
|
|
1251 Return a hash of interesting data from our blog file.
|
|
|
1252
|
|
|
1253 =end doc
|
|
|
1254
|
|
|
1255 =cut
|
|
|
1256
|
|
|
1257 sub readBlogEntry
|
|
|
1258 {
|
|
|
1259 my ( $filename ) = ( @_);
|
|
|
1260
|
|
|
1261 my %entry;
|
|
|
1262
|
|
33
|
1263 #
|
|
|
1264 # Do we have the memcache module available?
|
|
|
1265 #
|
|
|
1266 my $cache = undef;
|
|
|
1267 my $test = "use Cache::Memcached;";
|
|
|
1268 eval( $test );
|
|
|
1269 if ( ( ! $@ ) && ( ! $CONFIG{'no-cache'} ) )
|
|
|
1270 {
|
|
|
1271 # create the cache object
|
|
|
1272 $cache = new Cache::Memcached {'servers' => ["localhost:11211"] };
|
|
|
1273
|
|
|
1274 # fetch from the cache if it is present.
|
|
|
1275 my $cached = $cache->get( "file_$filename" );
|
|
|
1276 if ( defined( $cached ) )
|
|
|
1277 {
|
|
|
1278 $CONFIG{'verbose'} && print "memcache-get: $filename\n";
|
|
|
1279 return( \%$cached )
|
|
|
1280 }
|
|
|
1281 else
|
|
|
1282 {
|
|
|
1283 $CONFIG{'verbose'} && print "memcache-fail: $filename\n";
|
|
|
1284 }
|
|
|
1285 }
|
|
|
1286
|
|
1
|
1287
|
|
18
|
1288 my $title = ""; # entry title.
|
|
|
1289 my $tags = ""; # entry tags.
|
|
|
1290 my $body = ""; # entry body.
|
|
|
1291 my $date = ""; # entry date
|
|
|
1292 my $status = ""; # entry privacy/security.
|
|
11
|
1293
|
|
1
|
1294
|
|
|
1295 open( ENTRY, "<", $filename ) or die "Failed to read $filename $!";
|
|
|
1296 while( my $line = <ENTRY> )
|
|
|
1297 {
|
|
|
1298 #
|
|
62
|
1299 # Get the tags.
|
|
1
|
1300 #
|
|
62
|
1301 if (( $line =~ /^tags: (.*)/i ) && !length( $tags ) )
|
|
1
|
1302 {
|
|
62
|
1303 $tags = $1;
|
|
1
|
1304 }
|
|
|
1305 elsif (( $line =~ /^title: (.*)/i ) && !length($title) )
|
|
|
1306 {
|
|
62
|
1307 #
|
|
|
1308 # Get the title
|
|
|
1309 #
|
|
1
|
1310 $title = $1;
|
|
11
|
1311
|
|
|
1312 # strip leading and trailing space.
|
|
|
1313 $title =~ s/^\s+// if ( length $title );
|
|
|
1314 $title =~ s/\s+$// if ( length $title );
|
|
1
|
1315 }
|
|
|
1316 elsif (( $line =~ /^date: (.*)/i ) && !length($date) )
|
|
|
1317 {
|
|
62
|
1318 #
|
|
|
1319 # Get the date.
|
|
|
1320 #
|
|
1
|
1321 $date = $1;
|
|
11
|
1322
|
|
|
1323 # strip leading and trailing space.
|
|
|
1324 $date =~ s/^\s+// if ( length $date );
|
|
|
1325 $date =~ s/\s+$// if ( length $date );
|
|
|
1326 }
|
|
|
1327 elsif (( $line =~ /^status:(.*)/ ) && !length ( $status ) )
|
|
|
1328 {
|
|
62
|
1329 #
|
|
|
1330 # Security level?
|
|
|
1331 #
|
|
11
|
1332 $status = $1;
|
|
1
|
1333 }
|
|
|
1334 else
|
|
|
1335 {
|
|
62
|
1336 #
|
|
|
1337 # Just a piece of body text.
|
|
|
1338 #
|
|
1
|
1339 $body .= $line;
|
|
|
1340 }
|
|
|
1341 }
|
|
|
1342 close( ENTRY );
|
|
|
1343
|
|
|
1344 #
|
|
44
|
1345 # Determine the input format to use.
|
|
16
|
1346 #
|
|
44
|
1347 my $format = lc($CONFIG{'format'});
|
|
|
1348
|
|
|
1349 #
|
|
|
1350 # Now process accordingly.
|
|
|
1351 #
|
|
|
1352 if ( $format eq 'html' )
|
|
16
|
1353 {
|
|
|
1354 # nop
|
|
|
1355 }
|
|
44
|
1356 elsif( $format eq 'markdown' )
|
|
16
|
1357 {
|
|
|
1358 $body = markdown2HTML( $body );
|
|
|
1359 }
|
|
44
|
1360 elsif( $format eq 'textile' )
|
|
16
|
1361 {
|
|
|
1362 $body = textile2HTML( $body );
|
|
|
1363 }
|
|
|
1364 else
|
|
|
1365 {
|
|
44
|
1366 print "Unkown blog entry format ($CONFIG{'format'}).\n";
|
|
|
1367 print "Treating as HTML.\n";
|
|
16
|
1368 }
|
|
|
1369
|
|
|
1370 #
|
|
|
1371 #
|
|
44
|
1372 # If we have tags then we should use them.
|
|
1
|
1373 #
|
|
|
1374 my $entryTags;
|
|
|
1375
|
|
|
1376 foreach my $tag ( split( /,/, $tags ) )
|
|
|
1377 {
|
|
|
1378 # strip leading and trailing space.
|
|
|
1379 $tag =~ s/^\s+//;
|
|
|
1380 $tag =~ s/\s+$//;
|
|
|
1381
|
|
|
1382 # skip empty tags.
|
|
|
1383 next if ( !length($tag) );
|
|
62
|
1384
|
|
|
1385 # tags are lowercase.
|
|
1
|
1386 $tag = lc($tag);
|
|
|
1387 push ( @$entryTags, { tag => $tag } );
|
|
|
1388 }
|
|
|
1389
|
|
|
1390 #
|
|
|
1391 # If the date isn't set then use todays.
|
|
|
1392 #
|
|
|
1393 if ( ! defined($date) ||( !length( $date ) ) )
|
|
|
1394 {
|
|
|
1395 my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov De
|
|
|
1396 c );
|
|
|
1397 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
|
|
|
1398 localtime(time);
|
|
|
1399
|
|
|
1400 $year += 1900;
|
|
|
1401
|
|
|
1402 $date = "$mday $abbr[$mon] $year";
|
|
|
1403 }
|
|
|
1404
|
|
|
1405 #
|
|
|
1406 # Store the entry.
|
|
|
1407 #
|
|
|
1408 $entry{'title'} = $title;
|
|
|
1409 $entry{'body'} = $body if ( $body );
|
|
|
1410 $entry{'date'} = $date;
|
|
|
1411 $entry{'tags'} = $entryTags if ( $entryTags );
|
|
33
|
1412
|
|
|
1413 #
|
|
57
|
1414 # No title?
|
|
|
1415 #
|
|
|
1416 if ( !defined($entry{'title'}) ||
|
|
|
1417 !length($entry{'title'}) )
|
|
|
1418 {
|
|
|
1419 my $basename = $filename;
|
|
|
1420 if ( $basename =~ /(.*)\/(.*)/ )
|
|
|
1421 {
|
|
|
1422 $basename=$2;
|
|
|
1423 }
|
|
|
1424 if ( $basename =~ /^(.*)\.(.*)$/ )
|
|
|
1425 {
|
|
|
1426 $basename = $1;
|
|
|
1427 }
|
|
|
1428
|
|
|
1429 $entry{'title'} = $basename;
|
|
|
1430 }
|
|
|
1431
|
|
|
1432 #
|
|
|
1433 # Get the link - after ensuring we have a title.
|
|
|
1434 #
|
|
|
1435 my $link = fileToTitle( $entry{'title'} );
|
|
|
1436 $entry{'link'} = $link;
|
|
|
1437
|
|
|
1438
|
|
|
1439 #
|
|
33
|
1440 # Store the read file in the cache if we're using it.
|
|
|
1441 #
|
|
|
1442 if ( defined( $cache ) )
|
|
|
1443 {
|
|
|
1444 $CONFIG{'verbose'} && print "memcache-set: $filename\n";
|
|
|
1445 $cache->set( "file_$filename", \%entry );
|
|
|
1446 }
|
|
1
|
1447 return \%entry;
|
|
|
1448 }
|
|
|
1449
|
|
|
1450
|
|
|
1451
|
|
|
1452 =begin doc
|
|
|
1453
|
|
|
1454 Create a filename for an URL which does not contain unsafe
|
|
|
1455 characters.
|
|
|
1456
|
|
|
1457 =end doc
|
|
|
1458
|
|
|
1459 =cut
|
|
|
1460
|
|
|
1461 sub fileToTitle
|
|
|
1462 {
|
|
|
1463 my( $file ) = ( @_ );
|
|
|
1464
|
|
|
1465 if ( $file =~ /(.*)\.(.*)/ )
|
|
|
1466 {
|
|
|
1467 $file = $1;
|
|
|
1468 }
|
|
|
1469 $file =~ s/ /_/g;
|
|
|
1470 $file =~ s/\///g;
|
|
|
1471 $file =~ s/\\//g;
|
|
|
1472
|
|
60
|
1473 my $suffix = $CONFIG{'suffix'} || ".html";
|
|
|
1474 $file .= $suffix;
|
|
34
|
1475
|
|
|
1476 #
|
|
|
1477 # Lower case?
|
|
|
1478 #
|
|
|
1479 $file = lc($file) if ( $CONFIG{'lower-case'} );
|
|
|
1480
|
|
1
|
1481 return( $file );
|
|
|
1482
|
|
|
1483 }
|
|
|
1484
|
|
|
1485
|
|
|
1486
|
|
|
1487 =begin doc
|
|
|
1488
|
|
|
1489 Load a template file.
|
|
|
1490
|
|
|
1491 =end doc
|
|
|
1492
|
|
|
1493 =cut
|
|
|
1494
|
|
|
1495 sub loadTemplate
|
|
|
1496 {
|
|
|
1497 my( $file, %params ) = (@_);
|
|
|
1498
|
|
|
1499 #
|
|
61
|
1500 # Get the directory.
|
|
|
1501 #
|
|
|
1502 my $dir = $CONFIG{'theme-dir'};
|
|
|
1503
|
|
|
1504 #
|
|
|
1505 # XML files go in theme-dir/xml/
|
|
|
1506 #
|
|
|
1507 if ( $file =~ /\.xml\./i )
|
|
|
1508 {
|
|
|
1509 $dir .= "/xml/";
|
|
|
1510 }
|
|
|
1511 else
|
|
|
1512 {
|
|
|
1513 $dir .= "/" . $CONFIG{'theme'} . "/";
|
|
|
1514 }
|
|
|
1515
|
|
|
1516
|
|
|
1517 #
|
|
1
|
1518 # Make sure the file exists.
|
|
|
1519 #
|
|
61
|
1520 if ( ! -e $dir . $file )
|
|
1
|
1521 {
|
|
|
1522 print <<EOF;
|
|
|
1523
|
|
61
|
1524 The template file $file was not found in the theme directory.
|
|
|
1525
|
|
62
|
1526 Theme : $CONFIG{'theme'}
|
|
61
|
1527 Theme Directory: $CONFIG{'theme-dir'}
|
|
|
1528
|
|
|
1529 We expected to find $dir$file;
|
|
1
|
1530
|
|
|
1531 Aborting.
|
|
|
1532 EOF
|
|
|
1533 exit;
|
|
|
1534 }
|
|
|
1535
|
|
|
1536 my $t = HTML::Template->new( filename => $file,
|
|
61
|
1537 path => $dir,
|
|
1
|
1538 loop_context_vars => 1,
|
|
|
1539 global_vars => 1,
|
|
|
1540 %params );
|
|
|
1541
|
|
39
|
1542 return( $t );
|
|
|
1543 }
|
|
|
1544
|
|
|
1545
|
|
|
1546
|
|
|
1547 =begin doc
|
|
|
1548
|
|
|
1549 Set URL for top directory and output a template.
|
|
|
1550
|
|
|
1551 =end doc
|
|
|
1552
|
|
|
1553 =cut
|
|
|
1554
|
|
|
1555 sub outputTemplate
|
|
|
1556 {
|
|
|
1557 my( $template, $path ) = ( @_ );
|
|
|
1558
|
|
1
|
1559 #
|
|
39
|
1560 # Select relative/absolute URL prefix.
|
|
1
|
1561 #
|
|
39
|
1562 my $top;
|
|
1
|
1563 if ( $CONFIG{'url_prefix'} )
|
|
|
1564 {
|
|
39
|
1565 $top = $CONFIG{'url_prefix'};
|
|
1
|
1566 }
|
|
39
|
1567 else
|
|
|
1568 {
|
|
|
1569 $top = $path;
|
|
|
1570 $top =~ s'[^/]+/'../'g;
|
|
|
1571 $top =~ s'[^/]*$'';
|
|
|
1572 }
|
|
|
1573 $template->param( top => $top );
|
|
1
|
1574
|
|
39
|
1575 open( OUTPUT, ">", "$CONFIG{'output'}/$path" );
|
|
|
1576 print OUTPUT $template->output();
|
|
|
1577 close( OUTPUT );
|
|
1
|
1578 }
|
|
|
1579
|
|
|
1580
|
|
|
1581
|
|
|
1582 =begin doc
|
|
|
1583
|
|
7
|
1584 Read the specified configuration file if it exists.
|
|
1
|
1585
|
|
|
1586 =end doc
|
|
|
1587
|
|
|
1588 =cut
|
|
|
1589
|
|
|
1590 sub readConfigurationFile
|
|
|
1591 {
|
|
7
|
1592 my( $file ) = ( @_ );
|
|
|
1593
|
|
|
1594 #
|
|
|
1595 # If it doesn't exist ignore it.
|
|
|
1596 #
|
|
1
|
1597 return if ( ! -e $file );
|
|
|
1598
|
|
7
|
1599
|
|
1
|
1600 my $line = "";
|
|
|
1601
|
|
|
1602 open( FILE, "<", $file ) or die "Cannot read file '$file' - $!";
|
|
|
1603 while (defined($line = <FILE>) )
|
|
|
1604 {
|
|
|
1605 chomp $line;
|
|
|
1606 if ($line =~ s/\\$//)
|
|
|
1607 {
|
|
|
1608 $line .= <FILE>;
|
|
|
1609 redo unless eof(FILE);
|
|
|
1610 }
|
|
|
1611
|
|
|
1612 # Skip lines beginning with comments
|
|
|
1613 next if ( $line =~ /^([ \t]*)\#/ );
|
|
|
1614
|
|
|
1615 # Skip blank lines
|
|
|
1616 next if ( length( $line ) < 1 );
|
|
|
1617
|
|
|
1618 # Strip trailing comments.
|
|
|
1619 if ( $line =~ /(.*)\#(.*)/ )
|
|
|
1620 {
|
|
|
1621 $line = $1;
|
|
|
1622 }
|
|
|
1623
|
|
|
1624 # Find variable settings
|
|
|
1625 if ( $line =~ /([^=]+)=([^\n]+)/ )
|
|
|
1626 {
|
|
|
1627 my $key = $1;
|
|
|
1628 my $val = $2;
|
|
|
1629
|
|
|
1630 # Strip leading and trailing whitespace.
|
|
|
1631 $key =~ s/^\s+//;
|
|
|
1632 $key =~ s/\s+$//;
|
|
|
1633 $val =~ s/^\s+//;
|
|
|
1634 $val =~ s/\s+$//;
|
|
|
1635
|
|
|
1636 # command expansion?
|
|
|
1637 if ( $val =~ /(.*)`([^`]+)`(.*)/ )
|
|
|
1638 {
|
|
|
1639 # store
|
|
|
1640 my $pre = $1;
|
|
|
1641 my $cmd = $2;
|
|
|
1642 my $post = $3;
|
|
|
1643
|
|
|
1644 # get output
|
|
|
1645 my $output = `$cmd`;
|
|
|
1646 chomp( $output );
|
|
|
1647
|
|
|
1648 # build up replacement.
|
|
|
1649 $val = $pre . $output . $post;
|
|
|
1650 }
|
|
|
1651
|
|
|
1652 # Store value.
|
|
|
1653 $CONFIG{ $key } = $val;
|
|
|
1654 }
|
|
|
1655 }
|
|
|
1656
|
|
|
1657 close( FILE );
|
|
|
1658 }
|
|
|
1659
|
|
|
1660
|
|
|
1661
|
|
|
1662 =begin doc
|
|
|
1663
|
|
61
|
1664 Sanity check our arguments:
|
|
|
1665
|
|
|
1666 1. Make sure we have a theme-directory
|
|
|
1667
|
|
|
1668 2. Make sure we have a theme.
|
|
|
1669
|
|
|
1670 =end doc
|
|
|
1671
|
|
|
1672 =cut
|
|
|
1673
|
|
|
1674 sub sanityCheckArguments
|
|
|
1675 {
|
|
|
1676 if ( !$CONFIG{'theme-dir'} )
|
|
|
1677 {
|
|
|
1678 print <<EOF;
|
|
|
1679
|
|
|
1680 Error - You don't have a theme directory setup.
|
|
|
1681
|
|
|
1682 Please specify --theme-dir=/some/path, or add this to your configuration
|
|
|
1683 file:
|
|
|
1684
|
|
|
1685 theme-dir = /path/to/use/
|
|
|
1686 EOF
|
|
|
1687
|
|
|
1688 exit;
|
|
|
1689 }
|
|
|
1690
|
|
|
1691 if ( ! -d $CONFIG{'theme-dir'} )
|
|
|
1692 {
|
|
|
1693 print "The theme directory you specified doesn't exist:\n";
|
|
|
1694 print "\t" . $CONFIG{'theme-dir'} . "\n";
|
|
|
1695 exit;
|
|
|
1696 }
|
|
|
1697
|
|
|
1698 if ( !$CONFIG{'theme'} )
|
|
|
1699 {
|
|
|
1700 print <<EOF;
|
|
|
1701
|
|
|
1702 You've not specified a theme.
|
|
|
1703
|
|
|
1704 Please specify --theme=xx
|
|
|
1705
|
|
|
1706 Or add this to your configuration file:
|
|
|
1707
|
|
|
1708 theme = xx
|
|
|
1709
|
|
|
1710
|
|
|
1711 [You may list themes with --list-themes]
|
|
|
1712
|
|
|
1713 EOF
|
|
|
1714
|
|
|
1715 exit;
|
|
|
1716 }
|
|
|
1717
|
|
|
1718
|
|
|
1719 if ( ! -d $CONFIG{'theme-dir'} . "/" . $CONFIG{'theme'} )
|
|
|
1720 {
|
|
|
1721 print "The theme directory you specified doesn't exist in the theme directory:\n";
|
|
|
1722 print "\tTheme :" . $CONFIG{'theme'} . "\n";
|
|
|
1723 print "\tTheme dir:" . $CONFIG{'theme-dir'} . "\n";
|
|
|
1724 print "\tExpected :" . $CONFIG{'theme-dir'} . "/" . $CONFIG{'theme'} . "\n";
|
|
|
1725 exit;
|
|
|
1726 }
|
|
|
1727
|
|
|
1728 }
|
|
|
1729
|
|
|
1730
|
|
|
1731
|
|
|
1732
|
|
|
1733 =begin doc
|
|
|
1734
|
|
12
|
1735 Copy any static files from the theme directory into the "live" location
|
|
|
1736 in the output.
|
|
|
1737
|
|
|
1738 This only works for a top-level target directory.
|
|
1
|
1739
|
|
46
|
1740 Unless --force is specified we skip copying files which already exist.
|
|
|
1741
|
|
1
|
1742 =end doc
|
|
|
1743
|
|
|
1744 =cut
|
|
|
1745
|
|
12
|
1746 sub copyStaticFiles
|
|
1
|
1747 {
|
|
12
|
1748 #
|
|
|
1749 # Soure and destination for the copy
|
|
|
1750 #
|
|
61
|
1751 my $input = $CONFIG{'theme-dir'} . "/" . $CONFIG{'theme'};
|
|
12
|
1752 my $output = $CONFIG{'output'};
|
|
1
|
1753
|
|
12
|
1754 foreach my $pattern ( qw! *.css *.jpg *.gif *.png *.js *.ico ! )
|
|
|
1755 {
|
|
|
1756 foreach my $file ( glob( $input . "/" . $pattern ) )
|
|
|
1757 {
|
|
13
|
1758 #
|
|
|
1759 # Get the name of the file.
|
|
|
1760 #
|
|
|
1761 if ( $file =~ /(.*)\/(.*)/ )
|
|
|
1762 {
|
|
|
1763 $file = $2;
|
|
|
1764 }
|
|
46
|
1765 if ( $CONFIG{'force'} || ( ! -e "$output/$file" ) )
|
|
12
|
1766 {
|
|
13
|
1767 $CONFIG{'verbose'} && print "Copying static file: $file\n";
|
|
|
1768 copy( "$input/$file", "$output/$file" );
|
|
12
|
1769 }
|
|
|
1770 }
|
|
|
1771 }
|
|
1
|
1772 }
|
|
16
|
1773
|
|
|
1774
|
|
|
1775
|
|
|
1776 =begin doc
|
|
|
1777
|
|
|
1778 Convert from markdown to HTML.
|
|
|
1779
|
|
|
1780 =end doc
|
|
|
1781
|
|
|
1782 =cut
|
|
|
1783
|
|
|
1784 sub markdown2HTML
|
|
|
1785 {
|
|
|
1786 my( $text ) = (@_);
|
|
|
1787
|
|
|
1788 #
|
|
|
1789 # Make sure we have the module installed. Use eval to
|
|
|
1790 # avoid making this mandatory.
|
|
|
1791 #
|
|
|
1792 my $test = "use Text::Markdown;";
|
|
|
1793
|
|
|
1794 #
|
|
|
1795 # Test loading the module.
|
|
|
1796 #
|
|
|
1797 eval( $test );
|
|
|
1798 if ( $@ )
|
|
|
1799 {
|
|
|
1800 print <<EOF;
|
|
|
1801
|
|
|
1802 You have chosen to format your input text via Markdown, but the
|
|
|
1803 Perl module Text::Markdown is not installed.
|
|
|
1804
|
|
|
1805 Aborting.
|
|
|
1806 EOF
|
|
|
1807 exit;
|
|
|
1808 }
|
|
|
1809
|
|
|
1810 #
|
|
|
1811 # Convert.
|
|
|
1812 #
|
|
|
1813 $text = Text::Markdown::Markdown( $text );
|
|
|
1814 return( $text );
|
|
|
1815 }
|
|
|
1816
|
|
|
1817
|
|
|
1818
|
|
|
1819 =begin doc
|
|
|
1820
|
|
|
1821 Convert from textile to HTML.
|
|
|
1822
|
|
|
1823 =end doc
|
|
|
1824
|
|
|
1825 =cut
|
|
|
1826
|
|
|
1827 sub textile2HTML
|
|
|
1828 {
|
|
|
1829 my( $text ) = (@_);
|
|
|
1830
|
|
|
1831 #
|
|
|
1832 # Make sure we have the module installed. Use eval to
|
|
|
1833 # avoid making this mandatory.
|
|
|
1834 #
|
|
|
1835 my $test = "use Text::Textile;";
|
|
|
1836
|
|
|
1837 #
|
|
|
1838 # Test loading the module.
|
|
|
1839 #
|
|
|
1840 eval( $test );
|
|
|
1841 if ( $@ )
|
|
|
1842 {
|
|
|
1843 print <<EOF;
|
|
|
1844
|
|
|
1845 You have chosen to format your input text via Textile, but the
|
|
|
1846 Perl module Text::Textile is not installed.
|
|
|
1847
|
|
|
1848 Aborting.
|
|
|
1849 EOF
|
|
|
1850 exit;
|
|
|
1851 }
|
|
|
1852
|
|
|
1853 #
|
|
|
1854 # Convert.
|
|
|
1855 #
|
|
|
1856 $text = Text::Textile::textile( $text );
|
|
|
1857 return( $text );
|
|
|
1858 }
|
|
|
1859
|
|
|
1860
|
|
|
1861
|
|
|
1862
|
|
61
|
1863 sub listThemes
|
|
|
1864 {
|
|
|
1865 my( $dir ) = ( @_ );
|
|
|
1866
|
|
|
1867 $CONFIG{'verbose'} && print "Listhing themes beneath : $dir\n";
|
|
|
1868
|
|
|
1869 foreach my $name ( sort( glob( $dir . "/*" ) ) )
|
|
|
1870 {
|
|
|
1871 next unless( -d $name );
|
|
|
1872
|
|
|
1873 next if ( $name =~ /\/xml$/ );
|
|
|
1874
|
|
|
1875 if ( $name =~ /^(.*)\/([^\/\\]*)$/ )
|
|
|
1876 {
|
|
|
1877 print $2 . "\n";
|
|
|
1878 }
|
|
|
1879 }
|
|
|
1880 }
|
