source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts.pm @ 989

package LATMOS::Accounts;

use 5.010000;
use strict;
use warnings;
use base qw(Config::IniFiles);
use LATMOS::Accounts::Bases;
use LATMOS::Accounts::Synchro;
use LATMOS::Accounts::SynchAccess;
use LATMOS::Accounts::Log;
use LATMOS::Accounts::Acls;

our $VERSION = '2.0.6';

=head1 NAME

LATMOS::Accounts - Core module for LATMOS account management tools

=head1 DESCRITPTION

=cut

sub _configdir {
   my ($self) = @_;
   ($self || {})->{_configdir} || '/etc/latmos-accounts'
}

=head1 FUNCTION

=head2 new($configdir)

Instanciate a new LATMOS::Accounts object.

$configdir if defined is the directory containing files to use,
default to F</etc/latmos-accounts/>.

=cut

sub new {
    my ($class, $config, %options) = @_;

    $config ||= _configdir();
    my $oldconfig ||= '/etc/latmos-account.ini';

    # If config file not found, fallback to old one
    my $configfile = -f join('/', $config, 'latmos-accounts.ini')
        ? join('/', $config, 'latmos-accounts.ini')
        : '/etc/latmos-account.ini';

    my $self = Config::IniFiles->new(
        -file => $configfile,
        '-default' => '_default_',
    ) or do {
        la_log(LA_ERR, 'Can\'t open main config file %s', $configfile);
        return;
    };

    $self->{_configdir} = $config;
    bless($self, $class);

    if (!$options{noacl}) {
        if ($self->val('_default_', 'acls')) {
            $self->{_acls} = LATMOS::Accounts::Acls->new(
                $self->val('_default_', 'acls')
            ) or do {
                la_log(LA_ERR,
                    'Cannot load ACL file %s', $self->val('_default_', 'acls')
                );
                return;
            };
        } elsif (-f (my $aclf = join('/', $self->_configdir, 'la-acls.ini'))) {
            $self->{_acls} = LATMOS::Accounts::Acls->new($aclf) or do {
                la_log(LA_ERR, 'Cannot load ACL file %s', $aclf);
                return;
            };
        }
    }

    if ($self->val('_default_', 'allowed_values')) {
        $self->{_allowed_values} = Config::IniFiles->new(
            -file => $self->val('_default_', 'allowed_values'),
        ) or do {
            la_log(LA_ERR, 'Cannot load ALLOWED VALUES %s',
                $self->val('_default_', 'allowed_values'));
            return;
        };
    } elsif (-f (my $allowf = join('/', $self->_configdir,
                'la-allowed-values.ini'))) {
        $self->{_allowed_values} = Config::IniFiles->new(
            -file => $allowf,
        ) or do {
            la_log(LA_ERR, 'Cannot load ALLOWED VALUES %s', $allowf);
            return;
        };
    }

    $self
}

sub call_batch_sync {
    my ($self) = @_;
    if (my $sd = $self->val('_default_', 'state_dir')) {
        if (open(my $fh, '<', $sd . '/sync-manager.pid')) {
            my $pid = <$fh> || '';
            chomp($pid);
            close($fh);
            if ($pid && kill 1, $pid) {
                return 1; # \o/ we succeed
            } else {
                la_log(LA_ERR, "Can send signal -1 to la-sync-manager (pid: %s, %s)",
                    $pid || 'none', $!);
                return;
            }
        } else {
            la_log(LA_ERR, 'Cannot open la-sync-manager pid file');
            return;
        }
    } else {
        la_log(LA_WARN, "No statedir setup, cannot find la-sync-manager pid file");
        return;
    }
}

=head2 list_bases

Return the base list found in config file

=cut

sub list_bases {
    my ($self) = @_;
    grep {
        !m/^_.*_$/ &&
        !m/^sync:/
    } $self->Sections
}

=head2 base($basename)

Return a L<LATMOS::Accounts::Base> object over base named $basename
defined in the config file.

The base is loaded by this function.

=cut

sub base {
    my ($self, $section) = @_;
    # this method perform a cache
    $self->_load_base($section || $self->default_base_name);
}

=head2 default_base_name

Return the default base name according config file

=cut

sub default_base_name {
    my ($self) = @_;
    $self->val('_default_', 'base', ($self->list_bases)[0]);
}

=head2 default_base

Return a L<LATMOS::Accounts::Base> object over the default base according
configuration file.

=cut

sub default_base {
    my ($self) = @_;
    $self->base();
}

# do the bad work
sub _load_base {
    my ($self, $section) = @_;
    my $type = $self->val($section, 'type') or return;
    my %params = (
        map { $_ => ($self->val($section, $_)) } $self->Parameters($section),
        defattr => { map { $_ => ($self->val('_defattr_', $_)) } $self->Parameters('_defattr_') },
    );
    my $base = LATMOS::Accounts::Bases->new(
        $type,
        %params,
        label => $section,
        acls => $self->{_acls},
        allowed_values => $self->{_allowed_values},
        configdir => $self->_configdir,
        _la => $self,
    ) or do {
        la_log(LA_WARN, "Cannot instanciate base $section ($type)");
        return;
    };
    $base->load or return;
    $base;
}

sub default_synchro_name {
    my ($self) = @_;
    $self->val('_default_', 'sync');
}

sub list_synchro {
    my ($self) = @_;
    grep { $_ } map { /^sync:(.*)$/; $1 } $self->Sections
}

sub default_synchro {
    my ($self, %options) = @_;
    my $syncname = $self->default_synchro_name or do {
        la_log(LA_ERR, 'Cannot find default synchro in config');
        return;
    };
    $self->create_synchro($syncname, %options);
}

sub sync_from_name {
    my ($self, $syncname) = @_;
    return if (!$syncname);
    $self->val("sync:$syncname", 'from', $self->default_base_name);
}

sub create_synchro {
    my ($self, $name, %options) = @_;

    # taking options from config
    if ($name) {
        foreach my $param ($self->Parameters("sync:$name")) {
            if (!defined($options{$param})) {
                my @args = $self->val("sync:$name", $param);
                $options{$param} = ($args[1] || $param eq 'to')
                    ? [ @args ]
                    : $args[0];
            }
        }
    }

    my $labfrom = $options{from} ? $self->base($options{from}) : $self->default_base;

    my @labto =
        grep { $_ }
        map { $self->base($_) }
        @{ $options{to} || []}
        or do {
        la_log(LA_ERR, "No destination base load in this synchro");
        return;
    };

    my $sync = LATMOS::Accounts::Synchro->new(
        $labfrom, [ @labto ],
        state_dir => ($self->val('_default_', 'state_dir') || undef),
        %options,
        name => $name,
    );
}

sub sync_access {
    my ($self, $name, %options) = @_;

    my @obases;
    if ($name) {
        @obases =
        (map { $self->base($_) } ($self->sync_from_name($name), $self->val("sync:$name", 'to')));
    } elsif(@{ $options{bases} || []}) {
        @obases = map { $self->base($_) } @{ $options{bases} || []};
    } elsif (my $sname = $self->default_synchro_name) {
        @obases = (map { $self->base($_) }
            ($self->sync_from_name($sname), $self->val("sync:$sname", 'to'))
        );
    }

    LATMOS::Accounts::SynchAccess->new([ @obases ]);
}

1;

__END__

=head1 SEE ALSO

=head1 AUTHOR

Thauvin Olivier, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by Thauvin Olivier

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut