Mine

#!/usr/bin/perl -w

use XML::LibXML;
use XML::LibXML::Common;
use XML::NamespaceSupport;
use XML::SAX;

use Getopt::Std;
use Getopt::Long;

use strict;

# Step (1): setup the configuration
my %{CONFIG};
my %{CHROOT};

${CONFIG}{"DEBUG"} = 0;

## find if we are locked under a custom ROOT directory
if ((defined(${ENV}{"ROOT"})) && (${ENV}{"ROOT"} ne "")) {
  ${CONFIG}{"ROOT"} = ${ENV}{"ROOT"};
} else {
  ${CONFIG}{"ROOT"} = "";
}

my $configfile;
my $debug;
my $debuglevel;

my $stop;
my $start;
my $reset;
my $delete;

## check for the --config file
GetOptions ("config=s"   => \$configfile
            ,"debug"   => \$debug
            ,"debuglevel=i" => \$debuglevel
            ,"stop=s" => \$stop
            ,"start=s" => \$start
            ,"reset=s" => \$reset
            ,"delete=s" => \$delete
            );


if ((defined($configfile)) && ($configfile ne "")) {
  ${CONFIG}{"XML"} = ${CONFIG}{"ROOT"} . $configfile;
} else {
  ${CONFIG}{"XML"} = ${CONFIG}{"ROOT"} .
    "/etc/devel-chroots/default/devel-chroots.conf";
}

## check for --debug
if (defined($debug)) {
  ${CONFIG}{"DEBUG"} = $debug;
}

## check for --debuglevel
if (defined($debuglevel)) {
  ${CONFIG}{"DEBUG"} = $debuglevel;
}

## check for --stop (shut down chroot and unmount)
## check for --start (start chroot and mount)
## check for --reset (shut down chroot, unmount and reset config files like /etc/make.conf and restore /usr/portage)
## check for --delete (shut down chroot, unmount and delete chroot)

# Step (2): parse the XML config
my $xml = XML::LibXML->new()->parse_file(${CONFIG}{"XML"});
my @chroots = $xml->getDocumentElement()->childNodes;

foreach my $tag (@chroots) {
  if($tag->nodeType==ELEMENT_NODE) {
    if ($tag->nodeName ne "chroot") {
      ${CONFIG}{lc($tag->nodeName)} = $tag->textContent;
    } else {
      my @o = $tag->getElementsByTagName("owner");
      my @n = $tag->getElementsByTagName("name");

      for (@o) {
        my $cO = $_->textContent;

        for(@n) {
          my $cN = $_->textContent;

          ${CHROOT}{lc($cO)}{lc($cN)}{"idx"} = $cO . ":" . $cN . ":" . time();

          foreach my $p ($tag->childNodes) {
            if($p->nodeType==ELEMENT_NODE &&
               $p->nodeName ne "owner" &&
               $p->nodeName ne "name") {
              ${CHROOT}{lc($cO)}{lc($cN)}{lc($p->nodeName)} = $p->textContent;
} } } } } } }


if (${CONFIG}{"DEBUG"} > 10) {
  print "config initialized, dumping information: \n";
  print "GLOBAL CONFIGURATION:\n";
  for(keys(%{CONFIG})) {
    print "$_:" . ${CONFIG}{$_} . "\n";
  }
  print "\n";
  print "CHROOT CONFIGURATION:\n";
  foreach my $owner (keys(%CHROOT)) {
    foreach my $chrootname (keys( %{ ${CHROOT}{$owner} } )) {
      foreach my $prop (keys( %{ ${CHROOT}{$owner}{$chrootname} } )) {
        print "CHROOT{" . $owner . "}{" . $chrootname . "}{" . $prop . "}" .
          " = " . ${CHROOT}{$owner}{$chrootname}{$prop} . "\n";
} } } }

## find chroots we need to start
if (defined($start) && $start ne "") {
  my @STARTCHROOTS = split(",", $start);

  for (@STARTCHROOTS) {
    my $name = $_;
    if ($name =~ /all/) {
      print "starting all chroots\n";
      foreach my $user (keys(%CHROOT)) {
        foreach my $chrootname (keys( %{ ${CHROOT}{$user} } )) {
          startChroot($user, $chrootname) or die "startChroot failed for $user:$chrootname";
        }
      }
    } else {
      print "starting chroots for: $name\n";
      foreach my $chrootname (keys( %{ ${CHROOT}{$name} } )) {
       startChroot($name, $chrootname) or die "startChroot failed for $name:$chrootname";
} } } }

## find any chroots we need to stop (implies stopped)
if (defined($stop) && $stop ne "") {
  my @STOPCHROOTS = split(",", $stop);

  for (@STOPCHROOTS) {
    my $name = $_;
    if ($name =~ /all/) {
      print "stopping all chroots\n";
      foreach my $user (keys(%CHROOT)) {
        foreach my $chrootname (keys( %{ ${CHROOT}{$user} } )) {
          stopChroot($user, $chrootname) or die "stopChroot failed for $user:$chrootname";
        }
      }
    } else {
      print "stopping chroot: $name\n";
      foreach my $chrootname (keys( %{ ${CHROOT}{$name} } )) {
        stopChroot($name, $chrootname) or die "stopChroot failed for $name:$chrootname";
} } } }


## find chroots we need to reset (implies stopped)
if (defined($reset) && $reset ne "") {
  my @RESETCHROOTS = split(",", $reset);

  for (@RESETCHROOTS) {
    my $name = $_;
    if ($name =~ /all/) {
      print "resetting all chroots\n";
      foreach my $user (keys(%CHROOT)) {
        foreach my $chrootname (keys( %{ ${CHROOT}{$user} } )) {
          resetChroot($user, $chrootname) or die "resetChroot failed for $user:$chrootname";
        }
      }
    } else {
      print "resetting chroot: $name\n";
      foreach my $chrootname (keys( %{ ${CHROOT}{$name} } )) {
        resetChroot($name, $chrootname) or die "resetChroot failed for $name:$chrootname";
} } } } 

## find chroots we need to delete
if (defined($delete) && $delete ne "") {
  my @DELETECHROOTS = split(",", $delete);

  for (@DELETECHROOTS) {
    my $name = $_;
    if ($name =~ /all/) {
      print "deleting all chroots\n";
      foreach my $user (keys(%CHROOT)) {
        foreach my $chrootname (keys( %{ ${CHROOT}{$user} } )) {
          deleteChroot($user, $chrootname) or die "deleteChroot failed for $user:$chrootname";
        }
      }
    } else {
      print "deleting chroot: $name\n";
      foreach my $chrootname (keys( %{ ${CHROOT}{$name} } )) {
        deleteChroot($name, $chrootname) or die "startChroot failed for $name:$chrootname";
} } } }

sub startChroot {
  my $user = shift or die "no user in startChroot";
  my $chroot = shift or die "no chroot in startChroot";
  my $success = 1;

  print "startChroot:$user:$chroot\n";

  return ($success);
}

sub stopChroot {
  my $user = shift or die "no user in stopChroot";
  my $chroot = shift or die "no chroot in stopChroot";
  my $success = 1;

  print "stopChroot:$user:$chroot\n";

  return ($success);
}


sub resetChroot {
  my $user = shift or die "no user in resetChroot";
  my $chroot = shift or die "no chroot in resetChroot";
  my $success = 1;

  print "resetChroot:$user:$chroot\n";

  stopChroot($user, $chroot);

  return ($success);
}

sub deleteChroot {
  my $user = shift or die "no user in deleteChroot";
  my $chroot = shift or die "no chroot in deleteChroot";
  my $success = 1;

  print "deleteChroot:$user:$chroot\n";

  stopChroot($user, $chroot);

  return ($success);
}

#eof#