view release on metacpan or  search on metacpan

lib/CfgTie/TieRCService.pm  view on Meta::CPAN

   $R;
}

sub scan_rcscript($)
{
   my $self=shift;
   my $F = new Secure::File "<".$self->{'path'};
   while (<$F>)
    {
       if (/^\s*\#\s*chkconfig\s*:\s*(\d+)/i) 
         {
	    my @A=(0,0,0,0,0,0,0,0,0,0);
            for (my $I=0; $I< length $1; $I++)
             {$A[substr($1,$I,1)]=1;}
	    $self->{defaults}=\@A;
         }
       elsif (/^\s*\#\s*description\s*:\s*([^\s].*)$/i)
         {
	    my $A=$1;
	    #read the continuation in as neccessary
	    while ($A=~/\\\s*$/)
	     {
		$A=~s/\s*\\\s*$//;
	        my $B =<$F>;
	        if ($B=~/#\s*([^\s].*)$/i) {$A.=' '.$1;}
	     }
	    $self->{description}=$A;
         }
    }
   $F->close();
}

sub TIEHASH
{
   my ($self,$name,$levels)=@_;
   my $Node =
 	{
	    levels=>$levels,'name'=>$name,
	};

   return bless $Node, $self;
}

sub proc_id($)
{
   my $key = shift;

   if (!defined $key || !-e "/var/run/$key.pid") {return undef;}

   #use the canonically process ID
   my $F = new Secure::File "</var/run/$key.pid" or return undef;
   my ($I,$pid);
   while (<$F>)
    {
       if (/^(\d+)$/) {$pid=$1;}
    }
   $F->close;
   return $pid;
}

sub _stat($)
{
   my $self=shift;
   if (!defined $self) {return undef;}
   return stat("/var/run/".$self->{'name'}.".pid");
}

sub EXISTS ($$)
{
   my ($self,$key)=@_;
   my $lkey=lc($key);
   if (exists $self->{$lkey}) {return 1;}
   if ($lkey eq 'pid')
     {
        my $pid = proc_id($self->{'name'});
        if (defined $pid)
	  {
	      $self->{pid} =$pid;
	      return 1;
          }
     }
   elsif ($lkey eq 'path')
    {
       my $Path="/etc/rc.d/init.d/";
       my $A;
       if (-e $Path) {$A = scan_for_script($self->{'name'},$Path);}
       if (!defined $A)
	 {
	    $Path="/etc/init.d/";
            if (-e $Path) {$A = scan_for_script($self->{'name'},$Path);}
            if (!defined $A) {return 0;}
         }
       $self->{path}=$Path.'/'.$A;
       return 1;
    }
   elsif ($lkey eq 'description' || $lkey eq 'defaults')
    {
       if (!exists $self->{path}) {EXISTS($self,'path');}
       if (!exists $self->{path}) {return 0;}
       scan_rcscript($self);
       return exists $self->{$lkey};
    }
   elsif ($lkey eq 'stat')
     {
        my @A= _stat($self);
        if (scalar @A) {$self->{'stat'}=[@A]; return 1;}
     }
   return 0;
}

sub FIRSTKEY
{
    EXISTS($_[0],'pid');
   my $a = keys %{$_[0]};
   return scalar each %{$_[0]};
}

sub NEXTKEY
{return scalar each %{$_[0]};}

sub FETCH
{
   my ($self,$key)=@_;
   my $lkey =lc($key);
   if (EXISTS($self,$lkey)) {return $self->{$lkey};}
   undef;
}

sub trx   {CfgTie::Cfgfile::trx(@_);}
sub table {CfgTie::Cfgfile::table(@_);}
sub HTML ($)
{
   my $self=shift;
   #Levels it currently is in
   #Description
    EXISTS($self, 'description');
   #Defaults
    EXISTS($self, 'defaults');
   #Name
   #Process Id
    EXISTS($self, 'pid');
    EXISTS($self, 'stat');

   #Set up the current run levels and their default settings:
   my $A= table(undef,
		trx('Levels:',@{$self->{levels}}).
		trx('Defaults:', @{$self->{defaults}}),
		10);

   table("Run levels",
   "<tr><th>Service</th><th>0</th><th>1</th><th>2</th><th>3</th><th>4</th>".
   "<th>5</th><th>6</th><th>7</th><th>8</th></tr>\n$A",10);

   my $B='';
   if (exists $self->{'pid'}) {$B.= trx("Process Id:", $self->{'pid'});}
   if (exists $self->{'stat'})
     {
	$B.= trx("Started on:",
		POSIX::strftime("%a %b %e %H:%M:%S %Y",
				localtime($self->{'stat'}->[9])));
     }
   
   table($self->{'name'},
	 trx("Name:",       $self->{'name'}).
	 trx("Description:",$self->{'description'}).