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