view release on metacpan or  search on metacpan

MailBot/IniConf.pm  view on Meta::CPAN

package MailBot::IniConf;  # modified from Hutton's original IniConf.  --rhn
# package IniConf;

# below is original copyright notice.  --rhn

# AUTHOR

#  Scott Hutton (shutton@indiana.edu)

# COPYRIGHT

# Copyright (c) 1996 Scott Hutton. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.

# patched 1/97.  --rhn

require 5.002;
# $VERSION = 0.91;

use strict;
use Carp;
use vars qw( $VERSION @instance $instnum @oldhandler @errors );


#
# Package variables
#
@instance = ( );
$instnum  = 0;
@oldhandler =  ( );
@errors = ( );


sub new {
  my $class = shift;
  my %parms = @_;

  my $errs = 0;
  my @groups = ( );

  my $self           = {};
  $self->{cf}        = '';
  $self->{firstload} = 1;
  $self->{default}   = '';

  # Parse options
  my($k, $v);
  local $_;
  while (($k, $v) = each %parms) {
    if ($k eq '-file') {
      $self->{cf} = $v;
    }
    elsif ($k eq '-reloadsig') {
      $v =~ s/^SIG//;
      $self->{reloadsig} = uc($v);
    }
    elsif ($k eq '-default') {
      $self->{default} = $v;
    }
    elsif ($k eq '-nocase') {
      $self->{nocase} = $v ? 1 : 0;
    }
    elsif ($k eq '-reloadwarn') {
      $self->{reloadwarn} = $v ? 1 : 0;
    }
    else {
      carp "Unknown named parameter $k=>$v";
      $errs++;
    }
  }

  croak "must specify -file parameter for new $class" 
    unless $self->{cf};

  return undef if $errs;

  # Set up a signal handler if requested
  my($sig, $oldhandler, $newhandler);
  if ($sig = $self->{reloadsig}) {
    $oldhandler[$instnum] = $SIG{$sig};
    $newhandler = "${class}::SigHand_$instnum";
    my $toeval = <<"EOT";

	sub $newhandler {
	  \$SIG{$sig} = 'IGNORE';
	  \$${class}::instance[$instnum]->ReadConfig;
	  if (\$oldhandler[$instnum] && \$oldhandler[$instnum] ne 'IGNORE') {
	    eval '&$oldhandler[$instnum];';
	  }
	  \$SIG{$sig} = '$newhandler'
	}

EOT
    
    eval $toeval;
  }

  bless $self, $class;

  $instance[$instnum++] = $self;

  if ($self->ReadConfig) {
    $SIG{$sig} = $newhandler if $sig;
    return $self;
  } else {
    return undef;
  }
}


sub val {
  my $self = shift;
  my $sect = shift;
  my $parm = shift;

  if ($self->{nocase}) {
    $sect = lc($sect);
    $parm = lc($parm);
  }
#   my $val = $self->{v}{$sect}{$parm} || $self->{v}{$self->{default}}{$parm};
  my $val = $self->{v}{$sect}{$parm};  # --rhn
  if (ref($val) eq 'ARRAY') {
    return wantarray ? @$val : join($/, @$val);
  } else {
    return $val;
  }
}

sub setval {
  my $self = shift;
  my $sect = shift;
  my $parm = shift;
  my @val  = @_;

  if (defined($self->{v}{$sect}{$parm})) {
    if (@val > 1) {
      $self->{v}{$sect}{$parm} = \@val;
    } else {
      $self->{v}{$sect}{$parm} = shift @val;