view release on metacpan or  search on metacpan

Framework.pm  view on Meta::CPAN

		) || do {
			$errstr = "new: can't load secure config: $self->{'errstr'}";
			return (undef);
		};
	}
	
	#weed out descriptors under Secure namespace
	#ugly hack
	foreach (keys %{$self->{'Secure'}}){
		if (ref ($self->{'Secure'}->{$_}) eq "HASH"){
			if (exists($self->{'Secure'}->{$_}->{'content'})){
				$self->{'Secure'}->{$_} = $self->{'Secure'}->{$_}->{'content'};
			}
		}
	}
	
	#send back the constructed object
	return ($self);
}



## True for perl include ##########################
 1;
__END__
## AutoLoaded Methods 

## LoadXMLConfig ##################################
sub LoadXMLConfig {
	my ($self, %p) = @_;
	
	#File is a required option
	exists($p{'File'}) || do {
		$self->{'errstr'} = "LoadXMLConfig: 'File' is a required option";
		return (undef);
	};
	
	#check that the specified file exists
	(-e $p{'File'}) || do {
		$self->{'errstr'} = "LoadXMLConfig: specified file ($p{'File'}) does not exist";
		return (undef);
	};
	
	#open da file
	open (INFILE,"$p{File}") || do {
         $self->{'errstr'} = "LoadXMLConfig: can't open specified file ($p{'File'}) / $!";
         return (undef);
     };
     
     #flatten it into a big 'ol string
     my $data = join ('',<INFILE>);
     
     #at this point we're done with the filehandle
     close (INFILE);
     
     #if the file type was binary, we can presume it's encrypted
     if (-B $p{'File'}){
     	#use global key and crypt unless otherwise specified
		foreach ('Key','Crypt'){ $p{$_} = $self->{$_} unless exists($p{$_}); }
		#get the cipher
		require Crypt::CBC;
		my $cipher = new Crypt::CBC($p{'Key'},$p{'Crypt'});
		#decrypt the data
		$data = $cipher->decrypt($data);
	}
	
	#get a Data::DumpXML::Parser parser object unless we have one already
	exists($self->{'DDXMLParser'}) || do {
		$self->{'DDXMLParser'} = Data::DumpXML::Parser->new;
	};
	
	#parse it
	my $info = $self->{'DDXMLParser'}->parsestring($data) || do {
		$self->{'errstr'} = "LoadXMLConfig: failed to parse XML data from $p{'File'} / $!";
		return (undef);
	};
	
	#if there's only one element just return it
     if ($#{$info} == 0){
         return ($info->[0]);
     }else{
         return ($info);
     }
}


## LoadConfig #####################################
sub LoadConfig {
	my ($self, %p) = @_;
	
	#File is a required option
	exists($p{'File'}) || do {
		$self->{'errstr'} = "LoadConfig: 'File' is a required option";
		return (undef);
	};
	
	#find the file
	(-e $p{'File'}) || do {
		#if it exists under config_loc use that
		if (-e "$self->{'v_root'}/$self->{'config_loc'}/$p{'File'}"){
			$p{'File'} = "$self->{'v_root'}/$self->{'config_loc'}/$p{'File'}";
		#otherwise if it exists under the FrameworkDir, use that
		}elsif (-e "$self->{'FrameworkDir'}/$p{'File'}"){
			$p{'File'} = "$self->{'FrameworkDir'}/$p{'File'}";
		#other-otherwise if it exists in the user's home directory, use that
		}elsif (-e "$ENV{'HOME'}/$p{'File'}"){
			$p{'File'} = "$ENV{'HOME'}/$p{'File'}";
		#else there's a problem
		}else{
			$self->{'errstr'} = "LoadConfig: can't find the file $p{'File'}";
			return (undef);
		}
	};
	
	#load it up
	my $data = $self->LoadXMLConfig(%p) || do {
		$self->{'errstr'} = "LoadConfig: $self->{'errstr'}";
		return (undef);
	};
	
	#if the file dosen't define a config namespace ...
	exists($data->{'configNamespace'}) || do {

Framework.pm  view on Meta::CPAN

			) || do {
				$self->{'errstr'} = "LoadConfig: failed to load child config ($_) for parent ($data->{'configNamespace'}) $self->{'errstr'}";
				return (undef);
			};
		}
	}
	
	#'tis all good
	return (1);
}


## WriteConfig ####################################
# store values under a given namespace to a file.
sub WriteConfig {
	my ($self, %p) = @_;
	
	#configNamespace is a required option
	exists($p{'configNamespace'}) || do {
		$self->{'errstr'} = "WriteConfig: 'configNamespace' is a required option.";
		return (undef);
	};
	
	#dump given namespace down to xml
	my $xml_data = Data::DumpXML::dump_xml($self->{$p{'configNamespace'}});
	
	#if 'File' is specified, use that, otherwise use the file in _ConfigMap
	exists($p{'File'}) || do {
		exists($self->{'_ConfigMap'}->{$p{'configNamespace'}}) || do {
			$self->{'errstr'} = "WriteConfig: 'File' is not specified, and I can't find a file in _ConfigMap! ";
			$self->{'errstr'}.= "I don't know where to write this data!";
			return (undef);
		};
		$p{'File'} = $self->{'_ConfigMap'}->{$p{'configNamespace'}};
	};
	
	#since (presumably) anything in _ConfigMap is garanteed to exist, then we can use
	#the same file precedence matching as LoadConfig!!! 'cept this time we're checking
	#for writeability.
	#find the file
	(-w $p{'File'}) || do {
		#if it exists under config_loc use that
		if (-w "$self->{'v_root'}/$self->{'config_loc'}/$p{'File'}"){
			$p{'File'} = "$self->{'v_root'}/ $self->{'config_loc'}/$p{'File'}";
		#otherwise if it exists under the FrameworkDir, use that
		}elsif (-w "$self->{'FrameworkDir'}/$p{'File'}"){
			$p{'File'} = "$self->{'FrameworkDir'}/$p{'File'}";
		#other-otherwise if it exists in the user's home directory, use that
		}elsif (-w "$ENV{'HOME'}/$p{'File'}"){
			$p{'File'} = "$ENV{'HOME'}/$p{'File'}";
		#not having a file at all isn't a problem here, it might be new!
		}
	};
	
	#ok check if the file is binary, if it is, or if the 'Encrypt' option is set
	#then we need to encrypt it before we write it.
	if ((-B $p{'File'}) || ($p{'Encrypt'})){
		#use global key and crypt unless otherwise specified
		foreach ('Key','Crypt'){ $p{$_} = $self->{$_} unless exists($p{$_}); }
		#get the cipher
		require Crypt::CBC;
		my $cipher = new Crypt::CBC($p{'Key'},$p{'Crypt'});
		$xml_data = $cipher->encrypt($xml_data);
	}
	
	#dump it down to the file
	open (OUTFILE, ">$p{'File'}") || do {
		$self->{'errstr'} = "WriteConfig: can't open file ($p{'File'}) for writing $!";
		return (undef);
	};
	print OUTFILE $xml_data ;
	close (OUTFILE);
	return (1);
}


## AlertAdmin #####################################
sub AlertAdmin {
	my ($self, %p) = @_;
	
	#Message is requred
	exists($p{'Message'}) || do {
		$self->{'errstr'} = "AlertAdmin: 'Message' is a required option";
		return (undef);
	};
	
	#default 'To' is the admin
	exists($p{'To'}) || do {
		push (@{$p{'To'}}, $self->{'admin'});
	};
	
	#fix stringy 'To''s to work with arrayified ones
	if ((exists($p{'To'})) && (ref($p{'To'}) ne "ARRAY")){
		my $temp = $p{'To'};
		delete($p{'To'});
		push(@{$p{'To'}}, $temp);
	}
	
	#if we're in debug mode, just print the message to stdout and be done
	if ($self->{'debug'}){
		print $p{'Message'}, "\n";
		return (1);
	}
	
	#open sendmail pipe
	open (SENDMAIL, "|$self->{sendmail} -oi -t -fnobody") || do {
		#can't open sendmail, spew message to v_root/var/last_resort.log
		open (LAST_RESORT, ">>$self->{'v_root'}/var/log/last_resort.log") || do {
			print "AlertAdmin: can't open sendmail or last_resort.log $p{'Message'}\n";
			return (undef);
		};
		my $time = time();
		print LAST_RESORT "[$time]: can't open sendmail! $p{'Message'}\n";
		close (LAST_RESORT);
	};
	
	#give sendmail the message
	print SENDMAIL "From: nobody ($self->{'program'})\n";
	print SENDMAIL "To: ", join (', ', @{$p{'To'}}), "\n";
	print SENDMAIL "Subject: Auto-generated Alert from: $self->{program}\n";
	print SENDMAIL "Reply-To: nobody\n";
    print SENDMAIL "Errors-To: nobody\n\n";