| 1 |
wakaba |
1.1 |
#!/usr/bin/perl |
| 2 |
|
|
use strict; |
| 3 |
|
|
use CGI::Carp qw(fatalsToBrowser); |
| 4 |
|
|
|
| 5 |
|
|
use lib qw[/home/wakaba/work/manakai2/lib/]; |
| 6 |
|
|
|
| 7 |
|
|
require 'common.pl'; |
| 8 |
|
|
|
| 9 |
|
|
my $path = $ENV{PATH_INFO}; |
| 10 |
|
|
|
| 11 |
|
|
if ($path eq '/') { |
| 12 |
|
|
if ($ENV{REQUEST_METHOD} eq 'POST') { |
| 13 |
|
|
require Message::CGI::HTTP; |
| 14 |
|
|
require Encode; |
| 15 |
|
|
|
| 16 |
|
|
my $cgi = Message::CGI::HTTP->new; |
| 17 |
|
|
$cgi->{decoder}->{'#default'} = sub { |
| 18 |
|
|
return Encode::decode ('utf-8', $_[1]); |
| 19 |
|
|
}; |
| 20 |
|
|
|
| 21 |
|
|
my $en = $cgi->get_parameter ('en'); |
| 22 |
|
|
my $ja = $cgi->get_parameter ('ja'); |
| 23 |
|
|
my $is_pattern = $cgi->get_parameter ('pattern'); |
| 24 |
|
|
my $tags = [map {normalize ($_)} |
| 25 |
|
|
split /[\x0D\x0A]+/, $cgi->get_parameter ('tags') // '']; |
| 26 |
|
|
|
| 27 |
|
|
my $hash = get_hash ($en); |
| 28 |
wakaba |
1.4 |
my $entry = {en => $en, ja => $ja, tags => $tags, |
| 29 |
wakaba |
1.6 |
isPattern => $is_pattern}; |
| 30 |
wakaba |
1.3 |
|
| 31 |
wakaba |
1.1 |
lock_entry ($hash); |
| 32 |
wakaba |
1.3 |
set_entry ($hash, $is_pattern => $entry); |
| 33 |
wakaba |
1.1 |
commit_entries ("$path: $hash updated by $ENV{AUTH_USER}"); |
| 34 |
|
|
|
| 35 |
wakaba |
1.3 |
print "Status: 200 Saved\n"; |
| 36 |
|
|
|
| 37 |
|
|
my $updates = {$hash => $entry}; |
| 38 |
|
|
|
| 39 |
|
|
binmode STDOUT, ':encoding(utf-8)'; |
| 40 |
|
|
print "Content-Type: application/json\n\n"; |
| 41 |
|
|
|
| 42 |
|
|
require JSON; |
| 43 |
|
|
print scalar JSON::objToJson ($updates); |
| 44 |
wakaba |
1.1 |
exit; |
| 45 |
|
|
} else { |
| 46 |
|
|
print q[Status: 405 Method Not Allowed |
| 47 |
|
|
Content-Type: text/plain ; charset=us-ascii |
| 48 |
|
|
Allow: POST |
| 49 |
|
|
|
| 50 |
|
|
405]; |
| 51 |
|
|
exit; |
| 52 |
|
|
} |
| 53 |
|
|
} elsif ($path =~ m#^/([0-9a-f]+)\.json$#) { |
| 54 |
|
|
my $hash = $1; |
| 55 |
wakaba |
1.2 |
my $entry = get_entry_or_fallback_entry ($hash); |
| 56 |
wakaba |
1.1 |
|
| 57 |
|
|
binmode STDOUT, ':encoding(utf-8)'; |
| 58 |
|
|
print "Content-Type: application/json\n\n"; |
| 59 |
|
|
|
| 60 |
|
|
require JSON; |
| 61 |
|
|
print scalar JSON::objToJson ($entry); |
| 62 |
wakaba |
1.2 |
exit; |
| 63 |
|
|
} elsif ($path eq '/updates.json') { |
| 64 |
|
|
my $updates = {}; |
| 65 |
|
|
for (get_modified_hashes ()) { |
| 66 |
|
|
$updates->{$_} = get_entry_or_fallback_entry ($_); |
| 67 |
|
|
} |
| 68 |
|
|
|
| 69 |
|
|
binmode STDOUT, ':encoding(utf-8)'; |
| 70 |
|
|
print "Content-Type: application/json\n\n"; |
| 71 |
|
|
|
| 72 |
|
|
require JSON; |
| 73 |
|
|
print scalar JSON::objToJson ($updates); |
| 74 |
wakaba |
1.1 |
exit; |
| 75 |
|
|
} |
| 76 |
|
|
|
| 77 |
|
|
print q[Content-Type: text/plain ; charset=us-ascii |
| 78 |
|
|
Status: 404 Not Found |
| 79 |
|
|
|
| 80 |
|
|
404]; |
| 81 |
wakaba |
1.5 |
|
| 82 |
|
|
## Author: Wakaba <w@suika.fam.cx>. |
| 83 |
|
|
## License: Copyright 2008 Wakaba. You are granted a license to use, |
| 84 |
|
|
## reproduce and create derivative works of this script. |
| 85 |
wakaba |
1.6 |
## $Date: 2008/10/27 05:00:33 $ |
Parent Directory
| 
Revision Log