File Coverage

blib/lib/Csistck.pm

Criterion	Covered	Total	%
statement	82	98	83.6
branch	12	24	50.0
condition	3	15	20.0
subroutine	20	21	95.2
pod	3	4	75.0
total	120	162	74.0

package Csistck;

use 5.010;
use strict;
use warnings;

our $VERSION = '0.1003';

# We export function in the main namespace
use base 'Exporter';
our @EXPORT = qw(
    host
    role
    check
    option

    file
    noop
    pkg
    script
    template
);

# Imports for base
use Csistck::Config qw/option/;
use Csistck::Test::NOOP qw/noop/;
use Csistck::Test::File qw/file/;
use Csistck::Test::Pkg qw/pkg/;
use Csistck::Test::Script qw/script/;
use Csistck::Test::Template qw/template/;

use Csistck::Role;
use Csistck::Term;

use Sys::Hostname::Long qw//;
use Data::Dumper;
use Scalar::Util qw/blessed reftype/;
use List::Util qw/sum/;

# Package wide
my $Hosts = {};
my $Roles = {};


=head1 NAME

Csistck - Perl system consistency check framework

=head1 SYNOPSIS

    use Csistck;

    sub sig_hup_mysql { $ENV{'MAINT_HUP_MYSQL'} = 1; }

    for (qw/a b/) {
        host "$_.example.com" => role('mysql');
    }

    host 'c' => role('mysql');

    role 'mysql' =>
        pkg({
            dpkg => 'mysql-server',
            emerge => 'mysql'
        }),
        template(
            '/etc/mysql/my.cnf',
            src => 'mysql/my.cnf',
            mysql => {
                bind => '127.0.0.1',
                keysize => '1G'
            },
            mode => '0644',
            uid => 100,
            gid => 100,
            on_restart => \&sig_hup_mysql
        ),
        script('services.sh');

    check;

The script can then be called directly, using command line arguments below

=head1 DESCRIPTION

Csistck is a small Perl framework for writing scripts to maintain system
configuration and consistency. The focus of csistck is to stay lightweight,
simple, and flexible.

=head1 EXTENDING ROLES

Roles can be defined using the C keyword syntax, however a more flexible
method is to extend a new object from L:

    use Csistck;
    use base 'Csistck::Role';

    sub defaults {
        my $self = shift;
        $self->{config} = '/etc/example.conf';
    }

    sub tests {
        my $self = shift;
        $self->add(pkg({
            dpkg => 'test-server',
            pkg_info => 'net-test'
        }),
        template(
            $self->{config},
            src => 'files/example.conf',
            example => $self
        );

    }

    1;

See L for information on extending roles


=head1 METHODS


=head2 host($host, $checks)

Add tests to host C<$host> test array. Tests are Csistck::Test blessed references, code
references, or arrays of either. To process host tests, use C.

=cut

sub host {
    my $hostname = shift;

    # Add domain if option is set?
    my $domain_name = Csistck::Config::option('domain_name');
    $hostname = join '.', $hostname, $domain_name
      if (defined $domain_name);

    while (my $require = shift) {
        push(@{$Hosts->{$hostname}}, $require);
    }

    return $Hosts->{$hostname};
}

=head2 role($role, $checks)

Define a weak role. Constructed similar to a host check, however roles are not
called directly, rather they are used to define groups of common tests that can
be used by multiple hosts.

See L above for an object-based style of defining roles, which
allows for passing role configuration.

=cut

sub role {
    my $role = shift;

    # If tests specified, add now
    while (my $require = shift) {
        push(@{$Roles->{$role}}, $require);
    }

    return sub {
        # Run required role or die
        die ("What's this, \"${role}\"? That role is bupkis.")
          unless (defined $Roles->{$role});

        process($Roles->{$role});
    }
}

=head2 check($target)

Runs processing on C<$target>. If C<$target> is C, then look up the
system's full hostname. If C<$target> is a string, use that string for a
hostname lookup. If C<$target> is a C reference, a coderef, or an
arrayref, then process that object directly. This is useful for writing scripts
where hostname is not important.

=cut

sub check {
    my $target = shift // Sys::Hostname::Long::hostname_long();

    # Process cli arguments for mode/etc, usage
    Csistck::Oper::set_mode_by_cli();
    return if (Csistck::Oper::usage());

    # Role names specified on the command line via --role have priority. If
    # target is a string, process as hostname reference. Otherwise, assume a
    # test object was passed
    if (scalar @{$Csistck::Oper::Roles} gt 0) {
        return process(
            map { role($_) } @{$Csistck::Oper::Roles}
        );
    }
    elsif (!defined(reftype($target))) {
        die ("What's this, \"${target}\"? That host is bupkis.")
          unless (defined $Hosts->{$target});
        return process($Hosts->{$target});
    }
    else {
        return process($target);
    }
}

# For recursive testing based on type
sub process {
    my $obj = shift;

    # Iterate through array and recursively call process, call code refs,
    # and run tests

    given (ref $obj) {
        when ('ARRAY') {
            return map(process($_), @{$obj});
        }
        when ('CODE') {
            return &{$obj};
        }
        default {
            if (blessed($obj) and $obj->isa('Csistck::Test')) {
                # Check is mandatory, if auto repair is set, repair, otherwise prompt
                my $check = $obj->execute('check');
                return if ($check->passed);

                if (Csistck::Oper::repair()) {
                    my $repair = $obj->execute('repair');
                    if ($repair->passed and $obj->on_repair) {
                        &{$obj->on_repair};
                    }
                    return $repair;
                }
                else {
                    my $repair = Csistck::Term::prompt($obj);
                    if ($repair->passed and $obj->on_repair) {
                        &{$obj->on_repair};
                    }
                    return $repair;
                }
            }
            elsif (blessed($obj) and $obj->isa('Csistck::Role')) {
                return process($obj->get_tests);
            }
            else {
                die(sprintf("Unkown object reference: ref=<%s>", ref $obj));
            }
        }
    }
}

1;
__END__