1use strict;
2$^W = 1;
3
4use Test::More;
5use File::Temp;
6use File::Spec;
7use Devel::CheckOS;
8use Cwd;
9
10END { done_testing(); }
11
12my $cwd = getcwd();
13
14use Config ();
15our $Inc = join $Config::Config{path_sep}, @INC;
16
17emptydir();
18MakefilePLexists();
19BuildPLexists();
20BuildPLandMakefilePLexist();
21checkCopyCorrectModulesLinux26MicrosoftWindows();
22checkCopyCorrectModulesPOSIXRedir();
23checkDashl();
24
25sub checkDashl {
26    my $projectdir = File::Temp->newdir();
27    chdir($projectdir);
28    my $cmd = join(' ', map { qq{"$_"} } (
29        $^X, $cwd.'/bin/use-devel-assertos', '-l'
30    ));
31    do { local $ENV{PERL5LIB} = $Inc; $cmd = `$cmd` };
32    chomp($cmd);
33    is_deeply(
34        [sort { $a cmp $b } (Devel::CheckOS::list_platforms())],
35        [sort { $a cmp $b } split(/, /, $cmd)],
36	'-l spews the right stuff'
37    );
38    chdir($cwd);
39    ok(!-e File::Spec->catfile($projectdir, 'MANIFEST'),
40        "... and doesn't write a MANIFEST");
41    ok(!-e File::Spec->catfile($projectdir, 'Makefile.PL'),
42        "... or a Makefile.PL");
43    ok(!-e File::Spec->catdir($projectdir, 'inc'),
44        "... or create directories");
45}
46
47# a big family - make sure all are copied!
48sub checkCopyCorrectModulesPOSIXRedir {
49    my $projectdir = File::Temp->newdir();
50
51    _run_script($projectdir, qw(OSFeatures::POSIXShellRedirection));
52    print "# use-devel-assertos OSFeatures::POSIXShellRedirection\n";
53    my @modules = (
54        'OSFeatures::POSIXShellRedirection',
55        Devel::CheckOS::list_family_members('OSFeatures::POSIXShellRedirection'),
56        Devel::CheckOS::list_family_members('Unix'),
57        Devel::CheckOS::list_family_members('BeOS'),
58        Devel::CheckOS::list_family_members('QNX'),
59    );
60    foreach(@modules) {
61        ok(-e File::Spec->catfile(
62            $projectdir, qw(inc Devel AssertOS), split('::', "$_.pm")),
63	    join('/', "inc/Devel/AssertOS", split('::', "$_.pm"))." exists");
64    }
65    is_deeply(
66        [sort {$a cmp $b} split("\n", _getfile(File::Spec->catfile($projectdir, 'MANIFEST')))],
67	[sort {$a cmp $b} (
68            qw(
69	        inc/Devel/CheckOS.pm inc/Devel/AssertOS.pm
70	        MANIFEST Makefile.PL
71            ),
72            (map {
73                join('/', "inc/Devel/AssertOS", split('::', "$_.pm"))
74            } @modules)
75	)],
76	'... and update MANIFEST correctly'
77    );
78}
79
80# a family plus a specific module plus its parents
81sub checkCopyCorrectModulesLinux26MicrosoftWindows {
82    my $projectdir = File::Temp->newdir();
83
84    _run_script($projectdir, qw(Linux::v2_6 MicrosoftWindows));
85    print "# use-devel-assertos Linux::v2_6 MicrosoftWindows\n";
86    ok(-e File::Spec->catfile(
87        $projectdir, qw(inc Devel AssertOS Linux v2_6.pm)),
88	"inc/Devel/AssertOS/Linux/v2_6.pm exists");
89    ok(-e File::Spec->catfile(
90        $projectdir, qw(inc Devel AssertOS Linux.pm)),
91	"inc/Devel/AssertOS/Linux.pm exists");
92    ok(-e File::Spec->catfile(
93        $projectdir, qw(inc Devel AssertOS MSWin32.pm)),
94	"inc/Devel/AssertOS/MSWin32.pm exists");
95    ok(-e File::Spec->catfile(
96        $projectdir, qw(inc Devel AssertOS Cygwin.pm)),
97	"inc/Devel/AssertOS/Cygwin.pm exists");
98    ok(-e File::Spec->catfile(
99        $projectdir, qw(inc Devel AssertOS MicrosoftWindows.pm)),
100	"inc/Devel/AssertOS/MicrosoftWindows.pm exists");
101    ok(-e File::Spec->catfile(
102        $projectdir, qw(inc Devel AssertOS MSYS.pm)),
103	"inc/Devel/AssertOS/MSYS.pm exists");
104    ok(-e File::Spec->catfile(
105        $projectdir, qw(inc Devel AssertOS.pm)),
106	"inc/Devel/AssertOS.pm exists");
107    ok(-e File::Spec->catfile(
108        $projectdir, qw(inc Devel CheckOS.pm)),
109	"inc/Devel/CheckOS.pm exists");
110    is_deeply(
111        [sort split("\n", _getfile(File::Spec->catfile($projectdir, 'MANIFEST')))],
112	[sort qw( inc/Devel/AssertOS/Android.pm
113	    inc/Devel/AssertOS/Linux/v2_6.pm inc/Devel/AssertOS/Linux.pm
114	    inc/Devel/AssertOS/MSWin32.pm inc/Devel/AssertOS/Cygwin.pm
115	    inc/Devel/AssertOS/MicrosoftWindows.pm
116        inc/Devel/AssertOS/MSYS.pm
117	    inc/Devel/CheckOS.pm inc/Devel/AssertOS.pm
118	    MANIFEST Makefile.PL
119	)],
120	'... and update MANIFEST correctly'
121    );
122}
123
124sub BuildPLandMakefilePLexist {
125    my $projectdir = File::Temp->newdir();
126    _writefile(File::Spec->catfile($projectdir, 'Build.PL'),
127        "build stuff");
128    _writefile(File::Spec->catfile($projectdir, 'Makefile.PL'),
129        "makefile stuff");
130
131    _run_script($projectdir, qw(Linux MSWin32));
132    is_deeply(
133        _getfile(File::Spec->catfile($projectdir, 'Makefile.PL')),
134        'use lib qw(inc); use Devel::AssertOS qw(Linux MSWin32);
135
136makefile stuff', # mmm, significant whitespace
137        'if both exist, edit Makefile.PL'
138    );
139    is_deeply(
140        _getfile(File::Spec->catfile($projectdir, 'Build.PL')),
141        'use lib qw(inc); use Devel::AssertOS qw(Linux MSWin32);
142
143build stuff', # mmm, significant whitespace
144        '... and Build.PL'
145    );
146}
147sub BuildPLexists {
148    my $projectdir = File::Temp->newdir();
149    _writefile(File::Spec->catfile($projectdir, 'Build.PL'),
150        "wibblywobblywoo");
151    _writefile(File::Spec->catfile($projectdir, 'MANIFEST'),
152        "HLAGH\n");
153
154    _run_script($projectdir, qw(Linux MSWin32));
155    ok(!-e File::Spec->catfile($projectdir, 'Makefile.PL'),
156        'Makefile.PL not created');
157    is_deeply(
158        _getfile(File::Spec->catfile($projectdir, 'Build.PL')),
159        'use lib qw(inc); use Devel::AssertOS qw(Linux MSWin32);
160
161wibblywobblywoo', # mmm, significant whitespace
162        'if Build.PL exists, edit it'
163    );
164    is_deeply(
165        [sort split("\n", _getfile(File::Spec->catfile($projectdir, 'MANIFEST')))],
166	[sort qw( inc/Devel/AssertOS/Android.pm
167	    inc/Devel/AssertOS/Linux.pm inc/Devel/AssertOS/MSWin32.pm
168	    inc/Devel/CheckOS.pm inc/Devel/AssertOS.pm
169	    HLAGH
170	)],
171	'... and update MANIFEST correctly'
172    );
173}
174
175sub MakefilePLexists {
176    my $projectdir = File::Temp->newdir();
177    _writefile(File::Spec->catfile($projectdir, 'Makefile.PL'),
178        "wibblywobblywoo");
179    _writefile(File::Spec->catfile($projectdir, 'MANIFEST'),
180        "HLAGH\n");
181
182    _run_script($projectdir, qw(Linux MSWin32));
183    ok(!-e File::Spec->catfile($projectdir, 'Build.PL'),
184        'Build.PL not created');
185    is_deeply(
186        _getfile(File::Spec->catfile($projectdir, 'Makefile.PL')),
187        'use lib qw(inc); use Devel::AssertOS qw(Linux MSWin32);
188
189wibblywobblywoo', # mmm, significant whitespace
190        'if Makefile.PL exists, edit it'
191    );
192    is_deeply(
193        [sort split("\n", _getfile(File::Spec->catfile($projectdir, 'MANIFEST')))],
194	[sort qw( inc/Devel/AssertOS/Android.pm
195	    inc/Devel/AssertOS/Linux.pm inc/Devel/AssertOS/MSWin32.pm
196	    inc/Devel/CheckOS.pm inc/Devel/AssertOS.pm
197	    HLAGH
198	)],
199	'... and update MANIFEST correctly'
200    );
201}
202
203sub emptydir {
204    my $projectdir = File::Temp->newdir();
205    _run_script($projectdir, qw(Linux MSWin32));
206    ok(-e File::Spec->catfile($projectdir, 'Makefile.PL'),
207        "create Makefile.PL if there's neither Makefile.PL nor Build.PL");
208    is_deeply(
209        _getfile(File::Spec->catfile($projectdir, 'Makefile.PL')),
210        'use lib qw(inc); use Devel::AssertOS qw(Linux MSWin32);
211
212', # mmm, significant whitespace
213        '... and created it correctly'
214    );
215    is_deeply(
216        [sort split("\n", _getfile(File::Spec->catfile($projectdir, 'MANIFEST')))],
217	[sort qw( inc/Devel/AssertOS/Android.pm
218	    inc/Devel/AssertOS/Linux.pm inc/Devel/AssertOS/MSWin32.pm
219	    inc/Devel/CheckOS.pm inc/Devel/AssertOS.pm
220	    MANIFEST Makefile.PL
221	)],
222	'... and MANIFEST created OK where there wasn\'t one'
223    );
224}
225
226sub _getfile { open(my $fh, $_[0]) || return ''; local $/; return <$fh>; }
227sub _writefile { open(my $fh, '>', shift()) || return ''; print $fh @_; }
228sub _run_script {
229    chdir(shift());
230    require Config;
231    local $ENV{PERL5LIB} = $Inc;
232    system($^X, $cwd.'/bin/use-devel-assertos', '-q', @_);
233    chdir($cwd);
234}
235