File Coverage

makesdb.pl
Criterion Covered Total %
statement 8 34 23.5
branch 3 20 15.0
condition 1 3 33.3
subroutine 0 2 0.0
pod n/a
total 12 59 20.3


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             }