(public)
/docs/Lang/Perl/SrcReview  /docs/Lang/Perl  /docs/Lang  /docs  
YukiWikiMiniを読んで
Wikiの中で一番短いソースです

以下がスナップショットです


拡大イメージは ここ



拡大イメージは ここ

コメントつけて読んでみました

YukiWikiMini - Yet Another Wiki Clone. を読んで

#!/usr/bin/perl
#
# YukiWikiMini Version 1.0.1
#
# ykwkmini.cgi - Yet another WikiWikiWeb clone.
#
# Copyright (C) 2000,2001,2003 by Hiroshi Yuki.
# <hyuki@hyuki.com>
# http://www.hyuki.com/yukiwiki/
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
##############################
use strict;
my $dbname = 'ykwkmini';
my $thisurl = 'ykwkmini.cgi';
my $frontpage = 'FrontPage';
my $indexpage = 'Index';
my $errorpage = 'Error';
my $WikiName = '([A-Z][a-z]+([A-Z][a-z]+)+)';

                 # AaAaなどをWiKi名として認識する。

my $kanjicode = 'sjis';
my $editchar = '?';

                 # リンクはあるけど実体がないファイルは
                 #     ファイル名 ?
                 # となる          ̄   
   
my $bgcolor = 'white';
my $contenttype = 'Content-type: text/html; charset=Shift_JIS';
my $naviwrite = 'Write';
my $naviedit = 'Edit';
my $naviindex = 'Index';
my $msgdeleted = ' is deleted.';
my $cols = 80;
my $rows = 20;
my $style = <<'EOD';
<style type="text/css">
<!--
body { font-family: "Courier New", monospace; }
pre { line-height:130%; }
a { text-decoration: none }
a:hover { text-decoration: underline }
-->
</style>
EOD
##############################
my %form;         # ブラウザからのリクエストを格納するハッシュ
                  #
                  #    foo.cgi?bar=boo  の時
                  #       $form{bar}=boo

my %database;     # これが dbmopenでファイルと関係づけられるハッシュ
                  #   $database{Wiki名}=内容

# ブラウザからのリクエスト
#   mycmd     Edit,Index,Writeなどのアクションコマンド
#   mypage    Wiki名


require 'jcode.pl';
&main;
exit(0);

sub main {
    &init_form;
    &sanitize_form;

    #  wiki.cgi?Wiki名 のみの時は Wiki名で指定されたページをReadするアクション
    #  となる。
    foreach (keys %form) {
        if (/^($WikiName)$/) {
            $form{mycmd} = 'read';
            $form{mypage} = $1;
            last;
        }
    }

    # DBMのオープン
    unless (dbmopen(%database, $dbname, 0666)) {
        &print_error("(dbmopen)");
    }

    #  アクションコマンド毎の分岐
    $_ = $form{mycmd};
    if (/^read$/) {
        &do_read;
    } elsif (/^write$/) {
        &do_write;
    } elsif (/^edit$/) {
        &do_edit;
    } elsif (/^index$/) {
        &do_index;
    } else {
        $form{mypage} = $frontpage;
        &do_read;
    }

    dbmclose(%database);
}

#  mypageで識別されるデータベースの中のWiki名の内容を表示する
sub do_read {
    &print_header($form{mypage}, 1);
    &print_content;
    &print_footer;
}

# EDITするためのフォームを表示する。
sub do_edit {
    &print_header($form{mypage}, 0);

    # 既にデータがあったらそれを持ってくる。
    my $mymsg = &escape($database{$form{mypage}});

    print <<"EOD";
    <form action="$thisurl" method="post">
        <input type="hidden" name="mycmd" value="write">
        <input type="hidden" name="mypage" value="$form{mypage}">
        <input type="submit" value="$naviwrite"><br />
        <textarea cols="$cols" rows="$rows" name="mymsg" wrap="off">$mymsg</textarea><br />
        <input type="submit" value="$naviwrite">
    </form>
EOD

    &print_footer;
}

# データベースに格納されている Wiki名をすべてひろってsortして表示する。
sub do_index {
    &print_header($indexpage, 0);
    print qq|<ul>\n|;
    foreach (sort keys %database) {
        print qq|<li><a href="$thisurl?$_"><tt>$_</tt></a></li>\n|
    }
    print qq|</ul>\n|;
    &print_footer;
}

# データ書き込み
#   mymsg に書き込むべき内容が格納されている。空欄ならdeleteする。
sub do_write {

    if ($form{mymsg}) {
        # データベースに格納
        $database{$form{mypage}} = $form{mymsg};
        &print_header($form{mypage}, 1);
        &print_content;
    } else {
        delete $database{$form{mypage}};
        &print_header($form{mypage} . $msgdeleted, 0);
    }
    &print_footer;
}

# エラーページの表示
sub print_error {
    my $msg = shift;
    &print_header($errorpage, 0);
    print "<h1>$msg</h1>";
    &print_footer;
    exit(0);
}

#   メニューの表示、ヘッダーの表示
#   caneditは 真 なら Edit可として Editをメニューに表示する
sub print_header {
    my ($title, $canedit) = @_;
    print <<"EOD";
$contenttype

<html>
    <head><title>$title</title>$style</head>
    <body bgcolor="$bgcolor">
        <table width="100%" border="0">
            <tr valign="top">
                <td>
                    <h1>$title</h1>
                </td>
                <td align="right">
                    <a href="$thisurl?$frontpage">$frontpage</a> | 
                    @{[$canedit ? qq(<a href="$thisurl?mycmd=edit&mypage=$form{mypage}">$naviedit</a> | ) : '' ]}
                    <a href="$thisurl?mycmd=index">$naviindex</a> | 
                    <a href="http://www.hyuki.com/yukiwiki/mini/ykwkmini.html">YukiWikiMini</a>
                </td>
            </tr>
        </table>
EOD
}

# フッター出力
sub print_footer {
    print "</body></html>";
}

# HTML表示用にエスケープ
sub escape {
    my $s = shift;
    $s =~ s|\r\n|\n|g;
    $s =~ s|\r|\n|g;
    $s =~ s|&|&amp;|g;
    $s =~ s|<|&lt;|g;
    $s =~ s|>|&gt;|g;
    $s =~ s|"|&quot;|g;
    return $s;
}

sub print_content {

    # DBMファイルで Wiki名に関係づけられた内容を escapeしてから
    # $_ に格納する。 
    $_ = &escape($database{$form{mypage}});

    # その中に   mailto|http|https|ftp があったら Wiki名があったら
    # make_link($1)により展開する。
    s!
        (
            ((mailto|http|https|ftp):[\x21-\x7E]*)  # Direct http://...
                |
            ($WikiName)                             # LocalLinkLikeThis
        )
    !
        &make_link($1)
    !gex;

    # 展開したものを表示する。

    print "<pre>", $_, "</pre>";
}

# リンクに展開     FoFo を  <a href="FoFo">FoFo</a>  へ
sub make_link {
    $_ = shift;

    # 普通のリンク
    if (/^(http|https|ftp):/) {
        return qq|<a href="$_">$_</a>|;
    } elsif (/^(mailto):(.*)/) {
        return qq|<a href="$_">$2</a>|;

    # データベースに実体がある
    } elsif ($database{$_}) {
        return qq|<a href="$thisurl?$_">$_</a>|;

    # データベースに実体がない
    } else {
        return qq|$_<a href="$thisurl?mycmd=edit&mypage=$_">$editchar</a>|;
    }
}

#
#  HTMLフォームからの情報を %formに格納する。
#
sub init_form {
    my ($query);
    if ($ENV{REQUEST_METHOD} =~ /^post$/i) {
        read(STDIN, $query, $ENV{CONTENT_LENGTH});
    } else {
        $query = $ENV{'QUERY_STRING'};
    }
    my @assocarray = split(/&/, $query);
    foreach (@assocarray) {
        my ($property, $value) = split /=/;
        $value =~ tr/+/ /;
        $value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
        &jcode'convert(\$value, $kanjicode);
        $form{$property} = $value;
    }
}

#  mypageで指定されたWiki名の確認。
sub sanitize_form {
    if (defined($form{mypage}) and $form{mypage} !~ /^$WikiName$/) {
        &print_error("(invalid mypage)");
    }
}




(C)2004-2017 skunk nakamae (SKISS Document Tool Version 0.022)