Parent Directory
| 
Revision Log
New version of editing interface/database, first revision
| 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 | |||
| 29 | lock_entry ($hash); | ||
| 30 | set_entry ($hash, $is_pattern => {en => $en, ja => $ja, tags => $tags}); | ||
| 31 | commit_entries ("$path: $hash updated by $ENV{AUTH_USER}"); | ||
| 32 | |||
| 33 | print "Status: 204 Saved\n\n"; | ||
| 34 | exit; | ||
| 35 | } else { | ||
| 36 | print q[Status: 405 Method Not Allowed | ||
| 37 | Content-Type: text/plain ; charset=us-ascii | ||
| 38 | Allow: POST | ||
| 39 | |||
| 40 | 405]; | ||
| 41 | exit; | ||
| 42 | } | ||
| 43 | } elsif ($path =~ m#^/([0-9a-f]+)\.json$#) { | ||
| 44 | my $hash = $1; | ||
| 45 | my ($is_pattern, $entry) = get_entry ($hash); | ||
| 46 | unless (defined $entry->{en}) { | ||
| 47 | $entry = get_fallback_entry ($hash); | ||
| 48 | } | ||
| 49 | $entry->{tags} ||= [] if defined $entry->{en}; | ||
| 50 | $entry->{isPattern} = 1 if $is_pattern; | ||
| 51 | |||
| 52 | binmode STDOUT, ':encoding(utf-8)'; | ||
| 53 | print "Content-Type: application/json\n\n"; | ||
| 54 | |||
| 55 | require JSON; | ||
| 56 | print scalar JSON::objToJson ($entry); | ||
| 57 | exit; | ||
| 58 | } | ||
| 59 |