/[suikacvs]/test/suika-accounts/add.cgi
Suika

Diff of /test/suika-accounts/add.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Wed Oct 29 14:43:28 2008 UTC revision 1.3 by wakaba, Thu Oct 30 11:57:07 2008 UTC
# Line 8  use CGI::Carp qw[fatalsToBrowser]; Line 8  use CGI::Carp qw[fatalsToBrowser];
8  require Message::CGI::Carp;  require Message::CGI::Carp;
9    
10  require 'users.pl';  require 'users.pl';
11    require 'texts.pl';
12    
13  require Message::CGI::HTTP;  require Message::CGI::HTTP;
14  require Encode;  require Encode;
# Line 16  $cgi->{decoder}->{'#default'} = sub { Line 17  $cgi->{decoder}->{'#default'} = sub {
17    return Encode::decode ('utf-8', $_[1]);    return Encode::decode ('utf-8', $_[1]);
18  };  };
19    
20    our $Lang = 'ja'
21        if $cgi->get_meta_variable ('HTTP_ACCEPT_LANGUAGE') =~ /\bja\b/; ## TODO: ...
22    
23  require Message::DOM::DOMImplementation;  require Message::DOM::DOMImplementation;
24  my $dom = Message::DOM::DOMImplementation->new;  my $dom = Message::DOM::DOMImplementation->new;
25    
# Line 33  if (@path == 1 and $path[0] eq 'new-user Line 37  if (@path == 1 and $path[0] eq 'new-user
37      my $user_id = $cgi->get_parameter ('user-id');      my $user_id = $cgi->get_parameter ('user-id');
38    
39      if ($user_id !~ /\A[0-9a-z-]{4,20}\z/) {      if ($user_id !~ /\A[0-9a-z-]{4,20}\z/) {
40        print_error (400, qq[User id "$user_id" is invalid; use characters [0-9a-z-]{4,20}]);        print_error (400,
41                       q[User id %s is invalid; use characters [0-9a-z-]{4,20}],
42                       $user_id);
43        exit;        exit;
44      }      }
45            
46      if (get_user_prop ($user_id)) {      if (get_user_prop ($user_id)) {
47        print_error (400, qq[User id "$user_id" is already used]);        print_error (400, q[User id %s is already used], $user_id);
48        exit;        exit;
49      }      }
50    
# Line 47  if (@path == 1 and $path[0] eq 'new-user Line 53  if (@path == 1 and $path[0] eq 'new-user
53      my $user_prop = {id => $user_id, pass_crypted => $pass_crypted};      my $user_prop = {id => $user_id, pass_crypted => $pass_crypted};
54      set_user_prop ($user_id, $user_prop);      set_user_prop ($user_id, $user_prop);
55    
56        regenerate_htpasswd_and_htgroup ();
57      commit ();      commit ();
58    
59      my $user_url = get_absolute_url ('../edit/users/' . $user_id . '/');      my $user_url = get_absolute_url ('../edit/users/' . $user_id . '/');
# Line 57  Content-Type: text/html; charset=utf-8 Line 64  Content-Type: text/html; charset=utf-8
64    
65  <!DOCTYPE HTML>  <!DOCTYPE HTML>
66  <html lang=en>  <html lang=en>
67  <title>User "@{[htescape ($user_id)]}" registered</title>  <title>];
68        print_text ('User %s registered', sub { print '', htescape ($user_id) });
69        print q[</title>
70  <link rel=stylesheet href="/www/style/html/xhtml">  <link rel=stylesheet href="/www/style/html/xhtml">
71  <h1>User "@{[htescape ($user_id)]}" registered</h1>  <h1>];
72  <p>Your user account is created successfully.      print_text ('User %s registered', sub { print '', htescape ($user_id) });
73  <p>See <a href="@{[htescape ($user_url)]}">your user account information page</a>.];      print q[</h1><p>];
74        print_text ('Your user account is created successfully.');
75        print q[<p>];
76        print_text ('See %s.', sub {
77          print q[<a href="@{[htescape ($user_url)]}">];
78          print_text ('your user account information page');
79          print q[</a>];
80        });
81      exit;      exit;
82    } else {    } else {
83      binmode STDOUT, ":encoding(utf-8)";      binmode STDOUT, ":encoding(utf-8)";
84      print qq[Content-Type: text/html; charset=utf-8      print q[Content-Type: text/html; charset=utf-8
85    
86  <!DOCTYPE HTML>  <!DOCTYPE HTML>
87  <html lang=en>  <html lang=en>
88  <title>Create a new user account</title>  <title>];
89        print_text ('Create a new user account');
90        print q[</title>
91  <link rel=stylesheet href="/www/style/html/xhtml">  <link rel=stylesheet href="/www/style/html/xhtml">
92  <h1>Create a new user account</h1>  <h1>];
93        print_text ('Create a new user account');
94        print q[</h1>
95    
96  <form action=new-user accept-charset=utf-8 method=post>  <form action=new-user accept-charset=utf-8 method=post>
97    
98  <p><strong>User id</strong>: <input type=text name=user-id  <p><strong>];
99  maxlength=20 size=10 required pattern="[0-9a-z-]{4,20}"      print_text ('User id');
100  title="Use a string of characters 'a'..'z', '0'..'9', and '-' with length 4..10 (inclusive)">      print q[</strong>: <input type=text name=user-id
101    maxlength=20 size=10 required pattern="[0-9a-z-]{4,20}"> (];
102  <p><strong>Password</strong>: <input type=password name=user-pass      print_text ('Use [0-9a-z-]{4,20}.');
103  size=10 required pattern=".{4,}" title="Type 4 characters at minimum">      print q[)<p><strong>];
104        print_text ('Password');
105  <p><strong>Password</strong> (type again): <input type=password      print q[</strong>: <input type=password name=user-pass
106    size=10 required pattern=".{4,}"> (];
107        print_text ('Type 4 characters at minimum');
108        print q[)<p><strong>];
109        print_text ('Password');
110        print q[</strong> (];
111        print_text ('type again');
112        print q[): <input type=password
113  name=user-pass2 size=10 required pattern=".{4,}">  name=user-pass2 size=10 required pattern=".{4,}">
114    
115  <p><input type=submit value=Create>  <p><input type=submit value="];
116        print_text ('Create');
117  </form>];      print q["></form>];
118      exit;      exit;
119    }    }
120  } elsif (@path == 0) {  } elsif (@path == 0) {
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24