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

Last change on this file since 50 was 50, checked in by nanardon, 15 years ago
  • add L::A::create_synchro()
  • Property svn:keywords set to Id Rev
File size: 3.3 KB
Line 
1package LATMOS::Accounts;
2
3use 5.010000;
4use strict;
5use warnings;
6use base qw(Config::IniFiles);
7use LATMOS::Accounts::Bases;
8use LATMOS::Accounts::Synchro;
9
10our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];
11
12sub new {
13    my ($class, $config) = @_;
14
15    $config ||= '/etc/latmos-account.ini';
16
17    my $self = Config::IniFiles->new(
18        -file => $config
19    );
20
21    bless($self, $class)
22}
23
24sub base {
25    my ($self, $section) = @_;
26    # this method perform a cache
27    $self->{_bases}{$section} and return $self->{_bases}{$section};
28    $self->load_base($section) ? $self->{_bases}{$section} : undef;
29}
30
31sub default_base {
32    my ($self) = @_;
33    my $default = $self->default_base_name or return;
34    $self->base($default);
35}
36
37# load or a if need base
38sub load_base {
39    my ($self, $section) = @_;
40    return ($self->{_bases}{$section} ||= $self->_load_base($section))
41        ? 1
42        : 0;
43}
44
45# do the bad work
46sub _load_base {
47    my ($self, $section) = @_;
48    my $type = $self->val($section, 'type') or return;
49    my %params = map { $_ => ($self->val($section, $_)) } $self->Parameters($section);
50    my $base = LATMOS::Accounts::Bases->new($type, %params, label => $section);
51    $base->load or return;
52    $base;
53}
54
55sub default_base_name {
56    my ($self) = @_;
57    $self->val('_default_', 'base', ($self->list_bases)[0]);
58}
59
60sub list_bases {
61    my ($self) = @_;
62    grep {
63        !m/^_.*_$/
64    } $self->Sections
65}
66
67sub load_all_base {
68    my ($self) = @_;
69    foreach ($self->list_bases) {
70        $self->load_base($_) or do {
71            warn "Cannot load base $_\n";
72            return 0;
73        };
74    }
75    1;
76}
77
78sub config_sync_base {
79    my ($self, $from) = @_;
80    return split(/ /, $self->val($from, 'push', ''));
81} 
82
83sub create_synchro {
84    my ($self, $from, $to, %options) = @_;
85
86    my $labfrom = $from ? $self->base($from) : $self->default_base;
87
88    my @labto = map { $self->base($_) }
89        @{ $to || []}
90        ? @{ $to }
91        : ($self->config_sync_base($from
92                ? $from
93                : $self->default_base_name));
94
95    my $sync = LATMOS::Accounts::Synchro->new(
96        $labfrom, [ @labto ],
97        state_file => $self->val('_default_', 'state_file'),
98    );
99}
100
101
1021;
103
104__END__
105# Below is stub documentation for your module. You'd better edit it!
106
107=head1 NAME
108
109LATMOS::Accounts - Perl extension for blah blah blah
110
111=head1 SYNOPSIS
112
113  use LATMOS::Accounts;
114  blah blah blah
115
116=head1 DESCRIPTION
117
118Stub documentation for LATMOS::Accounts, created by h2xs. It looks like the
119author of the extension was negligent enough to leave the stub
120unedited.
121
122Blah blah blah.
123
124=head2 EXPORT
125
126None by default.
127
128
129
130=head1 SEE ALSO
131
132Mention other useful documentation such as the documentation of
133related modules or operating system documentation (such as man pages
134in UNIX), or any relevant external documentation such as RFCs or
135standards.
136
137If you have a mailing list set up for your module, mention it here.
138
139If you have a web site set up for your module, mention it here.
140
141=head1 AUTHOR
142
143Thauvin Olivier, E<lt>olivier.thauvin@latmosipsl.frE<gt>
144
145=head1 COPYRIGHT AND LICENSE
146
147Copyright (C) 2009 by Thauvin Olivier
148
149This library is free software; you can redistribute it and/or modify
150it under the same terms as Perl itself, either Perl version 5.10.0 or,
151at your option, any later version of Perl 5 you may have available.
152
153
154=cut
Note: See TracBrowser for help on using the repository browser.