view release on metacpan or  search on metacpan

Backup/Snapback.pm  view on Meta::CPAN

sub error {
	my $self = shift;
	my ($msg, @args);
	if(ref $self) {
		($msg, @args) = @_;
	}
	else {
		($msg, @args) = ($self, @_);
		undef $self;
	}

	$msg = sprintf($msg, @args) if @args;

	$ERROR = $errstr = $msg;
	if($self) {
		$self->{_errstr} = $msg;
	}
	return $msg;
}

=item errstr

Called as either an object method:

	$self->errstr;

or as a class method:

	Backup::Snapback::errstr;

Returns the most recent error text.

=cut

sub errstr {
	my $self = shift;
	$self and return $self->{_errstr};
	return $errstr;
}

## Internal
sub is_yes {
	my $val = shift;
	$val = lc $val;
	$val =~ s/\W+//g;
	my %true = qw(
		y      1
		yes    1
		on     1
		true   1
		1      1
	);
	$val = $true{$val} || 0;
	return $val;
}

=item config

Gets or sets configuration parameters. The base is set in hardcoded
program defaults; it then is overlayed with the configuration file results.
If a configuration block is entered, those settings override the parent
configuration block. Finally, internal setting can be done, temporarily
overriding configuration file settings (because of option dependencies).

    my $compress = $snap->config(-Compress);

	# turn off compression
	$snap->config( Compress => No);

Some options are boolean, and some accept the special value 'none' to
set them empty.

Parameter names are not case-sensitive.

=cut

sub config {
	my $self = shift;
	my $parm = shift;
	my $value = shift;

	$parm = lc $parm;
	$parm =~ s/^-//;

	my $sc  = $self->{_client_config} || $self->{_config};
	my $cfg = $self->{_cfg}           || $self->{_maincfg};

	if(defined $value) {
		$sc->{$parm} = $value;
		return $value;
	}

	my @vals;

	if(defined $sc->{$parm}) {
		if(ref $sc->{$parm} eq 'ARRAY') {
			@vals = @{$sc->{parm}};
		}
		else {
			@vals = $sc->{$parm};
		}
	}
	else {
		@vals = $cfg->get($parm);
	}

	my $num = scalar(@vals);
	my $val;

	if($num == 0) {
		$val = $Defaults{$parm};
	}
	elsif(@vals == 1) {
		$val = $vals[0];
	}
	elsif(wantarray) {
		return @vals;
	}
	else {
		$val = \@vals;