# COPYRIGHT_NOTICE_START
# Licensed Materials - Property of IBM
# "Restricted Materials of IBM" -- 5746-SM2
# (C) Copyright IBM Corp. 2007, 2008 All Rights Reserved.
# US Government Users Restricted Rights - Use, duplication or disclosure
# restricted by GSA ADP Schedule Contract with IBM Corp.
# COPYRIGHT_NOTICE_END

package Maiken::RO;
use base 'Maiken';

=head1 NAME

  Maiken::RO - IBM PowerVM Lx86 installation

=cut

use strict;
use warnings;
use Cwd ();
use Fcntl ':mode';
use File::Basename ();
use File::Copy ();
use File::Find ();
use File::Path ();

use Maiken::RO::PowerPack;

use constant DATE_FORMAT => '%a %b %e %T %Z %Y';

# Set up some RO-specific configuration
sub PRODUCT_NAME          { 'powervm-lx86'                         }
sub OLD_PRODUCT_NAMES     { ['p-ave']                              }
sub PRODUCT_NAME_FRIENDLY { 'PowerVM Lx86'                         }
sub PRODUCT_NAME_FRIENDLY_LONG {
  # The long name and the short name are the same for RO
  'PowerVM Lx86'
}
sub SELINUX_PREFIX        { 'lx86_'                                }
sub IBM_REGISTER_EMAIL    { 'lx86@us.ibm.com'            }
sub SW_NAME               { 'x86 World'                            }
sub SW_ROOT_PATH          { '/i386'                                }
sub SW_DEFAULT_HOMEDIR    { '/home'                                }
sub SW_RPM_DIR            { '/tmp/x86rpms'                         }
sub SUPPORT_NAME          { 'IBM support'                          }

sub RUNX86                { 'runx86'                               }
sub LINKX86               { 'linkx86'                              }
sub SW_PART               { '.sw_partially_installed'              }
sub SW_SUCC               { '.sw_installed_successfully'           }
sub IBM_REG_FILE          { 'activation-detail'                    }

sub ISO_MOUNTPOINT        { '/tmp/'.$_[0]->PRODUCT_NAME.
			      '-installer-iso-mountpoint' }

sub MAKEHOSTID { $_[0]->ROOT.'/resources/bin/RO/makeHostidFile.ppc' }
sub INIT_D { '/etc/init.d' }
sub RPM_DIR_RELATIVE { 'resources/rpm/RO' }
sub RPM_DIR { $_[0]->ROOT.'/'.$_[0]->RPM_DIR_RELATIVE }

# The minimum space required to install the product and the installer
# in MB
sub MINIMUM_SPACE_FOR_PRODUCT { 200 }

sub SPECIAL_CONFIG_FILE_VARS {
  {
    sw_install_media => '@',
  }
}

sub AUTHORIZED_POWERPACK_CONFIG_VARS {
  qw/qt_root_path logfile_path sw_root_path

     install_qt install_sw chosen_rpm_file sw_distro sw_homedir
     sw_install_media sw_tarball_location

     uninstall_qt uninstall_sw remove_logfile remove_config_dir
     uninstall_stop_qt

     ibm_company_name ibm_registrant_name ibm_address telephone_number
     ibm_email_address rh_company_name rh_registrant_name
     rh_email_address rhn_login rh_account_number/
}

# The separators for minor revision numbers in supported distros:
my $MINOR_REV_SEPARATORS = 'U|SP';

# A hash of supported distributions and their details. the keys here
# are the PPC native distros and the values are the supported subject
# worlds.:
our %DELEGATES =
  (
   'RHEL4U4+'  => {
		   class => 'RHEL',
		   name  => 'Red Hat Enterprise Linux release 4, Update 4 or greater',
		   rpm   => 'RHEL4',
		   subject_worlds => [qw/RHEL4U6AS_MIN RHEL4U6AS_FULL
                                         RHEL4U7AS_MIN RHEL4U7AS_FULL
                                         RHEL4U8AS_MIN RHEL4U8AS_FULL/],
		  },
   'RHEL5U3+'  => {
		   class => 'RHEL',
		   name  => 'Red Hat Enterprise Linux release 5, Update 3 or greater',
		   rpm   => 'RHEL5',
		   subject_worlds => [qw/RHEL5U3AS_MIN RHEL5U3AS_FULL RHEL5U4AS_MIN RHEL5U4AS_FULL RHEL5U5AS_MIN RHEL5U5AS_FULL/],
		  },
   'SLES10+'   => {
		   class => 'SLES',
		   name  => 'SUSE Linux Enterprise Server release 10',
		   rpm   => 'SLES10',
		   subject_worlds => [qw/SLES10_MIN SLES10_FULL
					 SLES10SP1_MIN SLES10SP1_FULL
					 SLES10SP2_MIN SLES10SP2_FULL
					 SLES10SP3_MIN SLES10SP3_FULL/],
		  },
   'SLES11+'   => {
		   class => 'SLES',
		   name  => 'SUSE Linux Enterprise Server release 11',
		   rpm   => 'SLES11',
		   subject_worlds => [qw/SLES11_MIN SLES11_FULL/],
		  },

  );

# Subject world information
our %SUBJ_WORLDS =
  (
   RHEL4U6AS_MIN =>
   { title   => 'Red Hat Enterprise Linux AS release 4, Update 6 (minimal)',
     size    => 903,
     rpmsize => 278},
   RHEL4U6AS_FULL =>
   { title   => 'Red Hat Enterprise Linux AS release 4, Update 6 (full)',
     size    => 7400,
     rpmsize => 2210},
   RHEL4U7AS_MIN =>
   { title   => 'Red Hat Enterprise Linux AS release 4, Update 7 (minimal)',
     size    => 917,
     rpmsize => 257},
   RHEL4U7AS_FULL =>
   { title   => 'Red Hat Enterprise Linux AS release 4, Update 7 (full)',
     size    => 7138,
     rpmsize => 2054},
   RHEL4U8AS_MIN =>
   { title   => 'Red Hat Enterprise Linux AS release 4, Update 8 (minimal)',
     size    => 854,
     rpmsize => 261},
   RHEL4U8AS_FULL =>
   { title   => 'Red Hat Enterprise Linux AS release 4, Update 8 (full)',
     size    => 7074,
     rpmsize => 2119},
   RHEL5U3AS_MIN =>
   { title   => 'Red Hat Enterprise Linux AS release 5, Update 3 (minimal)',
     size    => 850,
     rpmsize => 230},
   RHEL5U3AS_FULL =>
   { title   => 'Red Hat Enterprise Linux AS release 5, Update 3 (full)',
     size    => 6000,
     rpmsize => 1950},
   RHEL5U4AS_MIN =>
   { title   => 'Red Hat Enterprise Linux AS release 5, Update 4 (minimal)',
     size    => 850,
     rpmsize => 230},
   RHEL5U4AS_FULL =>
   { title   => 'Red Hat Enterprise Linux AS release 5, Update 4 (full)',
     size    => 6000,
     rpmsize => 1950},
  RHEL5U5AS_MIN =>
  {  title   => 'Red Hat Enterprise Linux AS release 5, Update 5 (minimal)',
     size    => 1000,
     rpmsize => 230},
  RHEL5U5AS_FULL =>
  {  title   => 'Red Hat Enterprise Linux AS release 5, Update 5 (full)',
     size    => 9000,
     rpmsize => 1950,},
   SLES10_MIN =>
   { title   => 'SUSE Linux Enterprise Server release 10 (minimal)',
     size    => 642,
     rpmsize => 192 },
   SLES10_FULL =>
   { title   => 'SUSE Linux Enterprise Server release 10 (full)',
     size    => 2560,
     rpmsize => 740 },
   SLES10SP1_MIN =>
   { title   => 'SUSE Linux Enterprise Server release 10, Service Pack 1 (minimal)',
     size    => 686,
     rpmsize => 206 },
   SLES10SP1_FULL =>
   { title   => 'SUSE Linux Enterprise Server release 10, Service Pack 1 (full)',
     size    => 2765,
     rpmsize => 797 },
   SLES10SP2_MIN =>
   { title   => 'SUSE Linux Enterprise Server release 10, Service Pack 2 (minimal)',
     size    => 780,
     rpmsize => 212 },
   SLES10SP2_FULL =>
   { title   => 'SUSE Linux Enterprise Server release 10, Service Pack 2 (full)',
     size    => 3100,
     rpmsize => 869 },
   SLES10SP3_MIN =>
   { title   => 'SUSE Linux Enterprise Server release 10, Service Pack 3 (minimal)',
     size    => 707,
     rpmsize => 195 },
   SLES10SP3_FULL =>
   { title   => 'SUSE Linux Enterprise Server release 10, Service Pack 3 (full)',
     size    => 3152,
     rpmsize => 897 },
   SLES11_MIN =>
   { title   => 'SUSE Linux Enterprise Server release 11 (minimal)',
     size    => 850,
     rpmsize => 200 },
   SLES11_FULL =>
   { title   => 'SUSE Linux Enterprise Server release 11 (full)',
     size    => 3636,
     rpmsize => 950 },

  );

=item B<ppack>

Return the PowerPack object.

=cut

sub ppack { $_[0]->{ppack} }

=item B<log_system_information>

A convenient place to log useful bits of system information to file:
- SELinux enforcement mode

=cut

sub log_system_information {
  my ($self) = @_;

  # Log SELinux enforcement mode
  my $getenforce_binary = '/usr/sbin/getenforce';
  if (-x $getenforce_binary) {
    my $enforcement_mode = $self->run_command($getenforce_binary);
    chomp($enforcement_mode);
    $self->log_only_to_file("SELinux enforcement mode is '$enforcement_mode'.\n");
  }
  else {
    $self->log_only_to_file("SELinux does not appear to be installed.\n");
  }

  $self->SUPER::log_system_information;
}

=item B<initialize_delegate>

Delegate to a class determined by determine_linux_distribution.

=cut

sub initialize_delegate {
  my ($class) = @_;
  my $self = bless({}, $class); # temporary $self

  my $distro = $self->determine_linux_distribution;
  my ($os, $maj, $min) = $distro =~ /^([A-Z]+)(\d+)(?:(?:$MINOR_REV_SEPARATORS)(\d+))?$/oi;
  $min ||= 0;

  my $delegate;
  if (exists $DELEGATES{$distro}) {
    # OK, we have a specific delegate for this distro
    $delegate = $DELEGATES{$distro};
  }
  elsif ($os) {
    # If we have a '+' delegate, it supports all minor revisions
    # greater than or equal to itself.

    # Looking for an "all minor revisions" delegate is easy:
    if (exists $DELEGATES{"$os$maj+"}) {
      $delegate = $DELEGATES{"$os$maj+"};
    }
    else {
      # If it's only from a specific minor rev onwards, we need to
      # look more closely at the keys of %DELEGATES.
      foreach my $key (keys %DELEGATES) {
	if ($key =~ /^$os$maj(?:$MINOR_REV_SEPARATORS)(\d+)\+$/) {
	  my $key_min = $1;
	  if ($key_min <= $min) {
	    $delegate = $DELEGATES{$key};
	  }
	}
      }
    }
  }

  # Nice message if distro isn't supported
  if (not $delegate) {
    $self->log("Your OS distribution ([_1]) is unsupported. Only the following are supported:", $distro);
    foreach my $details (sort {$a->{name} cmp $b->{name}} values %DELEGATES) {
      $self->log("- [_1]", $details->{name} );
    }
    exit 1;
  }

  # We don't want to log this until the class is set up
  push @{$self->{delayed_messages}},
    ["Host OS detected as [_1] ([_2])", $delegate->{name}, $distro];
  $self->{distribution} = $distro;
  $self->{distro_details} = $delegate;
  $self->{minor_os_revision} = $min;

  # Delegate to the appropriate class
  $class .= "::$delegate->{class}";
  eval qq{ require $class; };
  if ($@) {           
    $self->croak("Error loading [_1]: [_2]", $class, $@);
  }

  # Now we've loaded the class, rebless $self into it
  bless($self, $class);

  # Add a dummy PowerPack object which we can override later if we need to.
  $self->{ppack} = Maiken::RO::PowerPack->new(enabled => 0);


  return $self;
}

=item B<set_up_environment>

  umask 022

=cut

sub set_up_environment {
  my ($self) = @_;
  umask 022;
  $ENV{PATH} = '/sbin:/usr/sbin:/usr/local/bin:/usr/bin:/bin';

  if (not -d $self->{config}{config_dir}) {
    File::Path::mkpath($self->{config}{config_dir});
  }
}

=item B<check_environment>

  Are we on a ppc system with the appropriate /proc stuff?
  Check that we have required RPMs installed.
  set_default_config_common
  Is the translator RPM installed?

=cut

sub check_environment {
  my ($self) = @_;

  # Is it running under translation or on a non-PPC machine?
  if ($self->run_command('uname', '-m') ne "ppc64\n") {
    $self->croak("This installer must be run on an IBM System p platform");
  }

  # Look for IBM system information
  if (-d '/proc/device-tree') {
    $self->{config}{model} = $self->slurp('/proc/device-tree/model');
    chomp $self->{config}{model};
    $self->{config}{model} =~ s/\0$//;
    $self->{config}{serial} = $self->slurp('/proc/device-tree/system-id');
    chomp $self->{config}{serial};
    $self->{config}{serial} =~ s/\0$//;
    $self->{config}{model} =~ /IBM,(.*)/;
  }
  $self->{config}{model}  ||= 'unknown';
  $self->{config}{serial} ||= 'unknown';

  # Information about the QT RPM
  $self->{config}{rpm_installed} =
    $self->get_installed_rpm_full_name($self->PRODUCT_NAME);
  if (not $self->{config}{rpm_installed}) {
    # Look for old ones
    for (@{$self->OLD_PRODUCT_NAMES}) {
      if ($self->{config}{rpm_installed} =
	  $self->get_installed_rpm_full_name($_)) {
	$self->{config}{old_product_installed} = $_;
	last;
      }
    }
  }
  unless ($self->{quitting}) {
    $self->{config}{versions_available} = $self->versions_available;
  }

  # Common config - needs to come after the QT RPM in case there is an
  # old version installed
  $self->set_default_config_common;

  $self->check_sw_installation;

  # sw_rpm_dir - set from environment or use default
  if ($ENV{SW_RPM_DIR}) {
    $self->log("WARNING: using non-standard RPM staging directory [_1].",
	       $ENV{SW_RPM_DIR});
  }
  $self->{config}{sw_rpm_dir} = $ENV{SW_RPM_DIR} || $self->SW_RPM_DIR;
}

=item B<check_sw_installation>

Is the SW installed? What Distro is it?

=cut

sub check_sw_installation {
  my ($self) = @_;
  if (-f "$self->{config}{sw_root_path}/etc/".$self->SW_SUCC) {
    my ($first_line) = $self->slurp("$self->{config}{sw_root_path}/etc/".$self->SW_SUCC);
    if ($first_line and $first_line =~ /^(\w+)$/) {
      $self->{config}{sw_installed} = $1;
    }
    else {
      # Subject worlds installed with old versions of Maiken will not
      # have that line, so we need to guess - take the SW's distro and
      # append '_FULL'.
      $self->{config}{sw_installed} =
	$self->determine_linux_distribution($self->{config}{sw_root_path}).
	  "_FULL";
    }
  }
  else {
    $self->{config}{sw_installed} = undef;
  }
}

=item B<get_initial_config_interactively>

  get_registration_info_interactively

=cut

sub get_initial_config_interactively {
  my ($self) = @_;
  $self->license_agreement_interactively('utf16', 'LA', 'LI') or return;

  # We ignore the return value of get_registration_info_interactively
  # because this is a non-critical operation and we don't want the
  # user stuck if they can't send mails.
  $self->get_registration_info_interactively;

  return 1;
}

=item B<sanity_initial_config>

Check that either the license agreement has been agreed (polite
message if not) or the user has specified --license-accepted.

=cut

sub sanity_initial_config {
  my ($self, $modifiers) = @_;

  my $accepted_dir = "$self->{config}{config_dir}/".
    $self->ACCEPTED_LICENSE_DIR;

  # Is the user agreeing to the license?
  if ($modifiers->{'license-accepted'}) {
    # Get the text in English, since we can't rely on the language
    my $english_text = $self->get_license_text('en', 'utf16', 'LA', 'LI');
    # If an old style licence file exists, move it out of the way
    if (-e $accepted_dir and !-d $accepted_dir) {
      rename($accepted_dir, "$accepted_dir.old") or
	$self->croak("Unable to move old license file");
    }
    # Create the directory if it doesn't already exist
    (-d $accepted_dir) or File::Path::mkpath($accepted_dir) or
      $self->croak("Could not make the directory [_1]",
		   $accepted_dir);
    $self->write_file("$accepted_dir/".$self->LICENSE_FILE, $english_text);
  }

  # Is the license there?
  if (-e "$accepted_dir/".$self->LICENSE_FILE) {
    return 1;
  }
  else {
    if ($self->{powerpack_mode}) {
      $self->croak("No license file found.");
    }
    else {
      $self->croak("\nYou have not accepted the license agreement. To view the license agreement,\nplease rerun this command in interactive mode. If you accept the license\nagreement, please run this command with the option --license-accepted.\n");
    }
    return 0;
  }
}

=item B<get_install_config_interactively>

Ask what things the user wants to install.

Get the paths for various things.

=cut

sub get_install_config_interactively {
  my ($self) = @_;
  my $action = $self->prompt_user_for_install;
  return 0 if $action eq 'return';

  # Remember what the user wants to install
  $self->{config}{install_qt} = ($action =~ /qt/);
  $self->{config}{install_sw} = ($action =~ /sw/);
  $self->{config}{install_sw_from_archive} = ($action =~ /archive/);

  # Perform some common sanity checks
  $self->common_install_sanity or return 0;

  # Ask the user which version should be installed
  if ($self->{config}{install_qt}) {
    $self->{config}{chosen_rpm_file} = $self->version_menu;
    return 0 if $self->{config}{chosen_rpm_file} eq 'return';
    # Check we have enough disk space
    $self->check_disk_space_in_qt_root_dir or return 0;

    # Check the RPM can be installed and bomb out if it can't.
    if (not $self->install_rpm($self->RPM_DIR."/$self->{config}{chosen_rpm_file}", test => 1)) {
      $self->log;
      $self->log("RPM installation test failed.");
      $self->log($self->{rpm_output});
      $self->log("Installation of package [_1] failed, possible reason is that prerequisites are not installed. Please refer to documentation for details.", $self->{config}{chosen_rpm_file});
      return 0;
    }
  }

  if ($self->{config}{install_sw}) {
    $self->get_subject_world_config_interactively or return 0;
  }

  # Final confirmation before installing the subject world
  $self->log;
  $self->log("About to proceed with the following:");
  $self->log;
  if ($self->{config}{install_qt}) {
    $self->log("- Install [_1] to [_2]",
	       $self->PRODUCT_NAME,
	       [$self->{config}{qt_root_path}, 'user']);
    $self->log("  - Log files will be stored in [_1]",
	       [$self->{config}{logfile_path}, 'user']);
  }
  if ($self->{config}{install_sw}) {
    $self->log("- Install [_1] to [_2]",
	       $self->SW_NAME,
	       [$self->{config}{sw_root_path}, 'user']);
    $self->log("  - Selected distribution is [_1]",
	       $SUBJ_WORLDS{$self->{config}{sw_distro}}{title});
    unless ($self->{config}{install_sw_from_archive}) {
      if (defined $self->{config}{sw_homedir}
	  and $self->{config}{sw_homedir} ne 'skip') {
	$self->log("  - Home directories are in [_1]",
		   [$self->{config}{sw_homedir}, 'user']);
      }
      else {
	$self->log("  - Home directories will not be shared");
      }
    }
  }
  my $answer = $self->menu([
			    [cont => "Continue."],
			    [edit => "Change settings."],
			    [return => "Go back to the Main Menu."],
			   ]);
  if ($answer eq 'return') {
    $self->remove_sw_rpm_dir(cautious=>1);
    return 0;
	}
  # Do it again?
	elsif ($answer eq 'edit') {
    return $self->get_install_config_interactively;
  }
  return 1;
}

=item B<check_install_path_is_not_tmp>

Checks that neither powervm-lx86 nor the x86world path are in /tmp, or
actually /tmp.

=cut

sub check_install_path_is_not_tmp {
  my $self = shift;
  if ($self->{config}{install_qt}) {
    if ($self->{config}{qt_root_path} =~ m#^/tmp(/|$)#) {
      $self->log("You cannot install [_1] to /tmp.", $self->PRODUCT_NAME);
      return 0;
    }
  }
  if ($self->{config}{install_sw}) {
    if ($self->{config}{sw_root_path} =~ m#^/tmp(/|$)#) {
      $self->log("You cannot install [_1] to /tmp.", $self->SW_NAME);
      return 0;
    }
  }
  return 1;
}

=item B<check_sw_and_qt_paths_differ>

Checks that we're not trying to install powervm-lx86 and the x86world
to the same directory.

Also check that powervm-lx86 will not be installed to a subdirectory of x86
World.

=cut

sub check_sw_and_qt_paths_differ {
  my ($self) = @_;

  # Are both components going to end up installed on this machine?
  if ( ($self->{config}{install_qt} || $self->{config}{rpm_installed}) &&
       ($self->{config}{install_sw} || $self->{config}{sw_installed}) ) {

    if ($self->{config}{sw_root_path} eq $self->{config}{qt_root_path} or
	$self->{config}{qt_root_path} =~ m|^\Q$self->{config}{sw_root_path}\E/|) {
      $self->log("You cannot install [_1] and [_2] into the same directory." ,
		              $self->PRODUCT_NAME, $self->SW_NAME);
      $self->log("Please re-enter your installation paths.");

      return 0 ;
    }
  }

  return 1 ;
}

=item B<prompt_user_for_install>

Submenu for 'install'.

=cut

sub prompt_user_for_install {
  my ($self) = @_;
  my $options = [
		 [qt_sw => ["Install [_1] + [_2].",
			    $self->PRODUCT_NAME, $self->SW_NAME]],
		 [qt    => ["Install [_1].", $self->PRODUCT_NAME]],
		 [sw    => ["Install [_1].", $self->SW_NAME]],
		 [sw_archive => ["Install [_1] from a pregenerated archive.",
				 $self->SW_NAME]],
		 [return => "Go back to the Main Menu."],
		 [quit   => "Quit."],
		];
  my $action = $self->menu($options);
  $self->quit if $action eq 'quit';
  return $action;
}

=item B<get_subject_world_config_interactively>

To install the subject world we need some extra information from the
user.

=cut

sub get_subject_world_config_interactively {
  my ($self) = @_;

  # Offer to remove anything that doesn't look like a fully-installed
  # SW.
  if (-d $self->{config}{sw_root_path}) {
    if ($self->is_on_remote_filesystem($self->{config}{sw_root_path})) {
      $self->log;
      $self->log("[_1] appears to be on a remote filesystem. Installing to remote filesystems is unsupported.", [$self->{config}{sw_root_path}, 'user']);
      return 0;
    }

    my @files_in_dir = $self->read_directory($self->{config}{sw_root_path});
    # If the directory is empty, then just use it.
    if (@files_in_dir) {
      if (-f "$self->{config}{sw_root_path}/etc/".$self->SW_PART) {
	      $self->log("Found partially installed [_1] at [_2].",
		      $self->SW_NAME, [$self->{config}{sw_root_path}, 'user']);
      }
      elsif (-f "$self->{config}{sw_root_path}/etc/".$self->SW_SUCC) {
        $self->log("Found installed [_1] at [_2].",
          $self->SW_NAME, [$self->{config}{sw_root_path}, 'user']);
      }
      else {
	     $self->log("Directory [_1] already exists but doesn't look like an installation of [_2]", [$self->{config}{sw_root_path}, 'user'],
		     $self->SW_NAME);
      }

      # Empty the directory. We don't delete it in case it's a mount point.
      if ($self->ask(q => ["Empty the directory [_1]?",
			   [$self->{config}{sw_root_path}, 'user']
			   ], type => 'bool',
		     default => 0
		    )) {
	my $mounted = $self->directory_has_mounted_filesystems
	  ($self->{config}{sw_root_path});
	if ($mounted) {
	  $self->log("The directory [_1] contains mounted filesystems ([_2]). Please unmount them before retrying this operation.", [$self->{config}{sw_root_path}, 'user'], $mounted);
	  return 0;
	}
	$self->log("Emptying directory...");
	foreach (@files_in_dir) {
	  File::Path::rmtree("$self->{config}{sw_root_path}/$_") or
	      $self->croak("Unable to remove [_1]",
			   ["$self->{config}{sw_root_path}/$_", 'user']);
	}
      }
      else {
	$self->log("Aborting installation.");
 	return 0;
      }
    }
  }
  else {
    # Create the SW directory
    push @{$self->{cleanup_dirs}},
      File::Path::mkpath($self->{config}{sw_root_path});
    if ($self->is_on_remote_filesystem($self->{config}{sw_root_path})) {
      $self->log;
      $self->log("[_1] appears to be on a remote filesystem. Installing to remote filesystems is unsupported.", [$self->{config}{sw_root_path}, 'user']);
      return 0;
    }
  }

  # Give the user a choice of distribution for the subject world.
  unless ($self->{config}{install_sw_from_archive}) {
    my $options = [];
    foreach my $sw ($self->supported_distros) {
      push @$options, [$sw, $SUBJ_WORLDS{$sw}{title}];
    }
    if (@$options > 1) {
      $self->log("Which Linux/x86 OS distribution will you be installing for your [_1]?",
		 $self->SW_NAME);
      $self->{config}{sw_distro} =
	$self->menu($options,
		    "Please select a distribution from the list above:");
    }
    else {
      # If we only have one, just choose it automatically
      $self->{config}{sw_distro} = $options->[0][0];
    }
  }

  # The following questions are different depending whether this is a
  # media or archive installation.
  if ($self->{config}{install_sw_from_archive}) {
    while (1) {
      $self->{config}{sw_tarball_location} =
	$self->ask(q => "Please specify the location of the archive file (type 'skip' to return to the main menu):",
		   type => 'path', must_exist => 1, skip => 1);
      if ($self->{config}{sw_tarball_location} eq 'skip') {
	return 0;
      }
      if (not -f $self->{config}{sw_tarball_location}) {
	$self->log("That doesn't look like a valid archive file.");
	redo;
      }

      my $metadata = $self->get_metadata_from_archive_file($self->{config}{sw_tarball_location});
      if (not $metadata or not $metadata->{sw_distro}) {
	$self->log("That doesn't look like a valid archive file.");
	redo;
      }
      if (not grep {$_ eq $metadata->{sw_distro}} $self->supported_distros) {
	$self->log("That archive is of type '[_1]' which is not supported on this OS distribution.", $metadata->{sw_distro});
	redo;
      }
      $self->{config}{sw_distro} = $metadata->{sw_distro};
      last;
    }
    # Check the disk space
    $self->check_disk_space_in_sw_root_dir or return 0;
    return 1;
  }
  else {
    # Check the disk space
    $self->check_disk_space_in_sw_root_dir or return 0;

    $self->get_sw_media_config_interactively or return 0;

    # Ask the user about home directories
    $self->{config}{sw_homedir} = undef; # ask the question at least once
    $self->log;
    while (not defined $self->{config}{sw_homedir}) {
      $self->{config}{sw_homedir} =
        $self->ask(q => ["Where are the home directories located on this system (type 'skip' if you don't want the [_1] to share your home directories)?", $self->SW_NAME],
                   type => 'path', default => $self->SW_DEFAULT_HOMEDIR, skip => 1,
                   must_exist => 1);
      # Tidy it up
      if ($self->{config}{sw_homedir} ne 'skip') {
        $self->{config}{sw_homedir} = 
          Cwd::abs_path($self->{config}{sw_homedir});
        # Remove trailing slash
        $self->{config}{sw_homedir} =~ s|/$||
          if defined $self->{config}{sw_homedir};
      }
    }
    return 1;
  }
}

=item get_sw_media_config_interactively

Ask the user some questions about the subject world media, and then
call the populate_sw_rpm_dir function that loops populating the rpm
dir.

=cut

sub get_sw_media_config_interactively {
  my ($self) = @_;

  # Create the temporary RPM directory
  $self->log;
  $self->log(<<EOT, $self->SW_NAME, $self->PRODUCT_NAME, $SUBJ_WORLDS{$self->{config}{sw_distro}}{title});
To create the [_1] the [_2] installer will need the appropriate set of x86
RPMs. This set of RPMs is generated from the [_3] x86 install media
(ISO or CD/DVD-ROM).

EOT

  $self->prepare_sw_media_directory or return 0;
	
  if ( scalar( keys %{$self->{config}{rpms_still_to_get}}) > 0 ) {
    $self->populate_sw_rpm_dir or return 0;
  }
  $self->log("All RPMs found successfully.");

  return 1;
}

=item B<prepare_sw_media_directory>

Set up the sw_rpm_dir for copying RPMs into - this involves setting
all the appropriate variables in $self->{config} including the
rpms_still_to_get and also deleting any directory found at sw_rpm_dir.

In interactive mode, prompts to delete non-standard dirs. In
non-interactive mode, it fails if this is the case.

=cut

sub prepare_sw_media_directory {
  my ($self, %args) = @_;

  $self->{config}{rpms_still_to_get} = $self->get_rpm_list_as_hashref('base apps');

  # Regex_rpms are the special RPM names that are regexes, delimited by //
  my @regex_rpms = grep s|^/(.*)/$|$1|,
    keys %{$self->{config}{rpms_still_to_get}};
  $self->{config}{regex_rpms} = \@regex_rpms;
  $self->{config}{real_names_for_regexes} = {};
  $self->{config}{total_rpms_required} =
    scalar keys %{$self->{config}{rpms_still_to_get}};
  my $base_rpms = $self->get_rpm_list_as_hashref('base');
  $self->{config}{total_base_rpms_required} = scalar keys %$base_rpms;
  $self->{config}{rpms_found} = 0;

  # Have these rpms already been copied into the tmp area? If so, this
  # is probably either from a previous failed installation or they
  # were put there by the PowerPack. We'll check the filenames and
  # trust that this is enough.
  if (-d $self->{config}{sw_rpm_dir} and not $args{analysis_failed_once}) {
    $self->analyze_sw_rpm_dir;
    if (keys %{$self->{config}{rpms_still_to_get}}) {
      # Failed to find all the RPMs on a first pass so we'll just
      # behave as if the directory was never there and call this
      # function again.
      $self->prepare_sw_media_directory(analysis_failed_once => 1);
    }
  }
  # Can't be too sure what's in the tmp dir so we'll rm it
  else {
    $self->remove_sw_rpm_dir or return 0;
    # Recreate it
    $self->ensure_sw_rpm_dir_exists;
    $self->{config}{sw_distro_in_rpm_dir} = $self->{config}{sw_distro};
  }
  return 1;
}

=item B<common_install_sanity>

Sanity checks common to both the interactive and non-interactive
installations.

=cut

sub common_install_sanity {
  my ($self) = @_;
  # Check we have the capability to do archived installs
  if ($self->{config}{install_sw_from_archive}) {
    $self->check_archive_functionality_available or return 0;
  }

  # Can't install the SW without QT
  if ($self->{config}{install_sw} and
      not ($self->{config}{install_qt} or $self->{config}{rpm_installed})) {
    $self->log;
    $self->log("Cannot install [_1] when [_2] is not installed.",
	       $self->SW_NAME, $self->PRODUCT_NAME);
    $self->{config}{install_sw} = 0;
    return 0;
  }

  # Is QT already installed?
  if ($self->{config}{install_qt} && $self->{config}{rpm_installed}) {
    $self->log;
    $self->log("Cannot install [_1] because it ([_2]) is already installed",
	       $self->PRODUCT_NAME, $self->{config}{rpm_installed});
    $self->log("Perhaps you meant to upgrade?");
    $self->{config}{install_qt} = 0;
    return 0;
  }

  do {
    $self->check_sw_installation; # Since we may be looking in a
                                  # different place now
    # Is the SW already installed?
    if ($self->{config}{install_sw} && $self->{config}{sw_installed}) {
      $self->log("Cannot install [_1] because it ([_2]) is already installed", 
		 $self->SW_NAME, $self->{config}{sw_installed});
      $self->{config}{install_sw} = 0;
      return 0;
    }
    # Just go with the config from the config file if we're not in
    # interactive mode
    if ($self->{interactive_mode}) {
      $self->get_config_common_interactively;
    }
  }
  until ($self->check_sw_and_qt_paths_differ
      && $self->check_install_path_is_not_tmp);

  # Ban /mnt and /media from being filesystems of their own
  if ($self->{config}{install_sw}) {
    foreach my $dir (qw|/mnt /media|) {
      if (-d $dir and (stat $dir)[0] != (stat '/')[0]) {
	$self->log("Unable to install [_1] because [_2] is a mounted filesystem.\nPlease unmount it before installing [_1].",
		   $self->SW_NAME, $dir);
	return 0;
      }
    }
  }

  return 1;
}

=item B<sanity_install_config>

Check all the necessary config has been supplied in the config file
and it is correct.

=cut

sub sanity_install_config {
  my ($self, $modifiers) = @_;

  my %products;
  if ($modifiers->{products}) {
    @products{@{$modifiers->{products}}} = ();
  }

  # Work out what they want to install
  if (exists $products{Lx86}) {
    delete $products{Lx86};
    $self->{config}{install_qt} = 1;
  }
  if (exists $products{x86world}) {
    delete $products{x86world};
    $self->{config}{install_sw} = 1;
  }
  if (%products) {
    $self->croak("No such product: [_1]", join(' ', keys %products));
  }

  if ($modifiers->{archive}) {
    $self->{config}{sw_tarball_location} = $modifiers->{archive};
  }
  if ($modifiers->{media}) {
    $self->{config}{sw_install_media} = $modifiers->{media};
  }
  if ($modifiers->{distro}) {
    $self->{config}{sw_distro} = $modifiers->{distro};
  }

  if ($self->{config}{install_sw} and
      $self->{config}{sw_tarball_location}) {
    $self->{config}{install_sw_from_archive} = 1;
  }

  # Perform some common sanity checks
  $self->common_install_sanity or return 0;

  # Check the QT config
  if ($self->{config}{install_qt}) {
    # Check we have enough disk space
    $self->check_disk_space_in_qt_root_dir or return 0;

    if (not $self->{config}{chosen_rpm_file}) {
      if (keys %{$self->{config}{versions_available}} == 1) {
	$self->{config}{chosen_rpm_file} =
	  (values %{$self->{config}{versions_available}})[0];
      }
      else {
	$self->croak("Cannot determine RPM file to install.");
      }
    }
    my $rpm_abspath = $self->RPM_DIR."/$self->{config}{chosen_rpm_file}";
    if (not -f $rpm_abspath) {
      $self->croak("No such file [_1]", $rpm_abspath);
    }
    if (not $self->install_rpm($rpm_abspath, test => 1)) {
      $self->log;
      $self->log("RPM installation test failed.");
      $self->log($self->{rpm_output});
      return 0;
    }
  }

  # Check the SW config
  if ($self->{config}{install_sw}) {

    if (not exists $SUBJ_WORLDS{$self->{config}{sw_distro}}) {
      $self->croak("The subject world distribution '[_1]' does not exist.\nPlease check the name, remembering that names typically end with _MIN or _FULL.",
                  $self->{config}{sw_distro});
    }

    unless ($self->{config}{sw_tarball_location} or
	    $self->{config}{sw_install_media}) {
      $self->log("Please specify either media or archive for [_1] installation.", $self->SW_NAME);
      return 0;
    }

    if (-d $self->{config}{sw_root_path}) {
      if ($self->is_on_remote_filesystem($self->{config}{sw_root_path})) {
        $self->log;
        $self->log("[_1] appears to be on a remote filesystem. Installing to remote filesystems is unsupported.", [$self->{config}{sw_root_path}, 'user']);
        return 0;
      }

      # Check the directory is empty
      my @files_in_dir = $self->read_directory($self->{config}{sw_root_path});
      if (@files_in_dir) {
        if ($self->{config}{empty_sw_dir}) {
          my $mounted = $self->directory_has_mounted_filesystems
            ($self->{config}{sw_root_path});
          if ($mounted) {
            $self->log("The directory [_1] contains mounted filesystems ([_2]). Please unmount them before retrying this operation.", [$self->{config}{sw_root_path}, 'user'], $mounted);
            return 0;
          }
          $self->log("Emptying directory...");
          foreach (@files_in_dir) {
            File::Path::rmtree("$self->{config}{sw_root_path}/$_") or
              $self->croak("Unable to remove [_1]",
			         ["$self->{config}{sw_root_path}/$_", 'user']);
          }
        } else {
          $self->log("The directory [_1] is not empty.",
		       [$self->{config}{sw_root_path}, 'user']);
          return 0;
        }
      }
    } else {
      # Create the SW directory
      push @{$self->{cleanup_dirs}},
      File::Path::mkpath($self->{config}{sw_root_path});
      if ($self->is_on_remote_filesystem($self->{config}{sw_root_path})) {
        $self->log;
        $self->log("[_1] appears to be on a remote filesystem. Installing to remote filesystems is unsupported.", [$self->{config}{sw_root_path}, 'user']);
        return 0;
      }
    }

    # If this is an archive installation, the next steps are different
    # FIXME
    if ($self->{config}{install_sw_from_archive}) {
      if (not -f $self->{config}{sw_tarball_location}) {
        $self->log("That doesn't look like a valid archive file.");
        return 0;
      }

      my $metadata = $self->get_metadata_from_archive_file($self->{config}{sw_tarball_location});
      if (not $metadata or not $metadata->{sw_distro}) {
        $self->log("That doesn't look like a valid archive file.");
        return 0;
      }
      if (not grep {$_ eq $metadata->{sw_distro}} $self->supported_distros) {
        $self->log("That archive is of type '[_1]' which is not supported on this OS distribution.", $metadata->{sw_distro});
        return 0;
      }
      $self->{config}{sw_distro} = $metadata->{sw_distro};

      # Check we have enough disk space to install it
      $self->check_disk_space_in_sw_root_dir or return 0;
      return 1;
    }

    # This point is only reached for media installations.
    # Check we know what we're installing and that it's legal.
    if (not $self->{config}{sw_distro}) {
      $self->log("Cannot determine which distribution of [_1] to install.", $self->SW_NAME);
      return 0;
    }

    # Check we have enough disk space to install it
    $self->check_disk_space_in_sw_root_dir or return 0;

    if (not grep {$_ eq $self->{config}{sw_distro}} $self->supported_distros) {
      $self->log("[_1] is unsupported on this OS distribution.",
        $self->{config}{sw_distro});
      return 0;
    }

    # Now we need to get the install media
    $self->prepare_sw_media_directory or return 0;
    # Finally populate the directory
    if (not $self->populate_sw_rpm_dir($self->{config}{sw_install_media})) {
      $self->log("Not all required RPMs could be located on the specified install media.");
      return 0;
    }
  }

  return 1;
}

=item B<remove_sw_rpm_dir>

Remove the subject world rpm staging area

Optional arg: cautious
$self->remove_sw_rpm_dir(cautious=>1);
Leaves non-standard RPM directories behind without prompting the user

=cut

sub remove_sw_rpm_dir {
  my ($self, %options) = @_;

  if (-d $self->{config}{sw_rpm_dir}) {
    # Prompt the user if I'm about to remove a non-standard RPM directory
    if ( $self->{config}{sw_rpm_dir} ne $self->SW_RPM_DIR ) {
      if (not $self->{interactive_mode}) {
	$self->log("Won't remove non-standard RPM staging directory [_1] in non-interactive mode", $self->{config}{sw_rpm_dir});
	return 0;
      }

      if ($options{cautious} or
          !$self->ask(q => ["Non-standard RPM staging directory [_1] already ".
                               "exists! OK to remove it?",
                               $self->{config}{sw_rpm_dir}],
                               type => 'bool', default => 1)) {
        return 0;
      }
    }
    File::Path::rmtree($self->{config}{sw_rpm_dir});
  }
  elsif(-e $self->{config}{sw_rpm_dir}) {
    unlink($self->{config}{sw_rpm_dir})
  }


  return 1;
}



=item B<install>

User can choose to install QT, SW or both.

=cut

sub install {
  my ($self) = @_;

  # PowerPack needs to know the number of steps
  my $steps = 0;
  $steps++ if $self->{config}{install_qt};
  if ($self->{config}{install_sw}) {
    if ($self->{config}{install_sw_from_archive}) {
      $steps += 3;
    }
    else {
      $steps += 5;
    }
  }
  $steps++ if ($self->{config}{install_qt} || $self->{config}{rpm_installed})
    and ($self->{config}{install_sw} || $self->{config}{sw_installed});

  $self->ppack->begin_operation(title => 'install', steps => $steps);

  $self->stop_qt;
  if ($self->{config}{install_qt}) {
    $self->install_qt or return 0;
  }
  if ($self->{config}{install_sw}) {
    $self->install_sw or return 0;
  }

  # The special RPMs are usually installed as part of the SW install.
  # If there was a SW present and we are installing a QT then we need
  # to make sure the existing SW has the special RPMs installed/updated.
  if ( $self->{config}{install_qt} && $self->{config}{sw_installed} )
  {
    $self->install_special_rpms;
    $self->remove_rpm_staging_directory;
  }

  # If we're not installing the SW from media we should start the
  # daemon back up here.
  unless ($self->{config}{install_sw} and
	  not $self->{config}{install_sw_from_archive}) {
    $self->start_qt;
  }

  $self->check_environment;
  if ($self->{config}{rpm_installed} and $self->{config}{sw_installed}) {
    $self->bind_qt_and_sw or return 0;
  }

  $self->ppack->end_operation;

  return 1;
}

=item B<install_qt>

Install the QT RPM and perform some postprocessing.

Also install the installer into the qt_root_path. It's done here
because we don't know the qt_root_path until this point.

Similarly, linkx86 is created at this stage because it needs access to
the installer libraries.

=cut

sub install_qt {
  my ($self) = @_;

  $self->ppack->next_step(title => 'Installing '.$self->PRODUCT_NAME_FRIENDLY);


  # Install the installer into the specified qt_root_path
  $self->ppack->progress(percent => 0, title => "Installing installer");
  my $installer_path = "$self->{config}{qt_root_path}/installer";
  $self->install_self_into($installer_path);

  $self->ppack->progress(percent => 25, title => "Configuring installation");
  # Move the config dir to the right location
  $self->fix_config_dir;

  # Symlink the doc/ directory
  symlink "$installer_path/resources/doc/RO",
    "$self->{config}{qt_root_path}/doc";

  # RPM
  $self->ppack->progress(percent => 50, title => "Installing RPM file");
  $self->install_rpm($self->RPM_DIR."/$self->{config}{chosen_rpm_file}",
		     prefix => $self->{config}{qt_root_path}) or
    $self->croak("RPM installation failed.");


  $self->ppack->progress(percent => 75, title => "Configuring installation");
  # Config file
  $self->write_config_file;

  # Log directory

  # Check that the parent of the logfile directory is read-only
  my $log_path        = $self->{config}{logfile_path};
  my $log_path_parent = File::Basename::dirname($log_path);
  if (-d $log_path_parent) {
    my $mode = (stat $log_path_parent)[2];
    if ( !(-O $log_path_parent)
      || ($mode & S_IWGRP)
      || ($mode & S_IWOTH))
    {
      $self->log(
        "WARNING: The directory [_1] is writable by non-root users. "
       ."This is insecure and should be made read-only.",
       $log_path_parent
      );
    }
  }

  umask 000;

  # Create any parent directories read-only, then chmod the log path
  File::Path::mkpath($log_path, undef, 0755);
  chmod(01777, $log_path);
  umask 022;

  # Symlink linkx86 from the installed installer path
  $self->create_linkx86_symlink;

  # Success! Add to transactions
  $self->log;
  $self->log("[_1] installed successfully.", $self->PRODUCT_NAME);
  $self->log;
  $self->add_transaction("Installed [_1]", $self->PRODUCT_NAME_FRIENDLY);
  $self->add_transaction("Installed installer into [_1]", [$installer_path, 'user']);
}

=item B<create_linkx86_symlink>

Creates the linkx86 symlink

=cut

sub create_linkx86_symlink {
	my ($self) = @_;

  my $linkx86_symlink = $self->BIN_DIR.'/'.$self->LINKX86;
  my $linkx86_source = "$self->{config}{qt_root_path}/installer/resources/bin/RO/".$self->LINKX86;
  if (-l $linkx86_symlink or -e $linkx86_symlink) {
    unlink $linkx86_symlink or
      $self->croak("Failed to remove [_1]", $linkx86_symlink);
  }
  symlink($linkx86_source, $linkx86_symlink) or
	    $self->croak("Failed to create symlink [_1]", $linkx86_symlink);
  if (not -x $linkx86_source) {
    chmod 0755, $linkx86_source;
  }	

}

=item B<install_sw>

Install a Subject World.

=cut

sub install_sw {
  my ($self) = @_;

  $self->ppack->next_step(title => 'Initializing '.$self->SW_NAME.' installation');

  $self->log;
  $self->log("Installing [_1]...", $self->SW_NAME);
  $self->log;

  $self->ppack->progress(percent => 0, title => "Configuring installation");

  if (not $self->{config}{install_sw_from_archive} and
      not -d $self->{config}{sw_rpm_dir}) {
    $self->croak("Failed to install subject world: [_1] does not exist",
		 $self->{config}{sw_rpm_dir});
  }

  $self->write_config_file;
  $self->initialize_sw_directory;

  # Get cwd so we can return to it later
  my $oldpwd = Cwd::cwd;

  # Get inside the SW before doing translated operations
  chdir $self->{config}{sw_root_path} or $self->croak("Couldn't chdir");

  if ($self->{config}{install_sw_from_archive}) {
    # We want to unpack this tarball as our subject world
    $self->unpack_subject_world;
    # Do this again, because the tarball probably contains /etc/passwd
    $self->replicate_passwd_and_friends($self->{config}{sw_root_path});
    # We don't need to do the translated install, but this method sets
    # up important stuff.
    $self->prepare_sw_for_translated_install(ppack => 0);
    #Make sure the special RPMs are added/upgraded.
    $self->install_special_rpms;
  } else {
    $self->install_base_rpms_natively;
    $self->prepare_sw_for_translated_install;
    $self->install_special_rpms;
    $self->install_rpms_translated;
    $self->verify_sw_installation;
  }

  $self->ppack->next_step(title => 'Setting up '.$self->SW_NAME);
  $self->setup_sw;
  $self->setup_sw_interactive;
  $self->finalize_sw_installation;

  $self->ppack->progress(percent => 75, title => "Cleaning up");
  $self->remove_rpm_staging_directory;

  # Recreate the linkx86 symlink if possible
  if ($self->{config}->{rpm_installed}) {
    $self->create_linkx86_symlink;
  }

  # Return to old cwd
  chdir $oldpwd or $self->croak("Couldn't chdir");

  $self->log;
  $self->log("[_1] installed successfully.", $self->SW_NAME);
  $self->log;
  $self->add_transaction("Installed [_1] ([_2])", $self->SW_NAME,
			 $SUBJ_WORLDS{$self->{config}{sw_distro}}{title});
}

=item B<initialize_sw_directory>

Create some directories and empty files.

Copy /etc/passwd and friends from the host.

=cut

sub initialize_sw_directory {
  my ($self) = @_;

  # Make directories
  foreach (qw|/etc /var/lock/rpm /var/lib/rpm|) {
    File::Path::mkpath("$self->{config}{sw_root_path}$_");
  }
  # Make empty files
  foreach ('/etc/'.$self->SW_PART, '/var/lock/rpm/transaction') {
    $self->write_file("$self->{config}{sw_root_path}$_");
  }

  $self->replicate_passwd_and_friends($self->{config}{sw_root_path});
}

=item B<install_base_rpms_natively>

Install the 'base' RPMs natively using --root.

=cut

sub install_base_rpms_natively {
  my ($self) = @_;

  $self->ppack->next_step(title => $self->SW_NAME.' installation step 1');

  $self->run_command('rpm', '--root', $self->{config}{sw_root_path},
		     '--initdb');
  if ($self->{exit}) {
    $self->croak("Failure initializing RPM database");
  }

  # Install the base RPMs natively
  $self->log("Step 1/2: Installing base RPMs...");
  $self->install_rpm_list(list => 'base', translated => 0, base_only => 1);
  $self->log;
}

=item B<install_rpm_list>

Install an RPM list. Takes the following options:

  list (compulsory): the name of the list (eg. 'base')
  translated:        if true, runs slightly different commands in order to
                     install the RPM list translated
  installed:         a hashref of RPMs currently installed that can be
                     used as an accumulator
  base_only:         Count only base RPMs when calculating percentage? Boolean.

Returns without doing anything if the file doesn't exist.

=cut

sub install_rpm_list {
  my ($self, %o) = @_;

  my $filename;

  my $rpmlist_root_dir = $self->get_rpm_list_root_dir;
  my $rpmlist_dir = $self->get_rpm_list_dir;

  #Check for OS specific lists. These override OS neutral lists.
  if( -f "$rpmlist_dir/$o{list}")
  {
    $filename = "$rpmlist_dir/$o{list}";
  }
  # Check for OS neutral  RPM lists.
  elsif( -f "$rpmlist_root_dir/$o{list}" )
  {
    $filename = "$rpmlist_root_dir/$o{list}";
  }

  if( not ( defined $filename and -f $filename ) ) {
    # _MIN installs don't have an 'apps' list.
    $self->log("Package list '[_1]' not found.", $o{list}) unless($o{list} eq "apps");
    return;
  }

  my @rpm_lines = $self->slurp($filename);

  # Restore from reference or create fresh
  my $installed = ref($o{installed}) ? $o{installed} : {};

  #
  # How many RPMs are we installing? It depends on whether we're
  # installing all RPMs, or just the base ones.
  #
  my $num_rpms_required;
  if ($o{base_only}) {
    $num_rpms_required = $self->{config}{total_base_rpms_required};
  }
  else {
    $num_rpms_required = $self->{config}{total_rpms_required};
  }

  if (@rpm_lines > 1 and $o{list} eq 'base') {
    $self->percent(0, $num_rpms_required,
		   ppack => $self->ppack, ppack_msg => 'Installing RPMs');
  }

  $self->{rpm_start_time} ||= time();
  foreach my $rpm_line (@rpm_lines) {
    my @rpms = split /\s+/, $rpm_line;
    next unless @rpms;
    # Substitute regexes for their real names
    @rpms = map {
      m|^/(.*)/$| ? $self->{config}{real_names_for_regexes}{$1} : $_;
    } @rpms;
    # Add path info
    # Bear in mind that rpm commands may be in this list.
    @rpms = map {
      /\.rpm$/ ? "$self->{config}{sw_rpm_dir}/$_" : $_
    } @rpms;

    # Install or upgrade/install
    my @flags = ("-v");
    if($o{upgrade}) {
      push @flags, "-U";
    }
    else {
      push @flags, "-i";
    }

    # This bit is different native/translated
    if (not $o{translated}) {
      my @command = ('rpm', '--root', $self->{config}{sw_root_path},
		     '--ignorearch', '--replacepkgs', '--noscripts',
		     '--nosignature', '--nodigest', @flags, @rpms, '2>&1');
      $self->log_only_to_file($self->run_command(@command));
      if ($self->{exit}) {
	$self->croak("Failure installing [_1]", "@rpms"); # quotes necessary
      }
    }
    else {
      my @cmd = ('/bin/rpm', '--nosignature', '--nodigest',
        '--replacefiles', '--replacepkgs', @flags, @rpms);
      push @cmd, '2>&1';

      # RPMs beginning 'filesystem-' need the /proc moving out of the way
      if ($rpm_line =~ /^filesystem-/) {
        rename "$self->{config}{sw_root_path}/proc",
        "$self->{config}{sw_root_path}/proc.bak";

        chdir($self->{config}{sw_root_path}) or $self->croak("Couldn't chdir");
        $self->log_only_to_file($self->run_translated(@cmd));
        
        rename "$self->{config}{sw_root_path}/proc.bak",
        "$self->{config}{sw_root_path}/proc";
      }
      else {
        chdir($self->{config}{sw_root_path}) or $self->croak("Couldn't chdir");
        $self->log_only_to_file($self->run_translated(@cmd));
      }

      if ($o{translated}) {
        $self->check_login_defs($rpm_line);
      }
    }

    my @real_rpms = grep { /\.rpm$/ } @rpms;
    @$installed{@real_rpms} = ();
    my $rpm_name = File::Basename::basename($real_rpms[0]);
    if (@rpm_lines > 1) {
      $self->percent(scalar keys %$installed,  $num_rpms_required,
		     ppack => $self->ppack, ppack_msg => $rpm_name);
    }
  }
}

=item B<prepare_sw_for_translated_install>

Escape some stuff. Make some files. Start QT.

Note: This method is also called after unpacking the subject world
from an archive, but the translated install never occurs. Please make
sure that nothing in this method *expects* the translated install to
occur.

Will report progress to the PowerPack unless you specify ppack => 0.

=cut

sub prepare_sw_for_translated_install {
  my ($self, %args) = @_;
  defined $args{ppack} or $args{ppack} = 1;

  # Change min uid/gid in /etc/login.defs before installing anything translated
  $self->modify_login_defs;

  # The /var/lib/rpm/ can cause problems. Throw its contents away.
  unless ($self->{config}{install_sw_from_archive}) {
    File::Path::rmtree("$self->{config}{sw_root_path}/var/lib/rpm");
    File::Path::mkpath("$self->{config}{sw_root_path}/var/lib/rpm");
  }

  #File::Path::rmtree("$self->{config}{sw_root_path}/proc");

  # Escape some things necessary for the next stage.
  $self->ppack->progress(percent => 5, title => "Escaping paths")
    if $args{ppack};
  $self->escape(qw{/dev /sys /selinux /mnt /media /var/yp/binding});

  $self->ppack->progress(percent => 10, title => "Creating system files")
    if $args{ppack};

  # Copy the /etc/hosts file from the native system
  $self->copy_preserve("/etc/hosts", "$self->{config}{sw_root_path}/etc/hosts");

  # Copy the /etc/resolv.conf file from the native system
  $self->copy_preserve("/etc/resolv.conf", "$self->{config}{sw_root_path}/etc/resolv.conf");

  # Create stub mtab file
  $self->write_file("$self->{config}{sw_root_path}/etc/mtab");

  # Create hostid file with the makeHostid program
  if (not -x $self->MAKEHOSTID) {
    chmod 0755, $self->MAKEHOSTID;
  }
  $self->run_command($self->MAKEHOSTID,
		     "$self->{config}{sw_root_path}/etc/hostid");
  if ($self->{exit}) {
    $self->croak("[_1] failed", $self->MAKEHOSTID);
  }

  # Symlink the RPM directory into the SW
  $self->escape($self->{config}{sw_rpm_dir});

  # Start QT up ready for the translated stage
  $self->start_qt;
}

=item B<install_rpms_translated>

Install all RPMs from the 'base' and 'apps' lists now under translation.

=cut

sub install_rpms_translated {
  my ($self) = @_;

  $self->ppack->next_step(title => $self->SW_NAME.' installation step 2');

  # Reinitialize the database
  $self->run_translated('/bin/rpm', '--initdb');
  if ($self->{exit}) {
    $self->croak("Failure initializing RPM database");
  }
  $self->log("Step 2/2: Installing [_1]...", $self->SW_NAME);
  my $installed = {};
  delete $self->{rpm_start_time}; # as don't want to inherit nontranslated timings
  
  # Reinstall the base rpms
  $self->install_rpm_list(list => "base", translated => 1, installed => $installed);

  # Do any OS-specific mid-install configuration
  $self->configure_sw_post_base_rpms();
  
  # Install the remaining rpms
  $self->install_rpm_list(list => "apps", translated => 1, installed => $installed);

  $self->log;
}

=item B<ensure_sw_rpm_dir_exists>

Create and escape the sw_rpm_dir if it'f not already present.

=cut

sub ensure_sw_rpm_dir_exists
{
  my ($self) = @_;

  # Create the directory unless it already exists
  unless(-d $self->{config}{sw_rpm_dir}) {
    File::Path::mkpath($self->{config}{sw_rpm_dir})
  }

  # Symlink the RPM directory into the SW
  $self->escape($self->{config}{sw_rpm_dir});
}

=item B<install_special_rpms_natively>

Install special subject RPMs into the subject world. Currently lx86 tools
which provides a memcpy preload for performance and a binary to run native power
code from within the subject world.

=cut

sub install_special_rpms {
  my ($self) = @_;

  $self->log("Installing Lx86 Tools RPM...");
  
  # Copy RPMs from /extras/ into the location we expect subject RPMS
  my $subject_rpm_glob = $self->{config}{qt_root_path}."/extras/*.rpm";
  my @special_rpms = glob($subject_rpm_glob);
  $self->{config}{total_rpms_required} += scalar @special_rpms;

  # Create the directory that pokes the RPMs into the subject world
  $self->prepare_sw_media_directory or return 0;

  $self->ensure_sw_rpm_dir_exists;

  # Start QT up ready for the translated stage
  $self->start_qt;

  # Copy the RPMs to somewhere the translated world can get to them
  foreach(@special_rpms)
  {
    File::Copy::copy($_, $self->{config}{sw_rpm_dir})
      or $self->croak("Cannot copy [_1] to [_2]", $_,
      $self->{config}{sw_rpm_dir});
  }

  # Install the remaining rpms
  $self->install_rpm_list(list => "special", translated => 1, upgrade => 1);

  $self->log;
}

=item B<unpack_subject_world>

Unpack a subject world from a the tarball specified in
$self->{config}{sw_tarball_location}.

=cut

sub unpack_subject_world {
  my ($self) = @_;

  my $tarball = $self->{config}{sw_tarball_location};
  my $root = $self->{config}{sw_root_path};

  $self->ppack->next_step(title => 'Unpacking '.$self->SW_NAME);
  $self->ppack->progress(percent => 0, title => 'Extracting data. This may take several minutes');
  $self->log("Extracting [_1] file from [_2].\nThis may take several minutes to complete. Please wait...", $self->SW_NAME, $tarball);
  $self->install_archive_file($tarball, $root);

  $self->log("Done.");
}

=item B<verify_sw_installation>

Get the number of installed RPMs. Croak if it is not the same as the
the number of RPMs we were expecting to install.

=cut

sub verify_sw_installation {
  my ($self) = @_;
  $self->ppack->next_step(title => 'Verifying '.$self->SW_NAME.' installation');
  $self->ppack->progress(percent => 0, title => 'Querying RPM database');
  my $actually_installed = $self->run_translated('/bin/rpm', '-qa');
  $self->ppack->progress(percent => 75, title => 'Verifying');
  my @n_installed = split "\n", $actually_installed;
  if (@n_installed < $self->{config}{total_rpms_required}) {
    $self->log_only_to_file("Missing RPMs:\n".$self->get_missing_rpms(\@n_installed));
    $self->croak("Failed to install all required rpms");
  }
}

=item B<get_missing_rpms>

Given a reference to an array of installed RPM names, find the RPMs
that should have been installed but weren't, and return them as a string.

=cut

sub get_missing_rpms {
  my ($self, $installed) = @_;
  my %expected = %{$self->get_rpm_list_as_hashref('base apps')};

  # Check each of the expected ones and make sure we installed one like it
  my @missing;
  foreach my $rpm (keys %expected) {
    $rpm =~ s/\\?\.\w+\\?\.rpm//; # remove the bit that rpm -q doesn't return
    my $regex = "^\Q$rpm";

    # Unless it's a regex-rpm
    if ($rpm =~ m|^/(.*)/$|) {
      $regex = $1;
    }

    push @missing, $rpm unless grep /$regex/, @$installed;
  }

  return join("\n", @missing)."\n";
}

=item B<setup_sw>

Set up various escape paths.

Bind /home.

Create mtab and fstab

=cut

sub setup_sw {
  my ($self) = @_;
  if (not $self->{config}{sw_root_path}) {
    $self->croak("sw_root_path is not set!");
  }
  $self->escape(qw{/dev /sys /selinux /mnt /media /net /misc 
		   /var/run/.nscd_socket /etc/localtime});

  # Escape logfile path and home directories
  $self->escape($self->{config}{logfile_path});
  if ($self->{config}{sw_homedir} and $self->{config}{sw_homedir} ne 'skip') {
    $self->escape($self->{config}{sw_homedir}, escape_anyway => 1);
  }

  # Copy the /etc/hosts file from the native system
  $self->copy_preserve("/etc/hosts", "$self->{config}{sw_root_path}/etc/hosts");

  # Copy the /etc/resolv.conf file from the native system
  $self->copy_preserve("/etc/resolv.conf", "$self->{config}{sw_root_path}/etc/resolv.conf");

  # Create stub utmp file
  $self->write_file("$self->{config}{sw_root_path}/var/run/utmp");

  # Create stub wtmp file
  $self->write_file("$self->{config}{sw_root_path}/var/log/wtmp");

  # Generate fstab
  $self->ppack->progress(percent => 15, title => 'Generating /etc/fstab');
  my @fstab = $self->slurp('/etc/fstab');
  my @sw_fstab;
  foreach (@fstab) {
    my @f = split;
    next unless @f >= 3;
    if ($f[1] eq '/' or $f[2] =~ /^(proc|sysfs|swap|devpts|tmpfs)$/) {
      push @sw_fstab, $_;
    }
  }
  $self->write_file("$self->{config}{sw_root_path}/etc/fstab", \@sw_fstab);
}

=item B<setup_sw_interactive>

Those parts of setup_sw that require user input.

This function is empty now.

=cut

sub setup_sw_interactive {
  my ($self) = @_;
}

=item B<finalize_sw_installation>

Remove any existing .rpmorig or .rpmnew files from the SW.

Update the flag to say SW is successfully installed.

=cut

sub finalize_sw_installation {
  my ($self) = @_;
  $self->log("Finalizing [_1] installation. Please wait...", $self->SW_NAME);

  $self->ppack->progress(percent => 25, title => "Removing installation files");

  # Ensure that any files named *.rpmorig or *.rpmnew are removed after the
  # install
  my $find = sub {
    if (/\.rpm(new|orig)$/) {
      unlink($File::Find::name) or
	$self->croak("Cannot perform post install remove of [_1]",
		     $File::Find::name);
    }
  };
  File::Find::find($find, $self->{config}{sw_root_path});

  # Finally move the flag to indicate the Subject World is installed
  # successfully.
  rename "$self->{config}{sw_root_path}/etc/".$self->SW_PART,
    "$self->{config}{sw_root_path}/etc/".$self->SW_SUCC;

  # Drop information about the SW and QT in the SW file
  $self->ppack->progress(percent => 35, title => "Registering installation information");
  my $qt_start = "$self->{config}{qt_root_path}/bin/".$self->PRODUCT_NAME;
  my $version_info = "$self->{config}{sw_distro}\n".
    $self->run_command($qt_start, '-b', '2>&1');
  $self->write_file("$self->{config}{sw_root_path}/etc/".$self->SW_SUCC,
		    $version_info);

  # Generate mtab
  # NOTE: this needs to go here, after we stamp the x86 World with
  #       the .sw_installed_successfully file, since the *-world-sync
  #       will exit quietly if it's not there.
  $self->ppack->progress(percent => 50, title => "Generating /etc/mtab");
  my $world_sync = "/usr/sbin/".$self->PRODUCT_NAME."-world-sync";
  $self->run_command($world_sync, "force_sync_mtab");
  if ($self->{exit}) {
    $self->croak("[_1] failed", $world_sync);
  }
}

=item B<remove_rpm_staging_directory>

Remove the RPM staging directory.

=cut

sub remove_rpm_staging_directory {
  my ($self) = @_;
  if (-d $self->{config}{sw_rpm_dir}) {
    $self->log("Removing [_1]...", $self->{config}{sw_rpm_dir});
    File::Path::rmtree($self->{config}{sw_rpm_dir});
    unlink "$self->{config}{sw_root_path}$self->{config}{sw_rpm_dir}";
  }
}

=item B<bind_qt_and_sw>

If the QT or SW has changed, we need to recreate the runx86 script.

=cut

sub bind_qt_and_sw {
  my ($self) = @_;

  $self->ppack->next_step(title => "Binding ".$self->PRODUCT_NAME." and ".$self->SW_NAME." together");

  $self->log;
  $self->log("[_1] and [_2] are now installed.",
	     $self->PRODUCT_NAME, $self->SW_NAME);
  $self->log;
  $self->log("Binding them together and creating [_1] script.", $self->RUNX86);

  $self->ppack->progress(percent => 10, title => "Generating runx86 script");

  # Useful paths
  my $qt_start = "$self->{config}{qt_root_path}/bin/".$self->PRODUCT_NAME;
  my $config_file = "$self->{config}{config_dir}/".$self->CONFIG_FILE;
  my $runx86_template = $self->ROOT."/resources/bin/RO/".$self->RUNX86.".template";
  my $runx86_path = "$self->{config}{qt_root_path}/installer/resources/bin/RO/".$self->RUNX86;
  my $runx86_symlink = $self->BIN_DIR.'/'.$self->RUNX86;
 
  # Take $runx86_template, set the constants, and write to $runx86_path
  my %runx86_template_data =
  ( 
    RUNX86                 => $self->RUNX86,
    LINKX86                => $self->LINKX86, 
    PRODUCT_NAME           => $self->PRODUCT_NAME,
    PRODUCT_NAME_FRIENDLY  => $self->PRODUCT_NAME_FRIENDLY,
    SW_NAME                => $self->SW_NAME,
    TRANSLATOR             => $qt_start,
    CONFIG_FULLPATH        => $config_file,
    SW_ROOT_PATH           => $self->{config}{sw_root_path},
    SELINUX_PREFIX         => $self->SELINUX_PREFIX,
  );
  my @runx86_script = $self->slurp($runx86_template);
  foreach (@runx86_script) {
    if (/^\s*use\s+constant\s+(\w+)\s*=>\s*'((?:\\'|[^'])+)'\s*;\s*$/) {
      my $constant = $1;
      my $old_value = $2;
      if (defined $runx86_template_data{$constant}) {
        my $value = $runx86_template_data{$constant};
        # Escape any backslashes and single quotes in the value, just in case.
        $value =~ s/([\\'])/\\$1/g;
        s/'(?:\\'|[^'])+'/'$value'/ if ($value ne $old_value);
      }
    }
  }
  $self->write_file($runx86_path, \@runx86_script, ':unix');

  # Link script to the bin
  chmod 0755, $runx86_path or
    $self->croak("Cannot chmod [_1]: [_2]", $runx86_path, $!);

  # Create the BIN_DIR if it doesn't already exist
  if (not -d $self->BIN_DIR) {
    File::Path::mkpath($self->BIN_DIR);
  }

  if (-l $runx86_symlink or -e $runx86_symlink) {
    unlink $runx86_symlink or
      $self->croak("Failed to remove [_1]", $runx86_symlink);
  }
  symlink($runx86_path, $runx86_symlink) or
    $self->croak("Failed to create symlink [_1]", $runx86_symlink);

  # Need to restart qt so it can init x86 services using runx86
  $self->ppack->progress(percent => 30, title => "Bringing up x86 services (this may take several minutes)");
  $self->restart_qt;

  # Tell the user we were successful
  $self->log;
  $self->log("To start a translated [_1] shell, run [_2]",
	     $self->SW_NAME, $self->BIN_DIR.'/'.$self->RUNX86);
  $self->log;

  # Return true
  return 1;
}

=item B<populate_sw_rpm_dir>

Create the RPM directory according to $self->{config}.
This is a temporary directory (defaults to /tmp/rpms)
in which we copy all RPMs before installation.

The RPMs are retrieved either from ISOs, or from CD/DVDs,
or from directories containing .rpm files.

Returns two values (as an array)
 1) The number of RPM files currently stored
 2) The number of RPM files that we require

So we're ready to go if (1) == (2)

If given an argument, it is taken to be an array of media. If run in
non-interactive mode, the user will never be presented with the
question asking for more.

=cut

sub populate_sw_rpm_dir {
  my ($self, $array_of_files) = @_;

  #
  # See how many RPMs we have so far.
  #
  $self->analyze_sw_rpm_dir;

  # Only check disk space if we're going to enter the loop below at
  # least once
  if ($self->{config}{rpms_found} < $self->{config}{total_rpms_required}) {
    $self->check_disk_space_in_sw_rpm_dir or return 0;
  }

  while ($self->{config}{rpms_found} < $self->{config}{total_rpms_required}) {

    #
    # If the user enters no directory, or there's an error, then stop
    # looping for directory names.
    #
    my @files;
    if ($array_of_files) {
      push @files, @$array_of_files;
    }
    if ($self->{interactive_mode}) {
      my $one_or_more_files = $self->get_installation_media_config_interactively;
      last if ! $one_or_more_files or $one_or_more_files eq 'skip';

      #
      # IF the entered directory is 'list', then list the RPMs still required
      #
      if (lc $one_or_more_files eq 'list') {
	my @rpms = keys %{$self->{config}{rpms_still_to_get}};
	$self->log;
	$self->log("The following [_1] RPMs are still required:", scalar(@rpms));
	$self->log(" - [_1]", $_) for sort @rpms;
	next;
      }
      push @files, glob($one_or_more_files);
    }

    $self->{config}{rpm_files} = [];
    $self->{config}{iso_files} = [];
    foreach my $file_or_dir (@files) {
      if (-f $file_or_dir) {
	if ($file_or_dir =~ /\.rpm$/) {
	  push @{$self->{config}{rpm_files}}, $file_or_dir;
	}
	elsif ($file_or_dir =~ /\.iso$/) {
	  push @{$self->{config}{iso_files}}, $file_or_dir;
	}
	else {
	  $self->log("The file [_1] is not a .iso or .rpm", $file_or_dir);
	}
      }
      elsif (-d $file_or_dir) {
	$self->log("Examining directory. Please wait...");
	$self->search_dir_for_rpms_and_isos($file_or_dir);
      }
      else {
	$self->log("Cannot find '[_1]'", [$file_or_dir, 'user']);
      }
    }

    #
    # Copy the RPM files we have
    #
    $self->copy_rpm_files_to_sw_rpm_dir;

    #
    # Find the RPMs in .iso files
    #
    foreach my $iso (@{$self->{config}{iso_files}}) {
      if (not -d $self->ISO_MOUNTPOINT) {
	File::Path::mkpath($self->ISO_MOUNTPOINT);
      }

      # What if it's already mounted because of a previous try?
      if ($self->directory_has_mounted_filesystems($self->ISO_MOUNTPOINT,
						   include_self => 1)) {
	$self->umount($self->ISO_MOUNTPOINT);
      }

      my $success = $self->mount_iso($iso, $self->ISO_MOUNTPOINT);
      last if not defined $success; # undef means we can't mount at all
      next if not $success; # 0 means we can't mount this iso
      $self->log("Examining ISO file [_1]", [$iso, 'user']);
      $self->search_dir_for_rpms_and_isos($self->ISO_MOUNTPOINT,
					  no_isos => 1);
      my $num_rpms_found = @{$self->{config}{rpm_files}};
      $self->copy_rpm_files_to_sw_rpm_dir;
      $self->umount($self->ISO_MOUNTPOINT);

      #
      # Don't waste time searching more ISOs unless we're done
      #
      $self->analyze_sw_rpm_dir;
      last if $self->{config}{rpms_found} == $self->{config}{total_rpms_required};
    }
    $self->{config}{iso_files} = [] ; # so we don't re-search

    $self->analyze_sw_rpm_dir;
    $self->log("Got [_1]/[_2] RPMs", $self->{config}{rpms_found},
	       $self->{config}{total_rpms_required});
    $self->log;

    # Only loop asking for more stuff if we're in interactive mode.
    last unless $self->{interactive_mode};
  }

  return ($self->{config}{rpms_found} ==
	  $self->{config}{total_rpms_required} ? 1 : 0);
}

=item B<get_installation_media_config_interactively>

Asks the user for a directory containing the RPMs.

Sets $self->{config}{sw_rpm_source_dir}

=cut

sub get_installation_media_config_interactively {
  my ($self) = @_;
  $self->log(<<END, $SUBJ_WORLDS{$self->{config}{sw_distro}}{title});
Please enter the directory or files containing [_1].
 - ISO9660 images are accepted (if they end with .iso)
 - RPM files are accepted (if they end with .rpm)
 - If you have a CD/DVD-ROM, please mount it and enter the mount path

You can enter each file or mount path individually or provide a pattern to
select multiple files at once, e.g. /files/rhel/RHEL4-U4-i386-AS-disc*.iso.

To view a list of missing RPM files, type 'list'
To return to the main menu, type 'skip'

END

  return $self->ask('q'  => 'Enter directory or file:',
		    type => 'path', list => 1, skip => 1);
}

=item B<get_rpm_list_dir>

Get the directory containing the RPM lists for the chosen subject
world.

=cut

sub get_rpm_list_dir {
  my ($self) = @_;
  my $root = $self->get_rpm_list_root_dir;
  return $root . "/$self->{config}{sw_distro}" if($self->{config}{sw_distro});
  return $root . "/$self->{config}{sw_installed}" if($self->{config}{sw_installed});
}

=item B<get_rpm_list_root_dir>

The root RPM lists directory. This contains the per-OS directories
and also any architecture neutral lists.

=cut

sub get_rpm_list_root_dir {
  my ($self) = @_;
  return $self->ROOT. "/resources/sw_lists/$self->{product}";
}

=item B<get_rpm_md5sum_file>

Get the file containing MD5 checksums of each RPM.

=cut

sub get_rpm_md5sum_file {
  my ($self) = @_;
  return $self->ROOT.
    "/resources/sw_lists/$self->{product}/$self->{config}{sw_distro}.md5sum";
}

=item B<get_rpm_list_as_hashref>

Get a list of all the RPMs we need to copy across for the selected
SW. Return it as a hashref with the RPMs as keys for easy
lookup/removal.

Supply a filename or glob as the second parameter.

=cut

sub get_rpm_list_as_hashref {
  my ($self, $filename) = @_;
  my $rpmlist_dir = $self->get_rpm_list_dir;
  if (not -d $rpmlist_dir) {
    $self->croak("Cannot find RPM list directory [_1]", $rpmlist_dir);
  }
  my %rpms_hash;
  # Move into the rpm lists directory so the glob can be more flexible
  my $cwd = Cwd::cwd;
  chdir $rpmlist_dir or $self->croak("Couldn't chdir");

  foreach my $file (glob($filename)) {
    next unless -f $file; # skip directories (eg. CVS/)
    my @rpms = split /\s+/, $self->slurp($file);

    # There will be some extra info in this file that won't correspond to
    # an rpm file, so filter it out now.
    @rpms = grep !/^--/, @rpms;

    # slice the hash with @rpms creating all the keys with undefs as the values
    @rpms_hash{@rpms} = ();
  }
  if (not %rpms_hash) {
    $self->croak("Cannot find any RPM lists in [_1]", $rpmlist_dir);
  }

  # Remember to go back to the previous dir.
  chdir $cwd or $self->croak("Couldn't chdir");

  return \%rpms_hash;
}

=item B<search_dir_for_rpms_and_isos>

Do a recursive find on the provided directory for any .rpm
files and .iso files.

Optional arguments (provided as hash):
 - no_isos - don't search for ISOs. Used when we're searching
   inside an ISO, as we don't have the ability to recursively
   mount ISOs.

=cut

sub search_dir_for_rpms_and_isos {
  my ($self, $dir, %args) = @_;
  # Follow a symlink if it's the very top level specified. Don't
  # follow symlinks below this (using find's 'follow' option) as it
  # can be dangerous.
  if (-l $dir) {
    return $self->search_dir_for_rpms_and_isos(readlink $dir, %args);
  }
  my $find_sub = sub {
    $File::Find::prune = 1 if (-d and (not -x or not opendir(my $d, $_)));
    return unless -f and -r;
    if (/\.rpm$/) {
      my $basename = File::Basename::basename($File::Find::name);
      if (exists $self->{config}{rpms_still_to_get}{$basename}
	 or $self->check_regex_rpms_for_file($basename)) {
	push @{$self->{config}{rpm_files}}, $File::Find::name;
      }
    }
    elsif (/\.iso$/ and not $args{no_isos}) {
      push @{$self->{config}{iso_files}}, $File::Find::name;
    }
  };
  File::Find::find({wanted => $find_sub, no_chdir => 1}, $dir);
}

=item B<check_regex_rpms_for_file>

Check the regex_rpms list to see if the given file basename matches
one of the regexes. If it does, the following happens:

  1. The key in rpms_still_to_get matching the regex is changed to the
  real filename.

  2. The real filename is added to the real_names_for_regexes hash
  with the regex as the key.

  3. The regex is removed from the regex_rpms list.

  4. True is returned.

Otherwise, false is returned.

=cut

sub check_regex_rpms_for_file {
  my ($self, $file) = @_;
  foreach my $regex (@{$self->{config}{regex_rpms}}) {
    if (exists $self->{config}{rpms_still_to_get}{"/$regex/"}
	and $file =~ /^$regex$/) {
      # Replace with its real name
      delete $self->{config}{rpms_still_to_get}{"/$regex/"};
      $self->{config}{rpms_still_to_get}{$file} = undef;
      # Record the name to use when we encounter the regex again
      $self->{config}{real_names_for_regexes}{$regex} = $file;
      # Remove it from the list
      @{$self->{config}{regex_rpms}} =
	grep {$_ ne $regex} @{$self->{config}{regex_rpms}};
      return 1;
    }
  }
  return 0;
}

=item B<analyze_sw_rpm_dir>

Looks in $self->{config}{sw_rpm_dir} to see all the RPMs we have.
Creates a list of those missing, and puts it in
$self->{config}{rpms_still_to_get}.

Sets: $self->{config}{rpms_still_to_get} (array or strings)
      $self->{config}{rpms_found}        (integer, count)

=cut

sub analyze_sw_rpm_dir {
  my ($self) = @_;

  opendir DIR, $self->{config}{sw_rpm_dir}
    or $self->croak('Cannot find the directory [_1]',
		    $self->{config}{sw_rpm_dir});
  foreach (readdir DIR) {
    my $file_and_dir = "$self->{config}{sw_rpm_dir}/$_";
    next unless -f $file_and_dir;
    if (exists $self->{config}{rpms_still_to_get}{$_}
	or $self->check_regex_rpms_for_file($_)) {
      delete $self->{config}{rpms_still_to_get}{$_};
      $self->{config}{rpms_found}++;
    }
  }

  closedir DIR or $self->croak("Cannot close directory connection");
}

=item B<copy_rpm_files_to_sw_rpm_dir>

Copies all files in $self->{config}{rpm_files}
into $self->{config}{sw_rpm_dir}

=cut

sub copy_rpm_files_to_sw_rpm_dir {
  my ($self) = @_;
  foreach (@{$self->{config}{rpm_files}}) {
    my $basename = File::Basename::basename $_;
    if (exists $self->{config}{rpms_still_to_get}{$basename}) {

      $self->check_rpm_md5sum($_, $basename) or do {
        $self->log("MD5 checksum of '[_1]' is incorrect - it is probably corrupt.", $basename);
	next;
      };

      File::Copy::copy($_, $self->{config}{sw_rpm_dir})
	  or $self->croak("Cannot copy [_1] to [_2]", $_,
			  $self->{config}{sw_rpm_dir});
    }
  }

  $self->{config}{rpm_files} = []; # so we don't re-copy
}

=item B<check_rpm_md5sum>

  my $ok = $self->check_rpm_md5sum($full_file_name, $basename);

Given an RPM file, returns TRUE iff either the md5sum matches
that stored in the md5sum file, or the file isn't present in the md5sum file.

=cut

sub check_rpm_md5sum {
  my ($self, $full_name, $basename) = @_;

  #
  # Read in the md5sums, unless we've done it before.
  #
  unless (exists $self->{rpm_md5sums}) {
    $self->{rpm_md5sums} = {};

    my $md5sum_file = $self->get_rpm_md5sum_file;
    if (!-f $md5sum_file) {
      $self->log_only_to_file("Cannot find '$md5sum_file'. Carrying on without it.\n");
      return 1; # if no md5sums, carry on anyway
    }

    my @contents = $self->slurp($md5sum_file);
    foreach (@contents) {
      (/^([\w\d]{32})\s+(.+?\.rpm)\s*$/)
        or $self->croak("Could not understand line in '[_1]': [_2]", $md5sum_file, $_);
      $self->{rpm_md5sums}{$2} = $1;
    }
  }

  #
  # No md5sum for this file? We assume everything's OK
  #
  my $stored_md5sum = $self->{rpm_md5sums}{$basename};
  if (not $stored_md5sum) {
    $self->log_only_to_file("No md5sum to check $basename against. Assuming it's OK.\n");
    return 1;
  }

  #
  # Work out the md5sum of this file and compare against the stored one
  #
  my $this_md5sum = $self->md5sum_of_file($full_name);

  return 1 if ($this_md5sum eq $stored_md5sum);

  $self->log_only_to_file("Checksums differ for $basename (expected '$stored_md5sum', got '$this_md5sum')\n");
  return 0;
}

=item B<check_disk_space_in_qt_root_dir>

Returns true if there is enough disk space in the qt_root_dir for the
product installation.

If not, alerts the user and returns false.

=cut

sub check_disk_space_in_qt_root_dir {
  my ($self) = @_;
  my $space = $self->check_disk_space_in($self->{config}{qt_root_path});
  if ($space < ($self->MINIMUM_SPACE_FOR_PRODUCT*1024)) {
    $self->log;
    $self->log("Disk space is too low to create [_1] in [_2].",
	       $self->PRODUCT_NAME, $self->{config}{qt_root_path});
    $self->log("Please make sure there are at least [_1] MB free before ".
	       "retrying.", $self->MINIMUM_SPACE_FOR_PRODUCT);
    return 0;
  }
  return 1;
}

=item B<check_disk_space_in_sw_rpm_dir>

Returns true if there is enough disk space in the sw_rpm_dir for the
RPMs.

If not, alerts the user and returns false.

=cut

sub check_disk_space_in_sw_rpm_dir {
  my ($self) = @_;
  my $free = $self->check_disk_space_in($self->{config}{sw_rpm_dir});
  my $required = ($SUBJ_WORLDS{$self->{config}{sw_distro}}{rpmsize} * 1.1); # add 10% for safety

  if ($free < ($required*1024)) {
    $self->log("Disk space is too low to create temporary directory [_1].",
	       $self->{config}{sw_rpm_dir});
    $self->log("Please make sure there are at least [_1] MB free before ".
	       "retrying.", $required);
    return 0;
  }

  return 1;
}

=item B<check_disk_space_in_sw_root_dir>

Returns true if there is enough disk space in the sw_root_path for the
RPMs.

If it is on the same disk as the RPM dir, then it will expect the
combined size to be free.

If not, alerts the user and returns false.

=cut

sub check_disk_space_in_sw_root_dir {
  my ($self) = @_;
  my $free = $self->check_disk_space_in($self->{config}{sw_root_path});
  my $required = ($SUBJ_WORLDS{$self->{config}{sw_distro}}{size} * 1.1); # add 10% for safety

  # Add on the rpmsize if the RPMs are to be stored on the same
  # filesystem.
  if ($self->are_files_on_same_filesystem($self->{config}{sw_rpm_dir},
					  $self->{config}{sw_root_path})) {
    $required += $SUBJ_WORLDS{$self->{config}{sw_distro}}{rpmsize};
  }

  if ($free < ($required*1024)) {
    $self->log("Disk space is too low to create [_1] in [_2].",
	       $self->SW_NAME, $self->{config}{sw_root_path});
    $self->log("Please make sure there are at least [_1] MB free before ".
	       "retrying.", $required);
    return 0;
  }

  return 1;
}



=item B<write_config_file>

Write out a config file with any options that are different to the defaults.

=cut

sub write_config_file {
  my ($self) = @_;

  # Common
  my @config = ($self->get_uncommon_config_lines,
		$self->get_config_file_lines_common);

  # Other things
  if ($self->{config}{qt_root_path} ne $self->QT_ROOT_PATH) {
    push @config,
      "LOCALISATION_FILES_DIR=$self->{config}{qt_root_path}/locale";
  }

  if (@config) {
    $self->write_file("$self->{config}{config_dir}/".$self->CONFIG_FILE,
		      \@config, ':unix');
  }
  elsif (-f "$self->{config}{config_dir}/".$self->CONFIG_FILE) {
    unlink "$self->{config}{config_dir}/".$self->CONFIG_FILE or
      $self->croak("Cannot remove [_1]: [_2]",
		   "$self->{config}{config_dir}/".$self->CONFIG_FILE, $!);
  }
}

=item B<get_upgrade_config_interactively>

Check if we already have QT installed and then ask the user which
version to upgrade to.

=cut

sub get_upgrade_config_interactively {
  my ($self) = @_;

  my $action = $self->prompt_user_for_upgrade;
  return 0 if $action eq 'return';

  # QT upgrade
  if ($action eq 'qt') {
    $self->{config}{upgrade_qt} = 1;

    # Check QT is already installed
    if (not $self->{config}{rpm_installed}) {
      $self->log("Cannot upgrade [_1] because it is not installed.",
 		 $self->PRODUCT_NAME);
      return 0;
    }

    # Check we have enough disk space - Note that this will actually
    # only measure spare disk space and not subtract the size of the
    # currently-installed product (if it's installed in the same
    # place). It's not brilliant, but we're talking about such small
    # sizes.
    $self->check_disk_space_in_qt_root_dir or return 0;

    # Ask the user which version should be installed
    $self->log("The currently installed version is: [_1]",
               $self->{config}{rpm_installed});
    $self->{config}{chosen_rpm_file} = $self->version_menu;
    return 0 if $self->{config}{chosen_rpm_file} eq 'return';
  }

  return 1;
}

=item B<prompt_user_for_upgrade>

Submenu for 'upgrade'.

=cut

sub prompt_user_for_upgrade {
  my ($self) = @_;
  my $options = [
		 [qt     => ["Upgrade a [_1] installation.",
			     $self->PRODUCT_NAME]],
		 [return => "Go back to the Main Menu."],
		 [quit   => "Quit."],
		];
  my $action = $self->menu($options);
  $self->quit if $action eq 'quit';
  return $action;
}

=item B<upgrade>

Install the new version of QT if appropriate.

=cut

sub upgrade {
  my ($self) = @_;

  $self->stop_qt;

  # Forcefully remove the rpm if it has the wrong name
  if ($self->{config}{old_product_installed}) {
    $self->uninstall_rpm($self->{config}{old_product_installed}) or
      $self->croak("RPM upgrade failed.");

    # If the RPM was installed into a dir containing the old product
    # name, offer the user a chance to change that directory component
    # to the new product name.
    foreach my $tuple ({var => 'qt_root_path',
			human => 'the install path',
			move => 0},
		       {var => 'logfile_path',
			human => 'the log file path',
			move => 1}) {
      if ($self->{config}{$tuple->{var}} =~
	  /\b$self->{config}{old_product_installed}\b/) {
	my $potential_new_path = $self->{config}{$tuple->{var}};
	$potential_new_path =~
	  s/\b$self->{config}{old_product_installed}\b/$self->PRODUCT_NAME/e;
	if ($self->ask(q =>
		       ["Would you like to update [_1] from [_2] to [_3]?",
			$tuple->{human},
			[$self->{config}{$tuple->{var}}, 'user'],
			[$potential_new_path, 'user']],
		       type => 'bool', default => 0)) {
	  if ($tuple->{move}) {
	    # Create all the parents
	    File::Path::mkpath($potential_new_path);
	    # If the directory is non-existent or empty then we can
	    # move it, otherwise, leave it alone and alert the user.
	    if (rmdir $potential_new_path) {
	      rename $self->{config}{$tuple->{var}}, $potential_new_path;
	      $self->{config}{$tuple->{var}} = $potential_new_path;
	    }
	    else {
	      $self->log("Directory [_1] already exists and is not empty. Leaving [_2] as [_3].",
			 [$potential_new_path, 'user'], $tuple->{human},
			 [$self->{config}{$tuple->{var}}, 'user']);
	    }
	  }
	  else {
	    # In this case, we can just update the variable, since we
	    # are not actually moving the directory ourselves.
	    $self->{config}{$tuple->{var}} = $potential_new_path;
	  }
	}
      }
    }

    # In case the old product had a different var name or the user has
    # updated the qt_root_path
    delete $self->{config}{old_product_installed};
    $self->write_config_file;
  }

  # Move the config dir to the right location
  $self->fix_config_dir;

  # RPM
  $self->install_rpm($self->RPM_DIR."/$self->{config}{chosen_rpm_file}",
		     upgrade => 1,
		     prefix  => $self->{config}{qt_root_path}) or
    $self->croak("RPM upgrade failed.");

  # Reinstall the installer
  my $installer_path = "$self->{config}{qt_root_path}/installer";
  if (-d $installer_path) {
    File::Path::rmtree($installer_path);
  }
  $self->install_self_into($installer_path);

  # Re-symlink the doc/ directory in case it's moved
  my $doc_path = "$self->{config}{qt_root_path}/doc";
  if (-l $doc_path) {
    unlink $doc_path;
  }
  symlink "$installer_path/resources/doc/RO", $doc_path;

  $self->start_qt;
  $self->log;
  $self->log("Upgrade successful.");
  $self->log;

  $self->check_environment;

  if ($self->{config}{rpm_installed} and $self->{config}{sw_installed}) {
    $self->bind_qt_and_sw or return 0;
    $self->install_special_rpms;
    $self->remove_rpm_staging_directory;
  }

  # Success! Add to transactions
  $self->add_transaction("Upgraded [_1]", $self->PRODUCT_NAME);
}

=item B<get_uninstall_config_interactively>

Ask the user what they want to uninstall and make sure it's safe to do
so.

=cut

sub get_uninstall_config_interactively {
  my ($self) = @_;
  my $action = $self->prompt_user_for_uninstall;
  return 0 if $action eq 'return';

  # Remember what the user wants to uninstall
  $self->{config}{uninstall_qt} = ($action =~ /qt/);
  $self->{config}{uninstall_sw} = ($action =~ /sw/);

  # Check things about QT
  if ($self->{config}{uninstall_qt}) {
    if (not $self->{config}{rpm_installed}) {
      $self->log("Cannot uninstall [_1] because it is not installed.",
		$self->PRODUCT_NAME);
      return 0;
    }
    # Check if processes are running and kill all
    unless ($self->check_qt_is_not_running) {
      $self->log("You cannot uninstall while there are still translated processes running.\nKill these processes to continue.");
      $self->ask(q => ["Do you want to kill these processes now?", $self->SW_NAME], 
		      type => 'bool', default => 0) or return 0;
     $self->stop_qt;
    }

    # Get confirmation
    $self->ask(q => ["Are you sure you want to uninstall [_1]?",
		     $self->PRODUCT_NAME],
	       type => 'bool', default => 0) or return 0;

    # Delete the logfile?
    if ( $self->ask(q => ["Remove log file directory ([_1])?",
		     [$self->{config}{logfile_path}, 'user']], type => 'bool', default => 0) ) {
		  $self->{config}{remove_logfile} = 1 ;
		}
	       	       
  }

  # Check things about SW
  if ($self->{config}{uninstall_sw}) {
    if (not -d $self->{config}{sw_root_path}) {
      $self->log("Cannot uninstall [_1] because it is not installed.", $self->SW_NAME);
      return 0;
    }
    # Check if processes are running and kill all
    unless ($self->check_qt_is_not_running) {
      $self->log("You cannot uninstall while there are still translated processes running.\nKill these processes to continue.");
      $self->ask(q => ["Do you want to kill these processes now?", $self->SW_NAME], 
		      type => 'bool', default => 0) or return 0;
     $self->stop_qt;
    }

    if ($self->{config}{sw_installed}) {
      $self->ask(q => ["Delete [_1] (installed at [_2]) from the filesystem?\nYou will lose all custom config and installed applications.",
		       $self->SW_NAME, [$self->{config}{sw_root_path}, 'user']],
		 type => 'bool', default => 0) or return 0;
    }
    elsif (-f "$self->{config}{sw_root_path}/etc/".$self->SW_PART) {
      $self->ask(q => ["Delete partially installed [_1] at [_2] from the filesystem?",
		       $self->SW_NAME, [$self->{config}{sw_root_path}, 'user']],
		 type => 'bool', default => 0) or return 0;
    }
    else {
	    $self->ask(q => ["Directory [_1] exists but doesn't look like an installation of [_2]. Delete it anyway?",
			    [$self->{config}{sw_root_path}, 'user'], $self->SW_NAME],
		      type => 'bool', default => 0) or return 0;
    }
    my $mounted = $self->directory_has_mounted_filesystems
      ($self->{config}{sw_root_path});
    if ($mounted) {
      $self->log("The directory [_1] contains mounted filesystems ([_2]). Please unmount them before retrying this operation.", [$self->{config}{sw_root_path}, 'user'], $mounted);
      return 0;
    }
  }

  # Will either component be left at the end of this installation?
  # If not, ask if installation config dir will be removed
  if (($self->{config}{uninstall_qt} || !$self->{config}{rpm_installed}) &&
      ($self->{config}{uninstall_sw} || !$self->{config}{sw_installed}) ) {
    $self->{config}{uninstalled_everything} = 1;
    if ( $self->ask(q => ["Remove the installation config directory ([_1])?",
         $self->{config}{config_dir}], type => 'bool', default => 0) ) {
	    $self->{config}{remove_config_dir} = 1 ;
    }
  }

  return 1;
}

=item B<prompt_user_for_uninstall>

Submenu for 'uninstall'.

=cut

sub prompt_user_for_uninstall {
  my ($self) = @_;
  my $options = [
		 [qt_sw => ["Uninstall [_1] + [_2].",
	     $self->PRODUCT_NAME, $self->SW_NAME]],
		 [qt => ["Uninstall [_1].",
			 $self->PRODUCT_NAME]],
		 [sw => ["Uninstall [_1].",
			 $self->SW_NAME]],
		 [return => "Go back to the Main Menu."],
		 [quit   => "Quit."],
		];
  my $action = $self->menu($options);
  $self->quit if $action eq 'quit';
  return $action;
}

=item B<sanity_uninstall_config>

Check we've been given enough config to uninstall.

=cut

sub sanity_uninstall_config {
  my ($self, $modifiers) = @_;

  my %products;
  if ($modifiers->{products}) {
    @products{@{$modifiers->{products}}} = ();
  }

  # Work out what they want to install
  if (exists $products{Lx86}) {
    delete $products{Lx86};
    $self->{config}{uninstall_qt} = 1;
  }
  if (exists $products{x86world}) {
    delete $products{x86world};
    $self->{config}{uninstall_sw} = 1;
  }
  if (%products) {
    $self->croak("No such product: [_1]", join(' ', keys %products));
  }

  if ($self->{config}{uninstall_qt}) {
    if (not $self->{config}{rpm_installed}) {
      $self->log("Cannot uninstall [_1] because it is not installed.",
		 $self->PRODUCT_NAME);
      return 0;
    }
    if ($self->{config}{uninstall_stop_qt}) {
      $self->check_qt_is_not_running or $self->stop_qt;
    }
    else {
      unless ($self->check_qt_is_not_running) {
	$self->log("You cannot uninstall while there are still translated processes running.\nKill these processes to continue.");
	return 0;
      }
    }
  }

  if ($self->{config}{uninstall_sw}) {
    unless ($self->{config}{sw_installed} or
	    -f "$self->{config}{sw_root_path}/etc/".$self->SW_PART) {
      $self->log("Cannot uninstall [_1] because it is not installed.",
		 $self->SW_NAME);
      return 0;
    }
    my $mounted = $self->directory_has_mounted_filesystems
      ($self->{config}{sw_root_path});
    if ($mounted) {
      $self->log("The directory [_1] contains mounted filesystems ([_2]). Please unmount them before retrying this operation.", [$self->{config}{sw_root_path}, 'user'], $mounted);
      return 0;
    }
  }

  # Will either component be left at the end of this installation?
  if (($self->{config}{uninstall_qt} || !$self->{config}{rpm_installed}) &&
      ($self->{config}{uninstall_sw} || !$self->{config}{sw_installed}) ) {
    $self->{config}{uninstalled_everything} = 1;
  }

  return 1;
}

=item B<uninstall>

Uninstall QT and/or SW as appropriate.

=cut

sub uninstall {
  my ($self) = @_;

  my $steps = 0;
  $steps++ if $self->{config}{uninstall_qt};
  $steps++ if $self->{config}{uninstall_sw};

  $self->ppack->begin_operation(title => 'uninstall', steps => $steps);

  if ($self->{config}{uninstall_qt}) {
    $self->log("Uninstalling [_1]. Please wait...", $self->PRODUCT_NAME);
    $self->ppack->next_step(title => 'Uninstalling '.$self->PRODUCT_NAME);
    $self->ppack->progress(percent => 0, title => 'Stopping daemons');
    $self->stop_qt;
    $self->ppack->progress(percent => 33, title => 'Removing RPM');
    $self->uninstall_rpm($self->{config}{old_product_installed} ||
			 $self->PRODUCT_NAME)
      or $self->croak("Failed to uninstall [_1] RPM", $self->PRODUCT_NAME);

    $self->ppack->progress(percent => 67, title => 'Cleaning up');

    #Remove the qt directory
    if ( -e $self->{config}{qt_root_path} ) {
      File::Path::rmtree($self->{config}{qt_root_path});
      $self->log("[_1] installation directory ([_2]) deleted.", 
      $self->PRODUCT_NAME, [$self->{config}{qt_root_path}, 'user']);
    }

    #Remove the log directory
    if ($self->{config}{remove_logfile}) {
      File::Path::rmtree($self->{config}{logfile_path});
      $self->log("Log file directory ([_1]) deleted.", [$self->{config}{logfile_path}, 'user']);
    }
    else {
      $self->log("Please remove log file directory ([_1]) if you no longer require it",
                  [$self->{config}{logfile_path}, 'user']);
    }
    # devLog created by QT
    unlink "/var/opt/p-ave/devLog";
    $self->add_transaction("Uninstalled [_1]", $self->PRODUCT_NAME);
  }
  if ($self->{config}{uninstall_sw}) {
    # This is a scary thought, but we have asked the user if he is
    # sure by this stage...
    $self->log("Uninstalling [_1]. Please wait...", $self->SW_NAME);
    $self->ppack->next_step(title => 'Uninstalling '.$self->SW_NAME);

    $self->ppack->progress(percent => 0, title => "Removing directory");
    File::Path::rmtree($self->{config}{sw_root_path});
    $self->ppack->progress(percent => 90, title => "Removing ".$self->LINKX86);
    # -e returns false when the symlink is broken so we check -l as well
    if (-l $self->BIN_DIR.'/'.$self->LINKX86 or
        -e $self->BIN_DIR.'/'.$self->LINKX86) {
      unlink $self->BIN_DIR.'/'.$self->LINKX86 or
	$self->croak("Can't remove [_1]: [_2]", $self->LINKX86, $!);
    }
    $self->add_transaction("Uninstalled [_1]", $self->SW_NAME);
  }
  # -e returns false when the symlink is broken so we check -l as well
  if (-l $self->BIN_DIR.'/'.$self->RUNX86 or
      -e $self->BIN_DIR.'/'.$self->RUNX86) {
    unlink $self->BIN_DIR.'/'.$self->RUNX86 or
	$self->croak("Can't remove [_1]: [_2]", $self->RUNX86, $!);
  }

  $self->ppack->progress(percent => 95, title => "Cleaning up");

  if (exists $self->{config}{qt_root_path}) {
    if (-e "$self->{config}{qt_root_path}/bin/" . $self->RUNX86) {
      unlink "$self->{config}{qt_root_path}/bin/" . $self->RUNX86
        or $self->croak("Can't remove [_1]: [_2]", $self->RUNX86, $!);
    }
  }

  if ($self->{config}{uninstalled_everything}) {
    # Remove the installer configuration directory
    if ($self->{config}{remove_config_dir}) {
      File::Path::rmtree($self->{config}{config_dir});
      $self->log("Config directory ([_1]) deleted.", $self->{config}{config_dir});
    }
    else {
      $self->log("Please remove config directory ([_1]) if you no longer require it", $self->{config}{config_dir});
    }
  }

  $self->ppack->end_operation;

  $self->log("\nExiting program after successful uninstall.");
  $self->quit;
}

=item B<check_qt_is_not_running>

Returns true if QT (PRODUCT_NAME) is not running, ignoring zombie processes.

If it is running, will print out a warning about uninstallation being
impossible and return false.

=cut

sub check_qt_is_not_running {
  my ($self) = @_;
  my @qt_pids = $self->get_running_processes_of_type($self->PRODUCT_NAME);
  if (@qt_pids) {
    my @pids = $self->get_living_processes(@qt_pids);
    if (@pids) {
      $self->log;
      $self->log("The following translated processes (pids) are running:");
      $self->log("@pids"); # quotes are necessary here
          $self->log;
      return 0;
    }
  }
  return 1;
}

=item B<start_qt>

Start the translator daemon. Croaks if there was a problem.

=cut

sub start_qt {
  my ($self) = @_;
  my @command = ('/etc/init.d/'.$self->PRODUCT_NAME, 'start');
  my $output = $self->run_command(@command, '2>&1');
  if ($self->{exit}) {
    # Only log the output to the screen if it fails
    $self->log_no_trans($output);
    $self->croak("Problem starting [_1]. Exit value was [_2].",
		 $self->PRODUCT_NAME, $self->{exit});
  } else {
    $self->log_only_to_file($output);
  }
}

=item B<stop_qt>

Stop the translator daemon. Croaks if there was a problem.

=cut

sub stop_qt {
  my ($self) = @_;
  # We might be calling this even if we haven't got one to stop
  my $product = $self->{config}{old_product_installed} || $self->PRODUCT_NAME;

  return if not -x "/etc/init.d/$product";

  my @command = ("/etc/init.d/$product", 'stop');
  my $output = $self->run_command(@command, '2>&1');
  if ($self->{exit}) {
    $self->log_no_trans($output);
    $self->croak("Problem stopping [_1]. Exit value was [_2].",
		 $product, $self->{exit});
  } else {
    $self->log_only_to_file($output);
  }
}

=item B<restart_qt>

Restart the translator daemon. Croaks if there was a problem.

=cut

sub restart_qt {
  my ($self) = @_;
  my @command = ('/etc/init.d/'.$self->PRODUCT_NAME, 'restart');
  my $output = $self->run_command(@command, '2>&1');
  if ($self->{exit}) {
    $self->log_no_trans($output);
    $self->croak("Problem restarting [_1]. Exit value was [_2].",
		 $self->PRODUCT_NAME, $self->{exit});
  } else {
    $self->log_only_to_file($output);
  }
}

=item B<run_translated>

Like run_command() but will invoke the given command with the
translator.

Must be an absolute *subject world* path, eg. /bin/ls

Your current working directory must be visible in the subject world or
the translator will croak.

=cut

sub run_translated {
  my ($self, $argv0, @argv) = @_;
  my @qt = ("$self->{config}{qt_root_path}/bin/".$self->PRODUCT_NAME);
  $argv0 = $self->{config}{sw_root_path}.$argv0;
  $self->log_only_to_file(POSIX::strftime('%H:%M:%S', localtime).
			  " [TRANSLATED $argv0 @argv]\n",
			 undef, $self->{encoding});
  if (defined wantarray) {
    return $self->run_command(@qt, $argv0, @argv);
  }
  else {
    $self->run_command(@qt, $argv0, @argv);
  }
}

=item B<get_installed_products>

Check if QT or SW are installed and return them as a list.

=cut

sub get_installed_products {
  my ($self) = @_;
  my @products;
  if ($self->{config}{rpm_installed}) {
    push @products, ["[_1] from package [_2]", $self->PRODUCT_NAME,
		     $self->{config}{rpm_installed}];
  }
  if ($self->{config}{sw_installed}) {
    push @products, ["[_1] ([_2]) installed at [_3]", $self->SW_NAME,
		     $self->{config}{sw_installed},
		     [$self->{config}{sw_root_path}, 'user']];
  }
  return @products;
}

=item B<get_configure_config_interactively>

Want to bind NIS?

=cut

sub get_configure_config_interactively {
  my ($self) = @_;
  my %config;
  if ($self->{config}{sw_installed}) {
    my $answer = $self->menu([
      [create_archive => ["Create archive of [_1].", $self->SW_NAME]],
      [return   => "Go back to the Main Menu."]
		]);
    if ($answer ne 'return') {
      $config{$answer} = 1;
      if ($answer eq 'create_archive') {
	if ($self->check_archive_functionality_available) {
	  $self->get_create_archive_config_interactively(\%config);
	}
	else {
	  return {};
	}
      }
    }
    return \%config;
  }	
  else {
    return $self->SUPER::get_configure_config_interactively;
  }
}

=item B<get_create_archive_config_interactively>

Get the directory to create the archive in.

=cut

sub get_create_archive_config_interactively {
  my ($self, $config) = @_;
  while (1) {
    # Check if processes are running and kill all
    unless ($self->check_qt_is_not_running) {
      $self->log("You cannot create an archive while there are translated processes running.\nKill these processes to continue.");
      if ($self->ask(q => "Do you want to kill these processes now?", type => 'bool', default => 0)) {
	$config->{user_stopped_qt} = 1;
        $self->stop_qt;
      }
      else {
        $self->log("Archive creation cancelled");
	delete $config->{create_archive};
	last;
      }
    }
      
    $config->{create_archive_directory} =
      $self->ask(q => "In what directory should the archive be placed?",
		 type => 'path',
		 default => '/',
		);
    $config->{create_archive_filename} =
      $self->ask(q => "What should the file be called?",
		 type => 'string',
		 default => $self->PRODUCT_NAME."-archive-$self->{config}{sw_installed}.bin");

    if (-e "$config->{create_archive_directory}/$config->{create_archive_filename}") {
      $self->ask(q => "That file exists already. OK to overwrite it?",
		 type => 'bool',
		 default => 1) or redo;
    }
    last;
  }
}

=item B<configure>

Create a subject world archive if requested.

=cut

sub configure {
  my ($self, $config) = @_;
  if ($config->{create_archive}) {
    File::Path::mkpath($config->{create_archive_directory});
    my $path = "$config->{create_archive_directory}/$config->{create_archive_filename}";
    $path =~ s|/+|/|g; # remove strings of slashes
    $self->log("Creating archive [_1]. This may take several minutes to complete. Please wait...",
	       [$path, 'user']);
    my $metadata = {
		    sw_distro => $self->{config}{sw_installed},
		    sw_root_path => $self->{config}{sw_root_path},
		   };
    # A customer experienced problems restoring the /selinux symlink,
    # so we remove this from the archive (it will be recreated on
    # restoration anyhow)
    $self->create_archive_file($path, $self->{config}{sw_root_path},
			       $metadata, ['*/'.$self->SW_SUCC, 'selinux']);
    if ($config->{user_stopped_qt}) {
      $self->start_qt;
      delete $config->{user_stopped_qt};
    }
    $self->log("Done.");
    $self->add_transaction("Created archive of [_1] in [_2]",
			   $self->SW_NAME, [$path, 'user']);
  }
}

=item B<versions_available>

Returns an hashref of the available versions to install on this
system.

The keys are version names (eg. 0.3.2-SLES) and the values are the
path of the RPM to install.

Croaks if no RPM can be found.

=cut

sub versions_available {
  my ($self) = @_;
  my $dir = $self->RPM_DIR;
  if (not -d $dir) {
    $self->croak("No such directory [_1].", $dir);
  }
  my $rpm_glob = $self->PRODUCT_NAME.
    "-*-$self->{distro_details}{rpm}.ppc64.rpm";
  my $version_regex = '([^/]*).ppc64.rpm$';
  # We need to chdir here in case the directory name contains spaces
  my $cwd = Cwd::cwd;
  chdir $dir or $self->croak("Couldn't chdir");
  my @files = glob($rpm_glob);
  chdir $cwd or $self->croak("Couldn't chdir");
  if (not @files) {
    $self->croak("No RPM file for [_1] could be found",
		 $self->{distro_details}{rpm});
  }
  my %versions;
  foreach my $file (@files) {
    my $dir_and_file = "$dir/$file";
    my $version = $self->get_uninstalled_rpm_full_name($dir_and_file);
    if (defined $version) {
      # Don't include the current version
      next if ($self->{config}{rpm_installed} and
               $self->{config}{rpm_installed} eq $version );

      # Don't include older versions
      $self->install_rpm($dir_and_file,
		         upgrade => 1,
				     test =>1);
    	next if ( $self->{rpm_output} =~ m/package.*which is newer than.*is already installed/g );
  	
      $versions{$version} = $file;
    }
    else {
      $self->croak("RPM is unable to query [_1]", $dir_and_file);
    }
  }
  
  return \%versions;
}

=item B<version_menu>

Give the user a choice of versions from
$self->{config}{versions_available}.

=cut

sub version_menu {
  my ($self) = @_;
  my $options = [];
  foreach my $version (sort keys %{$self->{config}{versions_available}}) {
    push @$options,
      [$self->{config}{versions_available}{$version} => $version];
  }
  if (not @$options) {
    $self->log;
    $self->log("Nothing is available to be installed on your system.");
    return 'return';
  }
  push @$options, [return => "Go back to the Main Menu."];
  return $self->menu
    (
     $options,
     ["Please select the version of [_1] you would like to install:",
      $self->PRODUCT_NAME]
    );
}

=item B<welcome>

Additional info for the welcome message.

=cut

sub welcome {
  my ($self) = @_;
  $self->SUPER::welcome;
  if ($self->{interactive_mode}) {
    my $welcome = q{
To run Linux/x86 applications the installation will require Linux/x86
application binaries, libraries and infrastructure files as well as the
PowerVM Lx86 software.

Please refer to the PowerVM Lx86 Administration Guide and Release Notes
for further details of the installation requirements.

};
    $self->log($welcome);
  }
}

=item B<ibm_registration_text>

Returns a string containing the contents of the registration
email to be sent to IBM.

=cut

sub ibm_registration_text {
  my ($self) = @_;
  my $c = $self->{config};
  my $text = qq{
Date:         $c->{registration_date}
System:       $c->{model}
Serial:       $c->{serial}

Company:      $c->{ibm_company_name}

Name:         $c->{ibm_registrant_name}
Address:      $c->{ibm_address}
Phone Number: $c->{telephone_number}
Email:        $c->{ibm_email_address}
};

  return $text;
}

=item B<ibm_subject_line>

Returns a string containing the subject line for the 
registration email to be sent to IBM.

=cut

sub ibm_subject_line {
  my ($self) = @_;

  my $subject_text = 'Activation of PowerVM Lx86 from: ' .
                       $self->{config}->{ibm_company_name};

  return $subject_text ;
}

=item B<escape>

Given a real absolute path, escape it into the subject world.

If it doesn't exist on the target system, skip it silently.

If it exists in the subject world, remove it first.

Intelligently realise if the target has been escaped via an
escape further up the path and take no action if so.

Given an array, does this for each argument.

=cut

sub escape {
  my ($self, @path) = @_;
  if (not $self->{config}{sw_root_path}) {
    $self->croak("sw_root_path is not set");
  }
  foreach my $path (@path) {
    $path =~ s!/+$!!; # remove any trailing slash
    next unless -e $path;
    if (not $path or $path !~ /\w/) {
      $self->croak("path '[_1]' is invalid", $path);
    }
    my $swpath = "$self->{config}{sw_root_path}$path";

    # If it already exists, remove it and any subdirs
    if (-e $swpath) {
      # Stat the two to make sure there isn't an escape further 
      # up the chain.
      my ($sw_dev, $sw_ino) = stat($swpath);
      my ($dev, $ino) = stat($path);
      if( ($sw_dev == $dev) and ($sw_ino == $ino) )
      {
        # It's already escaped as one of it's parent directories 
        # is an escape.
        return;
      }
      File::Path::rmtree($swpath);
    }
    # Otherwise create the path to it but remove it itself.
    else {
      File::Path::mkpath($swpath);
      rmdir $swpath;
    }

    # Symlink it in
    symlink $path, $swpath or
      $self->croak("Couldn't symlink [_1] to [_2]: [_3]", $path, $swpath, $!);
  }
}

=item B<get_registration_info_interactively>

This function collects common registration info interactively and adds
it to $self->{config}.

=cut

sub get_registration_info_interactively {
  my ($self) = @_;
  my $success1 = $self->get_ibm_registration_info_interactively;
  my $success2 = $self->get_distro_registration_info_interactively;
  return $success1 && $success2;
}

=item B<get_ibm_registration_info_interactively>

Called exclusively by get_registration_info_interactively.
Sends the email to IBM.

=cut

sub get_ibm_registration_info_interactively {
  my ($self) = @_;
  my @qs =
    (
     [ibm_company_name => "Please enter the name of your company:",
     '.+', 'A company name must be provided.'],
     [ibm_registrant_name => "Please enter your name:", '.+', 'You must provide your name.'],
     [ibm_address => "Please enter your address, use commas to separate fields (optional):"],
     [telephone_number => "Please enter your phone number (optional):"],
     [ibm_email_address => "Please enter your email address:",
      $self->EMAIL_REGEXP,
      'The email address is compulsory and must have an @ and a valid domain.'],
    );

  $self->set_registration_date;

  my $initial_text = qq{
You must provide some information to IBM before starting the installation
process.  This Activation information will be sent to IBM as an email.

Note: You must provide your company name, name and email address for the
installation to proceed.  All other details are optional.  The Activation
email will also include some details about this system.  Once you have
entered this information it will be presented to you to review.  You will
have the option to send the information to IBM via email or abort the
installation.

};

  return $self->register_interactively
    (
     email                       => $self->IBM_REGISTER_EMAIL,
     organisation                => 'IBM',
     record_file                 => "$self->{config}{config_dir}/".
                                      $self->IBM_REG_FILE,
     questions                   => \@qs,
     subject_line_method         => 'ibm_subject_line',
     email_body_method           => 'ibm_registration_text',     
     initial_text_for_first_time => $initial_text,
     compulsory                  => 1, 
    );
}

=item B<get_distro_registration_info_interactively>

Called exclusively by get_registration_info_interactively.
Override if you need it.

=cut

sub get_distro_registration_info_interactively {
  my ($self) = @_;
  # By default, do nothing
}

=item B<goodbye>

Override this if your product must say something specific before exiting.

=cut

sub goodbye {
  my ($self) = @_;
  if ($self->{successful_registrations}{IBM}) {
    $self->log(qq{
The Activation email data is stored on the system in
  [_1].

If this system is not set up to send email, please email
this data file to IBM at <[_2]>.
}, "$self->{config}{config_dir}/".$self->IBM_REG_FILE, $self->IBM_REGISTER_EMAIL);
  }

  if ($self->{successful_registrations}{'Red Hat Inc.'}) {
    $self->log(qq{
The Red Hat Subscription email data is stored on the system in
  [_1].

If this system is not set up to send email or you do not get an
acknowledgement email from Red Hat within the next 24 hours, please
email this data file to Red Hat at <[_2]>.
This will ensure that your Red Hat subscription is upgraded.
}, "$self->{config}{config_dir}/".$self->RH_REG_FILE, $self->RH_REGISTER_EMAIL);
  }

  $self->verbose_summary;

  $self->SUPER::goodbye;
	
  # Finally
  $self->copy_log_file_to_installed_log_dir_if_appropriate;
}

=item B<verbose_summary>

More verbose summary of installation

=cut

sub verbose_summary {
  my ($self) = @_;

  if (( $self->{config}{install_qt} and $self->{config}{rpm_installed} ) or 
      ($self->{config}{install_sw} and $self->{config}{sw_installed} )) {
    $self->log;
    $self->log("Installation Summary");
  }

  # If the QT rpm was successfully installed this time round...
  if ( $self->{config}{install_qt} and $self->{config}{rpm_installed} ) {
    $self->log;
    $self->log("Installed [_1]:", $self->PRODUCT_NAME);
    $self->log("  - From RPM: [_1]", $self->{config}{rpm_installed});
    $self->log("  - Installation directory: [_1]",
	       [$self->{config}{qt_root_path}, 'user']);
    $self->log("  - Log files created by [_1] will be stored in [_2]",
	       $self->PRODUCT_NAME, [$self->{config}{logfile_path}, 'user']);
	}
	
  # If the subject world was successfully installed this time round...
  if ($self->{config}{install_sw} and $self->{config}{sw_installed} ) {
    $self->log;
    $self->log("Installed [_1]", $self->SW_NAME);
    $self->log("  - Distribution: [_1]",
	       $SUBJ_WORLDS{$self->{config}{sw_installed}}{title});
    $self->log("  - Installed at: [_1]",
	       [$self->{config}{sw_root_path}, 'user']);
    if ($self->{config}{sw_homedir} and
	$self->{config}{sw_homedir} ne 'skip') {
      $self->log("  - Home directories are in [_1]",
		 [$self->{config}{sw_homedir}, 'user']);
    }
    else {
      $self->log("  - Home directories will not be shared");
    }
  }
}

=item B<copy_log_file_to_installed_log_dir_if_appropriate>

If the installed log dir exists at this stage, copy the installer
logfile there.

=cut

sub copy_log_file_to_installed_log_dir_if_appropriate {
  my ($self) = @_;
  if ($self->{config}{logfile_path} and -d $self->{config}{logfile_path}) {
    my $basename = File::Basename::basename($self->{logfile}->filename);
    $self->copy_preserve($self->{logfile}->filename,
			 "$self->{config}{logfile_path}/$basename");
  }
}

=item B<modify_login_defs>

Changes UID_MIN and GID_MIN in /etc/login.defs in the subject world to 50000.

=cut

sub modify_login_defs {
  my $self = shift;
  my $login_defs_file = "$self->{config}{sw_root_path}/etc/login.defs";
  my @login_defs = $self->slurp($login_defs_file);
  for my $line (@login_defs) {
    if ($line =~ /^((U|G)ID_MIN\s+)\d+/) {
      $line = "${1}50000";
    }
  }
  $self->write_file($login_defs_file, \@login_defs);
}

=item B<enable_services>

Enable translated services

=cut

sub enable_services {
  my ($self) = @_;
  # lets enable the basic required services now
  my $scripts_dir = $self->{config}{sw_root_path}.$self->INIT_D;
  if( -x "$scripts_dir/dbus" ) {
    $self->run_translated('/sbin/chkconfig', 'dbus', 'on');
  }
  if( -x "$scripts_dir/syslog" ) {
    $self->run_translated('/sbin/chkconfig', 'syslog', 'on');
  }
  if( -x "$scripts_dir/crond" ) {
    $self->run_translated('/sbin/chkconfig', 'crond', 'on');
  } elsif( -x "$scripts_dir/cron" ) {
    $self->run_translated('/sbin/chkconfig', 'cron', 'on');
  }
}

=item B<check_login_defs>

  $self->check_login_defs($rpm);

Checks whether $rpm is known to modify /etc/login.defs in the subject world
and, if so, calls modify_login_defs to restore UID_MIN and GID_MIN to 50000.

Requires an override for each OS, because the rpm will be different.

=cut

sub check_login_defs {}

=item B<configure_sw_post_base_rpms>

  $self->configure_sw_post_base_rpms();

Performs any OS-specific work that needs to be done between the translated 
install of the base rpms and the install of the remaining rpms.

By default does nothing.

=cut

sub configure_sw_post_base_rpms {}

=item B<run_powerpack_mode>

  $self->run_powerpack_mode($config_file);

Powerpack mode is a special RO-specific run mode that is used to
interface Maiken with IBM's PowerPack system. It takes a config file
written out by PowerPack as its argument.

=cut

sub run_powerpack_mode {
  my ($self, $config_file, $modifiers) = @_;

  $self->{powerpack_mode} = 1;
  $self->set_up_environment;
  $self->check_environment;

  # Set the contents of $self->{config} and also get any $additional_config
  my $additional_config = $self->get_powerpack_config_from($config_file);

  if (not $additional_config->{output_file}) {
    $self->croak("No 'output_file' set in PowerPack config file!");
  }
  # Override ppack with one that is enabled
  $self->{ppack} = Maiken::RO::PowerPack->new
    (maiken  => $self,
     channel => $additional_config->{output_file},
     enabled => 1);

  $self->sanity_initial_config($modifiers) or $self->croak;

  # Send the emails
  $self->do_registration_noninteractively
    (
     force => $additional_config->{redo_registration},
     do_redhat_registration => $additional_config->{do_redhat_registration},
    );

  if (not $additional_config->{function}) {
    $self->croak("No 'function' set in PowerPack config file!");
  }
  if ($additional_config->{function} eq 'install') {
    if ($self->sanity_install_config({})) {
      $self->install;
    }
    else {
      $self->cleanup_cleanup_dirs;
      $self->croak("[_1] failed. Please check the messages above.", 'Install');
    }
  }
  elsif ($additional_config->{function} eq 'uninstall') {
    if ($self->sanity_uninstall_config({})) {
      $self->uninstall;
    }
    else {
      $self->cleanup_cleanup_dirs;
      $self->croak("[_1] failed. Please check the messages above.", 'Uninstall');
    }
  }
  else {
    $self->croak("Unknown function '[_1]'", $additional_config->{function});
  }
}

=item B<get_powerpack_config_from>

  my $additional_config = $self->get_powerpack_config_from($config_file);

Set the contents of $self->{config} based on the values in
$config_file. If the values are not in the authorized list of
$self->{config} variables, then they will be returned in a hashref.

=cut

sub get_powerpack_config_from {
  my ($self, $config_file) = @_;

  if (not -f $config_file) {
    $self->croak("No such config file: [_1]", [$config_file, 'user']);
  }

  # Create a hash of all the authorized vars
  my %authorized;
  @authorized{AUTHORIZED_POWERPACK_CONFIG_VARS()} = ();

  my @lines = $self->slurp($config_file, ':unix');

  # Log the config file contents
  $self->log_only_to_file("\n");
  $self->log_only_to_file("Loaded PowerPack config from file $config_file\n");
  $self->log_only_to_file(join '', @lines);
  $self->log_only_to_file("\n");

  my %additional_config;
  foreach my $line (@lines) {
    if (my ($key, $value) = $line =~ /^(\w+)=(.*?)\s*$/) {
      if (exists $authorized{$key}) {
	if (exists $self->SPECIAL_CONFIG_FILE_VARS->{$key}) {
	  if ($self->SPECIAL_CONFIG_FILE_VARS->{$key} eq '@') {
	    # Array
	    push @{$self->{config}{$key}}, $value;
	  }
	  else {
	    # Hash
	    my ($key2, $value2) = split /=/, $value;
	    $self->{config}{$key}{$key2} = $value2;
	  }
	}
	else {
	  $self->{config}{$key} = $value;
	}
      }
      else {
	# It's an additional config value
	$additional_config{$key} = $value;
      }
    }
  }

  return \%additional_config;
}

=item B<do_registration_noninteractively>

  $self->do_registration_noninteractively(force => 1);

Assuming the config in $self->{config} is correct, send the
registration emails.

Pass a parameter "force" to this method if you want to send the emails
even if they have already been sent.

=cut

sub do_registration_noninteractively {
  my ($self, %opts) = @_;

  # Set registration_date
  $self->set_registration_date;

  $self->register_noninteractively
    (
     email                       => $self->IBM_REGISTER_EMAIL,
     organisation                => 'IBM',
     record_file                 => "$self->{config}{config_dir}/".
                                      $self->IBM_REG_FILE,
     subject_line_method         => 'ibm_subject_line',
     email_body_method           => 'ibm_registration_text',
     force                       => $opts{force},
    );
}

=item B<set_registration_date>

  $self->set_registration_date;

Sets $self->{config}{registration_date} to the current date.

=cut

sub set_registration_date {
  my ($self) = @_;

  # POSIX::strftime isn't sensitive to 'no locale' (never mind what
  # man perllocale says) so we need to set the LC_TIME locale back to
  # 'C' temporarily here so the string is in English.
  my $old = POSIX::setlocale(&POSIX::LC_TIME, 'C');
  $self->{config}{registration_date} =
    POSIX::strftime(DATE_FORMAT, localtime);
  POSIX::setlocale(&POSIX::LC_TIME, $old);
}

=item B<croak>

  $self->croak($msg, @sub_vars);

Send an error to PowerPack before calling $self->SUPER::croak

=cut

sub croak {
  my ($self, @args) = @_;
  if ($self->ppack->enabled) {
    my $english = $self->_get_lh('english')->maketext(@args);
    $self->ppack->error(message => $english);
  }

  $self->SUPER::croak(@args);
}

=item B<supported_distros>

  my $distros = $self->supported_distros;

Returns the list of subject world distros supported on this
architecture as an array.

=cut

sub supported_distros {
  my ($self) = @_;
  my @distros;
  foreach my $sw (sort @{$self->{distro_details}{subject_worlds}}) {
    # Skip distros newer than this one
    if ($sw =~ /^[A-Z]+\d+(?:(?:$MINOR_REV_SEPARATORS)(\d+))?/) {
      my $sw_min = $1 || 0;
      if ($sw_min > $self->{minor_os_revision}) {
	next;
      }
    }
    push @distros, $sw;
  }
  return @distros;
}

1;
