Perl/CGIスクリプト卸問屋は創業以来4,619,015,117名のお客様にご愛顧いただいております。

創業132年を誇る超老舗Perl/CGIスクリプト卸問屋へようこそ。当店では最先端技術駆使して作成したスクリプトを格安のパッケージにして販売するかもしれませんが現在は産地直送のため時価です。当社が持てる技術の粋を集めた7行シリーズをよろしく!(結構適当なのは内緒)

%ENV
@INC (キャッシュ更新中は激重になります)
適当に動かしてみる
  1. 格子
  2. チャット
  3. HTTP
  4. 魔方陣
ダウンロードとか
  1. ソース ダウンロード project/2ch/test/read.cgi
  2. ソース ダウンロード project/7lines/Storable.pm
  3. ソース ダウンロード project/7lines/_cms.cgi
  4. ソース ダウンロード project/7lines/analysis.cgi
  5. ソース ダウンロード project/7lines/calendar.cgi
  6. ソース ダウンロード project/7lines/counter.cgi
  7. ソース ダウンロード project/7lines/csv.cgi
  8. ソース ダウンロード project/7lines/excel.cgi
  9. ソース ダウンロード project/7lines/gc.cgi
  10. ソース ダウンロード project/7lines/hinomaru.cgi
  11. ソース ダウンロード project/7lines/http.cgi
  12. ソース ダウンロード project/7lines/httpd.pl
  13. ソース ダウンロード project/7lines/mail.cgi
  14. ソース ダウンロード project/7lines/navi.cgi
  15. ソース ダウンロード project/7lines/o.cgi
  16. ソース ダウンロード project/7lines/reverse.cgi
  17. ソース ダウンロード project/7lines/sum.cgi
  18. ソース ダウンロード project/7lines/tournament.cgi
  19. ソース ダウンロード project/7lines/upload.cgi
  20. ソース ダウンロード project/aabb.cgi
  21. ソース ダウンロード project/diary.cgi
  22. ソース ダウンロード project/download.cgi
  23. ソース ダウンロード project/explorer.cgi
  24. ソース ダウンロード project/gallery.cgi
  25. ソース ダウンロード project/mailer.cgi
  26. ソース ダウンロード project/message.cgi
  27. いらない ダウンロード project/mod_chat.cgi
    #!/usr/local/bin/speedy -- -r0 -t3600
    
    # データをメモリーに保持する記録ファイル不要の mod_perl 専用チャット
    # speedy でも動くようですがすぐにリセットされるかも。
    
    my $lines      = 10;
    my $time_limit = 10 * 60;
    my $max_user   = 100;
    
    
    use CGI qw/:standard/;
    
    our %user;
    our @data;
    
    my $id = crypt join(
            '',
            map sprintf("%02x", $_),
            grep /^\d{1,3}$/ && $_ <= 255,
            split /\./, substr $ENV{'REMOTE_ADDR'} || '127.0.0.1', 0, 32
        ), $ENV{'SERVER_ADDR'} || '00';
    
    delete @user{grep $user{$_}{'utime'} + $time_limit < time, keys %user};
    
    unless (exists $user{$id} && time < $user{$id}{'utime'} + $time_limit) {
        if ($max_user > keys %user) {
            $user{$id} = {
                'utime'  => time,
                'status' => 'passive',
                'id'     => substr crypt(substr($id, 2), join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]), 2
            };
        }
    } else {
        $user{$id}{'utime'} = time;
    }
    
    print header(-type => 'text/html', -charset => 'Shift_JIS'),
        start_html(-title => 'mod_chat', -declare_xml => 1, -encoding => 'Shift_JIS', -lang => 'ja'),
        start_form,
        do {
            unless (exists $user{$id}) {
                '大変混み合っているため新規参加はできません。'
            } elsif (param('name')) {
                my $name = substr param('name'), 0, 32;
                if (param('msg')) {
                    @data = (
                        {
                            'utime' => time,,
                            'id'    => $user{$id}{'id'},
                            'name'  => $name,
                            'msg'   => substr(param('msg'), 0, 256)
                        },
                        splice @data, 0, $lines - 1
                    );
                    $user{$id}{'status'} = 'active';
                }
                escapeHTML($name), ':', textfield(-name => 'msg', -size => 40),
                hidden(-name => 'name', -value => escapeHTML($name))
            } else {
                '名前:', textfield(-name => 'name', -size => 20)
            }
        },
        submit(-value => '送信'),
        end_form,
        ul(
            li([
                map {
                    join ' ',
                        font({-color => 'green'}, b(escapeHTML($_->{'name'} . ':'))),
                        escapeHTML($_->{'msg'}),
                        font(
                            {-color => 'green', -size => -1},
                            sub {
                                i(sprintf "%d/%02d/%02d %02d:%02d:%02d", 1900 + $_[5], 1 + $_[4], @_[3, 2, 1, 0])
                            }->(gmtime 9 * 60 * 60 + $_->{'utime'})
                        ),
                        font(
                            {-color => 'gray', -size => -1},
                            qq{($_->{'id'})}
                        )
                } grep ref eq 'HASH', @data
            ])
        ),
        do {
            my %num = (
                'active'  => 0,
                'passive' => 0
            );
            foreach (keys %user) {
                $num{$user{$_}{'status'}}++;
            }
            p(small('閲覧者(' . $num{'passive'} . ') 参加者(' . $num{'active'} . ')'))
        },
        comment(escapeHTML($ENV{'MOD_PERL'} || '')),
        end_html;
  28. ソース ダウンロード project/research.cgi
  29. ソース ダウンロード project/rss.cgi
使い方のようなもの
世界カレンダー?
Sister Projects

©2018 Perl/CGIスクリプト卸問屋