File: poll-mirrors.pl

package info (click to toggle)
lucene-solr 3.6.2%2Bdfsg-27
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 91,144 kB
  • sloc: java: 465,555; xml: 24,939; javascript: 5,291; ruby: 3,453; jsp: 2,637; python: 1,619; sh: 1,556; perl: 1,407; cpp: 305; makefile: 41
file content (128 lines) | stat: -rwxr-xr-x 4,297 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#!/usr/bin/perl
#
# poll-mirrors.pl
#
# This script is designed to poll download sites after posting a release
# and print out notice as each becomes available.  The RM can use this
# script to delay the release announcement until the release can be
# downloaded.
#
#
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#

use strict;
use warnings;
use Getopt::Long;
use POSIX qw/strftime/;
use LWP::UserAgent;

my $version;
my $interval = 300;
my $quiet = 0;

my $result = GetOptions ("version=s" => \$version, "interval=i" => \$interval);

my $usage = "$0 -v version [ -i interval (seconds; default: 300) ]";

unless ($result) {
  print STDERR $usage;
  exit(1);
}
unless (defined($version) && $version =~ /\d+(?:\.\d+)+/) {
  print STDERR "You must specify the release version.\n$usage";
  exit(1);
}

my $previously_selected = select STDOUT;
$| = 1; # turn off buffering of STDOUT, so status is printed immediately
select $previously_selected;

my $apache_url_suffix = "lucene/java/$version/lucene-$version.zip.asc";
my $apache_mirrors_list_url = "http://www.apache.org/mirrors/";
my $maven_url = "http://repo1.maven.org/maven2/org/apache/lucene/lucene-core/$version/lucene-core-$version.pom.asc";

my $agent = LWP::UserAgent->new();
$agent->timeout(2);

my $maven_available = 0;

my @apache_mirrors = ();

my $apache_mirrors_list_page = $agent->get($apache_mirrors_list_url)->decoded_content;
if (defined($apache_mirrors_list_page)) {
  #<TR>
  #  <TD ALIGN=RIGHT><A HREF="http://apache.dattatec.com/">apache.dattatec.com</A>&nbsp;&nbsp;<A HREF="http://apache.dattatec.com/">@</A></TD>
  #
  #  <TD>http</TD>
  #  <TD ALIGN=RIGHT>8 hours<BR><IMG BORDER=1 SRC="icons/mms14.gif" ALT=""></TD>
  #  <TD ALIGN=RIGHT>5 hours<BR><IMG BORDER=1 SRC="icons/mms14.gif" ALT=""></TD>
  #  <TD>ok</TD>
  #</TR>
  while ($apache_mirrors_list_page =~ m~<TR>(.*?)</TR>~gis) {
    my $mirror_entry = $1;
    next unless ($mirror_entry =~ m~<TD>\s*ok\s*</TD>\s*$~i); # skip mirrors with problems
    if ($mirror_entry =~ m~<A\s+HREF\s*=\s*"([^"]+)"\s*>~i) {
      my $mirror_url = $1;
      push @apache_mirrors, "$mirror_url/$apache_url_suffix";
    }
  }
} else {
  print STDERR "Error fetching Apache mirrors list $apache_mirrors_list_url";
  exit(1);
}

my $num_apache_mirrors = $#apache_mirrors;

my $sleep_interval = 0;
while (1) {
  print "\n", strftime('%d-%b-%Y %H:%M:%S', localtime);
  print "\nPolling $#apache_mirrors Apache Mirrors";
  print " and Maven Central" unless ($maven_available);
  print "...\n";

  my $start = time();
  $maven_available = (200 == $agent->get($maven_url)->code)
    unless ($maven_available);
  @apache_mirrors = &check_mirrors;
  my $stop = time();
  $sleep_interval = $interval - ($stop - $start);

  my $num_downloadable_apache_mirrors = $num_apache_mirrors - $#apache_mirrors;
  print "$version is ", ($maven_available ? "" : "not "),
    "downloadable from Maven Central.\n";
  printf "$version is downloadable from %d/%d Apache Mirrors (%0.1f%%)\n",
    $num_downloadable_apache_mirrors, $num_apache_mirrors,
    ($num_downloadable_apache_mirrors*100/$num_apache_mirrors);

  last if ($maven_available && 0 == $#apache_mirrors);

  if ($sleep_interval > 0) {
    print "Sleeping for $sleep_interval seconds...\n";
    sleep($sleep_interval)
  }
}

sub check_mirrors {
  my @not_yet_downloadable_apache_mirrors;
  for my $mirror (@apache_mirrors) {
    push @not_yet_downloadable_apache_mirrors, $mirror
      unless (200 == $agent->get($mirror)->code);
    print ".";
  }
  print "\n";
  return @not_yet_downloadable_apache_mirrors;
}