html5/spec-ja/edit2.cgi

#!/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 = $cgi->get_parameter ('en');
    my $ja = $cgi->get_parameter ('ja');
    my $is_pattern = $cgi->get_parameter ('pattern');
    my $tags = [map {normalize ($_)}
                split /[\x0D\x0A]+/, $cgi->get_parameter ('tags') // ''];

    my $hash = get_hash ($en);
    my $entry = {en => $en, ja => $ja, tags => $tags,
                 is_pattern => $is_pattern};
    
    lock_entry ($hash);
    set_entry ($hash, $is_pattern => $entry);
    commit_entries ("$path: $hash updated by $ENV{AUTH_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];
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			is_pattern => $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];