WebDocのソース

index.cgi

#!/usr/local/bin/perl

# WebDoc - Web Document System
# Copyright (C) Takashi Utsunomiya. All Rights Reserved.
# http://uttsu.com/
my $version = '1.17';

# 2003.04.26    ver 1.17
#   - <<〜>>, <%〜%>, <pre>〜</pre>で、次の行をくっつけてしまうbugをfix
# 2003.04.17    ver 1.16
#   - 行末の文章結合記号 \ を追加
#   - head部に AddPath 項目を追加
# 2003.04.15    ver 1.15
#   - HTMLへの変換部 改良
# 2003.04.12    ver 1.14
#   - <table>出力部変更
#   - <%img 〜>部修正
# 2003.04.06    ver 1.13
#   - 表示関係debug
#   - ディレクトリごとの設定ファイル（dir.conf.cgi）を採用
# 2003.04.05    ver 1.12
#   - 本体共有モード廃止
#   - text->html変換ルーチンをWebNoteのものを使用
#   - <title>ヘッダにPath情報を出力しないようにした
#   - 同名の原稿ファイルが複数ある場合にエラーを出力するようにした
# 2003.01.28    ver 1.11
#   - debug
#   - ヘッダにDate属性追加。ページ末に表示
# 2003.01.27    ver 1.10
#   - 複数のdapa_pathに対応
#   - ''.*?''と'''.*?'''をそれぞれ<em>と<strong>に
# 2003.01.23    ver 1.09
#   - ファイル名 _なしも有効に
#   - 画像展開コマンドを追加 ^<<img URL>$
# 2003.01.22    ver 1.08
#   - ファイル名は \d{8,8}_.*だけを有効に。_がないのは無効にした
#   - option に Path 加えた
#   - option に Menu 加えた
#   - option に Theme 加えた
# 2003.01.19    ver 1.07
#   - debug
# 2003.01.11    ver 1.06
#   - Last-Modifiedヘッダを出力するようにした
# 2003.01.10    ver 1.05
#   - 文書がない場合にステータス404を返すようにした
# 2003.01.09    ver 1.04
#   - Option機能追加（Title, SubTitle, MakeIndex）
#   - Title, SubTitleはヘッダ中でそれぞれ、^.*、^ .*のように指定。Title:などは使わない。
# 2003.01.07    ver 1.03
#   - bug fix
# 2002.12.28    ver 1.02
#   - 原稿ファイル名に[]内にコメントを入れて付けられるようにした
# 2002.12.25    ver 1.01
#   - トップページを表示しないようにした
# 2002.10.25    ver 1.00
#   - 作成開始
#   - 完成

# ■init
use strict;

require 'conf.cgi';
my @data_path = @conf::data_path;
my $contenttype = 'Content-type: text/html; charset=Shift_JIS';
my %file_path;
my %doc_head;

my $page_name = $conf::page_name;
my @page_path = @conf::page_path;
my $footer = ($conf::footer || '');
$doc_head{NoReferrer} = ($conf::no_referrer || 'No');

$ENV{'TZ'} = 'JST-9';
main();

# ■
sub main {
    my $target = ($ARGV[0] || '');

    foreach (@data_path) {
        get_file_path($_);
    }

    if ($file_path{$target}) {
        do_doc($target);
    } else {
        not_found();
    }
}

# ◆
sub get_file_path {
    my $dir = shift;
    $dir .= '/' if ($dir !~ /\/$/);

    opendir(DIR, "$dir") or die $!;
    @_ = readdir(DIR);
    closedir(DIR);

    foreach (@_) {
        get_file_path("$dir$_") if (-d "$dir$_" && !/^\./);
        if (/^(\d{8,8}(_\d+)?).*\.txt$/) {
            if ($file_path{$1}) {
                print "$contenttype\n\n同名の原稿ファイルが複数あります: $1\.txt\n";
                exit;
            }
            $file_path{$1} = "$dir$_";
        } elsif (/(.+\.(menu|css))$/) {
            $file_path{$1} = "$dir$_";
        }
    }
}

# ◆
sub not_found {
    print <<EOF;
$contenttype
Status: 404 Not Found

404 Not Found
EOF
}

# ◆
sub do_doc {
    my $target = shift;
    my $title;
    my $body;

    # get Title, SubTitle
    open(IN, $file_path{$target}) or die;
    if (chomp($_=<IN>), /^ (.*)/) {
        $doc_head{SubTitle} = $1;
        $doc_head{SubTitlePrefix} = 'Yes';
        chomp($_=<IN>), $doc_head{Title} = $_;
    } else {
        $doc_head{Title} = $_;
        if (chomp($_=<IN>), /^ (.*)/) {
            $doc_head{SubTitle} = $1;
        }
    }
    close(IN);

    # get head from dir.conf.cgi
    $file_path{$target} =~ /(.*\/).*?$/;
    if (open(IN, $1.'dir.conf.cgi')) {
        while ($_=<IN>, !/^$/) {
            $doc_head{$1} = $2 if (/(.*?)\s*:\s*(.*)/);
        }
        close(IN);
    }
    if ($_ = $doc_head{AddPath}) {
        $doc_head{Path} .= ', '. $_;
        $doc_head{AddPath} = '';
    }

    # get head
    open(IN, $file_path{$target}) or die;
    while ($_=<IN>, !/^$/) {
        $doc_head{$1} = $2 if (/(.*?)\s*:\s*(.*)/);
    }
    $doc_head{Path} .= ', '. $doc_head{AddPath} if ($doc_head{AddPath});

    undef $/;
    $body = <IN>;
    $/ = "\n";
    close(IN);
    $body = join('', text_to_html($body));
#   $_ = 0;
#   $body =~ s/^<h4>\x00/"<h4><a id=".(++$_)." href=#$_ class=anchor>_<\/a> "/gme;

    $_ =  gmtime((stat($file_path{$target}))[9]);
    print "$contenttype\n";
    print "Last-modified: $_\n\n";
    exit if ($ENV{REQUEST_METHOD} =~ /^head$/i);

    print put_header();
    print put_menu($doc_head{Menu}) if ($doc_head{Menu});
    print $body;
    print put_footer();
}


# ◆
sub text_to_html {
    $_ = shift;
    my (@body, $is_paragraph);

    s/\l\n/\n/g;

    # 複数行のコマンドを1行にまとめる
    s/\\\n/\x01/g;
    s/^<%\n.*?^%>(?:\n)/text2html_cnv($&)/gsme;
    s/^<pre>\n.*?^<\/pre>(?:\n)/text2html_cnv($&)/gsme;
    s/^(・|\*|-|\+|:|\|)?([^\n]+?)=\n(http:\/\/.+?)$/$1<\@$2=$3>/gm;
    s/^(・|\*|-|\+|:|\|)([^\n]+?)\n(?=\1)/$1$2\x00/gsm;
    s/^<<\n.*?^>>(?:\n)/text2html_cnv($&)/gsme;

    foreach (split(/\n/)) {
        if (/^$/) {
            $is_paragraph = 1;
        } elsif (/^  (.*)/) {
            push(@body, "<h3>".inline($1)."</h3>\n\n");
        } elsif (/^ (.*)/) {
            push(@body, "<h2>".inline($1)."</h2>\n\n");
        } elsif (/^(・|\*|-|\+)/) {
            push(@body, (/^\+/ ? '<ol>' : '<ul>')."\n");
            foreach (split(/\x00/)) {
                s/^(・|\*|-|\+)\s*(.*)/"<li>".inline($2)/e;
                push(@body, "$_\n");
            }
            push(@body, (/^\+/ ? '</ol>' : '</ul>')."\n\n");
        } elsif (/^:/) {
            s/\x00/\n/g;
            s/^:\s*([^:]+?)\s*:\s*(.*?)\s*$/'<dt>'.inline($1).'<dd>'.inline($2)."\n"/gme;
            push(@body, "<dl>\n".$_."</dl>\n\n");
        } elsif (/^\|/) {
            s/(\x00|$)/\n/g;
            s/\s*\|\n/\n/g;
            s/\|\s+([^\|]*?)\s*/'<th>'.inline($1)/ge;
            s/\|([^\|]*?)\s*/'<td>'.inline($1)/ge;
            s/^/<tr>/gm;
            push(@body, "<table border=1 cellpadding=4 cellspacing=0>\n".$_."</table>\n\n");
        } elsif (/^<pre>\x00/) {
            s/(^<pre>\x00|<\/pre>\x00$)//g;
            $_ = escape($_);
            s/\x00/\n/g;
            push(@body, "<pre>\n$_</pre>\n\n");
        } elsif (/^<<\x00/) {
            s/(^<<\x00|>>\x00$)//g;
            $_ = inline($_);
            s/\x00/<br>\n/g;
            push(@body, "<blockquote>\n$_</blockquote>\n\n");
        } elsif (/^<%\x00/) {
            s/(^<%\x00|%>\x00$)//g;
            s/\x00/\n/g;
            push(@body, "$_\n");
        } elsif (/^<%img\s+(.*)\s*>/) {
            push(@body, "<img src=$1>\n");
        } else {
            if (!$is_paragraph && @body && $body[@body-1] =~ /^<p>(.*)<\/p>\n\n$/s) {
                $body[@body-1] = "<p>$1<br>\n".inline($_)."</p>\n\n";
            } else {
                push(@body, '<p>'.inline($_)."</p>\n\n");
                $is_paragraph = 0;
            }
        }
    }
    $body[@body-1] =~ s/\n*$/\n/;
    return @body;
}
# ◆
sub text2html_cnv {
    $_ = shift;
    tr/\n/\x00/;
    return $_;
}
# ◆
sub inline {
    $_ = escape(shift);
    my $noref = '/r/' if ($doc_head{NoReferrer} =~ /^yes$/i);

    s/^((http|https|ftp):[\x21-\x7E]*)/<a href=$noref$1>$1<\/a>/g;
    s/<@(.*?)=([\x21-\x7E]*)>/<a href=$2>$1<\/a>/g;

    s/'''(.*?)'''/<strong>$1<\/strong>/g;
    s/''(.*?)''/<em>$1<\/em>/g;
    s/\x01/<br>\n/g;

    return $_;
}
# ◆
sub escape {
    $_ = shift;
    s|<|<|g;
    return $_;
}

# ◆
sub put_menu {
    my $target = shift;
    $target .= '.menu' if (!/\.menu$/);
    open(IN, $file_path{$target}) or die;
    @_ = <IN>;
    close(IN);
    unshift(@_, "<div class=menu>\n");
    push(@_, "</div>\n\n");
    return @_;
}

# ◆
sub put_header {
    my $title = $doc_head{Title};
    my $html_title = $title;
    my ($path, $title_path, $theme);

    push(@page_path, split(/\s*,\s*/, $doc_head{Path})) if ($doc_head{Path});

    $path = "<a href=$page_path[1]><b>$page_path[0]</b></a>";
    $title_path = "$page_path[0]";
    for (1..@page_path/2-1) {
        $path .= " > <a href=$page_path[$_*2+1]>$page_path[$_*2]</a>";
        $title_path .= " - $page_path[$_*2]";
    }

    if ($doc_head{SubTitle}) {
        if ($doc_head{SubTitlePrefix} eq 'Yes') {
            $html_title = "<span class=subtitle>$doc_head{SubTitle}</span><br>$title";
            $title = "$doc_head{SubTitle} $title";
        } else {
            $html_title = "$title<br><span class=subtitle>$doc_head{SubTitle}</span>";
            $title .= " $doc_head{SubTitle}";
        }
    }

    $theme = 'style.css';
    if ($doc_head{Theme}) {
        $_ = $doc_head{Theme};
        $_ .= '.css' if (!/\.css$/);
        $theme = $file_path{$_} if ($file_path{$_});
    }

    @_ = <<EOF;
<title>$title</title>
<link rel=stylesheet href=$theme>

$path >
<h1>$html_title</h1>

EOF
}

# ◆
sub put_footer {
    $footer .= "<br>\n".$doc_head{Date} if ($doc_head{Date});
    @_ = <<EOF;

<p><hr>
$footer
EOF
}

conf.cgi

package conf;

# データファイル用のディレクトリ
@data_path = ('./');

# ページのパス
# ページ名, URL, … というようにページ名とURLを対で記述
@page_path = ('uttsu.com', '/');

# フッター。ページ下部に表示。
$footer = 'Copyright (C) Takashi Utsunomiya. All Rights Reserved.';

1;

style.css

body { margin: 20px 5%; font-family: Verdana; }
h1 { text-align: center; }
h1 .subtitle { font-size: 80%; }
h2 { width: 100%; padding-left: .5em; clear: both; border: solid; border-width: 0 0 1 15; background: #f0f0f0; }
h3 { width: 100%; padding-left: .5em; border: solid; border-width: 0 0 0 5; }
p, small, li, dd { line-height: 140%; }
pre { width: 100%; padding: 3px; border: 1px solid; white-space: pre; background: #f0f0f0; }
blockquote { padding: 5px; background: #f0faf0; }
dt { font-weight: bold; }
.menu { float: right; width: 180; margin: 0 0 5 5; padding: 5; font-size: 85%; background: #f0f0f0; }
.menu h2 { margin: 0 0 5 0; padding: 0; font: bold 90% Verdata; background: tranceparent; border: 0; }

.htaccess

RewriteEngine On
RewriteRule ^([0-9]{8}_[0-9]+)\.html$ index.cgi?$1