App-Chronicle
view release on metacpan or search on metacpan
bin/chronicle view on Meta::CPAN
#!/usr/bin/perl
=head1 NAME
chronicle - A static blog-compiler.
=cut
=head1 SYNOPSIS
chronicle [options]
Path Options:
--comments Specify the path to the optional comments directory.
--config Specify a configuration file to read.
--database Specify the path to the SQLite database to create/use.
--input Specify the input directory to use.
--output Specify the directory to write output to.
--pattern Specify the pattern of files to work with.
--theme Specify the theme to use.
--theme-dir Specify the path to the theme templates.
--url-prefix Specify the prefix to the generated blog.
--template-engine Specify the template system to use
(HTMLTemplate (default), Xslate or XslateTT)
Counting Options:
--comment-days=N The maximum age a post may allow comments.
--entry-count=N Number of posts to show on the index.
--rss-count=N Number of posts to include on the RSS index feed.
Optional Features:
--author Specify the author's email address.
--blog-subtitle Set the title of the blog.
--blog-title Set the title of the blog.
--force Always regenerate pages.
--lower-case Write only lower-case post-files.
--unicode=<yes|no|mac>
Allow non-ASCII characters in file names. Default is
`no'. Use `mac' if serving files off an HFS+ volume.
Help Options:
--help Show the help information for this script.
--list-plugins List the available plugins.
--list-themes List the available themes.
--manual Read the manual for this script.
--verbose Show useful debugging information.
--version Show the version number and exit.
=cut
=head1 ABOUT
Chronicle is a blog-compiler which will convert a directory full of
plain-text blog-posts into a fully-featured HTML website containing
posts, tags, and archives.
All blog-posts from a given input directory are parsed into a SQLite
database which is then used to generate the output pages.
The SQLite database is assumed to persist, such that it will be updated
if new posts are written, or previous posts are updated. However if
it is removed it will be recreated when needed.
=cut
=head1 DATABASE STRUCTURE
When C<chronicle> is first executed it will create an SQLite database
if it is not already present. The database will contain two tables,
one for the posts, and one to store the tags associated with the posts,
if you choose to use tags in your entries.
The blog-entry table contains the following columns:
=over 8
=item mtime
The C<mtime> of the input file.
=item date
The date-header as self-reported in the blog-post.
=item body
The body of the blog-post itself.
=item title
The title of the blog-post itself.
=back
If you wish to add extra tables via a local plugin you're welcome to do so.
bin/chronicle view on Meta::CPAN
b) the Perl "Artistic License".
=cut
=head1 AUTHOR
Steve Kemp <steve@steve.org.uk>
=cut
use strict;
use warnings;
use open ':std' => ':locale';
use open IO => ':encoding(UTF-8)';
package Chronicle;
use Module::Pluggable::Ordered require => 1, inner => 0;
our $VERSION = "5.1.8";
use DBI;
use Date::Format;
use Date::Parse;
use Digest::MD5 qw(md5_hex);
use File::Basename;
use File::Find;
use File::Path;
use File::ShareDir;
use Getopt::Long;
use HTML::Element;
use Pod::Usage;
use Chronicle::Utils qw/ format_datetime /;
use Chronicle::URI;
use Chronicle::Config::Reader;
use Chronicle::Template;
#
# Default options - These may be overridden by the command-line
# or via the configuration files:
#
# /etc/chronicle/config
# ~/.chronicle/config
#
# NOTE: These filenames were deliberately chosen to avoid clashing
# with previous releases of chronicle.
#
our %CONFIG;
$CONFIG{ 'input' } = "./data";
$CONFIG{ 'pattern' } = "*.txt";
$CONFIG{ 'output' } = "./output";
$CONFIG{ 'database' } = "./blog.db";
$CONFIG{ 'comment-days' } = 10;
$CONFIG{ 'entry-count' } = 10;
$CONFIG{ 'rss-count' } = 10;
$CONFIG{ 'theme-dir' } = File::ShareDir::dist_dir('App-Chronicle');
$CONFIG{ 'theme' } = "default";
$CONFIG{ 'unicode' } = "no";
$CONFIG{ 'verbose' } = 0;
$CONFIG{ 'top' } = "/";
$CONFIG{ 'exclude-plugins' } =
"Chronicle::Plugin::Archived,Chronicle::Plugin::Verbose";
$CONFIG{ 'template-engine' } = "HTMLTemplate";
our %DATABASE_SCHEMA = (
blog => {
columns =>
[qw/ id file date title link mtime body truncatedbody template /],
create => [
'CREATE TABLE blog (id INTEGER PRIMARY KEY,file,date,title,link,mtime,body,truncatedbody,template )',
'CREATE UNIQUE INDEX unique_title on blog (title)',
],
},
tags => { columns => [qw/ id name blog_id /],
create =>
['CREATE TABLE tags (id INTEGER PRIMARY KEY, name, blog_id )'],
},
pages => {
columns => [qw/ id filename title content template /],
create => [], # Chronicle::Plugin::StaticPages will do it
},
);
#
# Options here are passed to all templates
#
our %GLOBAL_TEMPLATE_VARS = ();
#
# Read the global and per-user configuration file, if present.
#
my $cnf = Chronicle::Config::Reader->new();
$cnf->parseFile( \%CONFIG, "/etc/chronicle/config" );
$cnf->parseFile( \%CONFIG, $ENV{ 'HOME' } . "/.chronicle/config" );
#
# Parse our command-line options
#
parseCommandLine();
#
# If we have a configuration file then read it.
#
$cnf->parseFile( \%CONFIG, $CONFIG{ 'config' } )
if ( defined $CONFIG{ 'config' } );
#
# Switch on Mac quirks for Unicode file names if required
#
Chronicle::URI::i_use_hfs if $CONFIG{ 'unicode' } eq 'mac';
#
# If Unicode is on, also keep HTML::Element from encoding non-ASCII as entities
#
if ( $CONFIG{ 'unicode' } ne 'no' )
{
$HTML::Element::encoded_content = 1;
}
#
# Get the database handle, creating the database on-disk if necessary.
#
my $dbh = getDatabase();
#
# Parse/update blog posts from our input directory.
#
updateDatabase($dbh);
#
# Ensure we have an output directory.
#
File::Path::make_path( $CONFIG{ 'output' },
{ verbose => 0,
mode => oct("755"),
} )
unless ( -d $CONFIG{ 'output' } );
#
# Call on_initiate for all plugins which have not been excluded.
#
foreach my $plugin ( get_plugins_for_method("on_initiate") )
{
$CONFIG{ 'verbose' } && print "Calling $plugin on_initiate()\n";
$plugin->on_initiate( config => \%CONFIG, dbh => $dbh );
}
#
# Call on_generate for all plugins which have not been excluded.
#
# `on_generate` is logically identical to `on_initiate`, except
# the former plugins are guaranteed to have been invoked first.
#
foreach my $plugin ( get_plugins_for_method("on_generate") )
{
$CONFIG{ 'verbose' } && print "Calling $plugin on_generate()\n";
$plugin->on_generate( config => \%CONFIG, dbh => $dbh );
}
#
# Copy any static content from the theme-directory.
#
my $ts = $CONFIG{ 'theme-dir' } . "/" . $CONFIG{ 'theme' } . "/static";
if ( -d $ts )
{
#
# This could be improved, but it will cope with subdirectories, etc,
# so for the moment it will remain.
bin/chronicle view on Meta::CPAN
{
if ( $inHeader > 0 )
{
#
# If the line has the form of "key: value"
#
if ( $line =~ /^([^:]+):(.*)/ )
{
my $key = $1;
my $val = $2;
$key = lc($key);
$key =~ s/^\s+|\s+$//g;
$val =~ s/^\s+|\s+$//g;
#
# "subject" is a synonym for "title".
#
$key = "title" if ( $key eq "subject" );
#
# Update the value if there is one present,
# and we've not already saved that one away.
#
$meta{ $key } = $val
if ( defined($val) && length($val) && !$meta{ $key } );
}
else
{
#
# Empty line == end of header
#
$inHeader = 0 if ( $line =~ /^$/ );
}
}
else
{
$meta{ 'body' } .= $line;
}
}
close($handle);
# Ensure we have a title.
defined $meta{ 'title' } or die "Missing `Title:' line in `$filename'";
# initiate the truncated body.
$meta{ 'truncatedbody' } = '';
# initiate the template and change if there is a template is supplied.
$meta{ 'template' } = "entry.tmpl" unless defined $meta{ 'template' };
#
# Generate the link from the title of the post.
#
my $suffix = $CONFIG{ 'entry_suffix' } // ".html";
my $link = $meta{ 'title' };
if ( $CONFIG{ 'unicode' } eq 'no' )
{
# Unicode off, only use 7-bit alphanumerics from titles
$link =~ s/[^a-zA-Z0-9]/_/gi;
}
else
{
# Allow everything alphanumeric in any Unicode block
$link =~ s/[^[:alnum:]]/_/gi;
}
$meta{ 'link' } = Chronicle::URI->new( $link . $suffix );
#
# Let any plugins have access to the filename.
#
$meta{ 'file' } = $filename;
#
# Are we going to skip this post?
#
my $skip = 0;
#
# Update our meta-data via any loaded plugins.
#
foreach my $plugin ( get_plugins_for_method("on_insert") )
{
$CONFIG{ 'verbose' } && print "Calling $plugin - on_insert\n";
my $m = $plugin->on_insert( config => \%CONFIG,
dbh => $dbh,
data => \%meta
);
#print "after $plugin: $meta{ 'body' }\n";
if ( !$m )
{
#
# We'll skip any post if the insert plugin returned an
# empty value.
#
$skip = 1;
}
else
{
#
# If we know we're going to skip this post then we'll
# not update the meta-data, which will ensure that
# future plugins won't have empty data-structures.
#
# This isn't essential but it helps avoid warnings or
# weirdness.
#
%meta = %$m;
}
}
if ($skip)
{
bin/chronicle view on Meta::CPAN
$tag =~ s/^\s+//;
$tag =~ s/\s+$//;
# skip empty tags.
next if ( !length($tag) );
# Tags are always down-cased
$tag = lc($tag);
#
# Add the new tag to the post.
#
$tag_add->execute( $blog_id, $tag ) or
die "Failed to execute:" . $dbh->errstr();
}
}
}
=begin doc
Given a database handle, check that all required tables and columns exist.
Returns a boolean indicating success.
=end doc
=cut
sub check_database_structure
{
my ($dbh) = (@_);
while ( my ( $table_name, $table_spec ) = each %DATABASE_SCHEMA )
{
for my $column ( @{ $table_spec->{ columns } } )
{
local $dbh->{ PrintError } = 0;
$dbh->selectcol_arrayref("SELECT $column FROM $table_name LIMIT 1")
or
return;
}
}
return 1;
}
=begin doc
Open a named file as an SQLite database
=end doc
=cut
sub get_database_handle
{
my ($filename) = (@_);
my $dbh =
DBI->connect( "dbi:SQLite:dbname=$filename", "", "",
{ AutoCommit => 1, RaiseError => 0 } ) or
die "Could not open SQLite database: $DBI::errstr";
$dbh->{ sqlite_unicode } = 1;
return $dbh;
}
=begin doc
Create a database handle, if necessary creating the tables first.
=end doc
=cut
sub getDatabase
{
#
# Is the database already present?
#
my $present = 0;
#
# Ensure we have something specified.
#
die "No database configured - please use --database=/path/tocreate"
unless ( $CONFIG{ 'database' } );
#
# Does it exist?
#
$present = 1 if ( -e $CONFIG{ 'database' } );
my $dbh = get_database_handle( $CONFIG{ 'database' } );
# If it exists but fails the structure check, just delete it
if ( $present and not check_database_structure($dbh) )
{
$dbh->disconnect;
unlink $CONFIG{ 'database' };
$dbh = get_database_handle( $CONFIG{ 'database' } );
$present = 0;
}
if ( !$present )
{
for my $table_spec ( values %DATABASE_SCHEMA )
{
$dbh->do($_) for @{ $table_spec->{ create } };
}
foreach my $plugin ( get_plugins_for_method("on_db_create") )
{
$CONFIG{ 'verbose' } && print "Calling $plugin - on_db_create\n";
$plugin->on_db_create( config => \%CONFIG,
dbh => $dbh, );
}
}
foreach my $plugin ( get_plugins_for_method("on_db_load") )
{
bin/chronicle view on Meta::CPAN
$filename ? ( tmpl_file => $filename ) : ( tmpl_string => $scalar ),
%options ) or
return; # simply return undef to let the caller retry
for my $opt (qw/ blog_title blog_subtitle /)
{
$tmpl->param( $opt => $CONFIG{ $opt } ) if defined $CONFIG{ $opt };
}
$tmpl->param( \%GLOBAL_TEMPLATE_VARS );
return $tmpl;
}
=begin doc
Parse the command-line options.
=end doc
=cut
sub parseCommandLine
{
my $HELP = 0;
my $MANUAL = 0;
#
# Parse options.
#
if (
!GetOptions(
# Help options
"help", \$HELP,
"manual", \$MANUAL,
"verbose", \$CONFIG{ 'verbose' },
"version", \$CONFIG{ 'version' },
# theme support
"theme=s", \$CONFIG{ 'theme' },
"theme-dir=s", \$CONFIG{ 'theme-dir' },
"list-themes", \$CONFIG{ 'list-themes' },
"template-engine=s", \$CONFIG{ 'template-engine' },
# paths
"input=s", \$CONFIG{ 'input' },
"output=s", \$CONFIG{ 'output' },
"pattern=s", \$CONFIG{ 'pattern' },
"comments=s", \$CONFIG{ 'comments' },
# limits
"entry-count=s", \$CONFIG{ 'entry-count' },
"rss-count=s", \$CONFIG{ 'rss-count' },
# optional
"config=s", \$CONFIG{ 'config' },
"database=s", \$CONFIG{ 'database' },
"author=s", \$CONFIG{ 'author' },
"comment-days=s", \$CONFIG{ 'comment-days' },
"force", \$CONFIG{ 'force' },
"unicode=s", \$CONFIG{ 'unicode' },
"lower-case", \$CONFIG{ 'lower-case' },
# plugins
"list-plugins", \$CONFIG{ 'list-plugins' },
"exclude-plugins=s", \$CONFIG{ 'exclude-plugins' },
# title
"blog-title=s", \$CONFIG{ 'blog_title' },
"blog-subtitle=s", \$CONFIG{ 'blog_subtitle' },
# prefix
"url-prefix=s", \$CONFIG{ 'top' },
) )
{
exit;
}
pod2usage(1) if $HELP;
pod2usage( -verbose => 2 ) if $MANUAL;
#
# Show our version number, and terminate.
#
if ( $CONFIG{ 'version' } )
{
print "Chronicle $VERSION\n";
exit(0);
}
#
# List themes.
#
if ( $CONFIG{ 'list-themes' } )
{
#
# Global themese
#
my $global = File::ShareDir::dist_dir('App-Chronicle');
#
# The theme-directories we'll inspect
#
my @dirs = ();
push( @dirs, $global );
if ( $CONFIG{ 'theme-dir' } && ( $CONFIG{ 'theme-dir' } ne $global ) )
{
push( @dirs, $CONFIG{ 'theme-dir' } );
}
#
# For each global/local directory show the contents.
#
foreach my $dir (@dirs)
{
print "Themes beneath $dir\n";
foreach my $ent ( glob( $dir . "/*" ) )
{
my $name = File::Basename::basename($ent);
print "\t" . $name . "\n" if ( -d $ent );
}
}
exit(0);
}
#
# List plugins
#
if ( $CONFIG{ 'list-plugins' } )
{
for my $plugin ( Chronicle->plugins_ordered() )
{
print $plugin . "\n";
if ( $CONFIG{ 'verbose' } )
{
foreach my $method (
sort
qw! on_db_create on_db_load on_insert on_initiate on_generate !
)
{
if ( $plugin->can($method) )
{
print "\t$method\n";
}
}
}
}
exit 0;
}
# Show an error if 'unicode' is not an allowed value
$CONFIG{ 'unicode' } = lc $CONFIG{ 'unicode' };
unless ( grep {$_ eq $CONFIG{ 'unicode' }} qw/ no yes mac / )
{
print STDERR "--unicode must be one of `yes', `no' or `mac'";
exit 1;
}
}
=begin doc
Return an array of plugins that implement the given method.
This result set will exclude anything that has been deliberately
excluded by the user.
=end doc
=cut
sub get_plugins_for_method
{
my ($method) = (@_);
my @plugins = ();
#
# Call any on_initiate plugins we might have loaded.
#
for my $plugin ( Chronicle->plugins_ordered() )
{
my $skip = 0;
if ( $CONFIG{ 'exclude-plugins' } )
{
foreach my $exclude ( split( /,/, $CONFIG{ 'exclude-plugins' } ) )
{
# strip leading and trailing space.
$exclude =~ s/^\s+//;
$exclude =~ s/\s+$//;
# skip empty tags.
next if ( !length($exclude) );
if ( $plugin =~ /\Q$exclude\E/i )
{
$CONFIG{ 'verbose' } && print "Skipping plugin: $plugin\n";
$skip = 1;
}
}
}
next if ($skip);
next unless $plugin->can($method);
push( @plugins, $plugin );
}
return (@plugins);
}
( run in 0.664 second using v1.01-cache-2.11-cpan-d7f47b0818f )