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 | use CPANPLUS::Backend; |
5bc5f6dc |
10 | use CPANPLUS::Internals::Constants; |
6aaee015 |
11 | |
12 | use Test::More 'no_plan'; |
13 | use Data::Dumper; |
5bc5f6dc |
14 | use File::Basename qw[dirname]; |
6aaee015 |
15 | |
16 | my $conf = gimme_conf(); |
5bc5f6dc |
17 | my $cb = CPANPLUS::Backend->new( $conf ); |
18 | |
19 | ### XXX temp |
20 | # $conf->set_conf( verbose => 1 ); |
6aaee015 |
21 | |
6aaee015 |
22 | isa_ok($cb, "CPANPLUS::Internals" ); |
23 | |
24 | my $mt = $cb->_module_tree; |
25 | my $at = $cb->_author_tree; |
26 | my $modname = TEST_CONF_MODULE; |
27 | |
28 | for my $name (qw[auth mod dslip] ) { |
29 | my $file = File::Spec->catfile( |
30 | $conf->get_conf('base'), |
31 | $conf->_get_source($name) |
32 | ); |
33 | ok( (-e $file && -f _ && -s _), "$file exists" ); |
34 | } |
35 | |
5bc5f6dc |
36 | ok( scalar keys %$at, "Authortree loaded successfully" ); |
37 | ok( scalar keys %$mt, "Moduletree loaded successfully" ); |
38 | |
39 | ### test lookups |
40 | { my $auth = $at->{'EUNOXS'}; |
41 | my $mod = $mt->{$modname}; |
42 | |
43 | isa_ok( $auth, 'CPANPLUS::Module::Author' ); |
44 | isa_ok( $mod, 'CPANPLUS::Module' ); |
45 | } |
46 | |
47 | ### check custom sources |
48 | ### XXX whitebox test |
49 | { ### first, find a file to serve as a source |
50 | my $mod = $mt->{$modname}; |
51 | my $package = File::Spec->rel2abs( |
52 | File::Spec->catfile( |
53 | $FindBin::Bin, |
54 | TEST_CONF_CPAN_DIR, |
55 | $mod->path, |
56 | $mod->package, |
57 | ) |
58 | ); |
59 | |
60 | ok( $package, "Found file for custom source" ); |
61 | ok( -e $package, " File '$package' exists" ); |
62 | |
63 | ### remote uri |
64 | my $uri = $cb->_host_to_uri( |
65 | scheme => 'file', |
66 | host => '', |
67 | path => File::Spec->catfile( dirname($package) ) |
68 | ); |
69 | |
70 | ### local file |
71 | my $src_file = $cb->_add_custom_module_source( uri => $uri ); |
72 | ok( $src_file, "Sources written to '$src_file'" ); |
73 | ok( -e $src_file, " File exists" ); |
74 | |
75 | ### and write the file |
76 | { my $meth = '__write_custom_module_index'; |
77 | can_ok( $cb, $meth ); |
78 | |
79 | my $rv = $cb->$meth( |
80 | path => dirname( $package ), |
81 | to => $src_file |
82 | ); |
83 | |
84 | ok( $rv, " Sources written" ); |
85 | is( $rv, $src_file, " Written to expected file" ); |
86 | ok( -e $src_file, " Source file exists" ); |
87 | ok( -s $src_file, " File has non-zero size" ); |
88 | } |
89 | |
90 | ### let's see if we can find our custom files |
91 | { my $meth = '__list_custom_module_sources'; |
92 | can_ok( $cb, $meth ); |
93 | |
94 | my %files = $cb->$meth; |
95 | ok( scalar(keys(%files)), |
96 | " Got list of sources" ); |
5879cbe1 |
97 | |
98 | ### on VMS, we can't predict the case unfortunately |
99 | ### so grep for it instead; |
100 | my $found = map { |
101 | my $src_re = quotemeta($src_file); |
102 | $_ =~ /$src_re/i; |
103 | } keys %files; |
104 | |
105 | ok( $found, " Found proper entry for $src_file" ); |
5bc5f6dc |
106 | } |
107 | |
108 | ### now we can have it be loaded in |
109 | { my $meth = '__create_custom_module_entries'; |
110 | can_ok( $cb, $meth ); |
6aaee015 |
111 | |
5bc5f6dc |
112 | ### now add our own sources |
113 | ok( $cb->$meth, "Sources file loaded" ); |
6aaee015 |
114 | |
5bc5f6dc |
115 | my $add_name = TEST_CONF_INST_MODULE; |
116 | my $add = $mt->{$add_name}; |
117 | ok( $add, " Found added module" ); |
118 | |
119 | ok( $add->status->_fetch_from, |
120 | " Full download path set" ); |
121 | is( $add->author->cpanid, CUSTOM_AUTHOR_ID, |
122 | " Attributed to custom author" ); |
123 | |
124 | ### since we replaced an existing module, there should be |
125 | ### a message on the stack |
126 | like( CPANPLUS::Error->stack_as_string, qr/overwrite module tree/i, |
127 | " Addition message recorded" ); |
128 | } |
129 | |
130 | ### test updating custom sources |
131 | { my $meth = '__update_custom_module_sources'; |
132 | can_ok( $cb, $meth ); |
133 | |
134 | ### mark what time it is now, sleep 1 second for better measuring |
135 | my $now = time; |
136 | sleep 1; |
137 | |
138 | my $ok = $cb->$meth; |
139 | |
140 | ok( $ok, "Custom sources updated" ); |
141 | cmp_ok( [stat $src_file]->[9], '>=', $now, |
142 | " Timestamp on sourcefile updated" ); |
143 | } |
144 | |
145 | ### now update it individually |
146 | { my $meth = '__update_custom_module_source'; |
147 | can_ok( $cb, $meth ); |
148 | |
149 | ### mark what time it is now, sleep 1 second for better measuring |
150 | my $now = time; |
151 | sleep 1; |
152 | |
153 | my $ok = $cb->$meth( remote => $uri ); |
154 | |
155 | ok( $ok, "Custom source for '$uri' updated" ); |
156 | cmp_ok( [stat $src_file]->[9], '>=', $now, |
157 | " Timestamp on sourcefile updated" ); |
158 | } |
159 | |
160 | ### now update using the higher level API, see if it's part of the update |
161 | { CPANPLUS::Error->flush; |
162 | |
163 | ### mark what time it is now, sleep 1 second for better measuring |
164 | my $now = time; |
165 | sleep 1; |
166 | |
167 | my $ok = $cb->_build_trees( |
168 | uptodate => 0, |
169 | use_stored => 0, |
170 | ); |
171 | |
172 | ok( $ok, "All sources updated" ); |
173 | cmp_ok( [stat $src_file]->[9], '>=', $now, |
174 | " Timestamp on sourcefile updated" ); |
175 | |
176 | like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/, |
177 | " Update recorded in the log" ); |
178 | } |
179 | |
180 | ### now remove the index file; |
181 | { my $meth = '_remove_custom_module_source'; |
182 | can_ok( $cb, $meth ); |
183 | |
184 | my $file = $cb->$meth( uri => $uri ); |
185 | ok( $file, "Index file removed" ); |
186 | ok( ! -e $file, " File '$file' no longer on disk" ); |
187 | } |
188 | } |
6aaee015 |
189 | |
190 | # Local variables: |
191 | # c-indentation-style: bsd |
192 | # c-basic-offset: 4 |
193 | # indent-tabs-mode: nil |
194 | # End: |
195 | # vim: expandtab shiftwidth=4: |