Changes in / [20:30]

Location:

/LATMOS-Accounts

Files:

• bin (added)
• bin/la-config (added)
• lib/LATMOS/Accounts.pm (modified) (1 diff)
• lib/LATMOS/Accounts/Bases.pm (modified) (3 diffs)
• lib/LATMOS/Accounts/Bases/Objects.pm (modified) (2 diffs)
• lib/LATMOS/Accounts/Bases/SQL (deleted)
• lib/LATMOS/Accounts/Bases/Sql (added)
• lib/LATMOS/Accounts/Bases/Sql.pm (added)
• lib/LATMOS/Accounts/Bases/Sql/Group.pm (added)
• lib/LATMOS/Accounts/Bases/Sql/User.pm (added)
• lib/LATMOS/Accounts/Bases/Sql/objects.pm (added)
• sample (added)
• sample/latmos-account.ini (added)
• t/11_bases_unix.t (modified) (1 diff)
• t/20_accounts.t (added)
• testdata/config (added)

/LATMOS-Accounts/lib/LATMOS/Accounts.pm

@@ -4 +4 @@
 use strict;
 use warnings;
+use base qw(Config::IniFiles);
+use LATMOS::Accounts::Bases;
 
-require Exporter;
+our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];
 
-our @ISA = qw(Exporter);
+sub new {
+    my ($class, $config) = @_;
 
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
+    $config ||= '/etc/latmos-account.ini';
 
-# This allows declaration       use LATMOS::Accounts ':all';
-# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
-# will save memory.
-our %EXPORT_TAGS = ( 'all' => [ qw(
-        
-) ] );
+    my $self = Config::IniFiles->new(
+        -file => $config
+    );
 
-our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+    bless($self, $class)
+}
 
-our @EXPORT = qw(
-        
-);
+sub base {
+    my ($self, $section) = @_;
+    # this method perform a cache
+    $self->{_bases}{$section} and return $self->{_bases}{$section};
+    $self->load_base($section) ? $self->{_bases}{$section} : undef;
+}
 
-our $VERSION = '0.01';
+sub default_base {
+    my ($self) = @_;
+    my $default = $self->dafault_base_name or return;
+    $self->base($default);
+}
 
+# load or a if need base
+sub load_base {
+    my ($self, $section) = @_;
+    return ($self->{_bases}{$section} ||= $self->_load_base($section))
+        ? 1
+        : 0;
+}
 
-# Preloaded methods go here.
+# do the bad work
+sub _load_base {
+    my ($self, $section) = @_;
+    my $type = $self->val($section, 'type') or return;
+    my %params = map { $_ => ($self->val($section, $_) || undef) } $self->Parameters($section);
+    return LATMOS::Accounts::Bases->new($type, %params);
+}
+
+sub default_base_name {
+    my ($self) = @_;
+    $self->val('_default_', 'base', ($self->list_bases)[0]);
+}
+
+sub list_bases {
+    my ($self) = @_;
+    grep {
+        !m/^_.*_$/
+    } $self->Sections
+}
+
+sub load_all_base {
+    my ($self) = @_;
+    foreach ($self->list_bases) {
+        $self->load_base($_) or do {
+            warn "Cannot load base $_\n";
+            return 0;
+        };
+    }
+    1;
+}
 
 1;
+
 __END__
 # Below is stub documentation for your module. You'd better edit it!

/LATMOS-Accounts/lib/LATMOS/Accounts/Bases.pm

@@ -78 +78 @@
 }
 
+=head2 list_objects($otype)
+
+Return the list of UID for object of $otype.
+
+=cut
+
+sub list_objects {
+    my ($self, $otype) = @_;
+    my $pclass = $self->_load_obj_class($otype) or return;
+    $pclass->list($self);
+}
+
 =head2 get_object($type, $id)
 
@@ -88 +100 @@
     my ($self, $otype, $id) = @_;
 
-    return LATMOS::Accounts::Bases::Objects->new($self, $otype, $id);
+    return LATMOS::Accounts::Bases::Objects->_new($self, $otype, $id);
 }
 
@@ -102 +114 @@
 sub create_object {
     my ($self, $otype, $id, %data) = @_;
-    return;
+    my $pclass = $self->_load_obj_class($otype);
+    $pclass->create($id, %data) or return;
+    $self->get_object($otype, $id);
 }
 

/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm

@@ -22 +22 @@
 =cut
 
-=head2 new($base, $type, $id, ...)
+=head2 list($base)
 
-Return a new object of type $type having unique identifier
-$id, all remaining arguments are passed to the subclass.
+List object supported by this module existing in base $base
+
+=cut
+
+sub list {
+    my ($class) = @_;
+    return;
+}
+
+=head2 new($base, $id)
+
+Create a new object having $id as uid.
 
 =cut
 
 sub new {
+    my ($class, $base, $id, @args) = @_;
+    # So can be call as $class->SUPER::new()
+    bless {
+        _base => $base,
+        _type => ($class =~ m/[^:]*$/)[0],
+    }, $class;
+}
+
+# _new($base, $type, $id, ...)
+
+# Return a new object of type $type having unique identifier
+# $id, all remaining arguments are passed to the subclass.
+
+sub _new {
     my ($class, $base, $otype, $id, @args) = @_;
 
@@ -39 +63 @@
     return $newobj;
 }
+
+=head2 type
+
+Return the type of the object
+
+=cut
 
 sub type {

/LATMOS-Accounts/t/11_bases_unix.t

@@ -56 +56 @@
 is($user->get_field('shell'), '/bin/tcsh', 'Can get modified login shell');
 
-warn $dir
-#system('rm', '-fr', $dir);
+system('rm', '-fr', $dir);