view release on metacpan or  search on metacpan

Pgreet/Config.pm  view on Meta::CPAN

	 imagedir => ['is_directory'],
	 datadir => ['is_directory'],
	 confdir => ['is_directory'],
	 templatedir => ['is_directory'],
	 tmpdir => ['is_directory'],
	 scheduled_mail_queue => ['is_directory'],
	 pgreet_uid => ['want_int', ['num_min' => 1], 'existing_uid'],
	 pgreet_gid => ['want_int', ['num_min' => 1], 'existing_gid'],
	 Timeout => ['want_int', ['num_min' => 1]],
	 MaxRuns  => ['want_int', ['num_min' => 1]],
	 SMTP_server =>
	     {SMTP_Timeout => ['want_int', ['num_min' => 1]],
		 },
	 today_pause => ['want_int', ['num_min' => 1]],
	 batch_pause => ['want_int', ['num_min' => 1]],
	 batch_send_hour => ['want_int', ['num_min' => 0]],
	 delete_state => ['want_int', ['num_min' => 1]],
	 flush_pause => ['want_int', ['num_min' => 1]],
	 purge_pause => ['want_int', ['num_min' => 1]],
	 purge_db_hour => ['want_int', ['num_min' => 0]],
	 reload_config => ['want_int', ['num_min' => 1]],
	 PID_path => ['is_directory'],
	);


############### Extensions to String::Checker #################

String::Checker::register_check("is_directory",
#
# Test if this parameter is an existing local directory
#
        sub {
		     my($s) = shift;
			 if ((defined($$s)) && (not -d $$s)) {
			   return 1;
			 }
			 return undef;
		   }
);

String::Checker::register_check("num_min",
#
# Test if this parameter is greater than numerical lower bound
#
        sub {
		     my($s) = shift;
			 my($t) = shift;
			 if ((defined($$s)) && (not ($t <= $$s))) {
			   return 1;
			 }
			 return undef;
		   }
);

String::Checker::register_check("existing_uid",
#
# Test if this parameter is an existing user ID number
#
        sub {
		     my($s) = shift;
			 if ((defined($$s)) && (not getpwuid($$s))) {
			   return 1;
			 }
			 return undef;
		   }
);


String::Checker::register_check("existing_gid",
#
# Test if this parameter is an existing group ID number
#
        sub {
		     my($s) = shift;
			 if ((defined($$s)) && (not getgrgid($$s))) {
			   return 1;
			 }
			 return undef;
		   }
);


########################### METHODS ###########################

sub new {
#
# Traditional empty contructor.
# Assign values needed by
# particular instances of object
#
  my $class = shift;
  my $config_file = shift;
  my $Pg_error = shift;
  my $default_config = shift;
  my $no_merge = shift;

  my $self = {};
  bless $self, $class;
  my $default_config_hash = {};
  my $config_hash = {};
  my $cache_conf;

  # Have we cached this secondary ecard site already? - if so just return it.
  if ($default_config and
	  ($cache_conf = $default_config->fetch_cache_site($config_file))
	 ) {
	return($cache_conf);

  # Otherwise we need to construct new object and read data from a file.
  } else {
	# If we have an existing Error object, bind that to object.
	if (defined($Pg_error)) {
	  $self->{'Pg_error'} = $Pg_error;
	}

	# Set value of configuration file and read data
	$self->{'config_file'} = $config_file;
	$config_hash = $self->_read_config_file($config_file);

	# Do we have a default configuration to merge into this object?
	if(defined($default_config)) {