#!/usr/bin/perl # $OpenBSD: find-all-conflicts,v 1.5 2002/03/19 22:20:50 espie Exp $ # Copyright (c) 2000 # Marc Espie. All rights reserved. # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Neither the name of OpenBSD nor the names of its contributors # may be used to endorse or promote products derived from this software # without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY ITS AUTHOR AND THE OpenBSD project ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # check all packages in the current directory, and report conflicts which # are not apparent in @pkgcfl. use strict; use File::Spec; sub analyze { my $fh = shift; my $all = shift; my $dir = shift; my $conflicts = shift; my ($name, $cwd); my $default_conflict=1; my $conflict_list = []; my $basedir; local $_; while (<$fh>) { chomp; if (m/^\@(?:newdepend|libdepend|comment|exec|unexec|mtree|src|pkgdep|mode|group|owner|display)/) { next; } elsif (m/^\@ignore/) { $_ = <$fh>; next; } elsif (m/^\@name\s+/) { $name = $'; } elsif (m/^\@cwd\s+/) { my $newpath = $'; if (File::Spec->file_name_is_absolute($newpath)) { $cwd = $newpath; } else { $cwd = File::Spec->catfile($cwd, $newpath); } $basedir = $cwd unless defined $basedir; } elsif (m/^\@pkgcfl\s+(.*?)\s*$/) { my $conflict=$1; $conflict =~ s/\*/\.\*/g; $conflict =~ s/\?/\./g; $conflict =~ s/\+/\\\+/g; push @$conflict_list, "$conflict"; } elsif (m/^\@option\s+no-default-conflict/) { $default_conflict=0; } elsif (m/^\@dirrm\s+/) { my $d = $'; if (!File::Spec->file_name_is_absolute($d)) { $d = File::Spec->catfile($basedir, $d); } $d = File::Spec->canonpath($d); unless (defined $dir->{$d}) { $dir->{$d} = []; } push @{$dir->{$d}}, $name; } elsif (m/^\@/) { print $_, "\n"; } else { my $file= File::Spec->catfile($cwd, $_); $file = File::Spec->canonpath($file); unless (defined $all->{$file}) { $all->{$file} = []; } push @{$all->{$file}}, $name; } } if ($default_conflict) { if ($name =~ m/^(.*)\-\d/) { push @$conflict_list, "\Q$1\E\\-\\d.*"; } elsif ($name =~ m/^(.*)-/) { push @$conflict_list, "\Q$1\E\\-.*"; } } $conflicts->{$name}=$conflict_list; } sub show_problems { my $h = shift; my $conflicts = shift; while (my ($key, $l) = each %$h) { if (@$l > 1) { my $notfound = 0; for my $pkg (@$l) { FOUND: for my $pkg2 (@$l) { next FOUND if $pkg2 eq $pkg; for my $check (@{$conflicts->{$pkg}}) { next FOUND if ($pkg2 =~ m/^$check$/); } $notfound = 1; } } if ($notfound) { print "$key: ", join(',', @$l), "\n"; } } } } my %hash=(); my %dirhash=(); my %conflicts=(); print "Scanning packages\n"; print "-----------------\n"; for my $pkgname (<*.tgz>) { print STDERR "$pkgname\n"; system "tar zxqf $pkgname +CONTENTS"; if (open(my $fh, '<+CONTENTS')) { analyze($fh, \%hash, \%dirhash, \%conflicts); unlink("+CONTENTS"); } else { warn "Problem with $pkgname"; } } print "File problems:\n"; print "-------------\n"; show_problems(\%hash, \%conflicts); print "\@dirrm problems:\n"; print "---------------\n"; show_problems(\%dirhash, \%conflicts);