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

創業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
    #!/usr/local/bin/perl
    
    # はじめに
    #
    #    パーミッションは適当に設定してください。
    #    Apache 以外のサーバーではテストしていません。
    #    .htaccess が無効のサーバーでは使えません。
    #    .htaccess で 404 の時のファイルを指定できないサーバーでは使えません。
    #    広告やゴミが強制挿入される無料サーバー等では使えません。
    #    ファイル名は半角英数程度しか扱えません。
    #    設置も設定も厄介なので短気な方には向いていないかもしれません。
    #    他にも環境依存で動かない可能性は高いですが省略します。
    #
    #
    # 設置の例
    #
    #    このファイルを
    #    http://127.0.0.1/download.cgi
    #    として設置する。
    #
    #    http://127.0.0.1/download/
    #    http://127.0.0.1/download_archive/
    #    http://127.0.0.1/download.dat
    #    を作成する。
    #
    #    http://127.0.0.1/download/
    #    に .htaccess を入れる。
    #    .htaccess には
    #    ErrorDocument 404 /download.cgi
    #    のように書いて 404 の時にこのファイルを呼ぶようにする。
    #
    #    http://127.0.0.1/download_archive/
    #    に *.zip や *.lzh を入れる。仮に test.zip を入れたとする。
    #
    #    http://127.0.0.1/download/test.zip で呼び出すと Status: 200 で 
    #    http://127.0.0.1/download_archive/test.zip がダウンロードされ
    #    http://127.0.0.1/download.dat にダウンロード数が記録される。
    #
    #    http://127.0.0.1/download.cgi で起動するとダウンロード数が表示される。
    
    my $fake    = '/download/';
    my $archive = './download_archive/';
    my $logfile = './download.dat';
    my %mime    = (
        'gif' => 'image/gif',
        'jpg' => 'image/jpeg',
        'pdf' => 'application/pdf',
        'png' => 'image/png',
        'zip' => 'application/zip',
    );
    
    #以下変更不可
    
    $archive =~ s/[\\\/]+$//;
    $fake =~ s/[\\\/]+$//;
    my $uri = $ENV{'REDIRECT_URL'} || $ENV{'REDIRECT_SCRIPT_URI'} || $ENV{'REQUEST_URI'} || '';
    if ($uri =~ /([ \w-]{1,256}\.\w{1,4})$/ && open my $fh, "$archive/$1") {
        my $filename = $1;
        my $buffer = 65536 + (-s $fh) / 1000;
        my $pattern = join '|', keys %mime;
        binmode $fh;
        binmode STDOUT;
        print join "\x0d\x0a",
            'Status: 200 OK',
            'Cache-Control: no-cache',
            'Pragma: no-cache',
            'Content-Type: ' . ($filename =~ /\.($pattern)$/i ? $mime{$1} : 'application/octet-stream'),
            'Content-Length: ' . -s _,
    #        qq{Content-Disposition: attachment; filename="$filename"},
            '',
            '';
        while (read $fh, my $bin, $buffer) {
            print $bin;
        }
        close $fh;
        if (open my $fh, "+< $logfile") {
            flock $fh, 2;
            my %data;
            while (<$fh>) {
                chomp;
                my ($name, $count) = split /\t/;
                $data{$name} = $count;
            }
            if (seek $fh, 0, 0) {
                $data{$filename}++;
                foreach (sort keys %data) {
                    print $fh join("\t", $_, $data{$_}), "\n";
                }
                truncate $fh, tell $fh;
            }
            close $fh;
        } else {
            warn $!;
        }
    } else {
        my %data;
        if (open my $fh, $logfile) {
            while (<$fh>) {
                chomp;
                my ($name, $count) = split /\t/;
                $data{$name} = $count;
            }
            close $fh;
        } else {
            warn $!;
        }
        print "Content-Type: text/html\n\n";
        print '<table border="1">';
        if (opendir my $dh, $archive) {
            print map qq{<tr><td><a href="$fake/$_">$fake/$_</a></td><td>} . ($data{$_} || 0) . '</td></tr>',
                sort grep !/^\./, readdir $dh;
            closedir $dh;
        }
        print '</table>';
        print '<p style="color:teal">Smart counter 7.1.4</p>';
    }
    
    #if (open O, '>> ./test.dat') {
    #    print O map "$_ => $ENV{$_}\n", sort keys %ENV;
    #    close O;
    #}
  23. ソース ダウンロード project/explorer.cgi
  24. ソース ダウンロード project/gallery.cgi
  25. ソース ダウンロード project/mailer.cgi
  26. ソース ダウンロード project/message.cgi
  27. ソース ダウンロード project/mod_chat.cgi
  28. ソース ダウンロード project/research.cgi
  29. ソース ダウンロード project/rss.cgi
使い方のようなもの
世界カレンダー?
Sister Projects

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