#!/usr/bin/perl #- Generate filelist with obseletes packages. #- Copyright (C) 2000 MandrakeSoft (fpons@mandrakesoft.com) #- #- This program is free software; you can redistribute it and/or modify #- it under the terms of the GNU General Public License as published by #- the Free Software Foundation; either version 2, or (at your option) #- any later version. #- #- This program 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 General Public License for more details. #- #- You should have received a copy of the GNU General Public License #- along with this program; if not, write to the Free Software #- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #- usage is: #- genfilelist #+use strict qw(subs vars refs); sub packfilelist { my %countdir = (); my @commonparts; #- search for common parts of name. foreach (@_) { my $filename = $_; foreach (4..length($filename)) { ++$countdir{substr($filename, 0, $_)}; } } my @costlysort = (sort { $countdir{$b} <=> $countdir{$a} || ($countdir{$b} == $countdir{$a} && length($b) <=> length($a)) } grep { $countdir{$_} > 2 } keys %countdir); #- pass 1: recompute counter. foreach (grep { length($_) > 4 } @costlysort) { my $filepart = $_; foreach (4..length($filepart)-1) { my $subpart = substr($filepart, 0, $_); if (length($subpart) * $countdir{$subpart} < length($filepart) * $countdir{$filepart}) { $countdir{$subpart} -= $countdir{$filepart} if $countdir{$filepart} > 0; } else { $countdir{$filepart} -= $countdir{$subpart} if $countdir{$subpart} > 0; } } } #- pass 2: filter out overstring. foreach (grep { length($_) > 4 && $countdir{$_} > 2 } reverse @costlysort) { my $filepart = $_; foreach (4..length($filepart)-1) { delete $countdir{substr($filepart, 0, $_)}; } } #- pass 3: get result. foreach (grep { $countdir{$_} > 2 } @costlysort) { push @commonparts, $_ if @commonparts < 10; } @commonparts; } #- main program. sub main { my ($rpms_dir) = @_; my (@filelist, @obsoletes) = (); local *RPM_QA; open RPM_QA, "rpm -qp --queryformat \"#\%{NAME}\\n\" --obsoletes -l $rpms_dir/*.rpm |"; foreach () { if (/^\#/) { #- work on previous obsoletes and filelist. genfilelist(\@filelist, \@obsoletes); (@filelist, @obsoletes) = (); print $_; } else { chomp; m|^/| ? push(@filelist, $_) : push(@obsoletes, $_); } } genfilelist(\@filelist, \@obsoletes); } sub genfilelist { my ($filelist, $obsoletes) = @_; my @commonparts = packfilelist(@$filelist); foreach (@$obsoletes) { print "*$_\n" } foreach (@commonparts) { print "=$_\n" } #- commonparts are printed in from 0 to n-1. foreach my $filename (@$filelist) { map { if (substr($filename, 0, length($commonparts[$_])) eq $commonparts[$_]) { print $_ . substr($filename, length($commonparts[$_])) . "\n"; next; } } (0..$#commonparts); print " $filename\n"; } } foreach (@ARGV) { main($_); }