1 #!/usr/local/bin/perl
2
3 use warnings;
4 use strict;
5
6 use DBI;
7 use Data::Dumper;
8 use HTTP::Date;
9
10 # Configuration for DRC's laptop and for live
11 use constant BACKPAN => -e '/web/cpxxxan/backpan'
12 ? '/web/cpxxxan/backpan'
13 : '/Users/david/BackPAN';
14 use constant CPXXXANROOT => -e '/web/cpxxxan'
15 ? '/web/cpxxxan'
16 : '.';
17
18 my $perl = shift();
19 die("Must specify a perl, eg\n\n \$ $0 5.6.2\n") unless($perl);
20
21 my $os = '';
22 $os = $perl if($perl =~ /[a-z]/i);
23
24 my $cpxxxan = DBI->connect('dbi:mysql:database=cpXXXan', 'root', '');
25
26 (my $view = 'relevantpasses'.$os.$perl) =~ s/\W//g;
27
28 my @modules = ();
29 my $query = qq{
30 CREATE OR REPLACE VIEW $view AS
31 SELECT * FROM passes WHERE FILTER
32 };
33 if($os) { $query =~ s/FILTER/osname='$os'/ }
34 else { $query =~ s/FILTER/perl='$perl'/ }
35
36 $cpxxxan->do($query);
37 $query = qq{
38 SELECT DISTINCT dist, distversion
39 FROM $view p1
40 WHERE normdistversion=(
41 SELECT MAX(normdistversion)
42 FROM $view p2
43 WHERE p1.dist=p2.dist
44 )
45 };
46 my $dist_maxdistversion = $cpxxxan->selectall_arrayref($query, {Slice => {}});
47
48 my $modules_sth = $cpxxxan->prepare(q{
49 SELECT module, modversion, file
50 FROM modules, dists
51 WHERE modules.dist=dists.dist AND
52 modules.distversion=dists.distversion AND
53 modules.dist = ? AND
54 modules.distversion = ?
55 });
56 foreach my $record (@{$dist_maxdistversion}) {
57 printf("DIST: %s: %s\n", $record->{dist}, $record->{distversion})
58 if($ENV{VERBOSE});
59 $modules_sth->execute($record->{dist}, $record->{distversion});
60 my $modules = $modules_sth->fetchall_arrayref({});
61 foreach my $module (@{$modules}) {
62 printf("MOD: %s: %s %s\n", map { $module->{$_} } qw(module modversion file))
63 if($ENV{VERBOSE});
64 push @modules, $module;
65 }
66 }
67
68 my $mirror = $os ? $os : $perl;
69
70 mkdir CPXXXANROOT."/cp${mirror}an";
71 mkdir CPXXXANROOT."/cp${mirror}an/modules";
72 mkdir CPXXXANROOT."/cp${mirror}an/authors";
73 mkdir CPXXXANROOT."/apache-conf";
74
75 unlink CPXXXANROOT."/cp${mirror}an/authors/01mailrc.txt.gz";
76 unlink CPXXXANROOT."/cp${mirror}an/modules/03modlist.data.gz";
77 unlink CPXXXANROOT."/cp${mirror}an/authors/id";
78 unlink CPXXXANROOT."/cp${mirror}an/other-mirrors.shtml";
79 unlink CPXXXANROOT."/cp${mirror}an/howitworks.shtml";
80
81 symlink BACKPAN."/authors/01mailrc.txt.gz",
82 CPXXXANROOT."/cp${mirror}an/authors/01mailrc.txt.gz";
83 symlink BACKPAN."/modules/03modlist.data.gz",
84 CPXXXANROOT."/cp${mirror}an/modules/03modlist.data.gz";
85 symlink BACKPAN."/authors/id",
86 CPXXXANROOT."/cp${mirror}an/authors/id";
87 symlink CPXXXANROOT."/other-mirrors.shtml",
88 CPXXXANROOT."/cp${mirror}an/other-mirrors.shtml";
89 symlink CPXXXANROOT."/src/howitworks.shtml",
90 CPXXXANROOT."/cp${mirror}an/howitworks.shtml";
91
92 open(my $packagesfile, '>', "cp${mirror}an/modules/02packages.details.txt")
93 || die("Can't write cp${mirror}an/modules/02packages.details.txt\n");
94 print $packagesfile "Description: This is a whitespace-seperated file.\n";
95 print $packagesfile "Description: Each line is modulename moduleversion filename.\n";
96 print $packagesfile "Line-Count: ".@modules."\n";
97 print $packagesfile "Last-Updated: ".HTTP::Date::time2str()."\n";
98 print $packagesfile "\n";
99 print $packagesfile sprintf(
100 "%s %s %s\n", $_->{module}, $_->{modversion}, $_->{'file'}
101 ) foreach (sort { $a->{module} cmp $b->{module} } @modules);
102 close($packagesfile);
103 system(qw(gzip -9f), "cp${mirror}an/modules/02packages.details.txt");
104
105 my $apacheconf = q{
106 <VirtualHost cpX.X.Xan.barnyard.co.uk>
107 CustomLog logs/cpX.X.Xan.barnyard.co.uk-access_log combined
108 ErrorLog /var/log/apache2/cpX.X.Xan.barnyard.co.uk-error_log
109 DocumentRoot "/web/cpxxxan/cpX.X.Xan"
110 ServerAdmin webmaster@cantrell.org.uk
111 ServerName cpX.X.Xan.barnyard.co.uk
112
113 AddType text/html .shtml
114 AddOutputFilter INCLUDES .shtml
115
116 <Directory "/web/cpxxxan/cpX.X.Xan">
117 Options FollowSymLinks Includes
118 AllowOverride None
119 Order allow,deny
120 Allow from all
121 </Directory>
122 </VirtualHost>
123 };
124 $apacheconf =~ s/X\.X\.X/$mirror/g;
125 open(APACHECONF, '>', CPXXXANROOT."/apache-conf/cp${mirror}an.conf")
126 || die("Can't write ".CPXXXANROOT."/apache-conf/cp${mirror}an.conf\n");
127 print APACHECONF $apacheconf;
128 close(APACHECONF);
129
130 my $indexshtml = q{
131 <html><head><title>
132 CPX.X.XAN: the Comprehensive Perl X.X.X Archive Network
133 </title></head><body>
134 <TABLE ALIGN=RIGHT><TR><TD WIDTH=100 ALIGN=CENTER>
135 <form action="https://www.paypal.com/cgi-bin/webscr" method="post">
136 <input type="hidden" name="cmd" value="_xclick">
137 <input type="hidden" name="business" value="david@cantrell.org.uk">
138 <input type="hidden" name="item_name" value="CPX.X.XAN">
139 <input type="hidden" name="no_note" value="1">
140 <input type="hidden" name="currency_code" value="EUR">
141 <input type="hidden" name="tax" value="0">
142 <input type="image" src="https://www.paypal.com/images/x-click-butcc-donate.gif" border="0" name="submit" alt="Make payments with PayPal">
143 </form>
144 </TD></TR></TABLE>
145 <p>
146 <a href=http://www.cantrell.org.uk/cgit/cgit.cgi/cpxxxan/>Source code</a> |
147 <a href=mailto:david@cantrell.org.uk?Subject=cpX.X.Xan%20bug%20report>Report bugs</a>
148 <h1>Welcome to CPX.X.XAN</h1>
149 To use this mirror, point your CPAN.pm config at
150 http://cpX.X.Xan.barnyard.co.uk/
151 <h1>Other similar mirrors</h1>
152 <!--#include virtual="other-mirrors.shtml"-->
153 <!--#include virtual="howitworks.shtml"-->
154
155 </body></html>};
156 $indexshtml =~ s/X\.X\.X/$mirror/g;
157 open(INDEXSHTML, '>', CPXXXANROOT."/cp${mirror}an/index.shtml")
158 || die("Can't write ".CPXXXANROOT."/cp${mirror}an/index.shtml\n");
159 print INDEXSHTML $indexshtml;
160 close(INDEXSHTML);
161
162 chdir(CPXXXANROOT);
163 opendir(DIR, '.') || die("Can't readdir(".CPXXXANROOT.")\n");
164 open(OTHERMIRRORS, '>', 'other-mirrors.shtml')
165 || die("Can't write ".CPXXXANROOT."/other-mirrors.shtml");
166 print OTHERMIRRORS '<ul>';
167 print OTHERMIRRORS "<li><a href=http://$_.barnyard.co.uk/>".
168 uc(substr($_, 0, 2)).
169 lc(substr($_, 2, length($_) - 4)).
170 uc(substr($_, -2)).
171 "</a>"
172 foreach(sort grep { /^cp.+an/ } readdir(DIR));
173 print OTHERMIRRORS '</ul>';
174 close(OTHERMIRRORS);
175 closedir(DIR);
|
