From 85715fef07df276640dcbb3e1dc8497d69be6c75 Mon Sep 17 00:00:00 2001 From: agriffis Date: Thu, 16 Sep 2004 01:30:32 +0000 Subject: [PATCH] remove epm, which distributes separately svn path=/; revision=136 --- trunk/src/epm/AUTHORS | 1 - trunk/src/epm/ChangeLog | 0 trunk/src/epm/README | 0 trunk/src/epm/epm | 421 ---------------------------------------- 4 files changed, 422 deletions(-) delete mode 100644 trunk/src/epm/AUTHORS delete mode 100644 trunk/src/epm/ChangeLog delete mode 100644 trunk/src/epm/README delete mode 100644 trunk/src/epm/epm diff --git a/trunk/src/epm/AUTHORS b/trunk/src/epm/AUTHORS deleted file mode 100644 index b0c578f..0000000 --- a/trunk/src/epm/AUTHORS +++ /dev/null @@ -1 +0,0 @@ -Currently unknown, if anybody remembers, mail karltk@gentoo.org. diff --git a/trunk/src/epm/ChangeLog b/trunk/src/epm/ChangeLog deleted file mode 100644 index e69de29..0000000 diff --git a/trunk/src/epm/README b/trunk/src/epm/README deleted file mode 100644 index e69de29..0000000 diff --git a/trunk/src/epm/epm b/trunk/src/epm/epm deleted file mode 100644 index 408f312..0000000 --- a/trunk/src/epm/epm +++ /dev/null @@ -1,421 +0,0 @@ -#!/usr/bin/perl -wI. -# $Id$ - -use Getopt::Long; -#use epm; - -# Global vars -my $verbose = 0; -my $dbpath = '/var/db/pkg'; -my $pkgregex = - '^(.+?)'. # name - '-(\d+(?:\.\d+)*\w*)'. # version, eg 1.23.4a - '((?:(?:_alpha|_beta|_pre|_rc)\d*)?)'. # special suffix - '((?:-r\d+)?)$'; # revision, eg r12 -my $root = '/'; -my %opt = ( - 'dbpath' => \$dbpath, - 'root' => \$root, - 'v' => \$verbose, -); -my $exitcode = 0; - -############################################## -# -# UTILITY FUNCTIONS -# -############################################## -sub verb { - print STDERR map "-- $_\n", @_ if $verbose; -} - -sub vverb { - print STDERR map "-- $_\n", @_ if $verbose > 1; -} - -############################################## -# -# QUERY MODE -# -############################################## -sub query { - verb "query mode"; - verb "actually Verify mode" if $opt{'V'}; - - # Implied -l similar to rpm - $opt{'dump'} and $opt{'l'} = 1; - $opt{'d'} and $opt{'l'} = 1; - $opt{'c'} and $opt{'l'} = 1; - - # @dgrps contains a list of all the groups at dbpath - # @dpkgs contains a list of all the packages at dbpath/@dgrps - # %dpkggrp contains a mapping of pkg=>grp - # %dnampkg contains a mapping of nam=>@pkg (libxml=>[libxml-1.8.13]) - # @pkgs is the list of packages being queried - # %dfilepkg is a mapping of filename=>@pkg - my (@dgrps, @dpkgs, %dpkggrp, %dnampkg, @pkgs); - - # Read all groups in the db (except for virtual) - opendir D, $dbpath or - die "epm: Database not found at $dbpath\n"; - @dgrps = grep {-d "$dbpath/$_" && !/^\./ && $_ ne 'virtual'} readdir D; - closedir D; - verb "read ".@dgrps." groups from $dbpath"; vverb @dgrps; - - # Read all pkgs in the db - for my $g (@dgrps) { - opendir D, "$dbpath/$g" or - die "epm: Error reading directory $dbpath/$g\n"; - my @dp = grep {-d "$dbpath/$g/$_" && !/^\./} readdir D; - verb "read ".@dp." pkgs in group $g"; vverb @dp; - @dpkggrp{@dp} = ($g) x @dp; - push @dpkgs, @dp; - } - vverb "package to group associations:"; - vverb map " $_ => $dpkggrp{$_}", keys %dpkggrp; - - # Create association of names => pkgs - for my $p (@dpkgs) { - $p =~ /$pkgregex/o || $dpkggrp{$p} eq 'virtual' || - die "epm: Could't parse name/version/suffix/rev from $p"; - # $2, $3, $4 aren't used right now, but they're in the regex - # for the sake of completeness. - push @{$dnampkg{$1}}, $p; - } - - # File-based query - if ($opt{'f'}) { - # Search through CONTENTS for elements in ARGV. Building an - # index would be bad because it would be HUGE. - for my $a (@ARGV) { - my $found = 0; - # Trim trailing slashes from directories - $a =~ s#/*$##; - # TODO: If it's a relative pathname, then figure out - # the full pathname - if ($a !~ m#^/#) { } - # TODO: stat the file here so that we can determine later - # what package the file currently belongs to - for my $p (@dpkgs) { - my ($CONTENTS, @files); - $CONTENTS = "$dbpath/$dpkggrp{$p}/$p/CONTENTS"; - unless (-s $CONTENTS) { - verb "skipping empty/nonexistent $CONTENTS"; - next; - } - open F, "<$CONTENTS" or die "epm: Can't open $CONTENTS\n"; - @files = ; - close F; - # Check this list of files for the current query - for my $f (@files) { - $f = (split ' ', $f)[1]; - next unless $f eq $a; - $found = 1; - # If not doing -qlf, then print the package name - unless ($opt{'l'}) { - # If doing -qGf, then include the group name - print $opt{'G'} ? "$dpkggrp{$p}/$p\n" : "$p\n"; - } - push @pkgs, $p; - } - } - unless ($found) { - print "file $a is not owned by any package\n"; - $exitcode = 1; - } - } - # Clear out ARGV so queries below don't get confused - @ARGV = (); - } - - # Group-based query - # Note that if -qfg specified, then rpm prioritizes -qf over -qg, - # so we do too. - elsif ($opt{'g'}) { - for my $a (@ARGV) { - verb "checking for packages in group $a"; - my @l = grep $dpkggrp{$_} eq $a, @dpkgs; - vverb "packages in group $a:"; - vverb " ", join "\n ", @l; - unless (@l) { - print "group $a does not contain any packages\n"; - $exitcode = 1; - } - push @pkgs, @l; - } - # Clear out ARGV so queries below don't get confused - @ARGV = (); - } - - # Package-based query (how does this work with emerge?) - if ($opt{'p'}) { - die "epm: Sorry, package-based query not yet supported\n"; - } - - # Query on all packages - if ($opt{'a'}) { - die "epm: extra arguments given for query of all packages\n" if @ARGV; - @pkgs = @dpkgs; - } - elsif (@pkgs) { - # must have been populated by, for instance, -qf - } - else { - for my $a (@ARGV) { - if ($a =~ /$pkgregex/o) { - verb "$a matches pkgregex"; - vverb "name=$1, version=$2, suffix=$3, revision=$4"; - push @pkgs, $a; - next; - } - if (defined $dnampkg{$a}) { - verb "$a found in dnampkg"; - vverb @{$dnampkg{$a}}; - push @pkgs, @{$dnampkg{$a}}; - next; - } - print "package $a is not installed\n"; - next; - } - } - - # Do a file listing of the requested packages - if ($opt{'l'}) { - for my $p (@pkgs) { - my $CONTENTS = "$dbpath/$dpkggrp{$p}/$p/CONTENTS"; - open F, "<$CONTENTS" || die "epm: Can't open $CONTENTS\n"; - my @files = ; - close F; - # Trim @files if config files requested - if ($opt{'c'}) { - # Read in CONFIG_PROTECT from /etc/make.{global,conf} - my @CONFIG_PROTECT = split ' ', - `. /etc/make.globals; - . /etc/make.conf; - echo \$CONFIG_PROTECT`; - die "CONFIG_PROTECT is empty" unless @CONFIG_PROTECT; - my $confprotre = join '|', @CONFIG_PROTECT; - @files = grep { - (split ' ', $_)[1] =~ /^($confprotre)/o - } @files; - } - # Trim @files if doc files requested - if ($opt{'d'}) { - # We don't have a variable like CONFIG_PROTECT to work - # with, so just fake it... :-) - my $docre = '/usr/share/doc|/usr/share/man'; - @files = grep { - (split ' ', $_)[1] =~ m/^($docre)/o - } @files; - } - # If this is a dump query, then print the entire array - if ($opt{'dump'}) { - print @files; - } - # Otherwise do some work so that intermediate directories - # aren't listed - else { - for (my $i=0; $i < @files; $i++) { - my ($f1) = $files[$i]; - $f1 = (split ' ', $f1)[1]; - if ($i < @files-1) { - my $f2 = $files[$i+1]; - $f2 = (split ' ', $f2)[1]; - vverb "Comparing $f1 to $f2"; - next if $f2 =~ m#^\Q$f1\E/#; - } - print $f1, "\n"; - } - } - } - } - - # If not another type of listing, then simply list the packages - if (!$opt{'l'} && !$opt{'f'}) { - # If doing -qG, then include the group name - print map(($opt{'G'} ? "$dpkggrp{$_}/$_\n" : "$_\n"), @pkgs); - } -} - -############################################## -# -# ERASE MODE -# -############################################## -sub erase { - verb "erase mode"; - verb "(testing)" if $opt{'test'}; - - # Catch empty command-line - die "epm: no packages given for uninstall\n" unless @ARGV; - - # Must be root to erase; rpm just lets permissions slide but I don't - if ($> != 0) { - print STDERR "Must be root to remove packages from the system\n"; - $exitcode = 1; - return; - } - - # Erase everything listed on the command-line. Give an error - # message on bogus names, but continue anyway, a la rpm. Note - # that for epm, we require the group name... - for my $a (@ARGV) { - unless ($a =~ '/') { - print STDERR "error: $a does not contain group/ prefix\n"; - $exitcode = 1; - next; - } - my $p = $a; - $p =~ s,^.*/,,; # remove the group - unless (-f "$dbpath/$a/$p.ebuild") { - print STDERR "error: package $a is not installed\n"; - $exitcode = 1; - next; - } - my @cmd = ('ebuild', "$dbpath/$a/$p.ebuild", 'unmerge'); - print STDERR join(" ", @cmd), "\n"; - unless ($opt{'test'}) { - system @cmd; - die "epm: Fatal error running ebuild; aborting\n" if $?; - } - } -} - -############################################## -# -# MAIN -# -############################################## - -# Syntax string for errors -my $syntax = < - use as the directory for the database - --root - use as the top level directory - Package specification options: - -a, --all - query all packages - -f + - query package owning - *-p + - query (uninstalled) package - *--triggeredby - query packages triggered by - *--whatprovides - query packages which provide capability - *--whatrequires - query packages which require capability - -g + --group + - query packages in group - Information selection options: - *-i, --info - display package information - -l - display package file list - -G, --showgroup - display group name in output (not in rpm) - -d - list only documentation files (implies -l) - -c - list only configuration files (implies -l) - --dump - show all verifiable information for each file - (must be used with -l, -c, or -d) - *--provides - list capabilities package provides - *-R, --requires - list package dependencies - *--scripts - print the various [un]install scripts - - --erase - -e - erase (uninstall) package - *--allmatches - remove all packages which match - (normally an error is generated if - specified multiple packages) - --dbpath - use as the directory for the database - *--justdb - update the database, but do not modify the - filesystem - *--nodeps - do not verify package dependencies - *--noorder - do not reorder package installation to satisfy - dependencies - *--noscripts - do not execute any package specific scripts - *--notriggers - don't execute any scripts triggered by this - package - --root - use as the top level directory - --test - don't uninstall, but tell what would happen - - -V, -y, --verify - verify a package installation using the same - package specification options as -q - --dbpath - use as the directory for the database - --root - use as the top level directory - --nodeps - do not verify package dependencies - --nomd5 - do not verify file md5 checksums - --nofiles - do not verify file attributes -EOT - -# Allow bundling of options since rpm does -Getopt::Long::Configure ("bundling"); - -# Parse the options on the cmdline. Put the short versions first in -# each optionstring so that the hash keys are created using the short -# versions. For example, use 'q|query', not 'query|q'. -my $result = GetOptions( - \%opt, - 'help', # help message - 'v+', # verbose, more v's for more verbosity - - 'q|query', # query mode - 'dbpath=s', # use as the directory for the database - 'root=s', # use as the top level directory - # Package specification options: - 'a|all', # query all packages - 'f', # query package owning file(s) - 'p', # query (uninstalled) package - 'g|group', # query packages in group(s) - 'whatprovides', # query packages which provide capability - 'whatrequires', # query packages which require capability - # Information selection options: - 'i|info', # display package information - 'l', # display package file list - 'd', # list documentation files (implies -l) - 'c', # list configuration files (implies -l) - 'dump', # show all verifiable information for each file - # (must be used with -l, -c, or -d) - 'R|requires', # list package dependencies - 'scripts', # print the various [un]install scripts - 'G|showgroup', # include group name in output - - 'e|erase', # erase mode - 'test', # don't uninstall, but tell what would happen - - 'V|y|verify', # verify a package installation using the same - # package specification options as -q - 'nodeps', # do not verify package dependencies - 'nomd5', # do not verify file md5 checksums - 'nofiles', # do not verify file attributes -); - -# Handle help message -if ($opt{'help'}) { print $syntax; exit 0 } - -# Determine which mode we're running in; make sure it's valid. -# (q)uery -# (V)erify -# (i)nstall -# (U)pgrade -# (e)rase -# (b)uild -# other -if ((defined $opt{"q"} || 0) + - (defined $opt{"V"} || 0) + - (defined $opt{"i"} || 0) + - (defined $opt{"U"} || 0) + - (defined $opt{"e"} || 0) + - (defined $opt{"b"} || 0) != 1) { - die "One mode required, and only one mode allowed\n"; -} - -# Query mode -if ($opt{'q'}) { query(); exit $exitcode } -if ($opt{'V'}) { query(); exit $exitcode } -if ($opt{'e'}) { erase(); exit $exitcode } - -# Other modes not implemented yet -die "epm: Sorry, this mode isn't implemented yet. Check back later! :-)\n"; -- 2.26.2