perl シンプルなCMS （お勉強用）

というわけで、ファイル入出力のサブルーチンを使ってシンプルなCMSを作ってみました。
ログイン機能は無しで、誰でも更新できるタイプですが、とりあえずはお勉強用ということで。
100行未満で作れる！ってのが素敵ポイント。

ファイルのダウンロード：cmsbase

#!/usr/bin/perl

use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Fcntl qw(:flock);
use Time::HiRes qw (time);

$CGI::POST_MAX=1024 * 100;  # max 100K posts
$CGI::DISABLE_UPLOADS = 1;  # no uploads

require 'r-io02.pl';
require 'r-lib.pl';
my $date_s = time;
my $q = CGI->new();

my $act = &escape_tag($q->param('act'));
my $q_pg = &escape_tag($q->param('pg'));
my $w_subtitle = &escape_tag($q->param('subtitle'));
my $w_section = &escape_tag($q->param('section'));

if ( $act eq 'edit_page' ) { &edit_page; }
elsif ( $act eq 'edit_write' ) { &edit_write; }
elsif ( $q_pg ne '' ) { &contents; }
else { &top_page; }

sub top_page {
    my @data = &read_array ('data.cgi');    #ファイルの読み込み

    my $contents = qq(<div id="edit_btn"><a href="?act=edit_page">NewPage</a></div><h2>LIST</h2><ul>);
    for (@data) {
        my ($pg,$subtitle,$section,$host,$date) = split(/\t/);
        $contents .= qq(<li><a href="./?pg=$pg">$subtitle</a> [$host] [$date]</li>);
    }
    $contents .= '</ul></div>';

    &html_out ('_template.html', 'TopPage', $contents);
}

sub contents {
    my $line = &read_line ('data.cgi',$q_pg);    #ファイルの読み込み

    my ($pg,$subtitle,$section,$host,$date) = split(/\t/, $line);
    $section =~ s/([^=^\"]|^)(https?\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%]+)/$1<a href=\"$2\" target=\"_blank\">$2<\/a>/g;#URLリンク
    $section = qq(<div id="edit_btn"><a href="?act=edit_page&pg=$q_pg">Edit</a></div><div id="date">$date</div><div id="section">$section</div></div>);
    &html_out ('_template.html', $subtitle, $section);
}

sub edit_page {
    my $line = &read_line ('data.cgi',$q_pg);    #ファイルの読み込み

    my ($pg,$subtitle,$section,$host,$date) = split(/\t/, $line);
    $section =~ s/<br>/\n/g;
    &html_out ('_template_form.html', $subtitle, $section);
}

sub edit_write {
    if ($w_subtitle eq '' && $w_section eq '' && $q_pg eq ''){ &top_page; }

    # 空なら削除
    if ($w_subtitle eq '' && $w_section eq '') { 
        &del_file ('data.cgi',$q_pg); 
        &top_page;
    }

    my $host = &get_host;
    my $date = &get_time;

    if ($q_pg eq '') { &write_new_line ('data.cgi', "$w_subtitle\t$w_section\t$host\t$date\t\n"); } # 新規ページの場合
    my $data = "$q_pg\t$w_subtitle\t$w_section\t$host\t$date\t\n";
    &write_line ('data.cgi',$q_pg,$data); # データの書込み
    &top_page;
}

sub html_out {
    my ($temp,$title,$contents) = @_;
    my @template = &read_array ($temp);    # テンプレート読み込み

    # ページ生成時間
    my $vtime = time - $date_s;
    $vtime = sprintf("%3f",$vtime);

    # 出力
    print "Content-type: text/html\n\n";
    for my $line (@template) {
        $line =~ s/<!--title-->/$title/i;
        $line =~ s/<!--contents-->/$contents/i;
        $line =~ s/<!--pg-->/$q_pg/i;
        $line =~ s/<!--vtime-->/$vtime/i;
        print $line;
    }
    exit;
}