#!/usr/bin/perl -w
# Feta - Unified Front End To APT
# Copyright (c)2001-2003 Joe Wreschnig <piman@debian.org>
#		         Matt McClanahan, Norbert Kiesel
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# 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

use Getopt::Std;
use strict;

my $VERSION = "1.4.14";

my @createdfiles;
my @uninstalled;
my $updated = 0;
my %opts;

getopts('-tvcsISLihUrpduqVyxmoOR', \%opts);

if ($opts{"-"}) {
 print STDERR "E: Feta does not accept long (--) options.\n";
 print STDERR "E: Try `man 1 feta'. Exiting before something dangerous happens...\n";
 exit 1;
}

my %opt_table = (
		 'c' => 'contents',
		 'L' => 'contents',
		 's' => 'info',
		 'I' => 'info',
		 'S' => 'find',
		 'i' => 'install',
		 'r' => 'remove',
		 'p' => 'purge',
		 'v' => 'version',
		 'h' => 'help');

foreach (keys %opt_table) {
 if ($opts{$_}) { unshift (@ARGV, $opt_table{$_}); }
}

if ($ENV{"FETA_OPTS"}) {
 foreach (split(//, $ENV{"FETA_OPTS"})) { $opts{$_} = 1; }
}

if ($opts{'U'}) { $updated = 1; }
if ($opts{'u'}) { unshift (@ARGV, "update,"); }

if (!$opts{'q'}) { open(QUIET, ">&STDOUT"); }
else { open(QUIET, ">>/dev/null"); }

if ($opts{'t'}) { open(TEACH, ">>/dev/null"); }
else { open(TEACH, ">&STDERR"); }

if (!@ARGV) {
 if ($opts{'R'}) {
  dselect();
 } else {
  print STDERR << "END";
Usage:
 $0 [options] [command] [packages|files|urls] ...
For a list of commands, try 'feta help'.
END
  exit 0;
 }
}

my %actions = (
 'add-override'  => \&add_override,
 'alternatives'  => \&alternatives,
 'apt-sources'   => \&apt_sources,
 'build'         => \&build_packages,
 'build-dep'     => \&builddep_packages,
 'build-depends' => \&builddep_packages,
 'check'         => \&check,
 'clean'         => \&clean,
 'commands'      => \&list_commands,
 'configure'     => \&configure_packages,
 'console'       => \&console,
 'contents'      => \&contents_packages,
 'dist-upgrade'  => \&dist_upgrade,
 'find'          => \&find_filenames,
 'force-install' => \&force_install,
 'force-purge'   => \&force_purge,
 'force-remove'  => \&force_remove,
 'help'          => \&help,
 'hold'          => \&hold_packages,
 'info'          => \&info_packages,
 'install'       => \&install_packages,
 'install-list'  => \&install_list,
 'list'          => \&list_packages,
 'list-overrides'=> \&list_overrides,
 'list-installed'=> \&list_installed,
 'moo'           => \&moo,
 'names'         => \&pkgnames,
 'overrides'     => \&list_overrides,
 'policy'        => \&policy,
 'prep'          => \&prep,
 'provides'      => \&find_filenames,
 'purge'         => \&purge_packages,
 'reconfigure'   => \&configure_packages,
 'reinstall'     => \&reinstall_packages,
 'remove'        => \&remove_packages,
 'remove-overrides'=>\&remove_overrides,
 'search'        => \&search_packages,
 'select'        => \&dselect,
 'show'          => \&info_packages,
 'show-package'  => \&showpkg,
 'source'        => \&source_packages,
 'status'        => \&status_packages,
 'swords'	 => \&swords,
 'to-install'    => \&to_install,
 'to-purge'      => \&to_purge,
 'unhold'        => \&unhold_packages,
 'update'        => \&update,
 'upgrade'       => \&upgrade,
 'version'       => \&version,
);

my $pending = " all pending packages...\n";

check_programs();

if (@uninstalled && $> == 0 && !(-r "/etc/apt/feta.prep")) {
 open(PREP, ">/etc/apt/feta.prep");
  print PREP "The existence of this file makes Feta not complain about missing packages.\n";
 close PREP;

 print << 'END';
You are missing some packages Feta recommends having. Although Feta will
run well without these packages, and will still be useful, some functionality
will be missing. Feta can automatically download these packages now, if you
like, or you can install them yourself later by running 'feta prep'.

END

 print "Install missing packages? [Y/n] ";
 my $i = <STDIN>;

 if ($i !~ /^n/i) {
  install_packages(@uninstalled);
  check_programs();
 }
}

parse_command_line(@ARGV);

exit 0;

###############################################################################

sub parse_command_line {
 while (@_) {
  my @params = ();
  while (@_ && $_[0] ne "," && $_[0] !~ /,$/) {
   push (@params, shift);
  }

  if ($_[0] && $_[0] =~ /.,$/) {
   chop $_[0];
   push (@params, shift);
  } else { shift; }

  if (dispatch(@params)) {
   warning("An error occurred trying to use the '$params[0]' command.");
   if (!$opts{'V'}) {
    warning("If you run Feta with -V, more information about the error may be printed.");
   }
   if ($opts{'x'}) {
    error("An error occured, and you used -x. Exiting...");
    exit 1;
   }
  }
 }
}

sub dispatch {
 my @opts;
 my $command = shift;
 my @paths = ("/usr/local/share/feta/plugins", "/usr/local/lib/feta/plugins",
              "/usr/share/feta/plugins", "/usr/lib/feta/plugins");

 if (!$command) { return 0; }

 foreach (@paths) {
  if (-x "$_/$command") {
   return run("$_/$command", feta_opts(), @_, 0);
  } elsif (-x "$_/$command.0") {
   return run("$_/$command.0", feta_opts(), @_, 1);
  }
 }

 if ($actions{$command}) { return &{$actions{$command}}(@_); }

 error("Invalid command '$command'. Try `help'.");
 return 1;
}

sub run {
 my $cline = shift; # The initial parameter is the command name.
 my $root = pop; # The last parameters is the rootness.

 if (!$opts{'V'} && $cline !~ /(^apt-|feta|dpkg|aptitude)/) { # APT outputs nicely.
  push (@_, "2>", "/dev/null");
 }

 foreach (@_) {
  $_ ||= "";
  if (/[^A-Za-z0-9\-;|\`>&]/) { $cline .= " '$_'"; } # Unwanted metacharacters
  else { $cline .= " $_"; }
 }

 if ($root && $> > 0) {
  print QUIET "You must be root to use this command.\n";
  if (-x "/usr/bin/sudo" && $opts{'o'} && ! $opts{'O'}) {
   print QUIET "Sudo will be used. Please enter your password if prompted.\n\n";
   $cline =~ s/ \; / \; sudo /g;
   $cline = "sudo $cline";
  } else {
   print QUIET "Please enter your root password when prompted.\n\n";
   $cline =~ s/\"/\\\\/g;
   $cline =~ s/\"/\\\"/g;
   $cline = "su -c \"$cline\"";
  }
 }

 print TEACH "\nRunning: $cline\n";
 return system($cline);
}

sub console {
 $ENV{'PERL_RL'} ||= "o=0"; # By default, turn off underlining

 require Term::ReadLine;
 my $term = new Term::ReadLine 'Feta Console';

 print QUIET << "END";
This is the Feta command console. You may run any Feta command from here,
and it will return you to the console afterwards. Feta will exit when you
use the command 'quit' (or, if you start Feta with the -x option, when
there is any error).
END

 while ((my $command = $term->readline("> ")) ne "quit") {
  parse_command_line(split ( /\s/, $command));
 }
}

sub install_packages {
 my (@dpkg, @fetched, @apt, @rpm);
 if (!@_) { run("apt-get", "--fix-missing", ag_opts(), "install", 1); }

 foreach (@_) {
  if (m![a-z]+://!i) { push (@fetched, $_); }
  elsif (is_deb_file($_)) { push (@dpkg, $_); }
  elsif (is_rpm_file($_)) { push (@rpm, $_); }
  else { push (@apt, $_); }
 }

 if ($apt[@apt - 1] && ($apt[@apt - 1] eq "--reinstall")) { @apt = (); }

 foreach (get_downloads(@fetched)) {
  if (is_deb_file($_)) { push (@dpkg, $_); }
  elsif (is_rpm_file($_)) { push (@rpm, $_); }  
 }

 if (@rpm) { push (@dpkg, alien(@rpm)); }
 if (@dpkg) { unshift (@dpkg, "dpkg", dpkg_opts(), "--install"); }
 if (@apt) { unshift (@apt, "apt-get", ag_opts(), "install"); }
 if (@dpkg && @apt) { push (@dpkg, ";"); }

 if (! (@dpkg or @apt)) {
   print STDERR "E: No valid packages found.\n";
  
 } else {
  return run(@dpkg, @apt, 1);
 }
}

sub remove_packages {
 if (!@_) {
  print "Removing" . $pending;
  return run("dpkg", dpkg_opts(), "--remove", "-a", 1);
 }
 return run("apt-get", ag_opts(), "remove", @_, 1);
}

sub purge_packages {
 if (!@_) {
  print "Purging" . $pending;
  return run("dpkg", dpkg_opts(), "--purge", "-a", 1);
 }
 my %packages;
 return run("apt-get", ag_opts(), "--purge", "remove", @_, 1);
}

sub configure_packages {
 if (!@_) {
  print "Configuring" . $pending;
  return run("dpkg", dpkg_opts(), "--configure", "-a", 1);
 }
 return run("dpkg-reconfigure", @_, 1);
}

sub source_packages {
 if (!@_) {
  return missing("source package name to download.");
 }
 return run("apt-get", ag_opts(), "source", @_, 0);
}

sub update {
 if ($_[0] && $updated) { return; } # The update call was not explicit.
 $updated = 1; # Ignore non-explicit update calls from now on.

 if ($_[0]) { # The calling function will handle updating.
  if ($opts{'y'}) {
   return ("apt-get", ag_opts(), "update", ";");
  } elsif (!$opts{'q'}) { #and -M "/var/cache/apt/pkgcache.bin" >= 1) {
   # mtime was a good idea, if I can find a file that only updates when
   # APT succeeds in finding updates files.
   my $unstable = 0;
   open FH, "/etc/apt/sources.list";
   while (<FH>) {
    $unstable = 1, last if /unstable|testing/;
   }
   print << "END";
It is possible that your Packages files (which list all the packages available
for download and their current versions) is out of date.

END

    if ($unstable) {
     print << "END";
You appear to be running the 'unstable' or 'testing' distribution of Debian.
This makes it more likely that your files are out of date (since new packages
are uploaded to these distributions daily), so doing this step is recommended.
END
    } else {
     print << "END";
You appear to be running the 'stable' distribution of Debian. This makes it
less likely that your files are out of date, so doing this step is optional.

END
    }
    print "Update? [Y/n] ";

    if (<STDIN> !~ /^n/i) {
     print "\n";
     return ("apt-get", ag_opts(), "update", ";");
    } else { print "\n"; return (); }
  }
 } else { # Explicit, immediate update. Don't prompt.
   run("apt-get", ag_opts(), "update", 1);
 }
}

sub upgrade {
 if (@_) { return install_packages(@_); }
 return run(update(1), "apt-get", ag_opts(), "upgrade", 1);
}

sub dist_upgrade {
 print QUIET << "END";
You have requested to perform a 'dist-upgrade' operation. This differs from
'upgrade' in that your system will try to automatically resolve many
problems rather than stopping and letting you handle it. While this is almost
always safe, please be aware that during this operation some packages may be
removed, if a new compatible version is not found.

END

 return run(update(1), "apt-get", ag_opts(), "dist-upgrade", 1);
}

sub info_packages {
 my (@apt, @dpkg);
 if (!@_) {
  return missing("package or file name to view its description.");
 }
 if ($_[0] =~ /(.*):$/) {
  return run("apt-cache", "show", $_[1], "|", "grep", "^$_[0]", "|",
             "sed", "s/^$_[0] //", 0);
 } else {
  foreach (@_) {
   if (is_deb_file($_)) {
    if (@dpkg) { push (@dpkg, ";"); }
    push (@dpkg, "dpkg", dpkg_opts(), "--info", $_);
   } else { push (@apt, $_); }
  }
  if (@apt) { unshift (@apt, "apt-cache", "show"); }

  if (@apt && @dpkg) { return run(@apt, ";", @dpkg, 0); }
  if (@apt || @dpkg) { return run(@apt, @dpkg, 0); }
 }
}

sub status_packages {
 return run("dpkg", "--status", @_, 0);
}

sub contents_packages {
 if (!@_) {
  return missing("package or file name to view its contents.");
 }
 my (@inst, @files);
 foreach (@_) {
  if (is_deb_file($_)) {
   if (@files) { push (@files, "&&"); }
   push (@files, "dpkg", dpkg_opts(), "--contents", $_);
  } else { push (@inst, $_); }
 }

 if (@inst) {
  unshift (@inst, "dpkg", dpkg_opts(), "--listfiles");
  if (!$opts{'V'}) { push(@inst, "2>", '/dev/null'); }
  push (@inst, '|', 'sed', 's/^package diverts others to://',
               '|', 'sort', '-u', '|', 'xargs', 'ls', '-ld');
 }

 if (@inst && @files) { push (@inst, ";"); }
 return run(@inst, @files, 0);
}

sub repack {
 if (!@_) {
  return missing("package name to repack.");
 }

 print QUIET << "END";
Repacked files are not quite the same as the originals. Most importantly,
files in /etc that you have modified locally are repackaged with the rest of
the package. These files may contain site-specific configurations, or
sometimes even passwords. You may wish to check the contents of the repacked
package after it is done building to make sure it does not contain any files
that could cause it to not work or release private information.
END

 return run("dpkg-repack", @_, 1);
}

sub build_packages {
 if (!@_) {
  return missing("package name to build.");
 }
 if (builddep_packages(@_)) { return 1; }
 return run("apt-get", ag_opts(), "--build", "source", @_, 1);
}

sub builddep_packages {
 if (!@_) {
  return missing("package to install the build dependencies for.");
 }
 return run("apt-get", ag_opts(), "build-dep", @_, 1)
}

sub find_filenames {
 if (!@_) {
  return missing("search term to find.");
 } elsif (run("dpkg", dpkg_opts(), "--search", @_, 0)) {
  warning("Some of your search terms returned no results.");
  return 0;
 } else { return 0; }
}

sub search_packages {
 if (!@_) {
  return missing("search term.");
 }
 if ($_[0] =~ /(.*):$/ && $_[1]) { # Search based on a field
  my $field = shift; chop $field;
  my $disp = "Package:"; # Display just package names.
  if ( $_[1] && $_[1] =~ /(.*):$/ ) {
   $disp = $_[1];
   splice (@_, 1, 1);
  }
  return dctrl($field, $disp, @_);
 } else {
  return run("apt-cache", "search", @_, 0);
 }
}

sub pkgnames { return run("apt-cache", "pkgnames", @_, '|', 'sort', '-u', 0); }

sub showpkg {
 if (!@_) {
  return missing("package name to show.");
 }
 return run("apt-cache", "showpkg", @_, 0);
}

sub clean {
 if ($_[0] && $_[0] eq "all") { return run("apt-get", "clean", 1); }
 return run("apt-get", "autoclean", 1);
}

sub orphan_packages {
 print "Finding libraries that are safe to remove...\n";
 chomp(my @packages = `deborphan`);
 if (!@packages) {
  warning("There are no orphaned libraries.");
  return 0;
 }
 return purge_packages(@packages);
}

sub dselect {
 my $command = $ENV{"FETA_SELECT"};
 $command ||= "dselect";
 my $ret = run($command, 0);
}

sub foster_packages {
 if ($opts{'q'} || $opts{'y'}) { return run('debfoster', '-q', 1); }
 elsif ($opts{'V'}) { return run('debfoster', '-n', 1); }
 return run("debfoster", 1);
}

sub list_packages { return run("dpkg", dpkg_opts(), "--list", @_, 0); }

sub hold_packages {
 if (!@_) {
  return missing("package name to hold.");
 }
 if ($> > 0) { return run("feta", feta_opts(), "hold", @_, 1); }  
 print TEACH "Running: | dpkg --set-selections\n";
 open DPKG, "|dpkg --set-selections";
 foreach (@_) {
  print TEACH "Piping: $_\thold\n";
  print DPKG "$_\thold\n";
  print QUIET "$_ is now marked as 'hold'.\n";
 }
 close DPKG;
 return 0;
}

sub unhold_packages {
 if (!@_) {
  return missing("package name to unhold.");
 }
 if ($> > 0) { return run("feta", feta_opts(), "unhold", @_, 1); }
 print TEACH "Running: dpkg --set-selections\n";
 open DPKG, "|dpkg --set-selections";
 foreach (@_) {
  print TEACH "Piping: $_\tinstall\n";
  print DPKG "$_\tinstall\n";
  print QUIET "$_ is now marked as 'install'.\n";
 }
 close DPKG;
 return 0;
}

sub bug {
 my $old = $opts{'V'}; $opts{'V'} = 1; # Geez. Why does this output to stderr?
 if (!@_) { run('reportbug', 0); }
 else { foreach (@_) { run("reportbug", $_, 0); } }
 $opts{'V'} = $old;
 return 0;
}

sub sums {
 print QUIET << "END";
The following is a list of files that have been modified since you installed
their package. If these are binaries, or system-critical files, you may wish
to reinstall the packages to correct the problem. If they are text or script
files, you should probably still look at them, but it\'s usually less
critical.

END

 if ($opts{'V'}) { return run("debsums", 1) }
 return run("debsums", "-c", 1);
}

sub prep {
 if (@uninstalled) { install_packages(@uninstalled); }
 check_programs();
 print "All recommended packages are installed.\n";
 return 0;
}

sub check { return run("apt-get", "check", 1); }

sub reinstall_packages {
 return install_packages("--reinstall", @_); # This is a great hack.
}

sub which_package {
 if (!($opts{'y'} || $opts{'q'})) {
  print QUIET << 'END';
To search uninstalled packages, Feta needs information about the packages
on the Debian server. This can be downloaded automatically, although if you
have done this recently, it is probably not necessary.
END
  print "Update the package information? [y/N] ";
 }

 if (!($opts{'U'} || $opts{'q'}) && ($opts{'y'} || <STDIN> =~ /^y/i)) {
  run('auto-apt', 'update', 1);
 }

 if (!@_) {
  return missing("package or file name to search for.");
 }

 foreach my $filename (@_) {
  print QUIET "Looking for packages containing $filename...\n";
  if ($filename =~ /^\//) {
   $filename = substr($filename, 1);
  }
  chomp (my @output = `auto-apt search $filename`);
  print TEACH "Running: auto-apt search $filename\n";
  print QUIET "Filename\t\t\t\t\tPackage(s)\n";
  foreach (@output) {
   my @two = split /\t/;
   print $two[0];
   for (my $i = 48 - length $two[0]; $i > 0; $i -= 8) { print "\t"; }
   $two[1] =~ s!([^/]+)/([^,]+)!$2,!g;
   $two[1] =~ s/,/, /g;
   chop $two[1]; chop $two[1];
   print $two[1] . "\n";
  }
  print "\n";
 }
}

sub to_install {
 print QUIET "If no packages are shown, none remain to install.\n";
 run("dpkg", dpkg_opts(), "--list", "*", "|", "grep", "^i[^i]", 0);
 return 0;
}

sub to_purge {
 print QUIET "If no packages are shown, none remain to purge.\n";
 run("dpkg", dpkg_opts(), "--list", "*", "|", "grep", "^pi", 0);
 return 0;
}

sub apt_sources {
 run("sensible-editor", "/etc/apt/sources.list", 1);
 if (!($opts{'q'} || $opts{'y'})) {
  print "Would you like to update your list of available packages now? [Y/n] ";
  if ($opts{'y'} || <STDIN> !~ /^n/i) { update(); }
 }
}

sub force_install { return force("install", @_); }
sub force_purge { return force("purge", @_); }
sub force_remove { return force("remove", @_); }

sub force {
 my $command = shift;
 if (!@_) {
  return missing("filename to forcibly $command.");
 }
 if (!$opts{'y'}) {
  print << "END";
Warning: You are about to forcibly $command a Debian package or packages.
This is **NOT A GOOD IDEA**. It may break dependencies, or cause files in
other packages to be modified.

END
  print "Continue? [y/N] ";
 }
 if ($opts{'y'} || <STDIN> =~ /^y/i) {
  return run('dpkg', dpkg_opts(), "--$command", '--force', 'all', @_, 1);
 }
 return 1;
}

sub policy {
 return run('apt-cache', 'policy', @_, 0);
}

sub add_override { return override('--update', '--add', @_, 1); }
sub remove_overrides { foreach (@_) { return override('--remove', $_, 1); } }
sub remove_override { return override('--remove', $_[0], 1); }
sub list_overrides { return override('--list', @_, 0); }
sub override { return run('dpkg-statoverride', @_); }

sub list_installed {
 my @output = ();
 if ($_[0]) {
  @output = (">", $_[0]);
  print QUIET "Outputting installed packages to $_[0].\n"
 }
 return run('dpkg', dpkg_opts(), '--get-selections', '|',
	    'cut', '-f1', @output, 0);
}

sub install_list {
 if (!@_) {
  return missing("list of package names.");
 }

 foreach (@_) {
  if (!(-r $_)) { warning("$_ does not exist."); next; }
  open PACKAGELIST, $_; my @packages = <PACKAGELIST>; close PACKAGELIST;

  chomp @packages;
  print QUIET "Packages will be installed in sets of 100.\n\n";
  while (@packages) {
   my @ps = splice @packages, 0, 100;
   if (install_packages(@ps) && $opts{'x'}) { return 1; }
  }
 }
 return 0;
}

sub alternatives {
 if (!@_) {
  error("You must specify at least one alternative to configure.");
  return 1;
 }
 foreach (@_) {
  my $ret = 0;
  if (-e "/etc/alternatives/$_") {
   $ret = run('update-alternatives', '--config', $_, 1);
  } else {
   warning("$_ has no alternatives.");
   $ret = 1;
  }
  if ($ret && $opts{'x'}) { return $ret; }
 }
 return 0;
}

sub dctrl {
 if (!-x '/usr/bin/grep-dctrl') { unavail(); return 1; }

 my (@sed, @show);
 my $field = shift;

 if ($_[0] =~ /(.*):$/) {
  unshift (@show, "-s", $1); shift;
  unshift (@sed, "|", "sed", "s/^$1: //");
 }

 if (!$field) {
  return missing("one field name to search.");
 }

 my $search = shift;
 return run("grep-dctrl", "-F", $field, @show, "-e", $search,
             "/var/lib/dpkg/available", @sed, '|', 'sort', '-u', 0);
}

sub alien {
 my @packages;
 if (-x "/usr/bin/alien" && -x "/usr/bin/fakeroot") {
  foreach (@_) {
   print "Converting $_ to a .deb file (this may take a while)... ";
   print TEACH "\nRunning: alien $_\n";
   my $file = `fakeroot alien $_`;
   if ($file =~ /^(.*\.deb) generated$/) {
    push (@packages, $1);
    print "Done\n";
   } else {
    print "Failed!\n";
    if ($opts{'x'}) { return undef; }
   }
  }
 } else {
  error("An RPM cannot be installed, because you do not have alien and/or fakeroot.");
  error("Run `feta prep' and try again.");
 }
 push (@createdfiles, @packages);
 return @packages;
}

sub get_downloads {
 my @newnames = ();
 foreach (@_) {
  my $tmp = $ENV{'TMPDIR'} || "/tmp";
  my $newname = $_;

  $newname =~ s!.*/(.*)!$1!;
  print "Downloading $_ to /tmp/$newname...";
  run("wget", "-c", "-O", "$tmp/$newname", $_, 0);
  push (@newnames, "$tmp/$newname");
  print " Done\n";
 }
 push (@createdfiles, @newnames);
 return @newnames;
}

sub is_deb_file { (-r $_[0] && !(-d $_[0]) && $_[0] =~ /\.deb$/i); }
sub is_rpm_file { (-r $_[0] && !(-d $_[0]) && $_[0] =~ /\.rpm$/i); }
sub is_url{ (!(-r $_[0]) && $_[0] =~ m!://!); }

sub moo { return run("apt-get", "moo", 0); }

sub unavail {
 print STDERR << "END";
The command you requested has been implemented in Feta, but you do not have
the other programs required to do it. To install those programs, run
'feta prep'.

END
 return 1;
}

sub ag_opts {
 my %conv = ('y' => 'assume-yes',
             'd' => 'download-only',
             'V' => 'show-upgraded',
             'q' => 'quiet',
             'm' => 'simulate');
 my @opts;
 foreach (keys %conv) { if ($opts{$_}) { push (@opts, "--$conv{$_}"); } }
 return @opts;
}

sub dpkg_opts {
 my %conv = ('m' => 'no-act' );
 my @opts;
 foreach (keys %conv) { if ($opts{$_}) { push (@opts, "--$conv{$_}"); } }
 return @opts;
}

sub feta_opts {
 my @opts;
 foreach ('y','t','V','q') { if ($opts{$_}) { push (@opts, "-$_"); } }
 return @opts;
}

sub check_programs {
 my %optional = ('bug'		=> [ '/usr/bin/reportbug', \&bug ],
 		 'foster'	=> [ '/usr/bin/debfoster', \&foster_packages ],
 		 'orphan'	=> [ '/usr/bin/deborphan', \&orphan_packages ],
 		 'repackage'	=> [ '/usr/bin/dpkg-repack', \&repack ],
 		 'sums'		=> [ '/usr/bin/debsums', \&sums ],
 		 'checksums'	=> [ '/usr/bin/debsums', \&sums ],
 		 'alien'	=> [ '/usr/bin/alien', undef ],
 		 'fakeroot'	=> [ '/usr/bin/fakeroot', undef ],
 		 'which-package'=> [ '/usr/bin/auto-apt', \&which_package ]);

 @uninstalled = ();

 foreach my $key (keys %optional) {
  my @values = @{$optional{$key}};
  if (-x $values[0]) {
   if ($values[1]) { $actions{$key} = $values[1]; }
  } elsif ($values[0] =~ m!/usr/bin/([^/]+)$!) {
   push (@uninstalled, $1);
  } elsif ($values[1]) {
   push (@uninstalled, $values[1]);
  } else { $actions{$key} = \&unavail; }
 }
}

sub list_commands {
 my @actions = (keys %actions);
 my @plugactions = (</usr/share/feta/plugins/*>,</usr/local/share/feta/plugins/*>,
                    </usr/lib/feta/plugins/*>,</usr/local/lib/feta/plugins/*>);

 foreach (@plugactions) { s!.*/(.*)!$1!; s/\.0//;}
 foreach ((@actions, @plugactions)) { print "$_\n"; }
}

sub help {
 if (@_) {
  my @files;
  foreach (@_) {
   if ($ENV{"LANG"} && -e "/usr/share/feta/help/$_.$ENV{LANG}") {
    push @files, "/usr/share/feta/help/$_.$ENV{LANG}";
   } elsif ($ENV{"LANG"} && -e "/usr/localshare/feta/help/$_.$ENV{LANG}") {
    push @files, "/usr/local/share/feta/help/$_.$ENV{LANG}";
   } elsif (-e "/usr/share/feta/help/$_") {
    push @files, "/usr/share/feta/help/$_";
   } elsif (-e "/usr/local/share/feta/help/$_") {
    push @files, "/usr/local/share/feta/help/$_";
   } else {
    warning("No help is available on $_.");
   }
  }
  if (@files) { run('sensible-pager', @files, 0); }
  else {
   warning("No help files were found for the commands given.");
   return 0;
  }
 } else { return run('man', '1', 'feta', 0); }
}

sub warning { print STDERR "W: $_[0]\n"; }
sub error { print STDERR "E: $_[0]\n"; }
sub missing { print STDERR "E: You must provide at least one $_[0]\n"; return 1; }

sub version {
 print STDERR << "END";
Feta $VERSION - Front End To APT
Copyright (c)2001-2003 Joe Wreschnig and others.

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License version 2 as published
by the Free Software Foundation.

On Debian systems, this may be found in /usr/share/common-licenses/GPL-2.
END
 return 0;
}

sub swords{print reverse split//,"\n.sdrows ekil I"; my(@c)=(' ','/','\\','|'
,'=','-',"\n",'{','}','_');my(@i)=(10,19,1,8,6,10,18,1,1,6,10,17,1,7,10,5,1,
8,6,10,2,19,14,11,3,15,4,1,7,19,40,6,1,3,14,13,3,1,2,3,15,5,1,19,40,2,6,2,3
,14,13,3,2,1,3,15,5,2,19,40,1,6,10,2,15,14,12,3,15,4,2,7,6,10,17,2,7,10,5,
2,8,6,10,18,2,2,6,10,19,2,8,6); while(@i){my$c=shift@i;if($c>9){for(my$i=
shift@i;$i>0;$i--){print$c[$c-10];}}else{print$c[$c];}}print TEACH"\nT".
"he 12 styles of the Vargus school correspond to the 12 signs of the ".
"Zodiac.\nJust as each sign has its own strengths and weaknesses, so".
" too does each style.\nTrue mastery comes not from-Ooh, shinies.\n"}

END { unlink(@createdfiles); }