root/lang/perl/blosxom/blosxom.nyarla.cgi @ 7286

Revision 7286, 18.6 kB (checked in by nyarla, 5 years ago)

lang/perl/blosxom/blosxom.nyarla.cgi: Added my blosxom script.

Line 
1#!/usr/bin/perl
2
3# Blosxom
4# Author: Rael Dornfest <rael@oreilly.com>
5# Version: 2.0.2
6# Home/Docs/Licensing: http://www.blosxom.com/
7# Development/Downloads: http://sourceforge.net/projects/blosxom
8
9package blosxom;
10
11use strict;
12use warnings;
13
14our $version = '2.0.2';
15
16# -- require modules ----------------- #
17
18use FileHandle;
19use DirHandle;
20use FindBin ();
21use File::Find;
22use File::stat;
23use Time::localtime;
24use CGI qw( :standard :netscape );
25
26# -- package variables --------------- #
27
28our (
29    # weblog
30    $blog_title, $blog_description, $blog_language, $url,
31    # entries                               # flavour
32    $datadir, $depth, $file_extension,      $flavour_dir, $default_flavour,
33    # view                                  # plugins
34    $num_entries, $show_future_entries,     $plugin_dir, $plugin_state_dir,
35    # request
36    $path_info, $path_info_yr, $path_info_mo, $path_info_mo_num, $path_info_da, $flavour,
37    # response              # system
38    $output, $header,       %template, @plugins, %plugins, %files, %indexes, %others,
39    # variables             # subroutines
40    %month2num, @num2month, $template, $interpolate, $entries,
41    # static
42    $static_or_dynamic, $static_dir, $static_password, @static_flavours, $static_entries,
43);
44
45my $fh = FileHandle->new;
46
47%month2num = (  nil => '00', Jan => '01', Feb => '02', Mar => '03',
48                Apr => '04', May => '05', Jun => '06', Jul => '07',
49                Aug => '08', Sep => '09', Oct => '10', Nov => '11', Dec => '12' );
50@num2month = sort { $month2num{$a} <=> $month2num{$b} } keys %month2num;
51
52# ------------------------------------ #
53
54# load configuration file
55{
56    my $file = env_value('config') || "$FindBin::Bin/config.pl";
57    eval { require $file };
58    die "Failed to load configuration file: $file: $@" if ( $@ );
59}
60
61# Use the stated preferred URL or figure it out automatically
62$url ||= url( -path_info => 1 );
63$url =~ s{^include:}{http:} if ( ( $ENV{'SERVER_PROTOCOL'} || q{} ) eq 'INCLUDED' );
64
65# NOTE: Since v3.12, it looks as if CGI.pm misbehaves for SSIs and
66# always appends path_info to the url. To fix this, we always
67# request an url with path_info, and always remove it from the end of the
68# string.
69{
70    my $path_info = ( $ENV{'PATH_INFO'} || q{} );
71    my $len = length $path_info;
72    my $frag = substr( $url, -$len );
73    substr( $url, -$len ) = q{} if ( $frag eq $path_info );
74}
75
76$url =~ s!/$!!;
77
78# Drop ending any / from dir settings
79for ( $datadir, $flavour_dir, $plugin_dir, $static_dir ) {
80    $_ =~ s{/$}{};
81}
82 
83# Fix depth to take into account datadir's path
84$depth += ( $datadir =~ tr{/}{} ) -1 if ( $depth );
85
86# Global variable to be used in head/foot.{flavour} templates
87$path_info = q{};
88
89$static_or_dynamic = (  !$ENV{'GATEWAY_INTERFACE'}
90                        && param('-password')
91                        && $static_password
92                        && param('-password') eq $static_password )
93                   ? 'static'
94                   : 'dynamic'
95                   ;
96param( -name => "-quiet", -value => 1 ) if ( $static_or_dynamic eq 'dynamic' );
97# Path Info Magic
98# Take a gander at HTTP's PATH_INFO for optional blog name, archive yr/mo/day
99my @path_info = split m{/+}, path_info() || param('path') || q{};
100shift @path_info;
101
102while ( $path_info[0] && $path_info[0] =~ /^[a-zA-Z].*$/ && $path_info[0] !~ /^.*\..*$/) {
103    $path_info .= '/' . shift @path_info;
104}
105
106# Flavour specified by ?flav={flav} or index.{flav}
107$flavour = q{};
108
109if ( $path_info[$#path_info] && $path_info[$#path_info] =~ /^(.+)\.(.+?)$/ ) {
110    $flavour = $2;
111    $path_info .= "/$1.$2" if ( $1 ne 'index' );
112    pop @path_info;
113}
114elsif ( ! -d "${datadir}${path_info}" ) {
115    $path_info .= ".${default_flavour}";
116    $flavour    = param('flav') || $default_flavour;
117}
118else {
119    $flavour = param('flav') || $default_flavour;
120}
121
122# Strip spurious slashes
123$path_info =~ s{^/*|/*$}{}g;
124
125# Date fiddling
126( $path_info_yr, $path_info_mo, $path_info_da ) = @path_info;
127$path_info_mo_num = ( $path_info_mo )
128                  ? ( ( $path_info_mo =~ /\d{2}/ )
129                      ? $path_info_mo
130                      : ($month2num{ucfirst(lc $path_info_mo)} || undef) )
131                  : undef ;
132
133$path_info_yr       ||= q{};
134$path_info_mo_num   ||= q{};
135$path_info_da       ||= q{};
136
137# Define standard template subroutine, plugin-overridable at Plugins: Template
138$template = sub {
139    my ( $path, $chunk, $flavour ) = @_;
140    my $dir = $flavour_dir || $datadir;
141    do {
142        if ( $fh->open("${dir}/${path}/${chunk}.${flavour}", '<') ) {
143            my $file = do { local $/; <$fh> };
144            $fh->close;
145            return $file;
146        }
147    }
148    while ( $path =~ s{(/*[^/]*)$}{} && $1 );
149
150    # Check for definedness, since flavour can be the empty string
151    if ( defined $template{$flavour}{$chunk} ) {
152        return $template{$flavour}{$chunk};
153    }
154    elsif ( defined $template{'error'}{$chunk} ) {
155        return $template{error}{$chunk}
156    }
157    else {
158        return q{};
159    }
160};
161# Bring in the templates
162%template = ();
163while (<DATA>) {
164    last if ( $_ =~ m{^__END__$} );
165    my ( $flav, $chunk, $text ) = ( $_ =~ m{^(\S+)\s(\S+)(?:\s(.*))?$} ) or next;
166    $text =~ s{\\n}{\n}mg;
167    $template{$flav}{$chunk} .= "${text}\n";
168}
169
170# Plugins: Start
171if ( $plugin_dir && defined( my $dh = DirHandle->new( $plugin_dir ) ) ) {
172    for my $plugin ( grep { $_ =~ m{^\w+$} && -f "${plugin_dir}/${_}" } sort $dh->read ) {
173        next if ( $plugin =~ m{~$} ); # Ignore emacs backups
174        my ( $name, $off ) = ( $plugin =~ m{^\d*(\w+?)(_?)$} );
175        my $on_off = ( $off eq '_' ) ? -1 : 1 ;
176        require "${plugin_dir}/$plugin";
177        if ( $name->start() ) {
178            $plugins{$name} = $on_off;
179            push @plugins, $name;
180        }
181    }
182    $dh->close;
183}
184# Plugins: Template
185# Allow for the first encountered plugin::template subroutine to override the
186# default built-in template subroutine
187overwrite_sub('template');
188
189# Provide backward compatibility for Blosxom < 2.0rc1 plug-ins
190sub load_template { $template->( @_ ) }
191
192# Define default entries subroutine
193$entries = sub {
194    my ( %files, $indexes, %others ) = @_;
195    find(
196        sub {
197            my $currnet = $File::Find::dir =~ tr{/}{};
198            return if ( $depth && $currnet > $depth );
199
200            my $name = $File::Find::name;
201
202            return if ( -d $name );
203            return if ( ! -r $name );
204
205            my $time  = time;
206            my $mtime = stat($name)->mtime;
207
208            my ( $path, $fn )
209                = ( $name =~ m{^$datadir/(?:(.*)/)?(.+)\.$file_extension$} );
210
211            if ( ! $fn && $fn eq 'index' || $fn =~ m{\.} ) {
212                $others{$name} = $mtime;
213                return;
214            }
215
216            return if ( ! $show_future_entries && $mtime > $time );
217            $files{$name} = $mtime;
218
219            my $check = "${static_dir}/${path}/index.$static_flavours[0]";
220            if ( param('-all') || ! -f $check || stat($check)->mtime < $mtime ) {
221                $indexes{$path} = 1;
222                my $dir = join q{/}, (nice_date($mtime))[5,2,3];
223                $indexes{$dir} = $dir;
224                $indexes{( $path ? '${path}/' : '' )."${fn}.${file_extension}"} = 1
225                    if ( $static_entries );
226            }
227
228        },
229        $datadir,
230    );
231
232    return ( \%files, \%others, \%indexes );
233};
234
235# Plugins: Entries
236# Allow for the first encountered plugin::entries subroutine to override the
237# default built-in entries subroutine
238overwrite_sub('entries');
239
240my ( $files, $indexes, $others ) = $entries->();
241%indexes = %{ $indexes };
242
243# Static
244if ( $static_or_dynamic eq 'static' ) {
245    print "Blosxom is generating static index pages...\n" if ( ! param('-quiet') );
246
247    # Home Page and Directory Indexes
248    my %done;
249    for my $item ( sort keys %indexes ) {
250        my $path = q{};
251        for ( '', split m{/+}, $item ) {
252            $path .= "/$_";
253            $path =~ s{^/}{};
254            $done{$path}++ and next;
255            if ( ! -d "${static_dir}/${path}" && $path !~ m{\.$file_extension$} ) {
256                mkdir "${static_dir}/${path}", 0755;
257            }
258            for $flavour ( @static_flavours ) {
259                my $content_type = $template->( $path, 'content_type', $flavour );
260                   $content_type =~ s{\n.*}{}s;
261                my $fn = ( $path =~ m{^(.+)\.$file_extension} ) ? $1 : "${path}/index" ;
262                print "${fn}.${flavour}\n" if ( ! param('-quiet') );
263                $fh->open( "${static_dir}/${fn}.${flavour}", '>' )
264                    or die "Couldn't open ${static_dir}/${path} for writing: $!";
265                $output = q{};
266                # dir, entry
267                if ( $indexes{$path} == 1 ) {
268                    $path_info = $path;
269                    $path_info =~ s{\.$file_extension}{.$flavour};
270                    print $fh &generate('static', $path_info, '', $flavour, $content_type);
271                }
272                # date
273                else {
274                    local ( $path_info_yr, $path_info_mo, $path_info_da, $path_info )
275                        = split m{/+}, $path, 4;
276                    $path_info = q{} if ( ! defined $path_info );
277                    print $fh &generate('static', '', $path, $flavour, $content_type );
278                }
279                $fh->close;
280            }
281        }
282    }
283}
284# Dynamic
285else {
286    my $content_type = $template->( $path_info, 'content_type', $flavour );
287       $content_type =~ s{\n.*}{}s;
288
289    $header = { -type => $content_type };
290
291    print generate('dynamic', $path_info, "$path_info_yr/$path_info_mo_num/$path_info_da", $flavour, $content_type);
292}
293
294# Plugins: End
295run_plugins('end');
296
297# Generate
298sub generate {
299    my ( $static_or_dynamic, $currentdir, $date, $flavour, $content_type ) = @_;
300
301    %files = %{ $files };
302    %others = ref $others ? %{ $others } : ();
303
304    # Plugins: Filter
305    run_plugins( filter => \%files, \%others );
306
307    my %f = %files;
308
309    # Plugins: Skip
310    # Allow plugins to decide if we can cut short story generation
311    my $skip;
312    if ( defined( my $flag = run_plugins_first('skip') ) ) {
313        $skip = $flag;
314    }
315
316    # Define default interpolation subroutine
317    $interpolate = sub {
318        package blosxom;
319        my $tmpl = shift;
320        $tmpl =~ s{(\$\w+(?:::)?\w*)}{"defined $1 ? $1 : ''"}gee;
321        return $tmpl;
322    };
323
324    if ( ! defined $skip || ! $skip ) {
325        # Plugins: Interpolate
326        # Allow for the first encountered plugin::interpolate subroutine to
327        # override the default built-in interpolate subroutine
328        overwrite_sub('interpolate');
329
330        # Head
331        my $head = $template->( $currentdir, 'head', $flavour ); 
332        # Plugins: Head
333        run_plugins( head => $currentdir, \$head );
334        $head = $interpolate->($head);
335        $output .= $head;
336       
337        # Stories
338        my $curdate = q{};
339        my $ne      = $num_entries;
340        if ( $currentdir =~ m{(.*?)([^/]+)\.(.+)$} && $2 ne 'index' ) {
341            $currentdir = "$1$2.$file_extension";
342            my $fullpath = "${datadir}/${currentdir}";
343            %f = ( $fullpath => $files{$fullpath} ) if ( $files{$fullpath} );
344        }
345        else {
346            $currentdir =~ s{/index\..+$}{};
347        }
348
349        # Define a default sort subroutine
350        my $sort = sub {
351            my ( $files_ref ) = @_;
352            return sort { $files_ref->{$b} <=> $files_ref->{$a} } keys %{ $files_ref };
353        };
354        # Plugins: Sort
355        # Allow for the first encountered plugin::sort subroutine to override the
356        # default built-in sort subroutine
357        if ( defined( my $sub = run_plugins_first('sort') ) ) {
358            $sort = $sub;
359        }
360
361        for my $path_file ( $sort->( \%f, \%others ) ) {
362            last if ( $ne <= 0 && $date !~ /\d/ );
363            use vars qw( $path $fn );
364            ( $path, $fn )
365                = ( $path_file =~ m{^$datadir/(?:(.*)/)?(.*)\.$file_extension} );
366            # Only stories in the right hierarchy
367            if ( $path !~ m{^$currentdir} && $path_file ne "${datadir}/${currentdir}" ) {
368                next;
369            }
370           
371            # Prepend a slash for use in templates only if a path exists
372            $path &&= "/$path";
373
374            # Date fiddling for by-{year,month,day} archive views
375            use vars qw/ $dw $mo $mo_num $da $ti $yr $hr $min $hr12 $ampm /;
376            ( $dw, $mo, $mo_num, $da, $ti, $yr ) = nice_date( $files{"$path_file"} );
377            ( $hr, $min) = split m{:}, $ti;
378            ( $hr12, $ampm ) = ( $hr >= 12 ) ? ( $hr - 12,'pm' ) : ( $hr, 'am' ) ;
379            $hr12 =~ s{^0}{};
380            $hr12 = 12 if ( $hr12 == 0 );
381
382            # Only stories from the right date
383            my ( $path_info_yr, $path_info_mo_num, $path_info_da ) = split m{/+}, $date;
384            next if ( $path_info_yr && $yr != $path_info_yr );
385            last if ( $path_info_yr && $yr < $path_info_yr );
386            next if ( $path_info_mo_num && $mo ne $num2month[$path_info_mo_num] );
387            next if ( $path_info_da && $da != $path_info_da );
388            last if ( $path_info_da && $da < $path_info_da );
389
390            # Date
391            my $date = $template->( $path, 'date', $flavour );
392
393            # Plugins: Date
394            run_plugins( date => $currentdir, \$date, $files{$path_file}, $dw, $mo, $mo_num, $da, $ti, $yr );
395            $date = $interpolate->($date);
396
397            if ( $curdate ne $date ) {
398                $curdate = $date;
399                $output .= $date;
400            }
401
402            use vars qw( $title $body $raw );
403            if ( -f $path_file && $fh->open( $path_file, '<' ) ) {
404                chomp( $title   = <$fh> );
405                chomp( $body    = do { local $/; <$fh> } );
406                $fh->close;
407                $raw = "${title}\n{$body}";
408            }
409            my $story = $template->( $path, 'story', $flavour );
410
411            # Plugins: Story
412            run_plugins( story => $path, $fn, \$story, \$title, \$body );
413
414            if ( $content_type =~ m{\bxml\b} ) {
415                # Escape <, >, and &, and to produce valid RSS
416                my %escape = (
417                    '<' => '&lt;',
418                    '>' => '&gt;',
419                    '&' => '&amp;',
420                    '"' => '&quote;',
421                    "'" => '&apos;',
422                );
423                my $escape_re = join '|', keys %escape;
424                for ( $title, $body ) {
425                    $_ =~ s{($escape_re)}{$escape{$1}}g;
426                }
427            }
428
429            $story   = $interpolate->( $story );
430            $output .= $story;
431            $ne--;
432        }
433 
434        # Foot
435        my $foot = $template->( $currentdir, 'foot', $flavour );
436 
437        # Plugins: Foot
438        run_plugins( foot => $currentdir, \$foot );
439        $foot    = $interpolate->( $foot );
440        $output .= $foot;
441
442        # Plugins: Last
443        run_plugins('last');
444    }# End skip
445
446    # Finally, add the header, if any and running dynamically
447    $output = header( $header ) . $output
448        if ( $static_or_dynamic eq 'dynamic' && $header );
449    return $output;
450}
451
452sub run_plugins {
453    my ( $method, @args ) = @_;
454
455    for my $plugin ( @plugins ) {
456        if ( $plugins{$plugin} > 0 && $plugin->can($method) ) {
457            $entries = $plugin->$method( @args );
458        }
459    }
460}
461
462sub run_plugins_first {
463    my ( $method, @args ) = @_;
464
465    for my $plugin ( @plugins ) {
466        if (    $plugins{$plugin} > 0
467                && $plugin->can($method)
468                && defined( my $ret = $plugin->$method( @args ) )   ) {
469            return $ret;
470        }
471    }
472
473    return;
474}
475
476sub overwrite_sub {
477    my ( $method, @args ) = @_;
478
479    if ( defined( my $sub = run_plugins_first( $method => @args ) ) ) {
480        die "Return value of plugin is not CODE reference: method:$method"
481            if ( ref $sub ne 'CODE' );
482        no strict 'refs';
483        ${"${method}"} = $sub;
484    }
485}
486
487sub nice_date {
488    my ( $unixtime ) = @_;
489
490    my $ctime = ctime($unixtime);
491    my ( $dw, $mo, $da, $ti, $yr )
492        = ( $ctime =~ m{(\w{3})[ ]+(\w{3})[ ]+(\d{1,2})[ ]+(\d{2}:\d{2}):\d{2}[ ]+(\d{4})$} );
493    $da = sprintf('%02d', $da);
494    my $mo_num = $month2num{$mo};
495
496    return ( $dw, $mo, $mo_num, $da, $ti, $yr );
497}
498
499sub env_value {
500    my $prefix = uc __PACKAGE__;
501    my $key    = uc( shift @_ );
502
503    my $env = "${prefix}_${key}";
504
505    if ( exists $ENV{$env} ) {
506        return $ENV{$env};
507    }
508    return;
509}
510
511# Default HTML and RSS template bits
512__DATA__
513html content_type text/html
514
515html head <html>
516html head     <head>
517html head         <link rel="alternate" type="type="application/rss+xml" title="RSS" href="$url/index.rss" />
518html head         <title>$blog_title $path_info_da $path_info_mo $path_info_yr
519html head         </title>
520html head     </head>
521html head     <body>
522html head         <center>
523html head             <font size="+3">$blog_title</font><br />
524html head             $path_info_da $path_info_mo $path_info_yr
525html head         </center>
526html head         <p />
527
528html story        <p>
529html story            <a name="$fn"><b>$title</b></a><br />
530html story            $body<br />
531html story            <br />
532html 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>
533html story        </p>
534
535html date         <h3>$dw, $da $mo $yr</h3>
536
537html foot
538html foot         <p />
539html foot         <center>
540html foot             <a href="http://www.blosxom.com/"><img src="http://www.blosxom.com/images/pb_blosxom.gif" border="0" /></a>
541html foot         </center>
542html foot     </body>
543html foot </html>
544
545rss content_type text/xml
546
547rss head <?xml version="1.0"?>
548rss head <!-- name="generator" content="blosxom/$version" -->
549rss head <!DOCTYPE rss PUBLIC "-//Netscape Communications//DTD RSS 0.91//EN" "http://my.netscape.com/publish/formats/rss-0.91.dtd">
550rss head
551rss head <rss version="0.91">
552rss head   <channel>
553rss head     <title>$blog_title $path_info_da $path_info_mo $path_info_yr</title>
554rss head     <link>$url</link>
555rss head     <description>$blog_description</description>
556rss head     <language>$blog_language</language>
557
558rss story   <item>
559rss story     <title>$title</title>
560rss story     <link>$url/$yr/$mo_num/$da#$fn</link>
561rss story     <description>$body</description>
562rss story   </item>
563
564rss date
565
566rss foot   </channel>
567rss foot </rss>
568
569error content_type text/html
570
571error head <html>
572error head <body>
573error 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>
574
575
576error story <p><b>$title</b><br />
577error story $body <a href="$url/$yr/$mo_num/$da#fn.$default_flavour">#</a></p>
578
579error date <h3>$dw, $da $mo $yr</h3>
580
581error foot     </body>
582error foot </html>
583__END__
584
585=head1 AUTHOR
586
587Original script by Rael Dornfest
588
589Based on blosxom 2.0.2 in SourceForge.net
590
591Modified by Naoki Okamura (Nyarla) E<lt>thotep@nyarla.netE<gt>
Note: See TracBrowser for help on using the browser.