| 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 = normalize_width ($cgi->get_parameter ('en')); |
| 22 |
my $ja = normalize_width ($cgi->get_parameter ('ja')); |
| 23 |
my $is_pattern = $cgi->get_parameter ('pattern'); |
| 24 |
my $tags = [map {normalize ($_)} |
| 25 |
split /[\x0D\x0A]+/, |
| 26 |
normalize_width ($cgi->get_parameter ('tags') // '')]; |
| 27 |
|
| 28 |
my $hash = get_hash ($en); |
| 29 |
my $entry = {en => $en, ja => $ja, tags => $tags, |
| 30 |
isPattern => $is_pattern}; |
| 31 |
|
| 32 |
lock_entry ($hash); |
| 33 |
set_entry ($hash, $is_pattern => $entry); |
| 34 |
commit_entries ("$path: $hash updated by $ENV{REMOTE_USER}"); |
| 35 |
|
| 36 |
print "Status: 200 Saved\n"; |
| 37 |
|
| 38 |
my $updates = {$hash => $entry}; |
| 39 |
|
| 40 |
binmode STDOUT, ':encoding(utf-8)'; |
| 41 |
print "Content-Type: application/json\n\n"; |
| 42 |
|
| 43 |
require JSON; |
| 44 |
print scalar JSON::objToJson ($updates); |
| 45 |
exit; |
| 46 |
} else { |
| 47 |
print q[Status: 405 Method Not Allowed |
| 48 |
Content-Type: text/plain ; charset=us-ascii |
| 49 |
Allow: POST |
| 50 |
|
| 51 |
405]; |
| 52 |
exit; |
| 53 |
} |
| 54 |
} elsif ($path =~ m#^/([0-9a-f]+)\.json$#) { |
| 55 |
my $hash = $1; |
| 56 |
my $entry = get_entry_or_fallback_entry ($hash); |
| 57 |
|
| 58 |
binmode STDOUT, ':encoding(utf-8)'; |
| 59 |
print "Content-Type: application/json\n\n"; |
| 60 |
|
| 61 |
require JSON; |
| 62 |
print scalar JSON::objToJson ($entry); |
| 63 |
exit; |
| 64 |
} elsif ($path eq '/updates.json') { |
| 65 |
my $updates = {}; |
| 66 |
for (get_modified_hashes ()) { |
| 67 |
$updates->{$_} = get_entry_or_fallback_entry ($_); |
| 68 |
} |
| 69 |
|
| 70 |
binmode STDOUT, ':encoding(utf-8)'; |
| 71 |
print "Content-Type: application/json\n\n"; |
| 72 |
|
| 73 |
require JSON; |
| 74 |
print scalar JSON::objToJson ($updates); |
| 75 |
exit; |
| 76 |
} |
| 77 |
|
| 78 |
print q[Content-Type: text/plain ; charset=us-ascii |
| 79 |
Status: 404 Not Found |
| 80 |
|
| 81 |
404]; |
| 82 |
|
| 83 |
## Author: Wakaba <w@suika.fam.cx>. |
| 84 |
## License: Copyright 2008 Wakaba. You are granted a license to use, |
| 85 |
## reproduce and create derivative works of this script. |
| 86 |
## $Date: 2008/10/31 04:30:24 $ |
Parent Directory
| 
Revision Log