Commit | Line | Data |
6aaee015 |
1 | ### make sure we can find our conf.pl file |
2 | BEGIN { |
3 | use FindBin; |
4 | require "$FindBin::Bin/inc/conf.pl"; |
5 | } |
6 | |
7 | use strict; |
8 | |
9 | ### make sure to keep the plan -- this is the only test |
10 | ### supported for 'older' T::H (pre 2.28) -- see Makefile.PL for details |
5bc5f6dc |
11 | use Test::More tests => 40; |
6aaee015 |
12 | |
13 | use Cwd; |
14 | use Data::Dumper; |
15 | use File::Spec; |
16 | use File::Basename; |
17 | |
18 | use CPANPLUS::Error; |
19 | use CPANPLUS::Internals::Utils; |
20 | |
bf269542 |
21 | # File::Spec and Cwd might return different values for a |
22 | # symlinked directory, so we need to be careful. |
23 | sub paths_are_same { |
24 | my($have, $want, $name) = @_; |
25 | |
26 | $have = _resolve_symlinks($have); |
27 | $want = _resolve_symlinks($want); |
28 | |
29 | my $builder = Test::More->builder; |
30 | return $builder->like( $have, qr/\Q$want/i, $name ); |
31 | } |
32 | |
33 | # Resolve any symlinks in a path |
34 | sub _resolve_symlinks { |
35 | my $path = shift; |
36 | my($vol, $dirs, $file) = File::Spec->splitpath($path); |
37 | |
38 | my $resolved = File::Spec->catpath( $vol, "", "" ); |
39 | |
40 | for my $dir (File::Spec->splitdir($dirs)) { |
41 | # Resolve the next part of the path |
42 | my $next = File::Spec->catdir( $resolved, $dir ); |
43 | $next = eval { readlink $next } || $next; |
44 | |
45 | # If its absolute, use it. |
46 | # Otherwise tack it onto the end of the previous path. |
47 | $resolved = File::Spec->file_name_is_absolute($next) |
48 | ? $next |
49 | : File::Spec->catdir( $resolved, $next ); |
50 | } |
51 | |
52 | return File::Spec->catfile($resolved, $file); |
53 | } |
54 | |
6aaee015 |
55 | my $Cwd = File::Spec->rel2abs(cwd()); |
56 | my $Class = 'CPANPLUS::Internals::Utils'; |
57 | my $Dir = 'foo'; |
58 | my $Move = 'bar'; |
59 | my $File = 'zot'; |
60 | |
61 | rmdir $Move if -d $Move; |
62 | rmdir $Dir if -d $Dir; |
63 | |
64 | ### test _mdkir ### |
65 | { ok( $Class->_mkdir( dir => $Dir), "Created dir '$Dir'" ); |
66 | ok( -d $Dir, " '$Dir' is a dir" ); |
67 | } |
68 | |
69 | ### test _chdir ### |
70 | { ok( $Class->_chdir( dir => $Dir), "Chdir to '$Dir'" ); |
5879cbe1 |
71 | |
bf269542 |
72 | my $abs = File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir)); |
73 | paths_are_same( File::Spec->rel2abs(cwd()), $abs, |
6aaee015 |
74 | " Cwd() is '$Dir'"); |
5879cbe1 |
75 | |
6aaee015 |
76 | ok( $Class->_chdir( dir => $Cwd), "Chdir back to '$Cwd'" ); |
bf269542 |
77 | paths_are_same( File::Spec->rel2abs(cwd()), $Cwd, |
5bc5f6dc |
78 | " Cwd() is '$Cwd'" ); |
6aaee015 |
79 | } |
80 | |
81 | ### test _move ### |
82 | { ok( $Class->_move( file => $Dir, to => $Move ), |
83 | "Move from '$Dir' to '$Move'" ); |
84 | ok( -d $Move, " Dir '$Move' exists" ); |
85 | ok( !-d $Dir, " Dir '$Dir' no longer exists" ); |
86 | |
87 | |
88 | { local $CPANPLUS::Error::ERROR_FH = output_handle(); |
89 | |
90 | ### now try to move it somewhere it can't ### |
91 | ok( !$Class->_move( file => $Move, to => 'inc' ), |
92 | " Impossible move detected" ); |
93 | like( CPANPLUS::Error->stack_as_string, qr/Failed to move/, |
94 | " Expected error found" ); |
95 | } |
96 | } |
97 | |
98 | ### test _rmdir ### |
99 | { ok( -d $Move, "Dir '$Move' exists" ); |
100 | ok( $Class->_rmdir( dir => $Move ), " Deleted dir '$Move'" ); |
101 | ok(!-d $Move, " Dir '$Move' no longer exists" ); |
102 | } |
103 | |
104 | ### _get_file_contents tests ### |
105 | { my $contents = $Class->_get_file_contents( file => basename($0) ); |
106 | ok( $contents, "Got file contents" ); |
107 | like( $contents, qr/BEGIN/, " Proper contents found" ); |
108 | like( $contents, qr/CPANPLUS/, " Proper contents found" ); |
109 | } |
110 | |
111 | ### _perl_version tests ### |
112 | { my $version = $Class->_perl_version( perl => $^X ); |
113 | ok( $version, "Perl version found" ); |
72c9b87d |
114 | like( $version, qr/\d.\d+.\d+/, " Looks like a proper version" ); |
6aaee015 |
115 | } |
116 | |
117 | ### _version_to_number tests ### |
118 | { my $map = { |
119 | '1' => '1', |
120 | '1.2' => '1.2', |
121 | '.2' => '.2', |
122 | 'foo' => '0.0', |
123 | 'a.1' => '0.0', |
124 | }; |
125 | |
126 | while( my($try,$expect) = each %$map ) { |
127 | my $ver = $Class->_version_to_number( version => $try ); |
128 | ok( $ver, "Version returned" ); |
129 | is( $ver, $expect, " Value as expected" ); |
130 | } |
131 | } |
132 | |
133 | ### _whoami tests ### |
134 | { sub foo { |
135 | my $me = $Class->_whoami; |
136 | ok( $me, "_whoami returned a result" ); |
137 | is( $me, 'foo', " Value as expected" ); |
138 | } |
139 | |
140 | foo(); |
141 | } |
142 | |
143 | ### _mode_plus_w tests ### |
144 | { open my $fh, ">$File" or die "Could not open $File for writing: $!"; |
145 | close $fh; |
146 | |
147 | ### remove perms |
148 | ok( -e $File, "File '$File' created" ); |
149 | ok( chmod( 000, $File ), " File permissions set to 000" ); |
150 | |
151 | ok( $Class->_mode_plus_w( file => $File ), |
152 | " File permissions set to +w" ); |
153 | ok( -w $File, " File is writable" ); |
154 | |
155 | 1 while unlink $File; |
156 | |
157 | ok( !-e $File, " File removed" ); |
158 | } |
6aaee015 |
159 | |
5bc5f6dc |
160 | ### uri encode/decode tests |
161 | { my $org = 'file://foo/bar'; |
162 | |
163 | my $enc = $Class->_uri_encode( uri => $org ); |
164 | |
165 | ok( $enc, "String '$org' encoded" ); |
166 | like( $enc, qr/%/, " Contents as expected" ); |
167 | |
168 | my $dec = $Class->_uri_decode( uri => $enc ); |
169 | ok( $dec, "String '$enc' decoded" ); |
170 | is( $dec, $org, " Decoded properly" ); |
171 | } |
6aaee015 |
172 | |
173 | |
174 | |
175 | # Local variables: |
176 | # c-indentation-style: bsd |
177 | # c-basic-offset: 4 |
178 | # indent-tabs-mode: nil |
179 | # End: |
180 | # vim: expandtab shiftwidth=4: |
181 | |