File Coverage

blib/lib/Wizard/Examples/Apache/Host.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# -*- perl -*-

use strict;

use Wizard::State ();
use Wizard::SaveAble ();
use Wizard::Examples::Apache::Server ();
use File::Spec ();
use File::Path ();
use Socket ();
use Symbol ();


package Wizard::Examples::Apache::Host;

@Wizard::Examples::Apache::Host::ISA = qw(Wizard::Examples::Apache);
$Wizard::Examples::Apache::Host::VERSION = '0.01';

sub init {
    my $self = shift;
    return $self->SUPER::init(1) unless shift;
    my $item = $self->{'host'} || die "Missing host";
    ($self->SUPER::init(1), $item);
}

sub GetKey { 'host';};

sub getFileDir {
    my($self, $name, $class)= @_;
    $class ||= (ref($self) || $self); my $meth = $class . '::_superFileDir';
    my($ofile, $odir) = $self->$meth('');
    my $key = $class->GetKey();
    $name ||= $self->{$key}->{'apache-' . $key . '-name'} if ref($self);
    my $file = File::Spec->catfile($odir, "$name.cfg");
    my $dir = File::Spec->catdir($odir, $name);
    wantarray ? ($file, $dir, $odir) : $file;
}

sub _superFileDir {
    Wizard::Examples::Apache::getFileDir(shift, shift, 'Wizard::Example::Apache');
}

sub Load {
    my ($self, $wiz, $class) = @_;
    $class ||= (ref($self) || $self);
    my $key = $class->GetKey();
    my $meth = $class . '::init'; $self->$meth();
    my $item =  $wiz->param('apache-' . $key) or die "Missing $key specification";
    $meth = $class . '::getFileDir';
    my $file = $self->$meth($item);
    $item = $self->{$key} = Wizard::SaveAble->new($file);
    $self->Store($wiz);
}

sub ShowMe {
    my($self, $wiz, $host) = @_;
    (['Wizard::Elem::Title',
      'value' => $host->CreateMe() ?
          'Apache Wizard: Create a new host' :
          'Apache Wizard: Edit an existing host'],
     ['Wizard::Elem::Link'],
     ['Wizard::Elem::Text', 'name' => 'apache-host-name',
      'value' => $host->{'apache-host-name'},
      'descr' => 'Hosts short, descriptive name'],
     ['Wizard::Elem::Text', 'name' => 'apache-host-descr',
      'value' => $host->{'apache-host-descr'},
      'descr' => 'Hosts long, informative description'],
     ['Wizard::Elem::Text', 'name' => 'apache-host-arch',
      'value' => $host->{'apache-host-arch'},
      'descr' => 'Hosts architecture'],
     ['Wizard::Elem::Text', 'name' => 'apache-host-ip',
      'value' => $host->{'apache-host-ip'},
      'descr' => 'Hosts DNS name or IP address'],
     ['Wizard::Elem::Submit', 'name' => 'Action_HostSave',
      'value' => 'Save these settings', 'id' => 1],
     ['Wizard::Elem::Submit', 'name' => 'Action_Reset',
      'value' => 'Return to host menu', 'id' => 98],
     ['Wizard::Elem::Submit', 'name' => 'Wizard::Examples::Apache::Action_Reset',
      'value' => 'Return to top menu', 'id' => 99]);
}

*Action_CreateHost = \&Action_CreateItem;

sub Action_CreateItem {
    my($self, $wiz, $notshow) = @_;
    $self->init(); my $key = $self->GetKey();

    $self->{$key} = Wizard::SaveAble->new();
    $self->{$key}->CreateMe(1);
    $self->Store($wiz);
    $self->ShowMe($wiz, $self->{$key}) unless $notshow;
}

sub Action_HostSave {
    my($self, $wiz) = @_;
    my ($prefs, $basedir, $host) = $self->init(1);

    my $old_name = $host->{'apache-host-name'};
    foreach my $opt (qw(apache-host-name apache-host-descr apache-host-arch
                        apache-host-ip)) {
	$host->{$opt} = $wiz->param($opt) if defined($wiz->param($opt));
    }

    # Verify the new settings
    my $errors = '';
    my $name = $host->{'apache-host-name'} || '';
    $errors .= "Missing host name.\n" unless $name;
    my $ip = $host->{'apache-host-ip'}
	or  ($errors .= "Missing host ip.\n");
    my $arch = $host->{'apache-host-arch'}
	or  ($errors .= "Missing host architecture.\n");

    my($file, $dir, $odir) = $self->getFileDir();
    unless ($name) {
	if ($host->CreateMe()  or  $name ne $old_name) {
	    $errors .= "A host $name already exists: $file.\n" if -e $file;
	    $errors .= "A host $name already exists: $dir.\n" if -e $dir;
	}
    }
    if ($ip) {
	$errors .= "Cannot resolve IP address $ip.\n"
	    unless Socket::inet_aton($ip);
    }
    die $errors if $errors;

    if (!$host->CreateMe()  and  ($name ne $old_name)) {
	my $old_file = File::Spec->catfile($odir, "$old_name.cfg");
	my $old_dir = File::Spec->catdir($odir, "$old_name");
	rename($old_file, $file)
	    or die "Failed to rename $old_file to $file: $!";
	rename($old_dir, $dir)
	    or die "Failed to rename $old_dir to $dir: $!";
    }
    $host->File($file);
    if ($host->CreateMe()) {
        File::Path::mkpath([$dir],0, 0777);
	die "Couldn't create directory $dir: $!" unless -d $dir;
    }
    $host->Modified(1);
    $self->Store($wiz, 1);
    $self->Action_Reset($wiz);
}

sub Action_Reset {
    my($self, $wiz) = @_;
    my ($prefs, $basedir) = $self->init();

    delete $self->{'host'};
    $self->Store($wiz);

    # Return the initial menu.
    (['Wizard::Elem::Title', 'value' => 'Apache Wizard Host Menu'],
     ['Wizard::Elem::Submit', 'value' => 'Create a new host',
      'name' => 'Action_CreateHost',
      'id' => 1],
     ['Wizard::Elem::Submit', 'value' => 'Modify an existing host',
      'name' => 'Action_ModifyHost',
      'id' => 2],
     ['Wizard::Elem::Submit', 'value' => 'Server Menu',
      'name' => 'Action_ServerMenu', 'id' => 3],
     ['Wizard::Elem::Submit', 'value' => 'Delete an existing host',
      'name' => 'Action_DeleteHost',
      'id' => 4],
     ['Wizard::Elem::BR'],
     ['Wizard::Elem::Submit', 'value' => 'Return to Top Menu',
      'name' => 'Wizard::Examples::Apache::Action_Reset',
      'id' => 98],
     ['Wizard::Elem::Submit', 'value' => 'Exit Apache Wizard',
      'id' => 99]);
}


sub Action_EditItem {
    my $self = shift; my $wiz = shift;
    my $key = $self->GetKey();
    $self->Load($wiz);
    $self->ShowMe($wiz, $self->{$key});
}

*Action_EditHost = \&Action_EditItem;

sub ItemList {
    my $self = shift;  my $basedir = shift;
    my $fh = Symbol::gensym();
    opendir($fh, $basedir) || die "Failed to open directory $basedir: $!";
    my @items = map { (/^(.*)\.cfg$/  and  -f File::Spec->catfile($basedir, $_))
			  ? $1 : () } readdir($fh);
    closedir($fh);
    @items;
}

sub Action_ModifyItem {
    my $self = shift; my $wiz = shift; my $button = shift;
    my $action = shift; my $descr = shift; my $key = shift;
    $key ||= $self->GetKey();
    $self->init();
    my @ret = $self->getFileDir();

    my @items = $self->ItemList($ret[2]);
    return $self->Action_Reset($wiz) unless @items;
    # Return the initial menu.
    (['Wizard::Elem::Title', 'value' => "Apache $descr Selection"],
     ['Wizard::Elem::Select', 'options' => \@items, 'name' => 'apache-' . $key,
      'descr' => 'Select a directory'],
     ['Wizard::Elem::Submit', 'value' => $button, 'name' => $action,
      'id' => 1]);

}

sub Action_ModifyHost {
    my $self = shift;
    $self->Action_ModifyItem(shift, shift || 'Modify host',
			     shift || 'Action_EditHost', 'Host');
}

sub Action_DeleteHost {
    my($self, $wiz) = @_;
    $self->Action_ModifyHost($wiz, 'Delete this host', 'Action_DeleteHost2');
}

sub Action_ServerMenu {
    my($self, $wiz) = @_;
    $self->Action_ModifyHost($wiz, 'Manage servers on this host',
			     'Wizard::Examples::Apache::Server::Action_Enter');
}

sub Action_DeleteHost2 {
    my $self = shift; my $wiz = shift;
    my ($prefs, $basedir) = $self->init();
    $self->Load($wiz);
    my $host = $self->{'host'};
    my ($file, $dir, $odir) = $self->getFileDir();

    (['Wizard::Elem::Title', 'value' => 'Deleting an Apache host'],
     ['Wizard::Elem::Link', 'action'=> 'DeleteHost'],
     ['Wizard::Elem::Data', 'descr' => 'Host name',
      'value' => $host->{'apache-host-name'}],
     ['Wizard::Elem::Data', 'descr' => 'Host description',
      'value' => $host->{'apache-host-descr'}],
     ['Wizard::Elem::Data', 'descr' => 'Host architecture',
      'value' => $host->{'apache-host-arch'}],
     ['Wizard::Elem::Data', 'descr' => 'Hosts DNS name',
      'value' => $host->{'apache-host-ip'}],
     ['Wizard::Elem::Submit', 'value' => 'Yes, delete it',
      'id' => 1, 'name' => 'Action_DeleteHost3'],
     (-d $dir ? ['Wizard::Elem::Submit',
		 'value' => 'Yes, delete it, including data directory',
		 'id' => 2, 'name' => 'Action_DeleteHost4'] : ()),
     ['Wizard::Elem::Submit', 'value' => 'Return to Host Menu',
      'id' => 98, 'name' => 'Action_Reset'],
     ['Wizard::Elem::Submit', 'value' => 'Return to Top Menu',
      'id' => 99, 'name' => 'Wizard::Examples::Apache::Action_Reset']);
}

sub DeleteItem {
    my $self = shift; my $wiz = shift; my $dirs = shift;
    $self->init(1); my $key = $self->GetKey();
    my($file, $dir) = $self->getFileDir();
    my $item = delete $self->{$key} or die "Missing $key";
    unlink $file or die "Failed to remove $file: $!";
    if (-d $dir and $dirs) {
	require File::Path;
	File::Path::rmtree([$dir]);
	die "Failed to remove directory $dir: $!" if -d $dir;
    }
    $self->Store($wiz);
}

sub Action_DeleteHost3 {
    my($self, $wiz) = @_;
    $self->DeleteItem($wiz);
    $self->Action_Reset($wiz);
}

sub Action_DeleteHost4 {
    my($self, $wiz) = @_;
    $self->DeleteItem($wiz, 1);
    $self->Action_Reset($wiz);
}