root/lang/perl/misc/ssuploader.cgi @ 19843

Revision 19843, 3.1 kB (checked in by drry, 5 years ago)
  • 誤字を修正しました。
  • lang 属性値を修正しました。
  • ほか。
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -T
2# Small Simple Uploader (ssuploader) by yto (たつを)
3# Version 1.1: http://chalow.net/2008-08-12-1.html
4# Version 1.0: http://chalow.net/2008-07-24-3.html
5# Version 0.0: http://nais.to/~yto/tools/ssupload/ [obsolete]
6use strict;
7use warnings;
8use CGI;
9use CGI::Carp qw(fatalsToBrowser);
10use POSIX qw(strftime);
11use utf8;
12use HTML::Template;
13use File::Basename;
14binmode STDOUT, ":utf8";
15
16# 準備: mkdir up; chmod 777 up
17my $up_dir = "up";
18
19my $q = new CGI;
20print $q->header(-charset => 'UTF-8');
21
22my $fh = $q->param('file_name') || "";
23my $mode = $q->param('mode') || "";
24
25my $message;
26if ($mode eq "up" or $mode eq "delete") {
27    if ($fh eq "") {
28        $message = "ファイルを指定してください。";
29    } else {
30        fileparse_set_fstype("MSDOS");
31        if (basename($fh) =~ m{^([^\x00-\x19\x7e-\xff\\/]+)$}) {
32            my $fn = $1;
33            $fn =~ s/^(.{100}).+$/$1/;
34            my $path = "$up_dir/$fn";
35            if (-f $path) {
36                if ($mode eq "delete") {
37                    unlink $path;
38                } else {
39                    $message = "同名のファイルが存在するので、"
40                        ."一度削除してからアップしてください。";
41                }
42            } elsif ($mode eq "up") {
43                open(my $upfh, ">", $path) or die;
44                flock($upfh, 2);
45                while (<$fh>) {
46                    print $upfh $_;
47                }
48                close $upfh;
49            }
50        } else {
51            $message = "ファイル名に日本語などの"
52                ."非対応文字が混じっています。";
53        }
54    }
55}
56
57$q->delete_all();
58
59my @file_list = sort {$b->{mtime} <=> $a->{mtime}} map {{
60    name => basename($_),
61    path => $_,
62    size => -s $_,
63    mtime => (stat $_)[9],
64    timestamp => strftime("%y-%m-%d %H:%M:%S", localtime((stat $_)[9])),
65    }}<$up_dir/*>;
66
67my $template = join("", <DATA>);
68my $t = HTML::Template->new(scalarref => \$template,
69                            gloval_vars => 1,
70                            die_on_bad_params => 0);
71$t->param(file_list => \@file_list);
72$t->param(reload_url => $q->self_url);
73$t->param(message => $message) if $message;
74print $t->output();
75
76__DATA__
77<html lang="ja">
78<head>
79<meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
80<title>Small Simple Uploader</title>
81</head>
82<body>
83<h1>Small Simple Uploader</h1>
84
85<TMPL_IF name=message>
86<div style="color:red;margin:10px"><TMPL_VAR name=message></div>
87</TMPL_IF>
88
89<form method="post" enctype="multipart/form-data" name="upup">
90<input type="file" name="file_name">
91<input type="hidden" name="mode" value="up">
92<input type="submit" value="アップロード">
93</form>
94
95<div><a href="<TMPL_VAR name=reload_url>">表示の更新</a></div>
96
97<div style="margin:10px">
98<table border="1">
99<tr><th></th><th>ファイル名</th><th>タイムスタンプ</th><th>サイズ</th></tr>
100<TMPL_LOOP name=file_list>
101<tr>
102<td><form method="post" style="margin:0;padding:0">
103<input type="hidden" name="file_name" value="<TMPL_VAR name=name>">
104<input type="hidden" name="mode" value="delete">
105<input type="button" value="削除"
106 onclick="if (confirm('本当に削除しますか？') == true) submit()">
107</form></td>
108<td><a href="<TMPL_VAR name=path>"><TMPL_VAR name=name></a></td>
109<td><TMPL_VAR name=timestamp></td>
110<td><TMPL_VAR name=size></td>
111</tr>
112</TMPL_LOOP>
113</table>
114</div>
115
116<div><a href="<TMPL_VAR name=reload_url>">表示の更新</a></div>
117</body>
118</html>
Note: See TracBrowser for help on using the browser.