#!/usr/bin/perl use strict; use CGI::Carp qw(fatalsToBrowser); use lib qw[/home/wakaba/work/manakai2/lib/]; require 'common.pl'; my $path = $ENV{PATH_INFO}; if ($path eq '/') { if ($ENV{REQUEST_METHOD} eq 'POST') { require Message::CGI::HTTP; require Encode; my $cgi = Message::CGI::HTTP->new; $cgi->{decoder}->{'#default'} = sub { return Encode::decode ('utf-8', $_[1]); }; my $en = normalize_width ($cgi->get_parameter ('en')); my $ja = normalize_width ($cgi->get_parameter ('ja')); my $is_pattern = $cgi->get_parameter ('pattern'); my $tags = [map {normalize ($_)} split /[\x0D\x0A]+/, normalize_width ($cgi->get_parameter ('tags') // '')]; my $hash = get_hash ($en); my $entry = {en => $en, ja => $ja, tags => $tags, isPattern => $is_pattern}; lock_entry ($hash); set_entry ($hash, $is_pattern => $entry); commit_entries ("$path: $hash updated by $ENV{REMOTE_USER}"); print "Status: 200 Saved\n"; my $updates = {$hash => $entry}; binmode STDOUT, ':encoding(utf-8)'; print "Content-Type: application/json\n\n"; require JSON; print scalar JSON::objToJson ($updates); exit; } else { print q[Status: 405 Method Not Allowed Content-Type: text/plain ; charset=us-ascii Allow: POST 405]; exit; } } elsif ($path =~ m#^/([0-9a-f]+)\.json$#) { my $hash = $1; my $entry = get_entry_or_fallback_entry ($hash); binmode STDOUT, ':encoding(utf-8)'; print "Content-Type: application/json\n\n"; require JSON; print scalar JSON::objToJson ($entry); exit; } elsif ($path eq '/updates.json') { my $updates = {}; for (get_modified_hashes ()) { $updates->{$_} = get_entry_or_fallback_entry ($_); } binmode STDOUT, ':encoding(utf-8)'; print "Content-Type: application/json\n\n"; require JSON; print scalar JSON::objToJson ($updates); exit; } print q[Content-Type: text/plain ; charset=us-ascii Status: 404 Not Found 404]; ## Author: Wakaba . ## License: Copyright 2008 Wakaba. You are granted a license to use, ## reproduce and create derivative works of this script. ## $Date: 2008/11/02 04:49:55 $