view release on metacpan or  search on metacpan

lib/Config/Writer.pm  view on Meta::CPAN

=item B<overwrite> = BOOLEAN

Existing backup file will be either overwritten if the flag is set to true
(overwrite = 1) or stayed untouched (overwrite = 0). E. g. if you choose to
store single backup per day, you'll get either the latest configuration version
before it being updated, or the configuration you've got at the beginning of the
day.

Default is 0.

=item B<extension> = STRING

Configuration file backup extension format as described in POSIX strftime function
documentation. The new extension will replace original one, so the backup files
should not be loaded even in case wildcards (e. g. 'B<*.conf>') are used to include
configuration from a several files. Existing backup files will either stay untouched
or overwritten depending on B<overwrite> flag value.

Default is '-%Y-%m-%d'.

=item B<owner> = STRING

Configuration file owner name. If file owner can not be changed, error flag is set.

Defaults to process EUID.

=item B<group> = STRING

Configuration file group name. If not provided, process EGID is used.

=item B<permissions> = OCTAL

Configuration file permissions in numeric format. Read B<chmod(1)> manual for
details.

Default is 0600.

=back

=back

=cut #}}}

    my $self = bless { 'error' => boolean::false }, __PACKAGE__;
    my @filename = File::Basename::fileparse $filename, qw(.cfg .conf .json .yaml), '';
    $self->{'filename'} = $filename[0];
    $self->{'retain'} = (defined $options->{'retain'} and $options->{'retain'} =~ /^\d+$/)
        ? $options->{'retain'} + 0
        : 0;
    $self->{'overwrite'} = (defined $options->{'overwrite'} and $options->{'overwrite'} =~ /^1$/)
        ? boolean::true
        : boolean::false;
    $self->{'extension'} = (defined $options->{'extension'} and $options->{'extension'} !~ m|/|)
        ? $options->{'extension'}
        : '-%Y-%m-%d';
    $self->{'owner'} = defined $options->{'owner'}
        ? (getpwnam $options->{'owner'})[2]
        : $>;
    $self->{'group'} = defined $options->{'group'}
        ? (getpwnam $options->{'group'})[3]
        : (getpwuid $self->{'owner'})[3];
    $self->{'permissions'} = (defined $options->{'permissions'} and $options->{'permissions'} =~ /^\d+$/)
        ? $options->{'permissions'}
        : 0600;
    if ($filename =~ m|^/|) {
        $self->{'workdir'} = Cwd::realpath((File::Basename::fileparse $filename)[1]);
    } else {
        $self->{'workdir'} = (defined $options->{'workdir'} and -d $options->{'workdir'})
            ? $options->{'workdir'}
            : Cwd::getcwd;
        $self->{'workdir'} = Cwd::realpath($self->{'workdir'} . '/' . $filename[1]);
    }
    unless (defined $self->{'workdir'}) {
        $self->{'error'} = boolean::true;
        return $self;
    }
    $self->{'fullname'} = $self->{'workdir'} . '/' . $self->{'filename'} . $filename[2];
    untaint $self->{'filename'} if tainted $self->{'filename'};
    untaint $self->{'fullname'} if tainted $self->{'fullname'};
    untaint $self->{'workdir'} if tainted $self->{'workdir'};
    $self->{'fh'} = File::Temp->new(
        'TEMPLATE' => $self->{'filename'} . '.XXXXXX',
        'DIR'      => $self->{'workdir'},
        'PERMS'    => $self->{'permissions'},
        'UNLINK'   => 0,
        'EXLOCK'   => 1
    );
    unless (defined $self->{'fh'}) {
        $self->{'error'} = boolean::true;
        return $self;
    }
    $self->{'fh'}->autoflush(1);
    $self->{'tmpfile'} = $self->{'fh'}->filename;
    untaint $self->{'tmpfile'} if tainted $self->{'tmpfile'};
    chown($self->{'owner'}, $self->{'group'}, $self->{'tmpfile'}) or $self->{'error'} = boolean::true;
    return $self;

} #}}}

sub error :prototype($) ($self = undef) {
    #{{{

=pod #{{{ error() method description

=over 4

=item B<error()>

Takes no arguments. Returns `false` if B<Config::Writer> object is
defined and `error` flag is not set and `true` otherwise.

=back

=cut #}}}

    return (defined $self and isFalse $self->{'error'})
        ? boolean::false
        : boolean::true;

} #}}}