source: LATMOS-Accounts/lib/LATMOS/Accounts.pm @ 400

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 = (q$Rev$ =~ /^Rev: (\d+) /)[0];

=head1 NAME

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

=head1 DESCRITPTION

=cut

=head1 FUNCTION

=head2 new($configfile)

Instanciate a new LATMOS::Accounts object.

$configfile if defined is the Config::IniFiles formatted file to use,
default to F</etc/latmos-account.ini>.

=cut

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

    $config ||= '/etc/latmos-account.ini';

    my $self = Config::IniFiles->new(
        -file => $config,
        '-default' => '_default_',
    );
    if ($self->val('_default_', 'acls')) {
        my $acls = LATMOS::Accounts::Acls->new(
            $self->val('_default_', 'acls')
        ) or do {
            return;
        };
        $self->{_acls} = $acls;
    }

    bless($self, $class)
}

=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);
}

=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) = @_;
    my $default = $self->default_base_name or return;
    $self->base($default);
}

# 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},
    ) 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_file => $self->val('_default_', 'state_file'),
        %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