line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
33
|
|
|
6
|
$dbname = shift (@ARGV) || prompt("Database name"); |
4
|
1
|
50
|
|
|
|
6
|
&usage() unless ($dbname =~ /^\w+$/); |
5
|
|
|
|
|
|
|
|
6
|
1
|
50
|
|
|
|
111
|
open (SDB, ">>${dbname}.sdb") || die "Could not open database \"${dbname}.sdb\"!\n"; |
7
|
|
|
|
|
|
|
|
8
|
1
|
50
|
|
|
|
5
|
if ($ARGV[0]) |
9
|
|
|
|
|
|
|
{ |
10
|
1
|
|
|
|
|
590
|
$cryptedpswd = crypt($ARGV[1], substr($ARGV[0],0,2)); |
11
|
1
|
|
|
|
|
18
|
print SDB <
|
12
|
|
|
|
|
|
|
$ARGV[2]/*$ARGV[3] |
13
|
|
|
|
|
|
|
$ARGV[0] |
14
|
|
|
|
|
|
|
$cryptedpswd |
15
|
|
|
|
|
|
|
$ARGV[5] |
16
|
|
|
|
|
|
|
$ARGV[4] |
17
|
|
|
|
|
|
|
END_REC |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
else |
20
|
|
|
|
|
|
|
{ |
21
|
|
|
|
|
|
|
do |
22
|
0
|
|
|
|
|
0
|
{ |
23
|
0
|
|
|
|
|
0
|
$dbuser = prompt("\nDatabase user"); |
24
|
0
|
0
|
|
|
|
0
|
goto DONE unless ($dbuser =~ /^\w+$/); |
25
|
0
|
|
|
|
|
0
|
$dbpswd = prompt("User password"); |
26
|
0
|
0
|
|
|
|
0
|
goto DONE unless ($dbpswd =~ /^\w+$/); |
27
|
0
|
|
|
|
|
0
|
$dbpath = prompt("Database path"); |
28
|
0
|
0
|
|
|
|
0
|
$dbpath = '.' unless ($dbpath); |
29
|
0
|
|
|
|
|
0
|
$dbpath =~ s#/$##; |
30
|
0
|
|
|
|
|
0
|
$dbext = prompt("Table file extension (default .stb)"); |
31
|
0
|
0
|
|
|
|
0
|
$dbext = '.stb' unless ($dbext); |
32
|
0
|
|
|
|
|
0
|
$rdelim = prompt("Record delimiter (default \\r\\n)"); |
33
|
0
|
0
|
|
|
|
0
|
$rdelim = '\r\n' unless ($rdelim); |
34
|
0
|
|
|
|
|
0
|
$fdelim = prompt("Field delimiter (default ::)"); |
35
|
0
|
0
|
|
|
|
0
|
$fdelim = '::' unless ($fdelim); |
36
|
0
|
|
|
|
|
0
|
$cryptedpswd = crypt($dbpswd, substr($dbuser,0,2)); |
37
|
0
|
|
|
|
|
0
|
print SDB <
|
38
|
|
|
|
|
|
|
$dbpath/*$dbext |
39
|
|
|
|
|
|
|
$dbuser |
40
|
|
|
|
|
|
|
$cryptedpswd |
41
|
|
|
|
|
|
|
$fdelim |
42
|
|
|
|
|
|
|
$rdelim |
43
|
|
|
|
|
|
|
END_REC |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
while (1); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
1
|
|
|
|
|
11
|
DONE: ; |
49
|
|
|
|
|
|
|
|
50
|
1
|
|
|
|
|
|
exit (0); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub prompt |
53
|
|
|
|
|
|
|
{ |
54
|
0
|
|
|
0
|
|
|
my ($pmpt,$dflt) = @_; |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
my ($t); |
57
|
0
|
|
|
|
|
|
print "$pmpt: "; |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
$t = <>; |
60
|
0
|
|
|
|
|
|
chomp($t); |
61
|
0
|
0
|
|
|
|
|
$t = $dflt unless ($t =~ /\S/); |
62
|
0
|
|
|
|
|
|
return $t; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub usage |
66
|
|
|
|
|
|
|
{ |
67
|
0
|
|
|
0
|
|
|
print "..usage: $0 [dbname [user password path ext rec_sep field_sep]]\n"; |
68
|
0
|
|
|
|
|
|
print "\nCreates / adds users to a Sprite database.\n\n"; |
69
|
0
|
|
|
|
|
|
exit (1); |
70
|
|
|
|
|
|
|
} |