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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Wed Oct 29 14:43:28 2008 UTC (17 years, 8 months ago) by wakaba
Branch: MAIN
File MIME type: text/plain
New

1 wakaba 1.1 use strict;
2    
3     my $user_data_dir_name = 'data/';
4     my $user_prop_file_suffix = '.user';
5    
6     my $group_data_dir_name = 'data/';
7     my $group_prop_file_suffix = '.group';
8    
9     my $htpasswd_file_name = 'data/htpasswd';
10     my $htgroup_file_name = 'data/htgroup';
11    
12     my $lock_file_name = $user_data_dir_name . '.lock';
13    
14     use Fcntl ':flock';
15     my $Lock;
16    
17     sub lock_start () {
18     return if $Lock;
19    
20     open $Lock, '>', $lock_file_name or die "$0: $lock_file_name: $!";
21     flock $Lock, LOCK_EX;
22     } # lock_start
23    
24     sub get_prop_hash ($) {
25     my $user_prop_file_name = shift;
26    
27     return undef unless -f $user_prop_file_name;
28    
29     my $r = {};
30    
31     open my $user_prop_file, '<:encoding(utf8)', $user_prop_file_name
32     or die "$0: $user_prop_file_name: $!";
33     while (<$user_prop_file>) {
34     tr/\x0D\x0A//d;
35     my ($n, $v) = split /:/, $_, 2;
36     if ($n =~ s/^\@//) {
37     push @{$r->{$n} ||= []}, $v // '';
38     } elsif ($n =~ s/^%//) {
39     $r->{$n}->{$v // ''} = 1;
40     } else {
41     $n =~ s/^\$//;
42     $r->{$n} = $v // '';
43     }
44     }
45    
46     return $r;
47     } # get_prop_hash
48    
49     sub set_prop_hash ($$) {
50     my $user_prop_file_name = shift;;
51     my $prop = shift;
52    
53     my $has_file = -f $user_prop_file_name;
54    
55     open my $user_prop_file, '>:encoding(utf8)', $user_prop_file_name
56     or die "$0: $user_prop_file_name: $!";
57     for my $prop_name (sort {$a cmp $b} keys %$prop) {
58     if (ref $prop->{$prop_name} eq 'ARRAY') {
59     my $v = '@' . $prop_name;
60     $v =~ tr/\x0D\x0A://d;