blosxom.cgi

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