--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/chronicle-spooler	Mon Apr 14 18:50:54 2008 +0100
@@ -0,0 +1,509 @@
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+chronicle-spooler - Automatically post pre-written entries.
+
+=cut
+
+=head1 SYNOPSIS
+
+
+  Path Options:
+
+   --config         Specify a configuration file to read.
+   --spool-dir      Specify where pending entries are located.
+   --live-dir       Specify where the entries should be moved to.
+
+
+  Post-Spool Commands:
+
+   --post-move   Specify a command to execute once entries have been moved.
+
+  Optional Features:
+
+   --test        Only report on what would be executed.
+
+  Help Options:
+
+   --help        Show the help information for this script.
+   --manual      Read the manual for this script.
+
+=cut
+
+
+=head1 ABOUT
+
+  chronicle-spooler is a companion scrip to the chronicle blog compiler.
+
+  It is designed to facilitate posting new entries automatically upon
+ particular dates.  (ie. If you have ten written blog entries in a spool
+ directory it will move them into place upon the date you've specified.)
+
+=cut
+
+
+=head1 DATE SPECIFICATION
+
+  To specify the date a particular entry should be made live you
+ must add another psuedo-header to your blog entry files, as follows:
+
+=for example begin
+
+    Title:  This is the title of the blog post
+    Date:  2nd March 2007
+    Publish: 15th April 2008
+    Tags: one, two, three, long tag
+
+    The text of your entry goes here.
+
+=for example end
+
+  In this example we know that this entry will be made live upon the
+ 15th April 2008, and not before.
+
+=cut
+
+=head1 AUTHOR
+
+ Steve
+ --
+ http://www.steve.org.uk/
+
+=cut
+
+=head1 LICENSE
+
+Copyright (c) 2008 by Steve Kemp.  All rights reserved.
+
+This module is free software;
+you can redistribute it and/or modify it under
+the same terms as Perl itself.
+The LICENSE file contains the full text of the license.
+
+=cut
+
+
+use strict;
+use warnings;
+
+
+use Date::Parse;
+use File::Copy;
+use Getopt::Long;
+use Pod::Usage;
+
+
+#
+#  Release number
+#
+#  NOTE:  Set by 'make release'.
+#
+my $RELEASE = 'UNRELEASED';
+
+
+#
+#  Our configuration options.
+#
+my %CONFIG;
+
+
+#
+#  Read the global and per-user configuration files, if they exist.
+#
+readConfigurationFile("/etc/chroniclerc");
+readConfigurationFile( $ENV{ 'HOME' } . "/.chroniclerc" );
+
+
+#
+#  Parse the command line arguments.
+#
+parseCommandLineArguments();
+
+
+#
+#  Another configuration file?
+#
+readConfigurationFile( $CONFIG{ 'config' } ) if ( defined $CONFIG{ 'config' } );
+
+
+#
+#  Make sure we have arguments which are sane.
+#
+#  Specifically we need an input directory and an output directory.
+#
+#
+sanityCheckArguments();
+
+
+#
+#  Find the potentially pending entries.
+#
+my @files = findPendingPosts( $CONFIG{ 'spool-dir' } );
+
+
+#
+#  Process each entry
+#
+my $live = 0;
+foreach my $entry ( sort(@files) )
+{
+    if ( shouldBeLive($entry) )
+    {
+        if ( $CONFIG{ 'test' } )
+        {
+            print "test: make entry live: $entry\n";
+        }
+        else
+        {
+            makeEntryLive($entry);
+            $live += 1;
+        }
+    }
+}
+
+
+#
+#  If we should run our command do so.
+#
+if ( $CONFIG{ 'post-move' } )
+{
+    if ( $CONFIG{ 'test' } )
+    {
+        print "test: should run: $CONFIG{'post-move'}\n";
+    }
+    else
+    {
+        system( $CONFIG{ 'post-move' } );
+    }
+}
+
+
+
+#
+#  All done.
+#
+exit;
+
+
+
+=begin doc
+
+  Parse the command line arguments this script was given.
+
+=end doc
+
+=cut
+
+sub parseCommandLineArguments
+{
+    my $HELP    = 0;
+    my $MANUAL  = 0;
+    my $VERSION = 0;
+
+    #
+    #  Parse options.
+    #
+    GetOptions(
+
+        # input / output
+        "spool-dir=s", \$CONFIG{ 'spool-dir' },
+        "live-dir=s",  \$CONFIG{ 'live-dir' },
+
+        # testing?
+        "test", \$CONFIG{ 'test' },
+
+        # command?
+        "post-move=s", \$CONFIG{ 'post-move' },
+
+        # Help options
+        "help",    \$HELP,
+        "manual",  \$MANUAL,
+        "verbose", \$CONFIG{ 'verbose' },
+        "version", \$VERSION,
+
+    );
+
+    pod2usage(1) if $HELP;
+    pod2usage( -verbose => 2 ) if $MANUAL;
+
+    if ($VERSION)
+    {
+        print("chronicle release $RELEASE\n");
+        exit;
+    }
+}
+
+
+
+=begin doc
+
+  Read the specified configuration file if it exists.
+
+=end doc
+
+=cut
+
+sub readConfigurationFile
+{
+    my ($file) = (@_);
+
+    #
+    #  If it doesn't exist ignore it.
+    #
+    return if ( !-e $file );
+
+
+    my $line = "";
+
+    open( FILE, "<", $file ) or die "Cannot read file '$file' - $!";
+    while ( defined( $line = <FILE> ) )
+    {
+        chomp $line;
+        if ( $line =~ s/\\$// )
+        {
+            $line .= <FILE>;
+            redo unless eof(FILE);
+        }
+
+        # Skip lines beginning with comments
+        next if ( $line =~ /^([ \t]*)\#/ );
+
+        # Skip blank lines
+        next if ( length($line) < 1 );
+
+        # Strip trailing comments.
+        if ( $line =~ /(.*)\#(.*)/ )
+        {
+            $line = $1;
+        }
+
+        # Find variable settings
+        if ( $line =~ /([^=]+)=([^\n]+)/ )
+        {
+            my $key = $1;
+            my $val = $2;
+
+            # Strip leading and trailing whitespace.
+            $key =~ s/^\s+//;
+            $key =~ s/\s+$//;
+            $val =~ s/^\s+//;
+            $val =~ s/\s+$//;
+
+            # command expansion?
+            if ( $val =~ /(.*)`([^`]+)`(.*)/ )
+            {
+
+                # store
+                my $pre  = $1;
+                my $cmd  = $2;
+                my $post = $3;
+
+                # get output
+                my $output = `$cmd`;
+                chomp($output);
+
+                # build up replacement.
+                $val = $pre . $output . $post;
+            }
+
+            # Store value.
+            $CONFIG{ $key } = $val;
+        }
+    }
+
+    close(FILE);
+}
+
+
+
+=begin doc
+
+  Sanity check our arguments, and setup to make sure there is nothing
+ obviously broken.
+
+=end doc
+
+=cut
+
+sub sanityCheckArguments
+{
+    if (    ( !$CONFIG{ 'spool-dir' } )
+         || ( !-d $CONFIG{ 'spool-dir' } ) )
+    {
+        print <<EOF;
+
+  Please specify the spool directory, which contains the entries which
+ are to be moved into the live directory in the future.
+
+EOF
+        exit;
+    }
+
+    if (    ( !$CONFIG{ 'live-dir' } )
+         || ( !-d $CONFIG{ 'live-dir' } ) )
+    {
+        print <<EOF;
+
+  Please specify the output directory into which entries should be
+ moved to make them live.
+
+EOF
+        exit;
+    }
+}
+
+
+
+=begin doc
+
+  Find any files that might be in the pending directory.
+
+=end doc
+
+=cut
+
+sub findPendingPosts
+{
+    my ($dir) = (@_);
+
+    my $pattern = "*";
+    my @files;
+
+    foreach my $file ( sort( glob("$dir/$pattern") ) )
+    {
+        push( @files, $file ) unless ( -d $file );
+    }
+
+    return (@files);
+}
+
+
+=begin doc
+
+  Read the given file and see if it should be published now.
+  That means that the file containes a "Publish:" psuedo-header
+ which is either in the past, or equal to todays date.
+
+=end doc
+
+=cut
+
+sub shouldBeLive
+{
+    my ($file) = (@_);
+
+    #
+    #  If the file doesn't exist we don't publish it.  Huh?
+    #
+    return 0 if ( !-e $file );
+
+    #
+    #  Look for a header
+    #
+    my $header = "";
+
+    open( FILE, "<", $file )
+      or die "Failed to read file $file - $!";
+
+    foreach my $line (<FILE>)
+    {
+        if (    ( $line =~ /^Publish:(.*)/i )
+             && ( !length($header) ) )
+        {
+            $header = $1;
+
+            # Strip leading and trailing whitespace.
+            $header =~ s/^\s+//;
+            $header =~ s/\s+$//;
+        }
+    }
+    close(FILE);
+
+    #
+    #  No header?  Not to be published
+    #
+    return 0 if ( length($header) < 1 );
+
+    #
+    #  OK we got a header - is it current / past?
+    #
+    my $today = time;
+    if ( !defined( $today ) )
+    {
+        print "FAILED TO FIND TODAY\n";
+        return 0;
+    }
+
+    #
+    #  Date of entry
+    #
+    my $ent = str2time($header);
+    if ( !defined( $ent ) )
+    {
+        print "FAILED TO PARSE: '$header'\n";
+        return 0;
+    }
+
+
+    #
+    #  Do the date test.
+    #
+    if ( $ent < $today )
+    {
+        return 1;
+    }
+    else
+    {
+        return 0;
+    }
+}
+
+
+
+=begin doc
+
+  Move the specified file into our "live" directory.
+
+=end doc
+
+=cut
+
+sub makeEntryLive
+{
+    my ($file) = (@_);
+
+
+    if ( -d $CONFIG{ 'live-dir' } )
+    {
+
+        #
+        #  Is there already a file there with that name?
+        #
+        #  If so don't truncate it.
+        #
+        my $dir  = $file;
+        my $base = $file;
+        if ( $base =~ /^(.*)[\\\/](.*)$/ )
+        {
+            $dir  = $1;
+            $base = $2;
+        }
+
+        while ( -e "$CONFIG{'live-dir'}/$base" )
+        {
+            $base = "x$base";
+        }
+
+        #
+        #  Moving
+        #
+        File::Copy::move( $file,
+                          $CONFIG{ 'live-dir' } . "/" . $base );
+    }
+    else
+    {
+        print "Weirdness  $CONFIG{'live-dir'} is not a directory!\n";
+        exit;
+    }
+}