#!/usr/bin/perl

# vim: set ts=3 sw=3 ai et nu:

#

# Verifies repository URLs and updates repository configuration files

# accordingly (removes failed URLs).

#

# by Pascal Bleser <pascal.bleser@opensuse.org>

#

#     This library is free software; you can redistribute it and/or modify it

#     under the terms of the GNU Lesser General Public License as published by

#     the Free Software Foundation; either version 2.1 of the License, or (at

#     your option) any later version.

#                 

#     This library is distributed in the hope that it will be useful, but

#     WITHOUT ANY WARRANTY; without even the implied warranty of

#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

#     Lesser General Public License for more details.

#      

#     You should have received a copy of the GNU Lesser General Public

#     License along with this library; if not, write to the Free Software

#     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307,

#     USA.

use strict;

use warnings;

use Term::ProgressBar;

use LWP::UserAgent;

use Getopt::Long;

my $repos = "./repos.d";

my $cache_dir = "./cache.d";

my $verbose = undef;

GetOptions(

   'v|verbose' => \$verbose,

);

my @repos = ();

{

   my @rfiles = ();

   if (scalar(@ARGV) > 0) {

      push(@rfiles, @ARGV);

   } else {

      @rfiles = grep { -f } glob($repos.'/*.conf');

   }

   foreach my $rfile (@rfiles) {

      open(my $fh, '<', $rfile) or die "failed to open $rfile: $!";

      while (<$fh>) {

         chomp;

         s/#.*$//;

         s/^\s*//;

         s/\s*//;

         next if /^$/;

         my ($repoid, $distname, $distversion, $baseurl) = split(/\s+/);

         push(@repos, {

            repoid         => $repoid,

            distname       => $distname,

            distversion    => $distversion,

            baseurl        => $baseurl,

            file           => $rfile,

         });

      }

      close($fh);

   }

}

my $ua = LWP::UserAgent->new(

   timeout      => 10,

   agent        => "webpin-repomanager/1.0",

   max_redirect => 4,

);

$ua->env_proxy();

my $progress = undef;

if ($verbose) {

   print "Checking ", scalar(@repos), " URLs", "\n";

   $progress = Term::ProgressBar->new({

      count => scalar(@repos),

      name  => "checking",

      ETA   => 'linear',

   });

   $progress->minor(0);

}

my $count = 0;

my @failed = ();

foreach my $r (@repos) {

   $count++;

   $progress->update($count) if defined $progress;

   my $url = $r->{baseurl}.'/repodata/repomd.xml';

   my $resp = $ua->head($url);

   next if $resp->is_success;

   $r->{code} = $resp->code;

   $r->{status} = $resp->status_line;

   $r->{url} = $url;

   push(@failed, $r);

}

if ($verbose) {

   print "\n", scalar(@failed), "/", scalar(@repos), " failed", "\n";

   foreach my $r (@failed) {

      print $r->{repoid},"\t", $r->{status}, "\t", $r->{url}, "\n";

   }

}

my %failed_repoids = map { $_->{repoid} => 1 } @failed;

my @failed_files = ();

{

   my %failed_files_h = map { $_->{file} => 1 } @failed;

   push(@failed_files, keys %failed_files_h);

}

foreach my $f (@failed_files) {

   my @lines = ();

   {

      open(my $fh, '<', $f) or die "failed to read $f: $!";

      while (<$fh>) {

         chomp;

         my ($repoid, $distname, $distversion, $baseurl) = split(/\s+/);

         push(@lines, $_) unless exists $failed_repoids{$repoid};

      }

      close($fh);

   }

   if (scalar(@lines) < 1) {

      unlink($f) or die "failed to delete file $f: $!";

   } else {

      open(my $fh, '>', $f) or die "failed to write $f: $!";

      foreach (@lines) {

         print $fh $_, "\n";

      }

      close($fh);

   }

}