html5/spec-ja/edit.cgi

#!/usr/bin/perl
use strict;
use CGI::Carp qw(fatalsToBrowser);

my $data_dir_name = q[data/];

my $path = $ENV{PATH_INFO};

sub htescape ($) {
  my $s = shift;
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/"/&quot;/g;
  return $s;
} # htescape

if ($path =~ m[^/([0-9a-z-]+)$]) {
  my $name = $1;
  my $file_name = $data_dir_name . $name . '.dat';
  if (-f $file_name) {
    if ($ENV{REQUEST_METHOD} eq 'GET') {
      my $data;
      {
        open my $file, '<:utf8', $file_name or die "$0: $file_name: $!";
        local $/ = undef;
        $data = <$file>;
      }
      
      print qq[Content-Type: text/html; charset=utf-8

<!DOCTYPE HTML>
<html lang=en>
<head>
<title>Edit &mdash; @{[htescape ($name)]}</title>
<style>
textarea {
  width: 95%;
  height: 40em;
}
</style>
<link rel=license href="./#license">
<body>
<h1>Edit &mdash; @{[htescape ($name)]}</h1>
<form action accept-charset=utf-8 method=post>
<p><textarea name=data lang>@{[htescape ($data)]}</textarea>
<p><input type=submit value=Save>
<strong>Important</strong>: See <a href="./#license" rel=license>license</a>.
</form>
];
      exit;
    } elsif ($ENV{REQUEST_METHOD} eq 'POST') {
      eval q{ use CGI qw(param) };
      my $data = param ('data');
      open my $file, '>', $file_name or die "$0: $file_name: $!";
      print $file $data;
      close $file;
      my $user = $ENV{REMOTE_USER};
      $user =~ s/[^0-9A-Za-z_-]/_/g;
      (system "cvs commit -m \"by remote user \'$user\'\" data > /dev/null") == 0 or die "$0: $?";

      print q[Status: 204 Saved; No Content];
      exit;
    } else {
      print q[Status: 405 Method Not Allowed
Content-Type: text/plain ; charset=us-ascii
Allow: GET, POST

405];
      exit;
    }
  }
} elsif ($path eq '/') {
  opendir my $data_dir, $data_dir_name or die "$0: $data_dir_name: $!";
  print q[Content-Type: text/html; charset=utf-8

<!DOCTYPE HTML>
<html lang=en>
<title>English-Japanese Data Files</title>
<link rel=history href="../data/,cvslog">
<link rel=license href="#license">
<h1>English-Japanese Data Files</h1>

<ul>];
  for (sort {$a cmp $b} grep {/\.dat$/} readdir $data_dir) {
    my $name = $_;
    $name =~ s/\.dat$//;
    print qq[<li><a href="@{[htescape ($name)]}"><code class=file>@{[htescape ($name)]}</code></a></li>];
  }
  print q[</ul>

<section id=license>
<h2>License of data files</h2>

<blockquote cite="http://whatwg.org/html5">
   <p class=copyright>&copy; Copyright 2004-2008 Apple Computer, Inc.,
    Mozilla Foundation, and Opera Software ASA.</p>

   <p class=copyright>You are granted a license to use, reproduce and create
    derivative works of this document.</p>
</blockquote>

<p><strong>For contributors</strong>: You have to agree that your 
contributions are licensed under the terms quoted above.
</section>
];
  exit;
}

print q[Content-Type: text/plain ; charset=us-ascii
Status: 404 Not Found

404];
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			use CGI::Carp qw(fatalsToBrowser);
4
5			my $data_dir_name = q[data/];
6
7			my $path = $ENV{PATH_INFO};
8
9			sub htescape ($) {
10			my $s = shift;
11			$s =~ s/&/&/g;
12			$s =~ s/</</g;
13			$s =~ s/"/"/g;
14			return $s;
15			} # htescape
16
17			if ($path =~ m[^/([0-9a-z-]+)$]) {
18			my $name = $1;
19			my $file_name = $data_dir_name . $name . '.dat';
20			if (-f $file_name) {
21			if ($ENV{REQUEST_METHOD} eq 'GET') {
22			my $data;
23			{
24			open my $file, '<:utf8', $file_name or die "$0: $file_name: $!";
25			local $/ = undef;
26			$data = <$file>;
27			}
28
29			print qq[Content-Type: text/html; charset=utf-8
30
31			<!DOCTYPE HTML>
32			<html lang=en>
33			<head>
34			<title>Edit — @{[htescape ($name)]}</title>
35			<style>
36			textarea {
37			width: 95%;
38			height: 40em;
39			}
40			</style>
41			<link rel=license href="./#license">
42			<body>
43			<h1>Edit — @{[htescape ($name)]}</h1>
44			<form action accept-charset=utf-8 method=post>
45			<p><textarea name=data lang>@{[htescape ($data)]}</textarea>
46			<p><input type=submit value=Save>
47			<strong>Important</strong>: See <a href="./#license" rel=license>license</a>.
48			</form>
49			];
50			exit;
51			} elsif ($ENV{REQUEST_METHOD} eq 'POST') {
52			eval q{ use CGI qw(param) };
53			my $data = param ('data');
54			open my $file, '>', $file_name or die "$0: $file_name: $!";
55			print $file $data;
56			close $file;
57			my $user = $ENV{REMOTE_USER};
58			$user =~ s/[^0-9A-Za-z_-]/_/g;
59			(system "cvs commit -m \"by remote user \'$user\'\" data > /dev/null") == 0 or die "$0: $?";
60
61			print q[Status: 204 Saved; No Content];
62			exit;
63			} else {
64			print q[Status: 405 Method Not Allowed
65			Content-Type: text/plain ; charset=us-ascii
66			Allow: GET, POST
67
68			405];
69			exit;
70			}
71			}
72			} elsif ($path eq '/') {
73			opendir my $data_dir, $data_dir_name or die "$0: $data_dir_name: $!";
74			print q[Content-Type: text/html; charset=utf-8
75
76			<!DOCTYPE HTML>
77			<html lang=en>
78			<title>English-Japanese Data Files</title>
79			<link rel=history href="../data/,cvslog">
80			<link rel=license href="#license">
81			<h1>English-Japanese Data Files</h1>
82
83			<ul>];
84			for (sort {$a cmp $b} grep {/\.dat$/} readdir $data_dir) {
85			my $name = $_;
86			$name =~ s/\.dat$//;
87			print qq[<li><a href="@{[htescape ($name)]}"><code class=file>@{[htescape ($name)]}</code></a></li>];
88			}
89			print q[</ul>
90
91			<section id=license>
92			<h2>License of data files</h2>
93
94			<blockquote cite="http://whatwg.org/html5">
95			<p class=copyright>© Copyright 2004-2008 Apple Computer, Inc.,
96			Mozilla Foundation, and Opera Software ASA.</p>
97
98			<p class=copyright>You are granted a license to use, reproduce and create
99			derivative works of this document.</p>
100			</blockquote>
101
102			<p><strong>For contributors</strong>: You have to agree that your
103			contributions are licensed under the terms quoted above.
104			</section>
105			];
106			exit;
107			}
108
109			print q[Content-Type: text/plain ; charset=us-ascii
110			Status: 404 Not Found
111
112			404];