/[suikacvs]/test/suika-accounts/users.pl
Suika

Diff of /test/suika-accounts/users.pl

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.6 by wakaba, Sat May 15 03:29:27 2010 UTC
# Line 1  Line 1 
1  use strict;  use strict;
2    
3    my $mail_from = q<webmaster@suika.fam.cx>;
4    my $mail_to = q<webmaster@suika.fam.cx>;
5    my $subject_prefix = q<[suika.fam.cx account]>;
6    
7  my $user_data_dir_name = 'data/';  my $user_data_dir_name = 'data/';
8  my $user_prop_file_suffix = '.user';  my $user_prop_file_suffix = '.user';
9    
# Line 80  sub set_prop_hash ($$) { Line 84  sub set_prop_hash ($$) {
84        print $user_prop_file $v . ':' . $pv . "\x0A";        print $user_prop_file $v . ':' . $pv . "\x0A";
85      }      }
86    }    }
87    close $user_prop_file_name;    close $user_prop_file;
88    
89    system_ ('cvs', 'add', $user_prop_file_name) unless $has_file;    system_ ('cvs', 'add', $user_prop_file_name) unless $has_file;
90  } # set_prop_hash  } # set_prop_hash
# Line 169  sub regenerate_htpasswd_and_htgroup () { Line 173  sub regenerate_htpasswd_and_htgroup () {
173    }    }
174  } # regenerate_htpasswd_and_htgroup  } # regenerate_htpasswd_and_htgroup
175    
176  sub print_error ($$) {  sub print_error ($$;$) {
177    my ($code, $text) = @_;    my ($code, $text, $text_arg) = @_;
178      our $Lang;
179    binmode STDOUT, ':encoding(utf-8)';    binmode STDOUT, ':encoding(utf-8)';
180    print qq[Status: $code $text    my $_text = $text;
181      $_text =~ s/%s/$text_arg/g;
182      print qq[Status: $code $_text
183  Content-Type: text/html; charset=utf-8  Content-Type: text/html; charset=utf-8
184    
185  <!DOCTYPE HTML>  <!DOCTYPE HTML>
186  <html lang=en>  <html lang="$Lang" class=account-error>
187  <title>$code @{[htescape ($text)]}</title>  <title lang=en>$code @{[htescape ($_text)]}</title>
188  <h1>Error</h1>  <link rel=stylesheet href="/admin/style/common">
189  <p>@{[htescape ($text)]}.<!--];  <h1>];
190      print_text ('Error');
191      print q[</h1><p>];
192      print_text ($text, sub { print '', htescape ($text_arg) });
193      print_text ('.');
194      print q[<!--];
195    print 0 for 0..511; # for WinIE    print 0 for 0..511; # for WinIE
196    print q[-->];    print q[-->];
197  } # print_error  } # print_error
# Line 204  sub check_password ($) { Line 216  sub check_password ($) {
216    return $pass_crypted;    return $pass_crypted;
217  } # check_password  } # check_password
218    
219    sub send_mail ($$) {
220      require Net::SMTP;
221      require Encode;
222      
223      my $smtp = Net::SMTP->new ('localhost');
224      $smtp->mail ($mail_from);
225      $smtp->to ($mail_to);
226      ## NOTE: What's wrong with UTF-8 Subject? :-)
227      $smtp->data (Encode::encode ('utf-8', "From: <$mail_from>
228    To: <$mail_to>
229    Subject: $_[0]
230    Content-Type: text/plain; charset=utf-8
231    MIME-Version: 1.0
232    
233    $_[1]"));
234      $smtp->send;
235    } # send_mail
236    
237  sub system_ (@) {  sub system_ (@) {
238    (system join (' ', map {quotemeta $_} @_) . " > /dev/null") == 0    (system join (' ', map {quotemeta $_} @_) . " > /dev/null") == 0
239        or die "$0: $?";        or die "$0: $?";
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24