blosxom.cgi

   1 #!/usr/bin/perl
   2
   3 # Blosxom
   4 # Author: Rael Dornfest (2002-2003), The Blosxom Development Team (2005-2008)
   5 # Version: 2.1.2 ($Id: blosxom.cgi,v 1.94 2009/03/08 01:18:11 xtaran Exp $)
   6 # Home/Docs/Licensing: http://blosxom.sourceforge.net/
   7 # Development/Downloads: http://sourceforge.net/projects/blosxom
   8
   9 package blosxom;
  10
  11 =head1 NAME
  12
  13 blosxom - A lightweight yet feature-packed weblog
  14
  15 =head1 SYNOPSIS
  16
  17 B<blosxom> is a simple web log (blog) CGI script written in perl.
  18
  19 =head1 DESCRIPTION
  20
  21 B<Blosxom> (pronounced "I<blossom>") is a lightweight yet feature-packed
  22 weblog application designed from the ground up with simplicity,
  23 usability, and interoperability in mind.
  24
  25 Fundamental is its reliance upon the file system, folders and files
  26 as its content database. Blosxom's weblog entries are plain text
  27 files like any other. Write from the comfort of your favorite text
  28 editor and hit the Save button. Create, edit, rename, and delete entries
  29 on the command-line, via FTP, WebDAV, or anything else you
  30 might use to manipulate your files. There's no import or export; entries
  31 are nothing more complex than title on the first line, body being
  32 everything thereafter.
  33
  34 Despite its tiny footprint, Blosxom doesn't skimp on features, sporting
  35 the majority of features one would find in any other Weblog application.
  36
  37 Blosxom is simple, straightforward, minimalist Perl affording even the
  38 dabbler an opportunity for experimentation and customization. And
  39 last, but not least, Blosxom is open source and free for the taking and
  40 altering.
  41
  42 =head1 USAGE
  43
  44 Write a weblog entry, and place it into the main data directory. Place
  45 the the title is on the first line; the body is everything afterwards.
  46 For example, create a file named I<first.txt> and put in it something
  47 like this:
  48
  49   First Blosxom Post!
  50
  51   I have successfully installed blosxom on this system.  For more
  52   information on blosxom, see the author's <a
  53   href="http://blosxom.sourceforge.net/">blosxom site</a>.
  54
  55 Place the file in the directory under the I<$datadir> points to. Be
  56 sure to change the default location to be somewhere accessable by the
  57 web server that runs blosxom as a CGI program.
  58
  59 =cut
  60
  61 # --- Configurable variables -----
  62
  63 # What's this blog's title?
  64 $blog_title = "My Weblog";
  65
  66 # What's this blog's description (for outgoing RSS feed)?
  67 $blog_description = "Yet another Blosxom weblog.";
  68
  69 # What's this blog's primary language (for outgoing RSS feed)?
  70 $blog_language = "en";
  71
  72 # What's this blog's text encoding ?
  73 $blog_encoding = "UTF-8";
  74
  75 # Where are this blog's entries kept?
  76 $datadir = "/Library/WebServer/Documents/blosxom";
  77
  78 # What's my preferred base URL for this blog (leave blank for
  79 # automatic)?
  80 $url = "";
  81
  82 # Should I stick only to the datadir for items or travel down the
  83 # directory hierarchy looking for items?  If so, to what depth?
  84 #
  85 # 0 = infinite depth (aka grab everything), 1 = datadir only,
  86 # n = n levels down
  87
  88 $depth = 0;
  89
  90 # How many entries should I show on the home page?
  91 $num_entries = 40;
  92
  93 # What file extension signifies a blosxom entry?
  94 $file_extension = "txt";
  95
  96 # What is the default flavour?
  97 $default_flavour = "html";
  98
  99 # Should I show entries from the future (i.e. dated after now)?
 100 $show_future_entries = 0;
 101
 102 # --- Plugins (Optional) -----
 103
 104 # File listing plugins blosxom should load (if empty blosxom will load
 105 # all plugins in $plugin_dir and $plugin_path directories)
 106 $plugin_list = "";
 107
 108 # Where are my plugins kept?
 109 $plugin_dir = "";
 110
 111 # Where should my plugins keep their state information?
 112 $plugin_state_dir = "$plugin_dir/state";
 113
 114 # Additional plugins location. A list of directories, separated by ';'
 115 # on windows, ':' everywhere else.
 116 $plugin_path = "";
 117
 118 # --- Static Rendering -----
 119
 120 # Where are this blog's static files to be created?
 121 $static_dir = "/Library/WebServer/Documents/blog";
 122
 123 # What's my administrative password (you must set this for static
 124 # rendering)?
 125 $static_password = "";
 126
 127 # What flavours should I generate statically?
 128 @static_flavours = qw/html rss/;
 129
 130 # Should I statically generate individual entries?
 131 # 0 = no, 1 = yes
 132 $static_entries = 0;
 133
 134 # --- Advanced Encoding Options -----
 135
 136 # Should I encode entities for xml content-types? (plugins can turn
 137 # this off if they do it themselves)
 138 $encode_xml_entities = 1;
 139
 140 # Should I encode 8 bit special characters, e.g. umlauts in URLs, e.g.
 141 # convert an ISO-Latin-1 \"o to %F6? (off by default for now; plugins
 142 # can change this, too)
 143 $encode_8bit_chars = 0;
 144
 145 # --------------------------------
 146
 147 =head1 ENVIRONMENT
 148
 149 =over
 150
 151 =item B<BLOSXOM_CONFIG_FILE>
 152
 153 Points to the location of the configuration file. This will be
 154 considered as first option, if it's set.
 155
 156
 157 =item B<BLOSXOM_CONFIG_DIR>
 158
 159 The here named directory will be tried unless the above mentioned
 160 environment variable is set and tested for a contained blosxom.conf
 161 file.
 162
 163
 164 =back
 165
 166
 167 =head1 FILES
 168
 169 =over
 170
 171 =item B</usr/lib/cgi-bin/blosxom>
 172
 173 The CGI script itself. Please note that the location might depend on
 174 your installation.
 175
 176 =item B</etc/blosxom/blosxom.conf>
 177
 178 The default configuration file location. This is rather taken as last
 179 ressort if no other configuration location is set through environment
 180 variables.
 181
 182 =back
 183
 184
 185 =head1 AUTHOR
 186
 187 Rael Dornfest <rael@oreilly.com> was the original author of blosxom. The
 188 development was picked up by a team of dedicated users of blosxom since
 189 2005. See <I<http://blosxom.sourceforge.net/>> for more information.
 190
 191 =cut
 192
 193
 194 use vars qw!
 195     $version
 196     $blog_title
 197     $blog_description
 198     $blog_language
 199     $blog_encoding
 200     $datadir
 201     $url
 202     %template
 203     $template
 204     $depth
 205     $num_entries
 206     $file_extension
 207     $default_flavour
 208     $static_or_dynamic
 209     $config_dir
 210     $plugin_list
 211     $plugin_path
 212     $plugin_dir
 213     $plugin_state_dir
 214     @plugins
 215     %plugins
 216     $static_dir
 217     $static_password
 218     @static_flavours
 219     $static_entries
 220     $path_info_full
 221     $path_info
 222     $path_info_yr
 223     $path_info_mo
 224     $path_info_da
 225     $path_info_mo_num
 226     $flavour
 227     $static_or_dynamic
 228     %month2num
 229     @num2month
 230     $interpolate
 231     $entries
 232     $output
 233     $header
 234     $show_future_entries
 235     %files
 236     %indexes
 237     %others
 238     $encode_xml_entities
 239     $encode_8bit_chars
 240     $content_type
 241 !;
 242
 243 use strict;
 244 use FileHandle;
 245 use File::Find;
 246 use File::stat;
 247 use Time::Local;
 248 use CGI qw/:standard :netscape/;
 249
 250 $version = "2.1.2+dev";
 251
 252 # Load configuration from $ENV{BLOSXOM_CONFIG_DIR}/blosxom.conf, if it exists
 253 my $blosxom_config;
 254 if ( $ENV{BLOSXOM_CONFIG_FILE} && -r $ENV{BLOSXOM_CONFIG_FILE} ) {
 255     $blosxom_config = $ENV{BLOSXOM_CONFIG_FILE};
 256     ( $config_dir = $blosxom_config ) =~ s! / [^/]* $ !!x;
 257 }
 258 else {
 259     for my $blosxom_config_dir ( $ENV{BLOSXOM_CONFIG_DIR}, '/etc/blosxom',
 260         '/etc' )
 261     {
 262         if ( -r "$blosxom_config_dir/blosxom.conf" ) {
 263             $config_dir     = $blosxom_config_dir;
 264             $blosxom_config = "$blosxom_config_dir/blosxom.conf";
 265             last;
 266         }
 267     }
 268 }
 269
 270 # Load $blosxom_config
 271 if ($blosxom_config) {
 272     if ( -r $blosxom_config ) {
 273         eval { require $blosxom_config }
 274             or warn "Error reading blosxom config file '$blosxom_config'"
 275             . ( $@ ? ": $@" : '' );
 276     }
 277     else {
 278         warn "Cannot find or read blosxom config file '$blosxom_config'";
 279     }
 280 }
 281
 282 my $fh = new FileHandle;
 283
 284 %month2num = (
 285     nil => '00',
 286     Jan => '01',
 287     Feb => '02',
 288     Mar => '03',
 289     Apr => '04',
 290     May => '05',
 291     Jun => '06',
 292     Jul => '07',
 293     Aug => '08',
 294     Sep => '09',
 295     Oct => '10',
 296     Nov => '11',
 297     Dec => '12'
 298 );
 299 @num2month = sort { $month2num{$a} <=> $month2num{$b} } keys %month2num;
 300
 301 # Use the stated preferred URL or figure it out automatically. Set
 302 # $url manually in the config section above if CGI.pm doesn't guess
 303 # the base URL correctly, e.g. when called from a Server Side Includes
 304 # document or so.
 305 unless ($url) {
 306     $url = url();
 307
 308     # Unescape %XX hex codes (from URI::Escape::uri_unescape)
 309     $url =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
 310
 311     # Support being called from inside a SSI document
 312     $url =~ s/^included:/http:/ if $ENV{SERVER_PROTOCOL} eq 'INCLUDED';
 313
 314     # Remove PATH_INFO if it is set but not removed by CGI.pm. This
 315     # seems to happen when used with Apache's Alias directive or if
 316     # called from inside a Server Side Include document. If that
 317     # doesn't help either, set $url manually in the configuration.
 318     $url =~ s/\Q$ENV{PATH_INFO}\E$// if defined $ENV{PATH_INFO};
 319
 320     # NOTE:
 321     #
 322     # There is one case where this code does more than necessary, too:
 323     # If the URL requested is e.g. http://example.org/blog/blog and
 324     # the base URL is correctly determined as http://example.org/blog
 325     # by CGI.pm, then this code will incorrectly normalize the base
 326     # URL down to http://example.org, because the same string as
 327     # PATH_INFO is part of the base URL, too. But this is such a
 328     # seldom case and can be fixed by setting $url in the config file,
 329     # too.
 330 }
 331
 332 # The only modification done to a manually set base URL is to strip
 333 # a trailing slash if present.
 334
 335 $url =~ s!/$!!;
 336
 337 # Drop ending any / from dir settings
 338 $datadir    =~ s!/$!!;
 339 $plugin_dir =~ s!/$!!;
 340 $static_dir =~ s!/$!!;
 341
 342 # Fix depth to take into account datadir's path
 343 $depth += ( $datadir =~ tr[/][] ) - 1 if $depth;
 344
 345 if (    !$ENV{GATEWAY_INTERFACE}
 346     and param('-password')
 347     and $static_password
 348     and param('-password') eq $static_password )
 349 {
 350     $static_or_dynamic = 'static';
 351 }
 352 else {
 353     $static_or_dynamic = 'dynamic';
 354     param( -name => '-quiet', -value => 1 );
 355 }
 356
 357 # Path Info Magic
 358 # Take a gander at HTTP's PATH_INFO for optional blog name, archive yr/mo/day
 359 my @path_info = split m{/}, path_info() || param('path');
 360 $path_info_full = join '/', @path_info;      # Equivalent to $ENV{PATH_INFO}
 361 shift @path_info;
 362
 363 # Flavour specified by ?flav={flav} or index.{flav}
 364 $flavour = '';
 365 if (! ($flavour = param('flav'))) {
 366     if ( $path_info[$#path_info] =~ /(.+)\.(.+)$/ ) {
 367        $flavour = $2;
 368         pop @path_info if $1 eq 'index';
 369     }
 370 }
 371 $flavour ||= $default_flavour;
 372
 373 # Fix XSS in flavour name (CVE-2008-2236)
 374 $flavour = blosxom_html_escape($flavour);
 375
 376 sub blosxom_html_escape {
 377   my $string = shift;
 378   my %escape = (
 379                 '<' => '&lt;',
 380                 '>' => '&gt;',
 381                 '&' => '&amp;',
 382                 '"' => '&quot;',
 383                 "'" => '&apos;'
 384                 );
 385   my $escape_re = join '|' => keys %escape;
 386   $string =~ s/($escape_re)/$escape{$1}/g;
 387   $string;
 388 }
 389
 390 # Global variable to be used in head/foot.{flavour} templates
 391 $path_info = '';
 392 # Add all @path_info elements to $path_info till we come to one that could be a year
 393 while ( $path_info[0] && $path_info[0] !~ /^(19|20)\d{2}$/) {
 394     $path_info .= '/' . shift @path_info;
 395 }
 396
 397 # Pull date elements out of path
 398 if ($path_info[0] && $path_info[0] =~ /^(19|20)\d{2}$/) {
 399   $path_info_yr = shift @path_info;
 400   if ($path_info[0] &&
 401      ($path_info[0] =~ /^(0\d|1[012])$/ ||
 402       exists $month2num{ ucfirst lc $path_info_mo })) {
 403     $path_info_mo = shift @path_info;
 404     # Map path_info_mo to numeric $path_info_mo_num
 405     $path_info_mo_num = $path_info_mo =~ /^\d{2}$/
 406       ? $path_info_mo
 407       : $month2num{ ucfirst lc $path_info_mo };
 408     if ($path_info[0] && $path_info[0] =~ /^[0123]\d$/) {
 409       $path_info_da = shift @path_info;
 410     }
 411   }
 412 }
 413
 414 # Add remaining path elements to $path_info
 415 $path_info .= '/' . join('/', @path_info);
 416
 417 # Strip spurious slashes
 418 $path_info =~ s!(^/*)|(/*$)!!g;
 419
 420 # Define standard template subroutine, plugin-overridable at Plugins: Template
 421 $template = sub {
 422     my ( $path, $chunk, $flavour ) = @_;
 423
 424     do {
 425         return join '', <$fh>
 426             if $fh->open("< $datadir/$path/$chunk.$flavour");
 427     } while ( $path =~ s/(\/*[^\/]*)$// and $1 );
 428
 429     # Check for definedness, since flavour can be the empty string
 430     if ( defined $template{$flavour}{$chunk} ) {
 431         return $template{$flavour}{$chunk};
 432     }
 433     elsif ( defined $template{error}{$chunk} ) {
 434         return $template{error}{$chunk};
 435     }
 436     else {
 437         return '';
 438     }
 439 };
 440
 441 # Bring in the templates
 442 %template = ();
 443 while (<DATA>) {
 444     last if /^(__END__)$/;
 445     my ( $ct, $comp, $txt ) = /^(\S+)\s(\S+)(?:\s(.*))?$/ or next;
 446     $txt =~ s/\\n/\n/mg;
 447     $template{$ct}{$comp} .= $txt . "\n";
 448 }
 449
 450 # Plugins: Start
 451 my $path_sep = $^O eq 'MSWin32' ? ';' : ':';
 452 my @plugin_dirs = split /$path_sep/, $plugin_path;
 453 unshift @plugin_dirs, $plugin_dir;
 454 my @plugin_list = ();
 455 my %plugin_hash = ();
 456
 457 # If $plugin_list is set, read plugins to use from that file
 458 if ( $plugin_list ) {
 459     if ( -r $plugin_list and $fh->open("< $plugin_list") ) {
 460         @plugin_list = map { chomp $_; $_ } grep { /\S/ && !/^#/ } <$fh>;
 461         $fh->close;
 462     }
 463     else {
 464         warn "unable to read or open plugin_list '$plugin_list': $!";
 465         $plugin_list = '';
 466     }
 467 }
 468
 469 # Otherwise walk @plugin_dirs to get list of plugins to use
 470 if ( ! @plugin_list && @plugin_dirs ) {
 471     for my $plugin_dir (@plugin_dirs) {
 472         next unless -d $plugin_dir;
 473         if ( opendir PLUGINS, $plugin_dir ) {
 474             for my $plugin (
 475                 grep { /^[\w:]+$/ && !/~$/ && -f "$plugin_dir/$_" }
 476                 readdir(PLUGINS) )
 477             {
 478
 479                 # Ignore duplicates
 480                 next if $plugin_hash{$plugin};
 481
 482                 # Add to @plugin_list and %plugin_hash
 483                 $plugin_hash{$plugin} = "$plugin_dir/$plugin";
 484                 push @plugin_list, $plugin;
 485             }
 486             closedir PLUGINS;
 487         }
 488     }
 489     @plugin_list = sort @plugin_list;
 490 }
 491
 492 # Load all plugins in @plugin_list
 493 unshift @INC, @plugin_dirs;
 494 foreach my $plugin (@plugin_list) {
 495     my ( $plugin_name, $off ) = $plugin =~ /^\d*([\w:]+?)(_?)$/;
 496     my $plugin_file = $plugin_list ? $plugin_name : $plugin;
 497     my $on_off = $off eq '_' ? -1 : 1;
 498
 499     # Allow perl module plugins
 500     # The -z test is a hack to allow a zero-length placeholder file in a
 501     #   $plugin_path directory to indicate an @INC module should be loaded
 502     if ( $plugin =~ m/::/ && ( $plugin_list || -z $plugin_hash{$plugin} ) ) {
 503
 504      # For Blosxom::Plugin::Foo style plugins, we need to use a string require
 505         eval "require $plugin_file";
 506     }
 507     else
 508     { # we try first to load from $plugin_dir before attempting from $plugin_path
 509         eval        { require "$plugin_dir/$plugin_file" }
 510             or eval { require $plugin_file };
 511     }
 512
 513     if ($@) {
 514         warn "error finding or loading blosxom plugin '$plugin_name': $@";
 515         next;
 516     }
 517     if ( $plugin_name->start() and ( $plugins{$plugin_name} = $on_off ) ) {
 518         push @plugins, $plugin_name;
 519     }
 520
 521 }
 522 shift @INC foreach @plugin_dirs;
 523
 524 # Plugins: Template
 525 # Allow for the first encountered plugin::template subroutine to override the
 526 # default built-in template subroutine
 527 foreach my $plugin (@plugins) {
 528     if ( $plugins{$plugin} > 0 and $plugin->can('template') ) {
 529         if ( my $tmp = $plugin->template() ) {
 530             $template = $tmp;
 531             last;
 532         }
 533     }
 534 }
 535
 536 # Provide backward compatibility for Blosxom < 2.0rc1 plug-ins
 537 sub load_template {
 538     return &$template(@_);
 539 }
 540
 541 # Define default entries subroutine
 542 $entries = sub {
 543     my ( %files, %indexes, %others );
 544     find(
 545         sub {
 546             my $d;
 547             my $curr_depth = $File::Find::dir =~ tr[/][];
 548             return if $depth and $curr_depth > $depth;
 549
 550             if (
 551
 552                 # a match
 553                 $File::Find::name
 554                 =~ m!^$datadir/(?:(.*)/)?(.+)\.$file_extension$!
 555
 556                 # not an index, .file, and is readable
 557                 and $2 ne 'index' and $2 !~ /^\./ and ( -r $File::Find::name )
 558                 )
 559             {
 560
 561                 # read modification time
 562                 my $mtime = stat($File::Find::name)->mtime or return;
 563
 564                 # to show or not to show future entries
 565                 return unless ( $show_future_entries or $mtime < time );
 566
 567                 # add the file and its associated mtime to the list of files
 568                 $files{$File::Find::name} = $mtime;
 569
 570                 # static rendering bits
 571                 my $static_file
 572                     = "$static_dir/$1/index." . $static_flavours[0];
 573                 if (   param('-all')
 574                     or !-f $static_file
 575                     or stat($static_file)->mtime < $mtime )
 576                 {
 577                     $indexes{$1} = 1;
 578                     $d = join( '/', ( nice_date($mtime) )[ 5, 2, 3 ] );
 579                     $indexes{$d} = $d;
 580                     $indexes{ ( $1 ? "$1/" : '' ) . "$2.$file_extension" } = 1
 581                         if $static_entries;
 582                 }
 583             }
 584
 585             # not an entries match
 586             elsif ( !-d $File::Find::name and -r $File::Find::name ) {
 587                 $others{$File::Find::name} = stat($File::Find::name)->mtime;
 588             }
 589         },
 590         $datadir
 591     );
 592
 593     return ( \%files, \%indexes, \%others );
 594 };
 595
 596 # Plugins: Entries
 597 # Allow for the first encountered plugin::entries subroutine to override the
 598 # default built-in entries subroutine
 599 foreach my $plugin (@plugins) {
 600     if ( $plugins{$plugin} > 0 and $plugin->can('entries') ) {
 601         if ( my $tmp = $plugin->entries() ) {
 602             $entries = $tmp;
 603             last;
 604         }
 605     }
 606 }
 607
 608 my ( $files, $indexes, $others ) = &$entries();
 609 %indexes = %$indexes;
 610
 611 # Static
 612 if (    !$ENV{GATEWAY_INTERFACE}
 613     and param('-password')
 614     and $static_password
 615     and param('-password') eq $static_password )
 616 {
 617
 618     param('-quiet') or print "Blosxom is generating static index pages...\n";
 619
 620     # Home Page and Directory Indexes
 621     my %done;
 622     foreach my $path ( sort keys %indexes ) {
 623         my $p = '';
 624         foreach ( ( '', split /\//, $path ) ) {
 625             $p .= "/$_";
 626             $p =~ s!^/!!;
 627             next if $done{$p}++;
 628             mkdir "$static_dir/$p", 0755
 629                 unless ( -d "$static_dir/$p" or $p =~ /\.$file_extension$/ );
 630             foreach $flavour (@static_flavours) {
 631                 $content_type
 632                     = ( &$template( $p, 'content_type', $flavour ) );
 633                 $content_type =~ s!\n.*!!s;
 634                 my $fn = $p =~ m!^(.+)\.$file_extension$! ? $1 : "$p/index";
 635                 param('-quiet') or print "$fn.$flavour\n";
 636                 my $fh_w = new FileHandle "> $static_dir/$fn.$flavour"
 637                     or die "Couldn't open $static_dir/$p for writing: $!";
 638                 $output = '';
 639                 if ( $indexes{$path} == 1 ) {
 640
 641                     # category
 642                     $path_info = $p;
 643
 644                     # individual story
 645                     $path_info =~ s!\.$file_extension$!\.$flavour!;
 646                     print $fh_w &generate( 'static', $path_info, '', $flavour,
 647                         $content_type );
 648                 }
 649                 else {
 650
 651                     # date
 652                     local (
 653                         $path_info_yr, $path_info_mo,
 654                         $path_info_da, $path_info
 655                     ) = split /\//, $p, 4;
 656                     unless ( defined $path_info ) { $path_info = "" }
 657                     print $fh_w &generate( 'static', '', $p, $flavour,
 658                         $content_type );
 659                 }
 660                 $fh_w->close;
 661             }
 662         }
 663     }
 664 }
 665
 666 # Dynamic
 667 else {
 668     $content_type = ( &$template( $path_info, 'content_type', $flavour ) );
 669     $content_type =~ s!\n.*!!s;
 670
 671     $content_type =~ s/(\$\w+(?:::\w+)*)/"defined $1 ? $1 : ''"/gee;
 672     $header = { -type => $content_type };
 673
 674     print generate( 'dynamic', $path_info,
 675         "$path_info_yr/$path_info_mo_num/$path_info_da",
 676         $flavour, $content_type );
 677 }
 678
 679 # Plugins: End
 680 foreach my $plugin (@plugins) {
 681     if ( $plugins{$plugin} > 0 and $plugin->can('end') ) {
 682         $entries = $plugin->end();
 683     }
 684 }
 685
 686 # Generate
 687 sub generate {
 688     my ( $static_or_dynamic, $currentdir, $date, $flavour, $content_type )
 689         = @_;
 690
 691     %files = %$files;
 692     %others = ref $others ? %$others : ();
 693
 694     # Plugins: Filter
 695     foreach my $plugin (@plugins) {
 696         if ( $plugins{$plugin} > 0 and $plugin->can('filter') ) {
 697             $entries = $plugin->filter( \%files, \%others );
 698         }
 699     }
 700
 701     my %f = %files;
 702
 703     # Plugins: Skip
 704     # Allow plugins to decide if we can cut short story generation
 705     my $skip;
 706     foreach my $plugin (@plugins) {
 707         if ( $plugins{$plugin} > 0 and $plugin->can('skip') ) {
 708             if ( my $tmp = $plugin->skip() ) {
 709                 $skip = $tmp;
 710                 last;
 711             }
 712         }
 713     }
 714
 715     # Define default interpolation subroutine
 716     $interpolate = sub {
 717         package blosxom;
 718         my $template = shift;
 719         # Interpolate scalars, namespaced scalars, and hash/hashref scalars
 720         $template =~ s/(\$\w+(?:::\w+)*(?:(?:->)?{([\'\"]?)[-\w]+\2})?)/"defined $1 ? $1 : ''"/gee;
 721         return $template;
 722     };
 723
 724     unless ( defined($skip) and $skip ) {
 725
 726         # Plugins: Interpolate
 727         # Allow for the first encountered plugin::interpolate subroutine to
 728         # override the default built-in interpolate subroutine
 729         foreach my $plugin (@plugins) {
 730             if ( $plugins{$plugin} > 0 and $plugin->can('interpolate') ) {
 731                 if ( my $tmp = $plugin->interpolate() ) {
 732                     $interpolate = $tmp;
 733                     last;
 734                 }
 735             }
 736         }
 737
 738         # Head
 739         my $head = ( &$template( $currentdir, 'head', $flavour ) );
 740
 741         # Plugins: Head
 742         foreach my $plugin (@plugins) {
 743             if ( $plugins{$plugin} > 0 and $plugin->can('head') ) {
 744                 $entries = $plugin->head( $currentdir, \$head );
 745             }
 746         }
 747
 748         $head = &$interpolate($head);
 749
 750         $output .= $head;
 751
 752         # Stories
 753         my $curdate = '';
 754         my $ne      = $num_entries;
 755
 756         if ( $currentdir =~ /(.*?)([^\/]+)\.(.+)$/ and $2 ne 'index' ) {
 757             $currentdir = "$1$2.$file_extension";
 758             %f = ( "$datadir/$currentdir" => $files{"$datadir/$currentdir"} )
 759                 if $files{"$datadir/$currentdir"};
 760         }
 761         else {
 762             $currentdir =~ s!/index\..+$!!;
 763         }
 764
 765         # Define a default sort subroutine
 766         my $sort = sub {
 767             my ($files_ref) = @_;
 768             return
 769                 sort { $files_ref->{$b} <=> $files_ref->{$a} }
 770                 keys %$files_ref;
 771         };
 772
 773      # Plugins: Sort
 774      # Allow for the first encountered plugin::sort subroutine to override the
 775      # default built-in sort subroutine
 776         foreach my $plugin (@plugins) {
 777             if ( $plugins{$plugin} > 0 and $plugin->can('sort') ) {
 778                 if ( my $tmp = $plugin->sort() ) {
 779                     $sort = $tmp;
 780                     last;
 781                 }
 782             }
 783         }
 784
 785         foreach my $path_file ( &$sort( \%f, \%others ) ) {
 786             last if $ne <= 0 && $date !~ /\d/;
 787             use vars qw/ $path $fn /;
 788             ( $path, $fn )
 789                 = $path_file =~ m!^$datadir/(?:(.*)/)?(.*)\.$file_extension!;
 790
 791             # Only stories in the right hierarchy
 792             $path =~ /^$currentdir/
 793                 or $path_file eq "$datadir/$currentdir"
 794                 or next;
 795
 796             # Prepend a slash for use in templates only if a path exists
 797             $path &&= "/$path";
 798
 799             # Date fiddling for by-{year,month,day} archive views
 800             use vars
 801                 qw/ $dw $mo $mo_num $da $ti $yr $hr $min $hr12 $ampm $utc_offset/;
 802             ( $dw, $mo, $mo_num, $da, $ti, $yr, $utc_offset )
 803                 = nice_date( $files{"$path_file"} );
 804             ( $hr, $min ) = split /:/, $ti;
 805             ( $hr12, $ampm ) = $hr >= 12 ? ( $hr - 12, 'pm' ) : ( $hr, 'am' );
 806             $hr12 =~ s/^0//;
 807             if ( $hr12 == 0 ) { $hr12 = 12 }
 808
 809             # Only stories from the right date
 810             my ( $path_info_yr, $path_info_mo_num, $path_info_da )
 811                 = split /\//, $date;
 812             next if $path_info_yr     && $yr != $path_info_yr;
 813             last if $path_info_yr     && $yr < $path_info_yr;
 814             next if $path_info_mo_num && $mo ne $num2month[$path_info_mo_num];
 815             next if $path_info_da     && $da != $path_info_da;
 816             last if $path_info_da     && $da < $path_info_da;
 817
 818             # Date
 819             my $date = ( &$template( $path, 'date', $flavour ) );
 820
 821             # Plugins: Date
 822             foreach my $plugin (@plugins) {
 823                 if ( $plugins{$plugin} > 0 and $plugin->can('date') ) {
 824                     $entries
 825                         = $plugin->date( $currentdir, \$date,
 826                         $files{$path_file}, $dw, $mo, $mo_num, $da, $ti,
 827                         $yr );
 828                 }
 829             }
 830
 831             $date = &$interpolate($date);
 832
 833             if ( $date && $curdate ne $date ) {
 834                 $curdate = $date;
 835                 $output .= $date;
 836             }
 837
 838             use vars qw/ $title $body $raw /;
 839             if ( -f "$path_file" && $fh->open("< $path_file") ) {
 840                 chomp( $title = <$fh> );
 841                 chomp( $body = join '', <$fh> );
 842                 $fh->close;
 843                 $raw = "$title\n$body";
 844             }
 845             my $story = ( &$template( $path, 'story', $flavour ) );
 846
 847             # Plugins: Story
 848             foreach my $plugin (@plugins) {
 849                 if ( $plugins{$plugin} > 0 and $plugin->can('story') ) {
 850                     $entries = $plugin->story( $path, $fn, \$story, \$title,
 851                         \$body );
 852                 }
 853             }
 854
 855             if ( $encode_xml_entities &&
 856                  $content_type =~ m{\bxml\b} &&
 857                  $content_type !~ m{\bxhtml\b} ) {
 858                 # Escape special characters inside the <link> container
 859
 860                 # The following line should be moved more towards to top for
 861                 # performance reasons -- Axel Beckert, 2008-07-22
 862                 my $url_escape_re = qr([^-/a-zA-Z0-9:._]);
 863
 864                 $url   =~ s($url_escape_re)(sprintf('%%%02X', ord($&)))eg;
 865                 $path  =~ s($url_escape_re)(sprintf('%%%02X', ord($&)))eg;
 866                 $fn    =~ s($url_escape_re)(sprintf('%%%02X', ord($&)))eg;
 867
 868                 # Escape <, >, and &, and to produce valid RSS
 869                 $title = blosxom_html_escape($title);
 870                 $body  = blosxom_html_escape($body);
 871                 $url   = blosxom_html_escape($url);
 872                 $path  = blosxom_html_escape($path);
 873                 $fn    = blosxom_html_escape($fn);
 874             }
 875
 876             if ($encode_8bit_chars) {
 877                 $url   =~ s([^-a-zA-Z0-9_./:])(sprintf('%%%02X', ord($&)))ge;
 878                 $path  =~ s([^-a-zA-Z0-9_./:])(sprintf('%%%02X', ord($&)))ge;
 879                 $fn    =~ s([^-a-zA-Z0-9_./:])(sprintf('%%%02X', ord($&)))ge;
 880             }
 881
 882             $story = &$interpolate($story);
 883
 884             $output .= $story;
 885             $fh->close;
 886
 887             $ne--;
 888         }
 889
 890         # Foot
 891         my $foot = ( &$template( $currentdir, 'foot', $flavour ) );
 892
 893         # Plugins: Foot
 894         foreach my $plugin (@plugins) {
 895             if ( $plugins{$plugin} > 0 and $plugin->can('foot') ) {
 896                 $entries = $plugin->foot( $currentdir, \$foot );
 897             }
 898         }
 899
 900         $foot = &$interpolate($foot);
 901         $output .= $foot;
 902
 903         # Plugins: Last
 904         foreach my $plugin (@plugins) {
 905             if ( $plugins{$plugin} > 0 and $plugin->can('last') ) {
 906                 $entries = $plugin->last();
 907             }
 908         }
 909
 910     }    # End skip
 911
 912     # Finally, add the header, if any and running dynamically
 913     $output = header($header) . $output
 914         if ( $static_or_dynamic eq 'dynamic' and $header );
 915
 916     $output;
 917 }
 918
 919 sub nice_date {
 920     my ($unixtime) = @_;
 921
 922     my $c_time = CORE::localtime($unixtime);
 923     my ( $dw, $mo, $da, $hr, $min, $sec, $yr )
 924         = ( $c_time
 925             =~ /(\w{3}) +(\w{3}) +(\d{1,2}) +(\d{2}):(\d{2}):(\d{2}) +(\d{4})$/
 926         );
 927     $ti = "$hr:$min";
 928     $da = sprintf( "%02d", $da );
 929     my $mo_num = $month2num{$mo};
 930
 931     my $offset
 932         = timegm( $sec, $min, $hr, $da, $mo_num - 1, $yr - 1900 ) - $unixtime;
 933     my $utc_offset = sprintf( "%+03d", int( $offset / 3600 ) )
 934         . sprintf( "%02d", ( $offset % 3600 ) / 60 );
 935
 936     return ( $dw, $mo, $mo_num, $da, $ti, $yr, $utc_offset );
 937 }
 938
 939 # Default HTML and RSS template bits
 940 __DATA__
 941 html content_type text/html; charset=$blog_encoding
 942
 943 html head <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
 944 html head <html>
 945 html head     <head>
 946 html head         <meta http-equiv="content-type" content="$content_type" >
 947 html head         <link rel="alternate" type="application/rss+xml" title="RSS" href="$url/index.rss" >
 948 html head         <title>$blog_title $path_info_da $path_info_mo $path_info_yr</title>
 949 html head     </head>
 950 html head     <body>
 951 html head         <div align="center">
 952 html head             <h1>$blog_title</h1>
 953 html head             <p>$path_info_da $path_info_mo $path_info_yr</p>
 954 html head         </div>
 955
 956 html story         <div>
 957 html story             <h3><a name="$fn">$title</a></h3>
 958 html story             <div>$body</div>
 959 html story             <p>posted at: $ti | path: <a href="$url$path">$path</a> | <a href="$url/$yr/$mo_num/$da#$fn">permanent link to this entry</a></p>
 960 html story         </div>
 961
 962 html date         <h2>$dw, $da $mo $yr</h2>
 963
 964 html foot
 965 html foot         <div align="center">
 966 html foot             <a href="http://blosxom.sourceforge.net/"><img src="http://blosxom.sourceforge.net/images/pb_blosxom.gif" alt="powered by blosxom" border="0" width="90" height="33" ></a>
 967 html foot         </div>
 968 html foot     </body>
 969 html foot </html>
 970
 971 rss content_type text/xml; charset=$blog_encoding
 972
 973 rss head <?xml version="1.0" encoding="$blog_encoding"?>
 974 rss head <rss version="2.0">
 975 rss head   <channel>
 976 rss head     <title>$blog_title</title>
 977 rss head     <link>$url/$path_info</link>
 978 rss head     <description>$blog_description</description>
 979 rss head     <language>$blog_language</language>
 980 rss head     <docs>http://blogs.law.harvard.edu/tech/rss</docs>
 981 rss head     <generator>blosxom/$version</generator>
 982
 983 rss story   <item>
 984 rss story     <title>$title</title>
 985 rss story     <pubDate>$dw, $da $mo $yr $ti:00 $utc_offset</pubDate>
 986 rss story     <link>$url/$yr/$mo_num/$da#$fn</link>
 987 rss story     <category>$path</category>
 988 rss story     <guid isPermaLink="false">$url$path/$fn</guid>
 989 rss story     <description>$body</description>
 990 rss story   </item>
 991
 992 rss date
 993
 994 rss foot   </channel>
 995 rss foot </rss>
 996
 997 error content_type text/html
 998
 999 error head <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
1000 error head <html>
1001 error head <head><title>Error: unknown Blosxom flavour "$flavour"</title></head>
1002 error head     <body>
1003 error head         <h1><font color="red">Error: unknown Blosxom flavour "$flavour"</font></h1>
1004 error head         <p>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.</p>
1005
1006 error story        <h3>$title</h3>
1007 error story        <div>$body</div> <p><a href="$url/$yr/$mo_num/$da#fn.$default_flavour">#</a></p>
1008
1009 error date         <h2>$dw, $da $mo $yr</h2>
1010
1011 error foot     </body>
1012 error foot </html>
1013 __END__
1014