URPM-repoclosure 1.7.1: added -cache option, removed false positives.

urpm-repoclosure.pl

@@ -1,9 +1,9 @@
 #!/usr/bin/perl
 ########################################################
-# URPM Repo Closure Checker 1.6.1 for Linux
+# URPM Repo Closure Checker 1.7.1 for Linux
 # A tool for checking closure of a set of RPM packages
 #
-# Copyright (C) 2011-2012 ROSA Laboratory
+# Copyright (C) 2011-2012 ROSA Lab
 # Written by Andrey Ponomarenko
 #
 # PLATFORMS
@@ -38,17 +38,17 @@ use File::Copy qw(copy move);
 use Data::Dumper;
 use strict;
 
-my $TOOL_VERSION = "1.6.1";
+my $TOOL_VERSION = "1.7.1";
 my $CmdName = get_filename($0);
 
 my ($Help, $ShowVersion, $RPMlist, $RPMdir, $StaticMode,
 $DynamicMode, $NoClean, $HDlist, $FileDeps, $ReportDir,
 $AddRPMs, $RTitle, $DepHDlists, $UpdateHDlists, $Profile,
-$Target, $ExtInfo);
+$Target, $ExtInfo, $UseCache);
 
 my $ShortUsage = "URPM Repo Closure Checker $TOOL_VERSION
 A tool for checking closure of a set of RPM packages
-Copyright (C) 2012 ROSA Laboratory
+Copyright (C) 2012 ROSA Lab
 License: GNU GPL
 
 Usage: $CmdName [options]
@@ -76,6 +76,7 @@ GetOptions("h|help!" => \$Help,
   "dep-hdlists=s" => \$DepHDlists,
   "update-hdlists=s" => \$UpdateHDlists,
   "profile=s" => \$Profile,
+  "cache!" => \$UseCache,
   "target=s" => \$Target,
   "info=s" => \$ExtInfo
 ) or ERR_MESSAGE();
@@ -148,6 +149,9 @@ OPTIONS:
   -profile <path>
       Profile of the test run.
       
+  -cache
+      Cache downloaded files.
+      
   -target <name>
       Run particular test described in the profile.
       
@@ -216,6 +220,7 @@ sub ERR_MESSAGE()
 }
 
 my %Cache;
+
 my $RPM_CACHE = "/var/cache/urpmi/rpms";
 my $TMP_DIR = tempdir(CLEANUP=>1);
 my %InstalledPackage;
@@ -224,6 +229,7 @@ my %Packages;
 my %BrokenSignature;
 my %InstallFailed;
 my $RESULTS_DIR = "repoclosure_reports";
+my $CACHE_DIR = "cache";
 
 sub parseTag(@)
 {
@@ -750,18 +756,52 @@ sub readDeps($$$)
     }
 }
 
+sub cachePath($)
+{
+    my $Url = $_[0];
+    $Url=~s/\A\w+:\/\///g;
+    $Url=~s/\.(cz|gz|lzma|xz)\Z//g;
+    return $Url;
+}
+
+sub cacheFile($$)
+{
+    my ($Url, $Path) = @_;
+    my $To = $CACHE_DIR."/".cachePath($Url);
+    mkpath(get_dirname($To));
+    copy($Path, $To);
+}
+
+sub getCachedFile($)
+{
+    my $Url = $_[0];
+    my $Path = $CACHE_DIR."/".cachePath($Url);
+    if(-f $Path) {
+        return $Path;
+    }
+    return undef;
+}
+
 sub downloadFile($)
 {
-    my $Path = $_[0];
+    my $Url = $_[0];
-    my $DownloadTo = $TMP_DIR."/extract/".get_filename($Path);
+    
+    if($UseCache)
+    {
+        if(my $CPath = getCachedFile($Url)) {
+            return $CPath;
+        }
+    }
+    
+    my $DownloadTo = $TMP_DIR."/extract/".get_filename($Url);
     $DownloadTo=~s/\.cz/\.gz/g; # cz == gz
     my $Dir = get_dirname($DownloadTo);
     mkdir($Dir);
-    system("wget -U '' --no-check-certificate \"$Path\" --connect-timeout=5 --tries=1 --output-document=\"$DownloadTo\" >/dev/null 2>&1");
+    system("wget -U '' --no-check-certificate \"$Url\" --connect-timeout=5 --tries=1 --output-document=\"$DownloadTo\" >/dev/null 2>&1");
     if(not -f $DownloadTo
     or not -s $DownloadTo)
     {
-        print STDERR "ERROR: cannot access \'$Path\'\n";
+        print STDERR "ERROR: cannot access \'$Url\'\n";
         exit(1);
     }
     
@@ -779,12 +819,18 @@ sub downloadFile($)
         my @Files = cmd_find($Dir, "f", "", "");
         if(not @Files)
         {
-            print STDERR "ERROR: cannot extract \'$Path\'\n";
+            print STDERR "ERROR: cannot extract \'$Url\'\n";
             exit(1);
         }
         unlink($DownloadTo);
         $DownloadTo = $Files[0];
     }
+    
+    if($UseCache)
+    {
+        cacheFile($Url, $DownloadTo);
+    }
+    
     return $DownloadTo;
 }
 
@@ -879,7 +925,7 @@ sub readHDlist($$$$$)
     my $Name = "";
     foreach (reverse(split(/\n/, $Content)))
     {
-        $_=~s/\A\@//g;
+        s/\A\@//g;
         my @Parts = split("\@", $_);
         my $Type = shift(@Parts);
         if($Type eq "info")
@@ -899,7 +945,8 @@ sub readHDlist($$$$$)
             $PkgName{$Name} = $PName;
             if($Kind eq "Target")
             {
-                if($Registered->{$TKind}{$PName})
+                if($Registered->{$TKind}{$PName}
+                and $Type eq "requires")
                 { # already added
                     next;
                 }
@@ -1101,7 +1148,7 @@ sub staticCheck()
     
     if(my @Pkgs = sort {lc($a) cmp lc($b)} keys(%Unresolved))
     {
-        my $Title = "Broken Packages (".($#Pkgs+1).")";
+        my $Title = "Broken Dependency (".($#Pkgs+1).")";
         $Report .= "\n$Title:\n\n";
         
         $VReport .= "<a name='Unresolved'></a>\n";
@@ -1111,7 +1158,7 @@ sub staticCheck()
         if($ExtInfo) {
             $VReport .= "<th onclick=\"sort(this)\">SRPM</th>\n";
         }
-        $VReport .= "<th onclick=\"sort(this)\">Dependency</th>\n";
+        $VReport .= "<th onclick=\"sort(this)\">Broken Dependency</th>\n";
         $VReport .= "</tr>\n";
         
         my $Num = 1;
@@ -1471,6 +1518,12 @@ sub checkProfile()
         exit(1);
     }
     my $Content = readFile($Profile);
+    
+    if($UseCache)
+    { # empty cache
+        rmtree($CACHE_DIR);
+    }
+    
     my %Index = ();
     my (%Order, %Order_S) = ();
     my $Num = 0;
@@ -1491,7 +1544,10 @@ sub checkProfile()
         writeFile("update.hdlists", $Info{"updates"});
         writeFile("info.hdlists", $Info{"info"});
         
-        my $Cmd = "perl urpm-repoclosure.pl";
+        my $Cmd = "perl $0";
+        if($UseCache) {
+            $Cmd .= " -cache";
+        }
         $Cmd .= " --hdlist=".$Info{"hdlist"};
         if($Info{"name"}) {
             $Cmd .= " --title=\"".$Info{"name"}."/".$Info{"arch"}."-".$Info{"section"}."\"";
@@ -1618,7 +1674,7 @@ sub checkProfile()
             foreach my $Section (sort {$Order_S{$Name}{$a}<=>$Order_S{$Name}{$b}} keys(%{$Index{$Name}{$Arch}}))
             {
                 my %Info = %{$Index{$Name}{$Arch}{$Section}};
-                $INDEX .= "<td><a href=\'".$Info{"HTML"}."\'>Report</a> (<a href=\'".$Info{"TXT"}."\'>txt</a>)</td>\n"; #  (<a href=\'".$Info{"TXT"}."\'>txt</a>)
+                $INDEX .= "<td><a href=\'".$Info{"HTML"}."\'>Report</a> (<a href=\'".$Info{"TXT"}."\'>txt</a>)</td>\n";
             }
             $INDEX .= "</tr>\n";
         }
@@ -1649,7 +1705,7 @@ sub scenario()
     }
     if($ShowVersion)
     {
-        print "URPM Repo Closure Checker $TOOL_VERSION\nCopyright (C) 2012 ROSA Laboratory\nLicense: GPL <http://www.gnu.org/licenses/>\nThis program is free software: you can redistribute it and/or modify it.\n\nWritten by Andrey Ponomarenko.\n";
+        print "URPM Repo Closure Checker $TOOL_VERSION\nCopyright (C) 2012 ROSA Lab\nLicense: GPL <http://www.gnu.org/licenses/>\nThis program is free software: you can redistribute it and/or modify it.\n\nWritten by Andrey Ponomarenko.\n";
         exit(0);
     }
     

urpm-tools.spec

@@ -1,5 +1,5 @@
 Name:           urpm-tools
-Version:        2.2.2
+Version:        2.2.3
 Release:        1
 Summary:        Utilities that help to work with URPM-based repositories
 Group:          System/Configuration/Packaging