Line # Revision Author
1 1 abw #!/usr/bin/perl -w # -*- perl -*-
2
3 use strict;
4 use warnings;
5
6 use lib qw( ./lib ../lib );
7 use Config;
8 use File::Spec::Functions qw( catfile );
9 use Template;
10 use ExtUtils::MakeMaker;
11 use Cwd;
12
13 select STDERR;
14 $| = 1;
15 select STDOUT;
16
17 our $CONFIG_DIR = -d 't' ? 't' : '.';
18 our $CONFIG_FILE = 'dbi_test.cfg';
19 our $CONFIG_PATH = catfile($CONFIG_DIR, $CONFIG_FILE);
20 our $RUN_TESTS = 'n';
21 our $TT_QUIET = 0;
22 our $TT_ACCEPT = 0;
23
24 dbi_config();
25
26 my %opts = (
27 'NAME' => 'Template-DBI',
28 'VERSION_FROM' => 'lib/Template/Plugin/DBI.pm',
29 'PMLIBDIRS' => [ 'lib' ],
30 'PREREQ_PM' => {
31 'Template' => 2.15,
32 'DBI' => 1.00,
33 },
34 'dist' => {
35 'COMPRESS' => 'gzip',
36 'SUFFIX' => 'gz',
37 },
38 'clean' => {
39 'FILES' => 't/dbi_test.cfg',
40 },
41 );
42
43
44 if ($ExtUtils::MakeMaker::VERSION >= 5.43) {
45 $opts{ AUTHOR } = 'Andy Wardley <abw@wardley.org>';
46 $opts{ ABSTRACT } = 'DBI plugin for the Template Toolkit',
47 }
48
49
50 WriteMakefile( %opts );
51
52
53 #------------------------------------------------------------------------
54 # dbi_config()
55 #
56 # Quiz the user for options related to running the DBI tests.
57 #------------------------------------------------------------------------
58
59 sub dbi_config {
60 my ($dsn, $user, $pass) = ('') x 3;
61
62 if (ttprompt("Do you want to run the DBI tests?\n" .
63 "It requires access to an existing test database.",
64 $RUN_TESTS) =~ /y/i) {
65
66 $RUN_TESTS = 1;
67 my ($driver, $dbname);
68 require DBI;
69 my @drivers = DBI->available_drivers();
70 local $" = ', ';
71
72 my $default = (grep(/m.?sql/i, @drivers))[0]
73 || $drivers[0] || '';
74
75 message(<<EOF);
76
77 DBI Test Configuration
78 ----------------------
79
80 Please enter the driver name for the test database.
81 The DBD drivers installed on your system are
82
83 @drivers
84
85 EOF
86
87 while (! $driver) {
88 $driver = ttprompt("Enter driver name: ", $default);
89 message("! No such DBD driver\n"), undef $driver
90 unless grep(/^$driver$/, @drivers);
91 }
92
93 message(<<EOF);
94
95 Now enter the data source (DSN) for the test database.
96 Many DBD drivers require only a database name (e.g. 'test') while
97 others may require an alternate format or additional parameters
98 (e.g. 'dbname=test'). Please consult your DBD documentation for
99 further details.
100
101 EOF
102
103 my $dbname_eg = $driver eq 'Pg' ? 'dbname=test' : 'test';
104 while (! $dbname) {
105 $dbname = ttprompt('Database name: ', $dbname_eg);
106 }
107
108 $dsn = "dbi:$driver:$dbname";
109 $user = ttprompt('Enter user name : ', '');
110 $pass = ttprompt('Enter password : ', '');
111 $user = '' unless defined $user;
112 $pass = '' unless defined $pass;
113 }
114 else {
115 $RUN_TESTS = 0;
116 }
117
118 message("\nwriting $CONFIG_PATH\n");
119 open(CFGFILE, ">$CONFIG_PATH") || die "$CONFIG_PATH: $!\n";
120 print CFGFILE <<EOF;
121 \$run = $RUN_TESTS;
122 \$dsn = '$dsn';
123 \$user = '$user';
124 \$pass = '$pass';
125 1;
126 EOF
127 close(CFGFILE);
128 }
129
130
131
132
133
134 #------------------------------------------------------------------------
135 # message($text)
136 #
137 # Print message unless quiet mode.
138 #------------------------------------------------------------------------
139
140 sub message {
141 return if $TT_QUIET;
142 print @_;
143 }
144
145
146 #------------------------------------------------------------------------
147 # ttprompt($message, $default)
148 #------------------------------------------------------------------------
149
150 sub ttprompt {
151 my ($msg, $def)=@_;
152 my $ISA_TTY = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe?
153 my $dispdef = defined $def ? "[$def] " : " ";
154 $def = defined $def ? $def : "";
155 my $ans = '';
156 local $|=1;
157 print "$msg $dispdef" unless $TT_QUIET;
158 if ($TT_ACCEPT || ! $ISA_TTY) {
159 print "$def\n" unless $TT_QUIET;
160 }
161 else {
162 chomp($ans = <STDIN>);
163 }
164 return ($ans ne '') ? $ans : $def;
165 }
166
167
168 #------------------------------------------------------------------------
169 # yep($text)
170 #------------------------------------------------------------------------
171
172 sub yep {
173 return if $TT_QUIET;
174 print '[X] ', shift, "\n";
175 }
176
177
178 #------------------------------------------------------------------------
179 # nope($text)
180 #------------------------------------------------------------------------
181 sub nope {
182 return if $TT_QUIET;
183 print '[ ] ', shift, "\n";
184 }