view release on metacpan or  search on metacpan

bin/chronicle  view on Meta::CPAN

if ( -d $ts )
{

    #
    #  This could be improved, but it will cope with subdirectories, etc,
    # so for the moment it will remain.
    #
    system("/bin/tar -C $ts -cpf - . | /bin/tar -C $CONFIG{'output'} -xf -");
}


#
#  Now we're done.
#
$dbh->disconnect();
exit(0);




=begin doc

Read each blog-post from beneath ./data/ - and if it is missing from the
database then insert it.

We also handle the case where the file on disk is newer than the database
version - in that case we remove the database version and update it to
contain the newer content.

=end doc

=cut

sub updateDatabase
{
    my ($dbh) = (@_);

    #
    #  Assume each entry is already present in the database.
    #
    my $sql =
      $dbh->prepare("SELECT id FROM blog WHERE ( file=? AND mtime=? )") or
      die "Failed to select post";


    #
    #  Look for posts.
    #

    foreach
      my $file ( get_post_files( $CONFIG{ 'input' }, $CONFIG{ 'pattern' } ) )
    {

        #
        # We want to find the mtime to see if it is newer than the DB-version.
        #
        my ( $dev,   $ino,     $mode, $nlink, $uid,
             $gid,   $rdev,    $size, $atime, $mtime,
             $ctime, $blksize, $blocks
           )
          = stat($file);


        #
        #  Lookup the existing entry
        #
        $sql->execute( $file, $mtime ) or
          die "Failed to execute: " . $dbh->errstr();
        my $result = $sql->fetchrow_hashref();

        if ( !$result )
        {

            #
            #  The file is not in the database, or it is present with a
            # different modification time.
            #
            #  Parse the file and insert it.
            #
            insertPost( $dbh, $file, $mtime );
        }
    }

    $sql->finish();
}



=begin doc

Given a filename containing a blog post then insert that post into
the database.

We also update the tags.

=end doc

=cut

sub insertPost
{
    my ( $dbh, $filename, $mtime ) = (@_);

    $CONFIG{ 'verbose' } && print "Adding post to DB: $filename\n";

    #
    #  Is the entry present, but with a different mtime?
    #
    #  If so we need to delete the post, and the tags which are pointing
    # at it, otherwise we'll have orphaned tags.
    #
    my $sql = $dbh->prepare("SELECT id FROM blog WHERE file=?");
    $sql->execute($filename) or die "Failed to execute :" . $dbh->errstr();
    my $id;
    $sql->bind_columns( undef, \$id );

    while ( $sql->fetch() )
    {
        $CONFIG{ 'verbose' } && print "Replacing DB post: $id\n";

        #

bin/chronicle  view on Meta::CPAN

   ..

=for example end

The downside of this approach is that the comment-writing CGI-script
would need to run C<mkdir> and we might be more at risk of directory
traversal, and other badness.  Also the seconds-past-epoch might result
in a collision - but we have that risk already, ssh!

=end doc

=cut

sub getComments
{
    my ($title) = (@_);

    #
    #  If there is no comment-directory setup then return nothing.
    #
    return unless ( $CONFIG{ 'comments' } );

    #
    #  If there is a comment-directory setup, but it doesn't exist
    # then again we do nothing.
    #
    return unless ( -d $CONFIG{ 'comments' } );


    #
    #  The resulting comments for this piece.
    #
    my $results;

    #
    #  Strip the .html suffix from the filename
    #
    if ( $title =~ /^(.*)\.([^.]+)$/ )
    {
        $title = $1;
    }

    #
    #  Lower-case it.
    #
    $title = lc($title);


    #
    #  Find each comment file.
    #
    my @entries;
    foreach my $file ( glob( $CONFIG{ 'comments' } . "/" . $title . "*" ) )
    {
        push( @entries, $file );
    }

    #
    # Sort them into order by mtime.
    #
    @entries = sort {( stat($a) )[9] <=> ( stat($b) )[9]} @entries;

    #
    #  Now process them, extracting the submitters IP, email,
    # etc, etc, from the body of the comment-file.
    #
    foreach my $file (@entries)
    {
        my $date    = "";
        my $name    = "";
        my $link    = "";
        my $body    = "";
        my $mail    = "";
        my $pubdate = "";

        #
        #  The name of the file has the date/time in it.
        #
        #  This could be so much cleaner, but it'd break if I changed
        # anything.
        #
        if ( $file =~ /^(.*)\.([^.]+)$/ )
        {
            $date = $2;

            if ( $date =~ /(.*)-([0-9:]+)/ )
            {
                my $d = $1;
                my $t = $2;

                $d =~ s/-/ /g;

                $date = "Submitted at $t on $d";
            }
        }

        #
        #  Process the contents of the file.
        #
        open my $comment, "<:encoding(utf-8)", $file or
          next;

        foreach my $line (<$comment>)
        {
            # Skip empty lines.
            next if ( !defined($line) );
            chomp($line);

            # Skip fields we don't care about.
            next if ( $line =~ /^IP-Address:/ );
            next if ( $line =~ /^User-Agent:/ );

            if ( !length($name) && $line =~ /^Name: (.*)/i )
            {
                $name = $1;
            }
            elsif ( !length($mail) && $line =~ /^Mail: (.*)/i )
            {
                $mail = $1;
            }
            elsif ( !length($link) && $line =~ /^Link: (.*)/i )