/[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.4 by wakaba, Sat Nov 1 10:13:14 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    our $subject_prefix;
14    
15  require Message::CGI::HTTP;  require Message::CGI::HTTP;
16  require Encode;  require Encode;
# Line 16  $cgi->{decoder}->{'#default'} = sub { Line 19  $cgi->{decoder}->{'#default'} = sub {
19    return Encode::decode ('utf-8', $_[1]);    return Encode::decode ('utf-8', $_[1]);
20  };  };
21    
22    our $Lang = 'ja'
23        if $cgi->get_meta_variable ('HTTP_ACCEPT_LANGUAGE') =~ /\bja\b/; ## TODO: ...
24    
25  require Message::DOM::DOMImplementation;  require Message::DOM::DOMImplementation;
26  my $dom = Message::DOM::DOMImplementation->new;  my $dom = Message::DOM::DOMImplementation->new;
27    
# Line 33  if (@path == 1 and $path[0] eq 'new-user Line 39  if (@path == 1 and $path[0] eq 'new-user
39      my $user_id = $cgi->get_parameter ('user-id');      my $user_id = $cgi->get_parameter ('user-id');
40    
41      if ($user_id !~ /\A[0-9a-z-]{4,20}\z/) {      if ($user_id !~ /\A[0-9a-z-]{4,20}\z/) {
42        print_error (400, qq[User id "$user_id" is invalid; use characters [0-9a-z-]{4,20}]);        print_error (400,
43                       q[User id %s is invalid; use characters [0-9a-z-]{4,20}],
44                       $user_id);
45        exit;        exit;
46      }      }
47            
48      if (get_user_prop ($user_id)) {      if (get_user_prop ($user_id)) {
49        print_error (400, qq[User id "$user_id" is already used]);        print_error (400, q[User id %s is already used], $user_id);
50        exit;        exit;
51      }      }
52    
# Line 47  if (@path == 1 and $path[0] eq 'new-user Line 55  if (@path == 1 and $path[0] eq 'new-user
55      my $user_prop = {id => $user_id, pass_crypted => $pass_crypted};      my $user_prop = {id => $user_id, pass_crypted => $pass_crypted};
56      set_user_prop ($user_id, $user_prop);      set_user_prop ($user_id, $user_prop);
57    
58        send_mail ("$subject_prefix User $user_id created",
59                   "User: $user_id\nStatus: User registered\n");
60    
61        regenerate_htpasswd_and_htgroup ();
62      commit ();      commit ();
63    
64      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 69  Content-Type: text/html; charset=utf-8
69    
70  <!DOCTYPE HTML>  <!DOCTYPE HTML>
71  <html lang=en>  <html lang=en>
72  <title>User "@{[htescape ($user_id)]}" registered</title>  <title>];
73        print_text ('User %s registered', sub { print '', htescape ($user_id) });
74        print q[</title>
75  <link rel=stylesheet href="/www/style/html/xhtml">  <link rel=stylesheet href="/www/style/html/xhtml">
76  <h1>User "@{[htescape ($user_id)]}" registered</h1>  <h1>];
77  <p>Your user account is created successfully.      print_text ('User %s registered', sub { print '', htescape ($user_id) });
78  <p>See <a href="@{[htescape ($user_url)]}">your user account information page</a>.];      print q[</h1><p>];
79        print_text ('Your user account is created successfully.');
80        print q[<p>];
81        print_text ('See %s.', sub {
82          print qq[<a href="@{[htescape ($user_url)]}">];
83          print_text ('your user account information page');
84          print q[</a>];
85        });
86      exit;      exit;
87    } else {    } else {
88      binmode STDOUT, ":encoding(utf-8)";      binmode STDOUT, ":encoding(utf-8)";
89      print qq[Content-Type: text/html; charset=utf-8      print q[Content-Type: text/html; charset=utf-8
90    
91  <!DOCTYPE HTML>  <!DOCTYPE HTML>
92  <html lang=en>  <html lang=en>
93  <title>Create a new user account</title>  <title>];
94        print_text ('Create a new user account');
95        print q[</title>
96  <link rel=stylesheet href="/www/style/html/xhtml">  <link rel=stylesheet href="/www/style/html/xhtml">
97  <h1>Create a new user account</h1>  <h1>];
98        print_text ('Create a new user account');
99        print q[</h1>
100    
101  <form action=new-user accept-charset=utf-8 method=post>  <form action=new-user accept-charset=utf-8 method=post>
102    
103  <p><strong>User id</strong>: <input type=text name=user-id  <p><strong>];
104  maxlength=20 size=10 required pattern="[0-9a-z-]{4,20}"      print_text ('User id');
105  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
106    maxlength=20 size=10 required pattern="[0-9a-z-]{4,20}"> (];
107  <p><strong>Password</strong>: <input type=password name=user-pass      print_text ('Use [0-9a-z-]{4,20}.');
108  size=10 required pattern=".{4,}" title="Type 4 characters at minimum">      print q[)<p><strong>];
109        print_text ('Password');
110  <p><strong>Password</strong> (type again): <input type=password      print q[</strong>: <input type=password name=user-pass
111    size=10 required pattern=".{4,}"> (];
112        print_text ('Type 4 characters at minimum');
113        print q[)<p><strong>];
114        print_text ('Password');
115        print q[</strong> (];
116        print_text ('type again');
117        print q[): <input type=password
118  name=user-pass2 size=10 required pattern=".{4,}">  name=user-pass2 size=10 required pattern=".{4,}">
119    
120  <p><input type=submit value=Create>  <p><input type=submit value="];
121        print_text ('Create');
122  </form>];      print q["></form>];
123      exit;      exit;
124    }    }
125  } elsif (@path == 0) {  } elsif (@path == 0) {
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24