#!/usr/bin/perl

# Blosxom
# Author: Rael Dornfest <rael@oreilly.com>
# Version: 2.0.2
# Home/Docs/Licensing: http://www.blosxom.com/
# Development/Downloads: http://sourceforge.net/projects/blosxom

package blosxom;

use strict;
use warnings;

our $version = '2.0.2';

# -- require modules ----------------- #

use FileHandle;
use DirHandle;
use FindBin ();
use File::Find;
use File::stat;
use Time::localtime;
use CGI qw( :standard :netscape );

# -- package variables --------------- #

our (
    # weblog
    $blog_title, $blog_description, $blog_language, $url,
    # entries                               # flavour
    $datadir, $depth, $file_extension,      $flavour_dir, $default_flavour,
    # view                                  # plugins
    $num_entries, $show_future_entries,     $plugin_dir, $plugin_state_dir, @plugin_order,
    # request
    $path_info, $path_info_yr, $path_info_mo, $path_info_mo_num, $path_info_da, $flavour,
    # response              # system
    $output, $header,       %template, @plugins, %plugins, %files, %indexes, %others,
    # variables             # subroutines
    %month2num, @num2month, $template, $interpolate, $entries,
    # static
    $static_or_dynamic, $static_dir, $static_password, @static_flavours, $static_entries,
);

my $fh = FileHandle->new;

%month2num = (  nil => '00', Jan => '01', Feb => '02', Mar => '03',
                Apr => '04', May => '05', Jun => '06', Jul => '07',
                Aug => '08', Sep => '09', Oct => '10', Nov => '11', Dec => '12' );
@num2month = sort { $month2num{$a} <=> $month2num{$b} } keys %month2num;

# ------------------------------------ #

# load configuration file
{
    my $file = env_value('config') || "$FindBin::Bin/config.pl";
    eval { require $file };
    die "Failed to load configuration file: $file: $@" if ( $@ );
}

# Use the stated preferred URL or figure it out automatically
$url ||= url( -path_info => 1 );
$url =~ s{^include:}{http:} if ( ( $ENV{'SERVER_PROTOCOL'} || q{} ) eq 'INCLUDED' );

# NOTE: Since v3.12, it looks as if CGI.pm misbehaves for SSIs and
# always appends path_info to the url. To fix this, we always
# request an url with path_info, and always remove it from the end of the
# string.
{
    my $path_info = ( $ENV{'PATH_INFO'} || q{} );
    my $len = length $path_info;
    my $frag = substr( $url, -$len );
    substr( $url, -$len ) = q{} if ( $frag eq $path_info );
}

$url =~ s!/$!!;

# Drop ending any / from dir settings
for ( $datadir, $flavour_dir, $plugin_dir, $static_dir ) {
    $_ =~ s{/$}{};
}
  
# Fix depth to take into account datadir's path
$depth += ( $datadir =~ tr{/}{} ) -1 if ( $depth );

# Global variable to be used in head/foot.{flavour} templates
$path_info = q{};

$static_or_dynamic = (  !$ENV{'GATEWAY_INTERFACE'}
                        && param('-password')
                        && $static_password
                        && param('-password') eq $static_password )
                   ? 'static'
                   : 'dynamic'
                   ;
param( -name => "-quiet", -value => 1 ) if ( $static_or_dynamic eq 'dynamic' );
# Path Info Magic
# Take a gander at HTTP's PATH_INFO for optional blog name, archive yr/mo/day
my @path_info = split m{/+}, path_info() || param('path') || q{}; 
shift @path_info;

while ( $path_info[0] && $path_info[0] =~ /^[a-zA-Z].*$/ && $path_info[0] !~ /^.*\..*$/) {
    $path_info .= '/' . shift @path_info;
}

# Flavour specified by ?flav={flav} or index.{flav}
$flavour = q{};

if ( $path_info[$#path_info] && $path_info[$#path_info] =~ /^(.+)\.(.+?)$/ ) {
    $flavour = $2;
    $path_info .= "/$1.$2" if ( $1 ne 'index' );
    pop @path_info;
}
elsif ( ! -d "${datadir}${path_info}" ) {
    $path_info .= ".${default_flavour}";
    $flavour    = param('flav') || $default_flavour;
}
else {
    $flavour = param('flav') || $default_flavour;
}

# Strip spurious slashes
$path_info =~ s{^/*|/*$}{}g;

# Date fiddling
( $path_info_yr, $path_info_mo, $path_info_da ) = @path_info;
$path_info_mo_num = ( $path_info_mo )
                  ? ( ( $path_info_mo =~ /\d{2}/ )
                      ? $path_info_mo
                      : ($month2num{ucfirst(lc $path_info_mo)} || undef) )
                  : undef ;

$path_info_yr       ||= q{};
$path_info_mo       ||= q{};
$path_info_mo_num   ||= q{};
$path_info_da       ||= q{};

for ( $path_info, $path_info_yr, $path_info_mo, $path_info_mo_num, $path_info_da, $flavour ) {
    $_ = html_escape( $_ );
}

# Define standard template subroutine, plugin-overridable at Plugins: Template
$template = sub {
    my ( $path, $chunk, $flavour ) = @_;
    my $dir = $flavour_dir || $datadir;
    $path ||= q{};
    do {
        if ( $fh->open("${dir}/${path}/${chunk}.${flavour}", '<') ) {
            my $file = do { local $/; <$fh> };
            $fh->close;
            return $file;
        }
    }
    while ( $path =~ s{(/*[^/]*)$}{} && $1 );

    # Check for definedness, since flavour can be the empty string
    if ( defined $template{$flavour}{$chunk} ) {
        return $template{$flavour}{$chunk};
    }
    elsif ( defined $template{'error'}{$chunk} ) {
        return $template{'error'}{$chunk} 
    }
    else {
        return q{};
    }
};
# Bring in the templates
%template = ();
while (<DATA>) {
    last if ( $_ =~ m{^__END__$} );
    my ( $flav, $chunk, $text ) = ( $_ =~ m{^(\S+)\s(\S+)(?:\s(.*))?$} ) or next;
    $text =~ s{\\n}{\n}mg;
    $template{$flav}{$chunk} .= "${text}\n";
}

# Plugins: Start
if ( $plugin_dir ) {
    if ( @plugin_order > 0 ) {
        for my $plugin ( @plugin_order ) {
            require "${plugin_dir}/${plugin}";
            if ( $plugin->start() ) {
                $plugins{$plugin} = 1;
                push @plugins, $plugin;
            }
        }
    }
    elsif ( defined( my $dh = DirHandle->new( $plugin_dir ) ) ) {
        for my $plugin ( grep { $_ =~ m{^\w+$} && -f "${plugin_dir}/${_}" } sort $dh->read ) {
            next if ( $plugin =~ m{~$} ); # Ignore emacs backup
            my ( $name, $off ) = ( $plugin =~ m{^\d*(\w+?)(_?)$} );
            my $on_off = ( $off eq '_' ) ? -1 : 1 ;
            require "${plugin_dir}/${plugin}";
            if ( $name->start() ) {
                $plugins{$name} = $on_off;
                push @plugins, $name;
            }
        }
        $dh->close;
    }
}

# Plugins: Template
# Allow for the first encountered plugin::template subroutine to override the
# default built-in template subroutine
overwrite_sub('template');

# Provide backward compatibility for Blosxom < 2.0rc1 plug-ins
sub load_template { $template->( @_ ) }

# Define default entries subroutine
$entries = sub {
    my ( %files, %indexes, %others );
    find(
        sub {
            my $currnet = $File::Find::dir =~ tr{/}{};
            return if ( $depth && $currnet > $depth );

            my $name = $File::Find::name;

            return if ( -d $name );
            return if ( ! -r $name );

            my $time  = time;
            my $mtime = stat($name)->mtime;

            my ( $path, $fn )
                = ( $name =~ m{^$datadir/(?:(.*)/)?(.+)\.$file_extension$} );

            if ( ! $fn && $fn eq 'index' || $fn =~ m{\.} ) {
                $others{$name} = $mtime;
                return;
            }

            return if ( ! $show_future_entries && $mtime > $time );
            $files{$name} = $mtime;

            if ( $static_dir && $static_flavours[0] ) {
                my $check = "${static_dir}/${path}/index.$static_flavours[0]";
                if ( param('-all') || ! -f $check || stat($check)->mtime < $mtime ) {
                    $indexes{$path} = 1;
                    my $dir = join q{/}, (nice_date($mtime))[5,2,3];
                    $indexes{$dir} = $dir;
                    $indexes{( $path ? '${path}/' : '' )."${fn}.${file_extension}"} = 1
                        if ( $static_entries );
                }
            }

        },
        $datadir,
    );

    return ( \%files, \%indexes, \%others, );
};

# Plugins: Entries
# Allow for the first encountered plugin::entries subroutine to override the
# default built-in entries subroutine
overwrite_sub('entries');

my ( $files, $indexes, $others ) = $entries->();
%indexes = %{ $indexes };

# Static
if ( $static_or_dynamic eq 'static' ) {
    print "Blosxom is generating static index pages...\n" if ( ! param('-quiet') );

    # Home Page and Directory Indexes
    my %done;
    for my $item ( sort keys %indexes ) {
        my $path = q{};
        for ( '', split m{/+}, $item ) {
            $path .= "/$_";
            $path =~ s{^/}{};
            $done{$path}++ and next;
            if ( ! -d "${static_dir}/${path}" && $path !~ m{\.$file_extension$} ) {
                mkdir "${static_dir}/${path}", 0755;
            }
            for $flavour ( @static_flavours ) {
                my $content_type = $template->( $path, 'content_type', $flavour );
                   $content_type =~ s{\n.*}{}s;
                my $fn = ( $path =~ m{^(.+)\.$file_extension} ) ? $1 : "${path}/index" ;
                print "${fn}.${flavour}\n" if ( ! param('-quiet') );
                $fh->open( "${static_dir}/${fn}.${flavour}", '>' )
                    or die "Couldn't open ${static_dir}/${path} for writing: $!";
                $output = q{};
                # dir, entry
                if ( $indexes{$path} == 1 ) {
                    $path_info = $path;
                    $path_info =~ s{\.$file_extension}{.$flavour};
                    print $fh &generate('static', $path_info, '', $flavour, $content_type);
                }
                # date
                else {
                    local ( $path_info_yr, $path_info_mo, $path_info_da, $path_info )
                        = split m{/+}, $path, 4;
                    $path_info = q{} if ( ! defined $path_info );
                    print $fh &generate('static', '', $path, $flavour, $content_type );
                }
                $fh->close;
            }
        }
    }
}
# Dynamic
else {
    my $content_type = $template->( $path_info, 'content_type', $flavour );
       $content_type =~ s{\n.*}{}s;

    $header = { -type => $content_type };

    print generate('dynamic', $path_info, "$path_info_yr/$path_info_mo_num/$path_info_da", $flavour, $content_type);
}

# Plugins: End
run_plugins('end');

# Generate 
sub generate {
    my ( $static_or_dynamic, $currentdir, $date, $flavour, $content_type ) = @_;

    %files = %{ $files };
    %others = ref $others ? %{ $others } : ();

    # Plugins: Filter
    run_plugins( filter => \%files, \%others );

    my %f = %files;

    # Plugins: Skip
    # Allow plugins to decide if we can cut short story generation
    my $skip;
    if ( defined( my $flag = run_plugins_first('skip') ) ) {
        $skip = $flag;
    }

    # Define default interpolation subroutine
    $interpolate = sub {
        package blosxom;
        my $tmpl = shift;
        $tmpl =~ s{(\$\w+(?:::)?\w*)}{"defined $1 ? $1 : ''"}gee;
        return $tmpl;
    };

    if ( ! defined $skip || ! $skip ) {
        # Plugins: Interpolate
        # Allow for the first encountered plugin::interpolate subroutine to 
        # override the default built-in interpolate subroutine
        overwrite_sub('interpolate');

        # Head
        my $head = $template->( $currentdir, 'head', $flavour );  
        # Plugins: Head
        run_plugins( head => $currentdir, \$head );
        $head = $interpolate->($head);
        $output .= $head;
        
        # Stories
        my $curdate = q{};
        my $ne      = $num_entries;
        if ( $currentdir =~ m{(.*?)([^/]+)\.(.+)$} && $2 ne 'index' ) {
            $currentdir = "$1$2.$file_extension";
            my $fullpath = "${datadir}/${currentdir}";
            %f = ( $fullpath => $files{$fullpath} ) if ( $files{$fullpath} );
        }
        else {
            $currentdir =~ s{/index\..+$}{};
        }

        # Define a default sort subroutine
        my $sort = sub {
            my ( $files_ref ) = @_;
            return sort { $files_ref->{$b} <=> $files_ref->{$a} } keys %{ $files_ref };
        };
        # Plugins: Sort
        # Allow for the first encountered plugin::sort subroutine to override the
        # default built-in sort subroutine
        if ( defined( my $sub = run_plugins_first('sort') ) ) {
            $sort = $sub;
        }

        for my $path_file ( $sort->( \%f, \%others ) ) {
            last if ( $ne <= 0 && $date !~ /\d/ );
            use vars qw( $path $fn );
            ( $path, $fn )
                = ( $path_file =~ m{^$datadir/(?:(.*)/)?(.*)\.$file_extension} );
            $path ||= q{};
            # Only stories in the right hierarchy
            if ( $path !~ m{^$currentdir} && $path_file ne "${datadir}/${currentdir}" ) {
                next;
            }
            
            # Prepend a slash for use in templates only if a path exists
            $path &&= "/$path";

            # Date fiddling for by-{year,month,day} archive views
            use vars qw/ $dw $mo $mo_num $da $ti $yr $hr $min $hr12 $ampm /;
            ( $dw, $mo, $mo_num, $da, $ti, $yr ) = nice_date( $files{"$path_file"} );
            ( $hr, $min) = split m{:}, $ti;
            ( $hr12, $ampm ) = ( $hr >= 12 ) ? ( $hr - 12,'pm' ) : ( $hr, 'am' ) ; 
            $hr12   =~ s{^0}{};
            $hr12 ||= 0;
            $hr12   = 12 if ( $hr12 == 0 );

            # Only stories from the right date
            my ( $path_info_yr, $path_info_mo_num, $path_info_da ) = split m{/+}, $date;
            next if ( $path_info_yr && $yr != $path_info_yr );
            last if ( $path_info_yr && $yr < $path_info_yr );
            next if ( $path_info_mo_num && $mo ne $num2month[$path_info_mo_num] );
            next if ( $path_info_da && $da != $path_info_da );
            last if ( $path_info_da && $da < $path_info_da ); 

            # Date 
            my $date = $template->( $path, 'date', $flavour );

            # Plugins: Date
            run_plugins( date => $currentdir, \$date, $files{$path_file}, $dw, $mo, $mo_num, $da, $ti, $yr );
            $date = $interpolate->($date);

            if ( $curdate ne $date ) {
                $curdate = $date;
                $output .= $date;
            }

            use vars qw( $title $body $raw );
            if ( -f $path_file && $fh->open( $path_file, '<' ) ) {
                chomp( $title   = <$fh> );
                chomp( $body    = do { local $/; <$fh> } );
                $fh->close;
                $raw = "${title}\n{$body}";
            }
            my $story = $template->( $path, 'story', $flavour );

            # Plugins: Story
            run_plugins( story => $path, $fn, \$story, \$title, \$body );

            if ( $content_type =~ m{\bxml\b} ) {
                # Escape <, >, and &, and to produce valid RSS
                for ( $title, $body ) {
                    $_ = html_escape( $_ );
                }
            }

            $story   = $interpolate->( $story );
            $output .= $story;
            $ne--;
        }
  
        # Foot
        my $foot = $template->( $currentdir, 'foot', $flavour );
  
        # Plugins: Foot
        run_plugins( foot => $currentdir, \$foot );
        $foot    = $interpolate->( $foot );
        $output .= $foot;

        # Plugins: Last
        run_plugins('last');
    }# End skip

    # Finally, add the header, if any and running dynamically
    $output = header( $header ) . $output
        if ( $static_or_dynamic eq 'dynamic' && $header );
    return $output;
}

sub run_plugins {
    my ( $method, @args ) = @_;

    for my $plugin ( @plugins ) {
        if ( $plugins{$plugin} > 0 && $plugin->can($method) ) {
            $entries = $plugin->$method( @args );
        }
    }
}

sub run_plugins_first {
    my ( $method, @args ) = @_;

    for my $plugin ( @plugins ) {
        if (    $plugins{$plugin} > 0
                && $plugin->can($method)
                && defined( my $ret = $plugin->$method( @args ) )   ) {
            return $ret;
        }
    }

    return;
}

sub overwrite_sub {
    my ( $method, @args ) = @_;

    if ( defined( my $sub = run_plugins_first( $method => @args ) ) ) {
        die "Return value of plugin is not CODE reference: method:$method"
            if ( ref $sub ne 'CODE' );
        no strict 'refs';
        ${"${method}"} = $sub;
    }
}

sub nice_date {
    my ( $unixtime ) = @_;

    my $ctime = ctime($unixtime);
    my ( $dw, $mo, $da, $ti, $yr )
        = ( $ctime =~ m{(\w{3})[ ]+(\w{3})[ ]+(\d{1,2})[ ]+(\d{2}:\d{2}):\d{2}[ ]+(\d{4})$} );
    $da = sprintf('%02d', $da);
    my $mo_num = $month2num{$mo};

    return ( $dw, $mo, $mo_num, $da, $ti, $yr );
}

sub env_value {
    my $prefix = uc __PACKAGE__;
    my $key    = uc( shift @_ );

    my $env = "${prefix}_${key}";

    if ( exists $ENV{$env} ) {
        return $ENV{$env};
    }
    return;
}



sub html_escape {
    my ( $str ) = @_;

    my %escape = (
        '<' => '&lt;',
        '>' => '&gt;',
        '&' => '&amp;',
        '"' => '&quot;',
        "'" => '&apos;',
    );

    my $escape_re = join q{|}, keys %escape;

    $str =~ s{($escape_re)}{$escape{$1}}sg;

    return $str;
}

# Default HTML and RSS template bits
__DATA__
html content_type text/html

html head <html>
html head     <head>
html head         <link rel="alternate" type="type="application/rss+xml" title="RSS" href="$url/index.rss" />
html head         <title>$blog_title $path_info_da $path_info_mo $path_info_yr
html head         </title>
html head     </head>
html head     <body>
html head         <center>
html head             <font size="+3">$blog_title</font><br />
html head             $path_info_da $path_info_mo $path_info_yr
html head         </center>
html head         <p />

html story        <p>
html story            <a name="$fn"><b>$title</b></a><br />
html story            $body<br />
html story            <br />
html story            posted at: $ti | path: <a href="$url$path">$path </a> | <a href="$url/$yr/$mo_num/$da#$fn">permanent link to this entry</a>
html story        </p>

html date         <h3>$dw, $da $mo $yr</h3>

html foot
html foot         <p />
html foot         <center>
html foot             <a href="http://www.blosxom.com/"><img src="http://www.blosxom.com/images/pb_blosxom.gif" border="0" /></a>
html foot         </center>
html foot     </body>
html foot </html>

rss content_type text/xml

rss head <?xml version="1.0"?>
rss head <!-- name="generator" content="blosxom/$version" -->
rss head <!DOCTYPE rss PUBLIC "-//Netscape Communications//DTD RSS 0.91//EN" "http://my.netscape.com/publish/formats/rss-0.91.dtd">
rss head 
rss head <rss version="0.91">
rss head   <channel>
rss head     <title>$blog_title $path_info_da $path_info_mo $path_info_yr</title>
rss head     <link>$url</link>
rss head     <description>$blog_description</description>
rss head     <language>$blog_language</language>

rss story   <item>
rss story     <title>$title</title>
rss story     <link>$url/$yr/$mo_num/$da#$fn</link>
rss story     <description>$body</description>
rss story   </item>

rss date 

rss foot   </channel>
rss foot </rss>

error content_type text/html

error head <html>
error head <body>
error head     <p><font color="red">Error: I'm afraid this is the first I've heard of a "$flavour" flavoured Blosxom.  Try dropping the "/+$flavour" bit from the end of the URL.</font>


error story <p><b>$title</b><br />
error story $body <a href="$url/$yr/$mo_num/$da#fn.$default_flavour">#</a></p>

error date <h3>$dw, $da $mo $yr</h3>

error foot     </body>
error foot </html>
__END__

=head1 AUTHOR

Original script by Rael Dornfest

Based on blosxom 2.0.2 in SourceForge.net

Modified by Naoki Okamura (Nyarla) E<lt>thotep@nyarla.netE<gt>