CipUX-Object-3.4.0.5000755001750001750 011424662704 14660 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/MANIFEST000444001750001750 113511424662704 16146 0ustar00ckuelkerckuelker000000000000bin/cipux_object_client Build.PL Changes doc/dep/depgraph.dot doc/dep/depgraph.png doc/dep/depgraph.svg expl/cipux_object_synopsis.pl lib/CipUX/Object.pm lib/CipUX/Object/Action.pm lib/CipUX/Object/Action/Attribute/Change.pm lib/CipUX/Object/Action/Attribute/List.pm lib/CipUX/Object/Action/Create.pm lib/CipUX/Object/Action/Destroy.pm lib/CipUX/Object/Action/List.pm lib/CipUX/Object/Client.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/00.load.t t/perlcritic.t t/perlcritic_cpan.t t/perlcriticrc t/pod-coverage.t t/pod.t t/refcount.t usr/share/cipux/etc/cipux-object.perl CipUX-Object-3.4.0.5/Build.PL000444001750001750 311711424662704 16313 0ustar00ckuelkerckuelker000000000000use strict; use warnings; use Module::Build; use version; our $VERSION = qv('3.4.0.5'); my $builder = Module::Build->new( module_name => 'CipUX::Object', license => 'gpl2', dist_author => 'Christian Kuelker ', dist_version => "$VERSION", installdirs => 'vendor', # create_makefile_pl => 'traditional', # create_readme => 1, meta_merge => { resources => { homepage => q(http://www.cipux.org), }, }, recommends => { 'Test::Perl::Critic' => 0, 'Test::Pod::Coverage' => '1.04', }, build_requires => { 'Test::More' => 0, 'Test::Pod' => '1.14', 'Test::Refcount' => 0, 'Test::LeakTrace' => 0, }, requires => { 'Carp' => 0, 'CipUX' => '3.4.0.11', 'CipUX::Storage' => '3.4.0.0', 'Class::Std' => '0.0.9', 'Crypt::SmbHash' => 0, 'Data::Dumper' => 0, 'Getopt::Long' => 0, 'Hash::Merge' => 0, 'Log::Log4perl' => 0, 'Pod::Usage' => 0, 'Readonly' => 0, 'version' => 0, }, perl_files => { 'usr/share/cipux/etc/cipux-object.perl' => 'myetc/cipux-object.perl', }, install_path => { 'myetc' => '/usr/share/cipux/etc' }, add_to_cleanup => ['CipUX-Object-*'], ); # Only to uncomment, if you changed the BUILD target # $builder->add_build_element('dat'); #$builder->do_create_readme(); #$builder->do_create_makefile_pl(); $builder->add_build_element('perl'); $builder->create_build_script(); CipUX-Object-3.4.0.5/README000444001750001750 120611424662704 15674 0ustar00ckuelkerckuelker000000000000CipUX-Object version 3.4.0.5 Object Layer for CipUX. Defines CipUX objects. INSTALLATION To install this module, preferably run the following commands: perl Build.PL ./Build ./Build test ./Build install DEPENDENCIES Carp CipUX CipUX::Storage Class::Std Crypt::SmbHash Data::Dumper English Getopt::Long Hash::Merge Log::Log4perl Pod::Usage Readonly version COPYRIGHT AND LICENSE Copyright (C) 2007 - 2009, Christian Kuelker Copyright (C) 2009, Andreas Brand This library is licensed under the GNU General Public License - GNU GPL version 2 or any later version. CipUX-Object-3.4.0.5/META.yml000444001750001750 306511424662704 16272 0ustar00ckuelkerckuelker000000000000--- abstract: 'Object layer class for CipUX' author: - 'Christian Kuelker ' build_requires: Test::LeakTrace: 0 Test::More: 0 Test::Pod: 1.14 Test::Refcount: 0 configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3607' license: gpl2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: CipUX-Object provides: CipUX::Object: file: lib/CipUX/Object.pm version: v3.4.0.5 CipUX::Object::Action: file: lib/CipUX/Object/Action.pm version: v3.4.0.5 CipUX::Object::Action::Attribute::Change: file: lib/CipUX/Object/Action/Attribute/Change.pm version: v3.4.0.5 CipUX::Object::Action::Attribute::List: file: lib/CipUX/Object/Action/Attribute/List.pm version: v3.4.0.5 CipUX::Object::Action::Create: file: lib/CipUX/Object/Action/Create.pm version: v3.4.0.5 CipUX::Object::Action::Destroy: file: lib/CipUX/Object/Action/Destroy.pm version: v3.4.0.5 CipUX::Object::Action::List: file: lib/CipUX/Object/Action/List.pm version: v3.4.0.5 CipUX::Object::Client: file: lib/CipUX/Object/Client.pm version: v3.4.0.5 recommends: Test::Perl::Critic: 0 Test::Pod::Coverage: 1.04 requires: Carp: 0 CipUX: v3.4.0.11 CipUX::Storage: v3.4.0.0 Class::Std: v0.0.9 Crypt::SmbHash: 0 Data::Dumper: 0 Getopt::Long: 0 Hash::Merge: 0 Log::Log4perl: 0 Pod::Usage: 0 Readonly: 0 version: 0 resources: homepage: http://www.cipux.org license: http://opensource.org/licenses/gpl-2.0.php version: v3.4.0.5 CipUX-Object-3.4.0.5/Makefile.PL000444001750001750 17111424662704 16746 0ustar00ckuelkerckuelker000000000000use Module::Build::Compat; Module::Build::Compat->run_build_pl(args => \@ARGV); Module::Build::Compat->write_makefile(); CipUX-Object-3.4.0.5/Changes000444001750001750 605511424662704 16316 0ustar00ckuelkerckuelker000000000000Revision history for CipUX-Object 3.4.0.5 2010-07-31T01:27:04 - changes: * drop build dependency to Module::Build::CipUX * add support for sambaPasswordHistory and sambaPwdLastSet attribute for example for a CipUX::Task target - contributor: Christian Kuelker - version created by: Christian Kuelker 3.4.0.4 2010-07-28T00:12:33 - changes: * fix bad whatis entry in man page * replace userPassword (userPassword, sambaLMPassword) with generic target 'value' * support for auto attribute sambaPwdLastSet * bump dependency to CipUX up to: 3.4.0.11 - contributor: Christian Kuelker - version created by: Christian Kuelker 3.4.0.3 2010-01-07T23:23:53 - changes: * add cipuxTask attribute to cipux_cat_module * fix uid arrary ref occurance in value of target * add doc/dep graphs - contributor: Christian Kuelker - version created by: Christian Kuelker 3.4.0.2 2009-08-19T00:43:36 - changes: * avoid premature creation of config space dirs in CipUX::Object::Action::Attribute::List * tests of t/refcount.t uses local cache dir * make CipUX::Object::Action variable cache dir aware * add build dependency to Test::LeakTrace - contributor: Andreas Brand Christian Kuelker - version created by: Christian Kuelker 3.4.0.1 2009-07-29T11:09:34 - changes: * add refcount test * remove indirect build dependency Module::Build * remove unused var from CipUX/Object/Action/Attribute/Change.pm * avoid premature creation of config space dirs in Action::List * added name and copyright statement to Action::List * removed superfluous formatting variables in Action::List * added name and copyright statement to cipux-core object README * remove 'All rights reserved!' * improve license wording - contributor: Andreas Brand Christian Kuelker - version created by: Christian Kuelker 3.4.0.0 2009-03-23T05:24:12 - version created by: Christian Kuelker 3.002016 2007-09-10T14:22:23 - version created by: Christian Kuelker 3.002015 Fri Jun 08 22:24:25 2007 - original version; created by h2xs 1.23 with options -v 3.002015 -XA -n Object CipUX-Object-3.4.0.5/MANIFEST.SKIP000444001750001750 24411424662704 16673 0ustar00ckuelkerckuelker000000000000-stamp$ \.orig$ \.bak$ \.swp$ \.svn _build blib Build$ \.ptkdb$ .deb$ .build$ .changes$ .upload$ .asc$ .dsc$ .tar.gz$ .cvsignore debian/files$ \..*\~$ ^MYMETA.yml$ CipUX-Object-3.4.0.5/lib000755001750001750 011424662704 15426 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/lib/CipUX000755001750001750 011424662704 16416 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/lib/CipUX/Object.pm000444001750001750 672511424662704 20331 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object || # || || # || CipUX Object Layer Class || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker. All rights reserved! || # || || # || License: GNU General Public License - GNU GPL version 2 || # || or (at your opinion) any later version. || # || || # +==========================================================================+ # $Id: Action.pm 2747 2008-09-27 11:31:15Z palik-guest $ # $Revision: 2747 $ # $HeadURL$ # $Date: 2008-09-27 13:31:15 +0200 (Sa, 27 Sep 2008) $ # $Source$ package CipUX::Object; use 5.008001; use strict; use warnings; use Carp; use Class::Std; use Data::Dumper; use Log::Log4perl qw(:easy); use Readonly; { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; sub capabilities { # +------------------------------------------------------------------+ # | API my $self = shift; my $msg = shift; # +------------------------------------------------------------------+ # | API return; } ## end sub out } # END INSIDE-OUT CLASS 1; __END__ =pod =head1 NAME CipUX::Object - Object layer class for CipUX =head1 VERSION version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object; my $obj = CipUX::Object->new(); =head1 DESCRIPTION Provides capabilities of Object layer =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Object =head2 capabilities TODO =head1 DIAGNOSTICS TODO =head1 CONFIGURATION AND ENVIRONMENT TODO =head1 DEPENDENCIES Carp Class:Std CipUX CipUX::Storage =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut CipUX-Object-3.4.0.5/lib/CipUX/Object000755001750001750 011424662704 17624 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/lib/CipUX/Object/Client.pm000444001750001750 4655311424662704 21572 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object::Client || # || || # || CipUX Object Client || # || || # || Copyright (C) 2008 - 2009 by Christian Kuelker. All rights reserved! || # || || # || License: GNU General Public License - GNU GPL version 2 || # || or (at your opinion) any later version. || # || || # +==========================================================================+ # ID: $Id: Client.pm 5011 2010-07-30 23:31:16Z christian-guest $ # Revision: $Revision: 5011 $ # Head URL: $HeadURL$ # Date: $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $ # Source: $Source$ package CipUX::Object::Client; use 5.008001; use strict; use warnings; use Carp; use Class::Std; use CipUX::Object::Action::Create; use CipUX::Object::Action::Destroy; use CipUX::Object::Action::List; use Data::Dumper; use English qw( -no_match_vars); use Getopt::Long; # command line options use Log::Log4perl qw(:easy); use Pod::Usage; use Readonly; use base qw(CipUX::Object::Action); { # BEGIN INSIDE-OUT CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; Readonly::Scalar my $LINEWIDTH => 78; Readonly::Scalar my $L4PCONF => '/etc/cipux/log4perl.conf'; Readonly::Array my @ACTION => qw( list create destroy); # +======================================================================+ # || INIT ARGS || # +======================================================================+ # register client with name: # name : cipux_object_client my %name_of : ATTR( init_arg => 'name'); # +======================================================================+ # || GLOBALS || # +======================================================================+ my $L = q{=} x $LINEWIDTH; $L .= "\n"; my $mattrvalue_hr = {}; my %opt = (); my $script = $EMPTY_STRING; my %option = ( 'cipux_object_client' => { 'must' => [qw(a=action)], 'may' => [ qw(c cfg D debug h ? help p pretty V verbose version x mattrvalue t type o object) ], 'not' => [], }, 'list' => { 'must' => [qw()], 'may' => [qw(c cfg D debug h ? help p pretty V verbose version )], 'not' => [qw(x mattrvalue t type o object)], }, 'create' => { 'must' => [qw(t=type o=object)], 'may' => [qw(c cfg D debug h ? help mattrvalue V verbose version x)], 'not' => [qw(p pretty)], }, 'destroy' => { 'must' => [qw(t=type o=object)], 'may' => [qw(c cfg D debug h ? help V verbose version )], 'not' => [qw(p pretty x mattrvalue)], }, ); sub run { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # constructor parameter from CipUX::Object::Client my $script = $name_of{ ident $self}; # test right away if we have a valid name if ( $script ne 'cipux_object_client' ) { $self->exc( { msg => 'unknown script name', value => $script } ); } # +------------------------------------------------------------------+ # | Environment Getopt::Long::Configure('bundling'); GetOptions( \%opt, 'action|a=s', 'cfg|c=s', 'debug|D', 'help|h', 'object|o=s', 'pretty|p', 'type|t=s', 'version|V', 'verbose', 'mattrvalue|x=s%' => sub { $self->store_mattrvalue( $mattrvalue_hr, \%opt, @_ ); }, ) or pod2usage( -exitstatus => 2, -msg => "$L problems parsing command line!\n$L" ); if ( exists $opt{debug} ) { Log::Log4perl->init_once($L4PCONF); } my $logger = get_logger(__PACKAGE__); $logger->debug('SUB'); # display help page if ( exists $opt{help} ) { pod2usage( -exitstatus => 0, -verbose => 1 ); } if ( exists $opt{version} ) { $self->out("$script $VERSION\n"); exit 0; } my $run_action = exists $opt{action} ? $opt{action} : undef; if ( not defined $run_action ) { my $msg = "$L Please give parameter --action or -a! \n"; $msg .= "valid object actions are: \n"; foreach my $a (@ACTION) { $msg .= "$a\n"; } $msg .= $L; pod2usage( -exitstatus => 1, -verbose => 0, -msg => $msg ); } $logger->debug( 'run_action: ', $run_action ); my $ret = $self->test_cli_option( { script => $run_action, logic_hr => \%option, opt_hr => \%opt, debug => 0, } ); # +------------------------------------------------------------------+ # | main my $action = exists $opt{action} ? $opt{action} : undef; my $pretty = exists $opt{pretty} ? 1 : 0; my $object = exists $opt{object} ? $opt{object} : undef; my $type = exists $opt{type} ? $opt{type} : undef; my $cfg = exists $opt{cfg} ? $opt{cfg} : undef; $logger->debug( 'pretty: ', $pretty ); if ( defined $object ) { $logger->debug( 'object: ', $object ); } if ( defined $type ) { $logger->debug( 'type: ', $type ); } if ( defined $cfg ) { $logger->debug( 'cfg: ', $cfg ); } if ( scalar( grep { $_ eq $action } @ACTION ) < 1 ) { my $msg = "unknown object action [$action]\n"; $msg .= "valid object actions are: \n"; foreach my $a (@ACTION) { $msg .= "$a\n"; } $msg .= $L; $self->exc( { msg => $msg } ); } my $sub = 'cipux_object_' . $run_action; $self->$sub( { action => $action, pretty => $pretty, type => $type, object => $object, cfg => $cfg, mattrvalue_hr => $mattrvalue_hr, } ); return; } # +----------------------------------------------------------------------+ # | cipux_object_list | # +----------------------------------------------------------------------+ sub cipux_object_list { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $cfg = exists $arg_r->{cfg} ? $self->l( $arg_r->{cfg} ) : $self->perr('cfg'); my $pretty = exists $arg_r->{pretty} ? $self->l( $arg_r->{pretty} ) : $self->perr('pretty'); #foreach my $p (qw(cfg)) { # if ( not defined $arg_r->{$p} ) { # my $msg = 'parameter not defined in sub cipux_object_list'; # $self->exc( { msg => $msg, value => $p } ); # } #} # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('SUB cipux_object_list'); $logger->debug( 'pretty: ', $pretty ); $logger->debug( 'cfg: ', { filter => \&Dumper, value => $cfg } ); $self->_print_list_type( { pretty => $pretty, cfg => $cfg } ); # +------------------------------------------------------------------+ # | API return; } # +----------------------------------------------------------------------+ # | cipux_object_create | # +----------------------------------------------------------------------+ sub cipux_object_create { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $type = exists $arg_r->{type} ? $self->l( $arg_r->{type} ) : $self->perr('type'); my $object = exists $arg_r->{object} ? $self->l( $arg_r->{object} ) : $self->perr('object'); my $cfg = exists $arg_r->{cfg} ? $self->l( $arg_r->{cfg} ) : $self->perr('cfg'); my $mattrvalue_hr = exists $arg_r->{mattrvalue_hr} ? $self->h( $arg_r->{mattrvalue_hr} ) : $self->perr('mattrvalue_hr'); foreach my $p (qw(type object)) { if ( not defined $arg_r->{$p} ) { my $msg = 'parameter not defined in sub cipux_object_create'; $self->exc( { msg => $msg, value => $p } ); } } # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); my $cfg_coupling_hr = $self->get_coupling_cfg(); my $cfg_object_hr = $self->get_object_cfg(); my $cfg_basis_hr = $self->get_basis_cfg(); my $create = CipUX::Object::Action::Create->new( { cfg => $cfg } ); my $return = $create->create_object_action( { action => 'create_object_action', type => $type, object => $object, attr_hr => $mattrvalue_hr, #overwrite_hr => $overwrite_hr, # TODO define that in CipUX::Object } ); # +------------------------------------------------------------------+ # | API return $return; } sub cipux_object_destroy { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $type = exists $arg_r->{type} ? $self->l( $arg_r->{type} ) : $self->perr('type'); my $object = exists $arg_r->{object} ? $self->l( $arg_r->{object} ) : $self->perr('object'); my $cfg = exists $arg_r->{cfg} ? $self->l( $arg_r->{cfg} ) : $self->perr('cfg'); foreach my $p (qw(type object )) { if ( not defined $arg_r->{$p} ) { my $msg = 'parameter not defined in sub cipux_object_destroy'; $self->exc( { msg => $msg, value => $p } ); } } # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug( 'object: ', $object ); $logger->debug( 'type: ', $type ); my $cfg_coupling_hr = $self->get_coupling_cfg(); my $cfg_object_hr = $self->get_object_cfg(); my $cfg_basis_hr = $self->get_basis_cfg(); $logger->debug( 'cfg_coupling_hr', { filter => \&Dumper, value => $cfg_coupling_hr } ); my $destroy = CipUX::Object::Action::Destroy->new( { cfg_coupling_hr => $cfg_coupling_hr, cfg_object_hr => $cfg_object_hr, cfg_basis_hr => $cfg_basis_hr } ); my $return = $destroy->destroy_object_action( { action => 'destroy_object_action', type => $type, object => $object, } ); # +------------------------------------------------------------------+ # | API return 1; } # +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+ # | PRIVATE INTERFACE | # +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+ sub _print_list_type { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $pretty = exists $arg_r->{pretty} ? $self->l( $arg_r->{pretty} ) : 0; my $cfg = exists $arg_r->{cfg} ? $self->l( $arg_r->{cfg} ) : 0; my $logger = get_logger(__PACKAGE__); $logger->debug( 'pretty: ', $pretty ); $logger->debug( 'cfg: ', $cfg ); my $cfg_coupling_hr = $self->get_coupling_cfg(); my $cfg_object_hr = $self->get_object_cfg(); my $cfg_basis_hr = $self->get_basis_cfg(); $logger->debug( 'cfg_coupling_hr: ', { filter => \&Dumper, value => $cfg_coupling_hr } ); my $list_ar = $self->list_type( { cfg_coupling_hr => $cfg_coupling_hr } ); $logger->debug( 'list_ar', { filter => \&Dumper, value => $list_ar } ); # this is without pretty print! # # foreach my $line (@$list_ar){ # chomp($line); # $self->out( "$line\n"); # } # mostly this stuff is for pretty print my $max_col = 0; my $width = 0; if ($pretty) { foreach my $line ( @{$list_ar} ) { if ( $max_col < length $line ) { $max_col = length $line; } } $width = 2 + $max_col; $self->out( q{+} . q{-} x $width . "+\n" ); $self->out( sprintf '| %-' . $max_col . "s |\n", 'type' ); $self->out( q{+} . q{=} x $width . "+\n" ); } foreach my $line ( @{$list_ar} ) { chomp $line; if ($pretty) { $self->out( sprintf '| %-' . $max_col . "s |\n", $line ); } else { $self->out("$line\n"); } } if ($pretty) { $self->out( q{+} . q{-} x $width . "+\n" ); } # +------------------------------------------------------------------+ # | API return; } # +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+ # | PUBLIC INTERFACE | # +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+ sub DEMOLISH { # +------------------------------------------------------------------+ # | API my ($self) = @_; # actualize library information #Library->remove($self); # +------------------------------------------------------------------+ # | API return; } # +======================================================================+ # || METHODS || # +======================================================================+ } # END INSIDE-OUT CLASS 1; # Magic true value required at end of module __END__ =head1 NAME CipUX::Object::Client - Command line client for CipUX objects =head1 VERSION This document describes CipUX::Object::Client version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object::Client; my $c = CipUX::Object::Client->new({name=>'cipux_object_client'}); $c->run(); =head1 DESCRIPTION Command line client library for CipUX Object. =head1 SUBROUTINES/METHODS =head2 DEMOLISH TODO =head2 run TODO =head2 cipux_object_create TODO =head2 cipux_object_destroy TODO =head2 cipux_object_list TODO =head1 DIAGNOSTICS =for author to fill in: List every single error and warning message that the module can generate (even the ones that will "never happen"), with a full explanation of each problem, one or more likely causes, and any suggested remedies. =over =item C<< Error message here, perhaps with %s placeholders >> [Description of error here] =item C<< Another error message here >> [Description of error here] [Et cetera, et cetera] =back =head1 CONFIGURATION AND ENVIRONMENT CipUX::Object::Client requires no configuration files or environment variables. =head1 DEPENDENCIES TODO =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS No bugs have been reported. =head1 SEE ALSO See the CipUX webpage and the manual at L =head1 AUTHOR Christian Kuelker C<< >> =head1 LICENSE AND COPYRIGHT Copyright (C) 2008 - 2009 , Christian Kuelker. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut CipUX-Object-3.4.0.5/lib/CipUX/Object/Action.pm000444001750001750 1525611424662704 21565 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object::Action || # || || # || CipUX Object Layer Class || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker. All rights reserved! || # || || # || License: GNU General Public License - GNU GPL version 2 || # || or (at your opinion) any later version. || # || || # +==========================================================================+ # $Id: Action.pm 5011 2010-07-30 23:31:16Z christian-guest $ # $Revision: 5011 $ # $HeadURL$ # $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $ # $Source$ package CipUX::Object::Action; use 5.008001; use strict; use warnings; use Carp; use Class::Std; use Data::Dumper; use English qw( -no_match_vars ); use Log::Log4perl qw(:easy); use Readonly; use base qw(CipUX); { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; # +======================================================================+ # || INIT ARGS || # +======================================================================+ my %coupling_cfg : ATTR( :get ); my %object_cfg : ATTR( :get ); my %basis_cfg : ATTR( :get ); # +======================================================================+ # || GLOBAL VARS || # +======================================================================+ # +======================================================================+ # || CONSTRUCTOR || # +======================================================================+ sub BUILD { # +------------------------------------------------------------------+ # | API my ( $self, $obj_id, $arg_r ) = @_; # add prefix for cfg, if needed my $pref = exists $arg_r->{pref} ? $self->l( $arg_r->{pref} ) : $EMPTY_STRING; my $cache_dir = exists $arg_r->{cache_dir} ? $self->l( $arg_r->{cache_dir} ) : $EMPTY_STRING; # +------------------------------------------------------------------+ # | prepare # +------------------------------------------------------------------+ # | main my $cfg_hr = $self->cfg( { 'sub' => 'object', pref => $pref, cache_dir => $cache_dir } ); $coupling_cfg{$obj_id} = $cfg_hr->{coupling}; $object_cfg{$obj_id} = $cfg_hr->{object}; $basis_cfg{$obj_id} = $cfg_hr->{basis}; undef $cfg_hr; # +------------------------------------------------------------------+ # | API return; } # +=======================================================================+ # || list_type || # +=======================================================================+ sub list_type { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my @return; # list of all objects my $object = $coupling_cfg{ ident $self}; foreach my $obj ( sort keys %{$object} ) { $logger->debug( 'object: ', $obj ); push @return, $obj; } $logger->debug('END'); # +------------------------------------------------------------------+ # | API return \@return; } ## end sub list_type } # END INSIDE-OUT CLASS 1; __END__ =pod =head1 NAME CipUX::Object::Action - Object Action layer class for CipUX =head1 VERSION version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object; my $obj = CipUX::Object::Action->new(cfg); # After installation, or you have to copy it there my $cfg = '/usr/share/cipux/etc/cipux-object.perl'; my $type_ar = $obj->list_type( { cfg_hr=> $cfg_hr, } ); foreach my $type ( @{$type_ar} ){ print "Valid CipUX Object Type: $type\n" or die 'Can not print to STDOUT!'; } =head1 DESCRIPTION Provides the base subroutines for other CipUX::Object::Action classes. The CipUX object layer is a generic abstract class, which can be used by other classes or scripts. =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Object::Action. =head2 BUILD init cipux-configurations =head2 list_type List all cipux object defined in the configuration. B $object->list_type({ cfg_hr=>$cfg__hr, }); =head1 DIAGNOSTICS TODO =head1 CONFIGURATION AND ENVIRONMENT TODO =head1 DEPENDENCIES Carp Class:Std CipUX =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut CipUX-Object-3.4.0.5/lib/CipUX/Object/Action000755001750001750 011424662704 21041 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/lib/CipUX/Object/Action/List.pm000444001750001750 2474711424662704 22505 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object::Action::List || # || || # || CipUX Object Layer Class || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker || # || Copyright (C) 2009 by Andreas Brand || # || || # || License: GNU GPL - GNU General Public License - version 2 || # || or (at your opinion) any later version. || # || || # +==========================================================================+ # $Id: List.pm 5011 2010-07-30 23:31:16Z christian-guest $ # $Revision: 5011 $ # $HeadURL$ # $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $ # $Source$ package CipUX::Object::Action::List; use 5.008001; use strict; use warnings; use utf8; use Carp; use Class::Std; use CipUX::Storage; use Data::Dumper; use English qw( -no_match_vars); use Log::Log4perl qw(:easy); use Readonly; use base qw(CipUX::Object::Action); { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; # +======================================================================+ # || INIT ARGS || # +======================================================================+ # my %cfg_coupling_of : ATTR(init_arg => 'cfg_coupling_hr'); # +=======================================================================+ # || GLOBAL VARS || # +=======================================================================+ # +=======================================================================+ # || object || # +=======================================================================+ # this is the entry point sub list_object_action { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $action = exists $arg_r->{action} ? $self->l( $arg_r->{action} ) : $self->perr('action'); my $type = exists $arg_r->{type} ? $self->l( $arg_r->{type} ) : $self->perr('type'); my $attr_hr = exists $arg_r->{attr_hr} ? $self->h( $arg_r->{attr_hr} ) : {}; my $filter_hr = exists $arg_r->{filter_hr} ? $self->h( $arg_r->{filter_hr} ) : $self->perr('filter_hr'); # +------------------------------------------------------------------+ # | main my $ldap = CipUX::Storage->new(); my $logger = get_logger(__PACKAGE__); $logger->debug( 'action: ', $action ); $logger->debug( 'type: ', $type ); # list object types and check it my $type_ar = $self->list_type(); my %type = (); foreach my $t ( @{$type_ar} ) { $type{$t} = 1; $logger->debug( 'found type: ', $t ); } if ( not defined $type{$type} ) { $self->exc( { msg => 'unknown type', value => $type } ); } # +---------------------------------------------------------------------+ # | list_object_action | # +---------------------------------------------------------------------+ #if ( $debug > 128 and defined $filter_hr ) { # $self->var_dump( { var_r => $filter_hr, name => 'filter_hr' } ); #} $logger->debug('PART list_object_action START'); my $cfg_coupling_hr = $self->get_coupling_cfg(); my $v_hr = $cfg_coupling_hr->{$type}; my $c_hr = {}; # create hash ref my $scope = 'all'; my $object_ar = $v_hr->{object_attr}; my $value_hr = $EMPTY_STRING; $logger->debug( 'object_ar v_hr->{object_attr}: ', { filter => \&Dumper, value => $object_ar } ); $logger->debug( 'scope: ', $scope ); $logger->debug( 'v_hr: ', { filter => \&Dumper, value => $v_hr } ); $logger->debug( 'array v_hr->{order}: ', { filter => \&Dumper, value => $v_hr->{order} } ); my $attribute_number = 0; # Exp: $v_hr->{order} = ['cipux_account.group','cipux_account.user'] foreach my $o ( @{ $v_hr->{order} } ) { # for every object in 'order' $logger->debug( 'object to list: ', $o ); # additional filter my $filter = $EMPTY_STRING; # &(uid=*)(objectClass=cipuxAccount)(cipuxIsAccount=TRUE) if ( defined $filter_hr->{$o} ) { foreach my $key ( keys %{ $filter_hr->{$o} } ) { my $value = $filter_hr->{$o}->{$key}; $filter .= "($key=$value)"; $logger->debug( 'add filter: ', $filter ); } } ## end if ( defined $filter_hr... # Example object_attr: # 0 = cn (cipux_account.group) # 1 = uid (cipux_account.user) my $obj = $object_ar->[$attribute_number]; $logger->debug( 'search object_attr (obj): ', $obj ); $attribute_number++; # my $object_type_name = $cfg_coupling_hr->{$type}; $value_hr = $ldap->get_value( { type => $o, scope => $scope, obj => $obj, filter => $filter # attr_ar => [], } ); # Last value ($value_hr) wins. If that is not desired # add a hash merge here. } ## end foreach my $o ( @{ $v_hr->{... $logger->debug('PART list_object_action END'); return $value_hr; } ## end sub list_object_action } # END INSIDE-OUT CLASS 1; __END__ =pod =head1 NAME CipUX::Object::Action::List - Object layer class for CipUX =head1 VERSION version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object::Action::List; =head1 DESCRIPTION Provides the functions cipux_object_create and cipux_object_destroy as well as some auto-calculated values for example for userPassword. =head1 ABSTRACT The CipUX object layer is a generic abstract class, which can be used by other classes or scripts. The function cipux_object_create may create one or several LDAP nodes according to the configuration structure in /etc/cipux/cipux-object.conf or ~/.cipux/cipux-object.conf. The function cipux_object_destroy tries to remove one or more LDAP nodes. =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Object::Action::List. =head2 new Constructor B my $cipux_object = CipUX::Object::Action::List->new({}); my $cipux_object = CipUX::Object::Action::List->new({debug=>1}); my $cfg = '/etc/cipux/cipux-object.conf'; my $cipux_object = CipUX::Object::Action::List->new({cfg=>$cfg}); B I Configuration files may be provided for convenience. This is meant to work in a single-server scenario and multi-server settings. The preset behavior is to throw an exception, when some parameter value of the configuration file is missing or is wrong. Summary: * if a configuration file is given incorporate this file if it is there else look for ~/.cipux/cipux-object.conf and incorporate if it is there else look for /etc/cipux/cipux-object.conf and incorporate if it is there B The configuration file is for dispatching multiple CipUX objects. TODO: write conf structure! For details see man page of cipux-object.conf. =head2 DESTROY Mandatory DESTROY Method for Inside-Out Class. B $i10n->DESTROY(); =head2 list_type Creates a CipUX object B $object->list_type({ }); =head2 preset Creates a CipUX object B $object->preset({ }); =head2 auto Creates a CipUX object B $object->auto({ }); =head2 mandatory Creates a CipUX object B $object->mandatory({ }); =head2 rule Creates a CipUX object B $object->rule({ }); =head2 alias Creates a CipUX object B $object->alias({ }); =head2 list_object_action TODO =head2 preset_auto_mandatory_rule_alias Creates a CipUX object B $object->preset_auto_mandatory_rule_alias({ }); =head2 oid_number_supremum TODO =head2 object TODO =head2 test_cfg TODO =head2 DEMOLISH TODO =head2 config TODO =head1 DIAGNOSTICS TODO =head1 CONFIGURATION AND ENVIRONMENT TODO =head1 DEPENDENCIES Carp Class:Std CipUX CipUX::Storage Pod::Usage Date::Manip =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut CipUX-Object-3.4.0.5/lib/CipUX/Object/Action/Create.pm000444001750001750 10365311424662704 23007 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object::Action::Create || # || || # || CipUX Object Layer Class || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker. All rights reserved! || # || || # || License: GNU GPL - GNU General Public License version 2 or any later || # || version. || # +==========================================================================+ # $Id: Create.pm 5011 2010-07-30 23:31:16Z christian-guest $ # $Revision: 5011 $ # $HeadURL$ # $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $ # $Source$ package CipUX::Object::Action::Create; use 5.008001; use strict; use warnings; use Carp; use Class::Std; use CipUX::Storage; use Crypt::SmbHash qw(lmhash nthash); use Data::Dumper; use English qw( -no_match_vars); use Hash::Merge qw( merge ); use Log::Log4perl qw(:easy); use Readonly; use base qw(CipUX::Object::Action); { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; # +======================================================================+ # || INIT ARGS || # +======================================================================+ #my %cfg_of :ATTR( init_arg => 'cfg'); # store conif file name # +=======================================================================+ # || GLOBAL VARS || # +=======================================================================+ my $cfg_object_hr; my $cfg_coupling_hr; # +=======================================================================+ # || object || # +=======================================================================+ sub create_object_action { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $action = exists $arg_r->{action} ? $self->l( $arg_r->{action} ) : $self->perr('action'); my $type = exists $arg_r->{type} ? $self->l( $arg_r->{type} ) : $self->perr('type'); my $attr_hr = exists $arg_r->{attr_hr} ? $self->h( $arg_r->{attr_hr} ) : {}; my $object = exists $arg_r->{object} ? $self->l( $arg_r->{object} ) : $self->perr('object'); my $overwrite_hr = exists $arg_r->{overwrite_hr} ? $self->h( $arg_r->{overwrite_hr} ) : {}; foreach my $p (qw(object type action)) { if ( not defined $arg_r->{$p} ) { $self->exc( { msg => 'parameter not defined', value => $p } ); } } # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug( 'action: ', $action ); $logger->debug( 'type: ', $type ); $logger->debug( 'object: ', $object ); $logger->debug('cfg: load cfg'); $cfg_coupling_hr = $self->get_coupling_cfg(); $cfg_object_hr = $self->get_object_cfg(); #if ( $debug > 128 and defined $attr_hr ) { # my $msg = 'we got this dump as INPUT (sub object):'; # $logger->debug( { msg: => $msg } ,"\n"); # $self->var_dump( { var_r => $attr_hr, name => 'attr_hr' } ); #} # list object types and check it my $type_ar = $self->list_type( { cfg_coupling_hr => $cfg_coupling_hr } ); my %type = (); foreach my $t ( @{$type_ar} ) { $type{$t} = 1; $logger->debug( 'found type: ', $t ); } if ( not defined $type{$type} ) { $self->exc( { msg => 'unknown type', value => $type } ); } # +---------------------------------------------------------------------+ # | create_object_action | # +---------------------------------------------------------------------+ #my $overwrite_hr = $self->h( $arg_r->{overwrite_hr} ) # || $self->perr('overwrite_hr'); # TODO #test_cfg( { cfg=>$config_hr0, task=>$task } ); my $add_ar = []; #y @add = (); # test if all mandatory attributes are given. my $v_hr = $cfg_coupling_hr->{$type}; my $c_hr = {}; # create hash ref #my $overwrite_hr = $v_hr->{overwrite}; # if ( $debug > 128 and defined $overwrite_hr ) { # $self->var_dump( # { var_r => $overwrite_hr, name => 'overwrite_hr' } ); # # } my $storage = CipUX::Storage->new(); # create every node in order: # $o = cipux_account.group, cipux_account.user, ... foreach my $o ( @{ $v_hr->{order} } ) { # for every object in 'order' $logger->debug( 'object to create: ', $o ); # preset->auto->mandatory->rule->alias cascade my $o_hr = $cfg_object_hr->{$o}; $logger->debug( 'href o_hr: ', $o_hr ); $c_hr->{$o} = $self->preset_auto_mandatory_rule_alias( { href => $o_hr, vhref => $v_hr, attr_hr => $attr_hr, object => $object } ); # join attributes from different sources # for now we have only one source, but this might change my %merged = ( %{$c_hr} ); #if ( $debug > 128 ) { # $self->var_dump( { name => 'merged', var_r => \%merged } ); #} #my %merged2 = (); # %{ $v_hr->{overwrite}->{$o} } : # add overwrite attributes from CipUX::Object::Action::Create layer # $cfg_coupling_hr->{overwrite}->{cipux_account.group}; # foreach cipux_account.group->attr, ... # %{ $overwrite_hr->{$o} } # add overwrite attributes from CipUX::Task layer # foreach cipux_account.group->attr, ... my %overwrite_task = (); if ( exists $overwrite_hr->{$o} and defined $overwrite_hr->{$o} ) { %overwrite_task = %{ $overwrite_hr->{$o} }; } my %overwrite_object = (); if ( defined $v_hr->{overwrite}->{$o} ) { %overwrite_object = %{ $v_hr->{overwrite}->{$o} }; } #C %merged2 = ( #C %{ $merged{$o} }, # calculated so far #C %overwrite_object, # CipUX::Object::Action::Create overwrite #C %overwrite_task, # CipUX::Task overwrite #C ); $logger->debug('overwrite_hr from task:'); $logger->debug( { filter => \&Dumper, value => \%overwrite_task } ); $logger->debug('overwrite_hr from object:'); $logger->debug( { filter => \&Dumper, value => \%overwrite_object } ); $logger->debug('calculated overwrite:'); $logger->debug( { filter => \&Dumper, value => \%overwrite_object } ); Hash::Merge::set_behavior('RIGHT_PRECEDENT'); my %merged1 = %{ merge( $merged{$o}, \%overwrite_object ) }; my %merged2 = %{ merge( \%merged1, \%overwrite_task ) }; $logger->debug('merged overwrite:'); $logger->debug( { filter => \&Dumper, value => \%merged2 } ); # }elsif(defined()){ # %merged2 = ( # %{ $merged{$o} }, # calculated so far # %{ $v_hr->{overwrite}->{$o} } # CipUX::Object::Action::Create overwrite # ); # } #if ( $debug > 128 ) { # $self->var_dump( { name => 'merged', var_r => \%merged } ); #} # add overwrite attributes from CipUX::Object::Action::Create layer # $cfg_coupling_hr->{overwrite}->{cipux_account.group}; # foreach cipux_account.group->attr, ... # foreach my $attr ( keys %{ $v_hr->{overwrite}->{$o} } ) { # my $value = $v_hr->{overwrite}->{$o}->{$attr}; # my $msg = "overwrite from OBJECT [$o] attr [$attr]:="; # $logger->debug($msg, $value ,"\n"); # $merged2{$attr} = $value; # } # add overwrite attributes from CipUX::Task layer # foreach cipux_account.group->attr, ... # foreach my $attr ( keys %{ $overwrite_hr->{$o} } ) { # my $value = $overwrite_hr->{$o}->{$attr}; # my $msg = "overwrite from TASK [$o] attr [$attr]:="; # $logger->debug($msg, $value ,"\n"); # $merged2{$attr} = $value; # } # do not need this meta info for creation delete $merged2{struc_rdn}; # do not need this meta info for creation delete $merged2{base_dn}; # do not need this meta info for creation while ( delete $merged2{dn} ) { $logger->debug( 'delete: ', 'dn' ); } #if ( $debug > 128 ) { # $self->var_dump( { name => 'merged2', var_r => \%merged2 } ); #} # make a check for mandatory attributes, because it is better # not partly creating a object (example: cipux_account.group OK, # but cipux_account.user FAILED) foreach my $m ( keys %{ $o_hr->{mandatory} } ) { $logger->debug( 'check mandatory: ', $m, ); if ( not defined $merged2{$m} ) { my $msg = 'This mandatory attribute is missing:'; $self->exc( { msg => $msg, value => $m } ) } } ## end foreach my $m ( keys %{ $o_hr... # will be executed later (push anon hash ref) push @{$add_ar}, { object_type_name => $o, object_id => $object, object_hr => \%merged2 }; } ## end foreach my $o ( @{ $v_hr->{... #if ( $debug > 128 ) { # $self->var_dump( { name => 'add_ar', var_r => $add_ar } ); #} # and now try to execute the addition # array_r of anon hash_rs foreach my $a_hr ( @{$add_ar} ) { # cipux_account.user my $msg = 'object_type_name'; $logger->debug( $msg, $a_hr->{object_type_name} ); # login $logger->debug( 'object_id: ', $a_hr->{object_id} ); $logger->debug( 'object_hr: ', $a_hr->{object_hr} ); my $value_hr = $storage->add_node( { type => $a_hr->{object_type_name}, obj => $a_hr->{object_id}, attr_hr => $a_hr->{object_hr} } ); } ## end foreach my $a_hr ( @{$add_ar... return 1; } ## end sub create_object_action # +=======================================================================+ # || preset || # +=======================================================================+ sub preset { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $href = $arg_r->{href}; # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); #if ( $debug > 128 and defined $href ) { # my $msg = 'we got this dump as result DEFAULT subroutine:'; # $logger->debug( { msg => $msg } ,"\n"); # #$self->var_dump( { var_r => $href, name => 'sub preset href' } ); #} return $href; } ## end sub preset # +=======================================================================+ # || auto || # +=======================================================================+ sub auto { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $href = $arg_r->{href}; my $ahref = $arg_r->{ahref}; # values from CLI my $attr_hr = $arg_r->{attr_hr}; # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $storage = CipUX::Storage->new(); my $cfg_basis_hr = $self->get_basis_cfg(); foreach my $var ( keys %{$ahref} ) { #if ( $debug > 2 ) { # my $msg = "auto: set [$var]:="; # $logger->debug( $msg, $ahref->{$var} } ,"\n"); #} # TODO: delete section? this might be done after: list_type if ( $var eq 'struc_rdn' ) { $ahref->{$var} = []; push @{ $ahref->{$var} }, 'ou=room'; # TODO my $msg = 'auto: struc_rdn:='; $logger->debug( $msg, $ahref->{$var} ); } elsif ( $var eq 'base_dn' ) { $ahref->{$var} = []; push @{ $ahref->{$var} }, 'dc=nodomain'; # TODO my $msg = 'auto: base_dn:='; $logger->debug( $msg, $ahref->{$var} ); } elsif ( $var eq 'uidNumber' ) { my $oid_number = $storage->oid_number_supremum( { cfg_basis_hr => $cfg_basis_hr } ); $ahref->{$var} = []; push @{ $ahref->{$var} }, $oid_number; my $msg = 'auto: uidNumber:='; $logger->debug( $msg, $ahref->{$var} ); } elsif ( $var eq 'gidNumber' ) { my $oid_number = $storage->oid_number_supremum( { cfg_basis_hr => $cfg_basis_hr } ); $ahref->{$var} = []; push @{ $ahref->{$var} }, $oid_number; my $msg = 'auto: gidNumber:='; $logger->debug( $msg, $ahref->{$var} ); } elsif ( $var eq 'userPassword' ) { # if defined $attr_hr->{userPassword} # and ref( $attr_hr->{userPassword} ) eq 'ARRAY' <---- CLI # elsif defined $attr_hr->{userPassword} <---- RPC # else set it <---- RND $attr_hr->{userPassword} = ( defined $attr_hr->{userPassword} and ref( $attr_hr->{userPassword} ) eq 'ARRAY' ) ? $attr_hr->{userPassword}->[0] : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword} : $self->random_password(); $ahref->{$var} = []; my $password_hash = $self->hash_password( { mode => 'crypt', password => $attr_hr->{userPassword} } ); push @{ $ahref->{$var} }, '{crypt}' . $password_hash; } elsif ( $var eq 'sambaLMPassword' ) { $attr_hr->{userPassword} = ( defined $attr_hr->{userPassword} and ref( $attr_hr->{userPassword} ) eq 'ARRAY' ) ? $attr_hr->{userPassword}->[0] : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword} : $self->random_password(); my $lm = lmhash( $attr_hr->{userPassword} ); $ahref->{$var} = []; push @{ $ahref->{$var} }, $lm; } elsif ( $var eq 'sambaNTPassword' ) { $attr_hr->{userPassword} = ( defined $attr_hr->{userPassword} and ref( $attr_hr->{userPassword} ) eq 'ARRAY' ) ? $attr_hr->{userPassword}->[0] : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword} : $self->random_password(); my $nt = nthash( $attr_hr->{userPassword} ); $ahref->{$var} = []; push @{ $ahref->{$var} }, $nt; } elsif ( $var eq 'sambaSID' ) { my $sid = $storage->get_sid(); my @uid = (); if ( defined $ahref->{uidNumber} ) { if ( ref $ahref->{uidNumber} eq 'ARRAY' ) { @uid = @{ $ahref->{uidNumber} }; } else { push @uid, $ahref->{uidNumber}; } } elsif ( defined $ahref->{gidNumber} ) { if ( ref $ahref->{uidNumber} eq 'ARRAY' ) { @uid = @{ $ahref->{gidNumber} }; } else { push @uid, $ahref->{gidNumber}; } } if ( scalar(@uid) == 0 ) { my $msg = 'No uidNumber or gidNumber available.'; $msg .= ' It is not possible to calculate'; $msg .= ' sambaSID value as auto value from '; $msg .= ' cipux-samba-object.conf.'; confess($msg); } $sid = sprintf( "%s-%s", $sid, int( $uid[0] ) * 2 + 1000 ); $ahref->{$var} = []; push @{ $ahref->{$var} }, $sid; } elsif ( $var eq 'cipuxCreationDate' ) { $ahref->{$var} = []; push @{ $ahref->{$var} }, $self->date_time( { today => 1 } ); my $msg = 'auto: set attr cipuxCreationDate:='; $logger->debug( $msg, $ahref->{$var} ); } elsif( $var eq 'sambaPwdLastSet'){ $ahref->{$var} = []; push @{ $ahref->{$var} }, $self->date_epoch( { today => 1 } ); my $msg = 'auto: set attr sambaPwdLastSet:='; $logger->debug( $msg, $ahref->{$var} ); } else { my $msg = 'auto: unknown auto variable'; $self->exc( { msg => $msg, value => $var } ); } } ## end foreach my $var ( keys %{$ahref... # 1: auto values (ahref) will overwrite href values # 2: CLI (-x) will not be merge here (attr_href) # They will be merged in sub mandatory my %merge = ( %{$href}, %{$ahref} ); #if ( $debug > 128 ) { # my $msg = 'we got this dump as result AUTO subroutine:'; # $logger->debug( { msg => $msg } ,"\n"); # $self->var_dump( { var_r => \%merge, name => 'merge' } ); #} return \%merge } ## end sub auto # +=======================================================================+ # || mandatory || # +=======================================================================+ sub mandatory { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # attributes calculated so far, and values from auto section my $href = $arg_r->{href}; # mandatory section of object_node_name of config file # Example: cipux_account.user->mandatory (cipuxFirstname, ...) my $mhref = $arg_r->{mhref}; # new cn (object_id) from command line -o my $object = exists $arg_r->{object} ? $self->l( $arg_r->{object} ) : $self->perr('object'); # object_attr section from object_type_name # Example: cipux_account->object_attr (uid,cn,...) my $obj_attr_ar = $arg_r->{obj_attr_ar}; # -x from CLI my $attr_hr = $arg_r->{attr_hr}; # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); $logger->debug( 'mandatory: object: ', $obj_attr_ar ); $logger->debug( 'obj_attr_ar: ', { filter => \&Dumper, value => $obj_attr_ar } ); # all mand. obj: uid, cipuxFirstname, ... # TODO: If not all mandatory attributes of an object in # cipux-object.conf are provided, we got # here the problem, that mhref will not iterate over given CLI # options (-x ATTR=VALUE). This given CLI options will # therefore NOT be merged! (1) test if this is also true for # other given CLI options (2) find a solution to overcome this # by (2a) make this in config obsolete or (2b) write a test for # it with exceptions. foreach my $var ( keys %{$mhref} ) { #if ( $debug > 1 ) { # my $msg = "mandatory: process [$var]:="; # $logger->debug($msg, $mhref->{$var} ,"\n"); #} # all CLI -o replace objects: uid, cn, ... # This only works if this is also a mandatory object foreach my $o ( @{$obj_attr_ar} ) { my $msg = "mandatory: check for CLI object: is [$var] eq [$o]?"; $logger->debug( { msg => $msg } ); if ( $o eq $var ) { my $msg = 'mandatory: yes! found replacement from -o '; $logger->debug( $msg, $var ); # replace existing mand. obj with -o value $href->{$var} = []; push @{ $href->{$var} }, $object; } elsif ( defined $attr_hr->{$var} ) { my $msg = 'mandatory: yes! found replacement from -x '; $logger->debug( $msg, $var ); $href->{$var} = $attr_hr->{$var}; } else { my $msg = 'mandatory: no! obj and CLI (-o or -x) '; $msg .= 'do not match'; $logger->debug( { msg => $msg } ); } } ## end foreach my $o ( @{$obj_attr_ar... } ## end foreach my $var ( keys %{$mhref... #my %merge = ( %{$href}, %{$mhref} ); my %merge = ( %{$href} ); #if ( $debug > 128 ) { # my $msg = 'we got this dump as result MANDATORY subroutine:'; # $logger->debug( { msg => $msg } ,"\n"); # $self->var_dump( { var_r => \%merge, name => 'merge' } ); #} return \%merge; } ## end sub mandatory # +=======================================================================+ # || rule || # +=======================================================================+ sub rule { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # attributes calculated so far, and values from mandatory section my $href = $arg_r->{href}; # rule section of object_node_name of config file # Example: cipux_account.user->rule (dn, homeDirectory, ...) my $rhref = $arg_r->{rhref}; # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); # for every rule attribute (dn, homeDriectory, ... foreach my $var ( keys %{$rhref} ) { $logger->debug( 'rule attribute: ', $var ); $logger->debug( '\$rhref->{\$var}: ', { filter => \&Dumper, value => $rhref->{$var} } ); my $rule = undef; if ( ref( $rhref->{$var} ) eq 'ARRAY' ) { $rule = join $EMPTY_STRING, @{ $rhref->{$var} }; } else { $rule = $rhref->{$var}; } next if not defined $rule; $logger->debug( '\$rule: ', { filter => \&Dumper, value => $rule } ); my $replacement = $rule; # TODO: Bad data while ( $rule =~ m/<([^>]+?)>/gxsm ) { my $attr = $1; my $value = $href->{$attr}; if ( not defined $rule ) { my $msg = 'Tryed to replace non-existing RULE '; $msg .= 'in subroutine [rule]. The attribute was:'; $self->exc( { msg => $msg, value => $attr } ); } $logger->debug( 'rule: ', $rule ); if ( not defined $attr ) { my $msg = 'Tryed to replace non-existing ATTRIBUTE '; $msg .= 'in subroutine [rule]. Rule was: '; $self->exc( { msg => $msg, value => $rule } ); } $logger->debug( 'attr: ', $attr ); if ( not defined $value ) { my $msg = 'Tryed to replace non-existing VALUE '; $msg .= 'in subroutine [rule] for rule '; $msg .= "[$rule]. The attribute was: [$attr]. "; $msg .= '(if you are using the command line, '; $msg .= 'you may define the value with: '; $msg .= "-x $attr=VALUE)"; $self->exc( { msg => $msg } ); } ## end if ( not defined $value) $logger->debug( 'value: ', $value ); if ( ref($value) eq 'ARRAY' ) { $value = join q{ }, @{$value}; } $replacement =~ s/<$attr>/$value/gmxe; $logger->debug("replace [<$attr>] with [$value]"); } ## end while ( $rule =~ m/<([^>]+?)>/gxsm) #if ( $debug > 1 ) { # my $msg = "rule: ... with replacement [$var]:="; # $logger->debug($msg, $replacement ,"\n"); #} $rhref->{$var} = []; push @{ $rhref->{$var} }, $replacement; # remember this $logger->debug("replacement [$replacement]"); } ## end foreach my $var ( keys %{$rhref... my %merge = ( %{$href}, %{$rhref} ); #if ( $debug > 128 ) { # my $msg = 'we got this dump as result RULE subroutine:'; # $logger->debug( { msg => $msg } ,"\n"); # $self->var_dump( { var_r => \%merge, name => 'merge' } ); #} $logger->debug( '\%merge: ', { filter => \&Dumper, value => \%merge } ); return \%merge; } ## end sub rule # +=======================================================================+ # || alias || # +=======================================================================+ sub alias { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # attr values processed so far my $href = $arg_r->{href}; # alias section of config file my $phref = $arg_r->{phref}; # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); foreach my $var ( keys %{$phref} ) { my $msg = "alias: is href [$var] defined?"; $logger->debug( { msg => $msg } ); if ( defined $href->{ $phref->{$var} } ) { my $msg = "alias: yes! set [$var]:="; my $value = $href->{ $phref->{$var} }; $href->{$var} = $value; $logger->debug( $msg, $value ); } ## end if ( defined $href->{ ... } ## end foreach my $var ( keys %{$phref... # foreach my $var ( keys %{$href} ) { # my $msg = 'alias ['.$var.']:=['.join('][',@{$href->{$var}}).']'; # if(defined($phref->{$var})){ # $msg .=':=['.join('][',@{$phref->{$var}}).']'; # } # $logger->debug( { msg => $msg } ,"\n"); # } #my %merge = ( %{$href}, %{$phref} ); my %merge = ( %{$href} ); #if ( $debug > 128 ) { # my $msg = 'we got this dump as result ALIAS subroutine:'; # $logger->debug( { msg => $msg } ,"\n"); # $self->var_dump( { var_r => \%merge, name => 'merge' } ); #} return \%merge; } ## end sub alias # +=======================================================================+ # || preset_auto_mandatory_rule_alias || # +=======================================================================+ sub preset_auto_mandatory_rule_alias { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $o_hr = $arg_r->{href} || $self->perr('href'); my $v_hr = $arg_r->{vhref} || $self->perr('vhref'); # -o ID from CLI my $object = $arg_r->{object} || $self->perr('object'); # -x attr=values from CLI my $attr_hr = $arg_r->{attr_hr} || $self->perr('attr_hr'); # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); $logger->debug( 'href: ', $o_hr ); $logger->debug( 'vhref: ', $v_hr ); $logger->debug( 'object: ', $object ); if ( defined $attr_hr ) { $logger->debug( 'attr_hr: ', $attr_hr ); } my $cfg_basis_hr = $self->get_basis_cfg(); # DEFAULT my $d_hr = $self->preset( { href => $o_hr->{preset} } ); # AUTO my $a_hr = $self->auto( { href => $d_hr, ahref => $o_hr->{auto}, cfg_basis_hr => $cfg_basis_hr, # used only for testing, getting but not modifying attr_hr => $attr_hr, } ); # MANDATORY my $m_hr = $self->mandatory( { # auto_hr href => $a_hr, # object attributes for -o obj_attr_ar => $v_hr->{object_attr}, # ID from -o CLI object => $object, # mandatory part of config # You have to add ALL mandatory attributes, or # sub mandatory will fail mhref => $o_hr->{mandatory}, # attr values from CLI, will be merged here attr_hr => $attr_hr } ); # RULE my $r_hr = $self->rule( { href => $m_hr, # mandatory_hr rhref => $o_hr->{rule} } ); # ALIAS my $p_hr = $self->alias( { href => $r_hr, phref => $o_hr->{alias} } ); return $p_hr; } ## end sub preset_auto_mandatory_rule_alias } # END INSIDE-OUT CLASS 1; __END__ =pod =head1 NAME CipUX::Object::Action::Create - Object layer class for CipUX =head1 VERSION version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object::Action::Create; =head1 DESCRIPTION Provides the functions cipux_object_create as well as some auto-calculated values for example for userPassword. The function cipux_object_create may create one or several LDAP nodes according to the configuration structure in /etc/cipux/cipux-object.conf or ~/.cipux/cipux-object.conf. =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Object::Action::Create. =head2 new Constructor B my $cipux_object = CipUX::Object::Action::Create->new({}); =head2 preset Creates a CipUX object B $object->preset({ }); =head2 auto Creates a CipUX object B $object->auto({ }); =head2 mandatory Creates a CipUX object B $object->mandatory({ }); =head2 rule Creates a CipUX object B $object->rule({ }); =head2 alias Creates a CipUX object B $object->alias({ }); =head2 preset_auto_mandatory_rule_alias Creates a CipUX object B $object->preset_auto_mandatory_rule_alias({ }); =head2 create_object_action TODO =head2 oid_number_supremum TODO =head1 DIAGNOSTICS TODO =head1 CONFIGURATION AND ENVIRONMENT TODO =head1 DEPENDENCIES Carp Class:Std =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut CipUX-Object-3.4.0.5/lib/CipUX/Object/Action/Destroy.pm000444001750001750 1613711424662704 23215 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object::Action::Destroy || # || || # || CipUX Object Layer Class || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker. All rights reserved! || # || || # || License: GNU GPL - GNU General Public License version 2 or any later || # || version. || # || || # +==========================================================================+ # $Id: Destroy.pm 5011 2010-07-30 23:31:16Z christian-guest $ # $Revision: 5011 $ # $HeadURL$ # $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $ # $Source$ package CipUX::Object::Action::Destroy; use 5.008001; use strict; use warnings; use Carp; use Class::Std; use CipUX::Storage; use English qw( -no_match_vars); use Data::Dumper; use Log::Log4perl qw(:easy); use Readonly; use base qw(CipUX::Object::Action); { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; Readonly::Scalar my $action => 0; Readonly::Scalar my $value_hr => {}; # +======================================================================+ # || INIT ARGS || # +======================================================================+ # my %cfg_coupling_of : ATTR(init_arg => 'cfg_coupling_hr'); # +======================================================================+ # || GLOBAL VARS || # +======================================================================+ # +======================================================================+ # || object || # +======================================================================+ # this is the entry point sub destroy_object_action { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $type = exists $arg_r->{type} ? $self->l( $arg_r->{type} ) : $self->perr('type'); my $object = exists $arg_r->{object} ? $self->l( $arg_r->{object} ) : $self->perr('object'); my $attr_hr = exists $arg_r->{attr_hr} ? $self->h( $arg_r->{attr_hr} ) : {}; # +------------------------------------------------------------------+ # | debug API my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); $logger->debug( '> type: ', $type ); $logger->debug( '> object: ', $object ); $logger->debug( '> attr_hr: ', { filter => \&Dumper, value => $attr_hr } ); # other values of interest $logger->debug( 'action: ', $action ); # +------------------------------------------------------------------+ # | param validation # # list object types and check it my $type_ar = $self->list_type(); my %type = (); foreach my $t ( @{$type_ar} ) { $type{$t} = 1; $logger->debug( 'found type: ', $t ); } if ( not defined $type{$type} ) { $self->exc( { msg => 'unknown type', value => $type } ); } # +------------------------------------------------------------------+ # | main $logger->debug('get object coupling configuration'); my $cfg_coupling_hr = $self->get_coupling_cfg(); # destroy every node of all type in a given order my $v_hr = $cfg_coupling_hr->{$type}; my $storage = CipUX::Storage->new(); # Exp: $v_hr->{order} = ['cipux_account.group','cipux_account.user'] # for every object type in a given 'order' foreach my $type ( @{ $v_hr->{order} } ) { $logger->debug( 'object type to destroy: ', $type ); my $value_hr = $storage->delete_node( { type => $type, obj => $object, } ); } ## end foreach my $type ( @{ $v_hr... $logger->debug('END'); return $value_hr; } ## end sub destroy_object_action } # END INSIDE-OUT CLASS 1; __END__ =pod =head1 NAME CipUX::Object::Action::Destroy - Object layer class for CipUX =head1 VERSION version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object::Action::Destroy; my $obj = CipUX::Object::Action::Destroy->new(); =head1 DESCRIPTION Provides the functions cipux_object_destroy. The function cipux_object_destroy tries to remove one or more LDAP nodes. =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Object::Action::Destroy. =head2 destroy_object_action my $result_hr = destroy_object_action({ type => $type, # CipUX object key object => $object, # object CN attr_hr => $attr_hr, # attributes and values cfg_coupling_hr => $cfg_coupling_hr, # part of cipux_object.conf }); =head2 new Inherit from CipUX::Object B my $cipux_object = CipUX::Object::Action::Destroy->new({}); =head2 DEMOLISH Inherit from CipUX::Object. Will called autmatically. B $cipux_object->DEMOLISH(); =head1 DIAGNOSTICS TODO =head1 CONFIGURATION AND ENVIRONMENT TODO =head1 DEPENDENCIES Carp Class:Std CipUX CipUX::Storage =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut CipUX-Object-3.4.0.5/lib/CipUX/Object/Action/Attribute000755001750001750 011424662704 23004 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/lib/CipUX/Object/Action/Attribute/Change.pm000444001750001750 6331511424662704 24714 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object::Action::Attribute::Change || # || || # || CipUX Object Layer Class || # || || # || Copyright (C) 2007 - 2010 by Christian Kuelker. All rights reserved! || # || || # || License: GNU GPL version 2 or any later version. || # || || # +==========================================================================+ # $Id: Change.pm 5011 2010-07-30 23:31:16Z christian-guest $ # $Revision: 5011 $ # $HeadURL$ # $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $ # $Source$ package CipUX::Object::Action::Attribute::Change; use 5.008001; use strict; use warnings; use utf8; use Carp; use Class::Std; use CipUX::Storage; use Data::Dumper; use Crypt::SmbHash qw(lmhash nthash); use Log::Log4perl qw(:easy); use Readonly; use base qw(CipUX::Object::Action); { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; Readonly::Scalar my $auto_hr => { userPassword => sub { userPassword(@_) }, sambaLMPassword => sub { sambaLMPassword(@_); }, sambaNTPassword => sub { sambaNTPassword(@_); }, sambaPwdLastSet => sub { sambaPwdLastSet(@_); }, sambaPasswordHistory => sub { sambaPasswordHistory(@_); }, member => sub { member(@_); }, }; # +======================================================================+ # || INIT ARGS || # +======================================================================+ #my %cfg_of :ATTR( init_arg => 'cfg'); # store config file name # +======================================================================+ # || GLOBAL VARS || # +======================================================================+ my $attr_hr = {}; # +======================================================================+ # || object || # +======================================================================+ # this is the entry point sub change_object_attribute_action { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $action = exists $arg_r->{action} ? $self->l( $arg_r->{action} ) : $self->perr('action'); my $type = exists $arg_r->{type} ? $self->l( $arg_r->{type} ) : $self->perr('type'); $attr_hr = exists $arg_r->{attr_hr} ? $self->h( $arg_r->{attr_hr} ) : {}; # +------------------------------------------------------------------+ # | prepare my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); $logger->debug( '> action : ', $action ); $logger->debug( '> type : ', $type ); $logger->debug( '> attr_hr : ', { filter => \&Dumper, value => $attr_hr } ); # list object types and check it my $type_ar = $self->list_type(); my %type = (); foreach my $t ( @{$type_ar} ) { $type{$t} = 1; $logger->debug( 'found type: ', $t ); } if ( not defined $type{$type} ) { $self->exc( { msg => 'unknown type', value => $type } ); } # +-------------------------------------------------------------------+ # | change_object_attribute_action | # +-------------------------------------------------------------------+ # API 2 my $object = exists $arg_r->{object} ? $self->l( $arg_r->{object} ) : $self->perr('object'); my $scope = exists $arg_r->{scope} ? $self->l( $arg_r->{scope} ) : $self->perr('scope'); # my $target = # exists $arg_r->{target} ? # $self->l( $arg_r->{target} ) # : undef; # $object->'add|delete|replace' my $changes_hr = exists $arg_r->{changes_hr} ? $self->h( $arg_r->{changes_hr} ) : $self->perr('changes_hr'); my $filter_hr = exists $arg_r->{filter_hr} ? $self->h( $arg_r->{filter_hr} ) : $self->perr('filter_hr'); my $target_hr = exists $arg_r->{target_hr} ? $self->h( $arg_r->{target_hr} ) : $self->perr('target_hr'); # debug API 2 $logger->debug( '> object : ', $object ); $logger->debug( '> scope : ', $scope ); $logger->debug( '> changes_hr : ', { filter => \&Dumper, value => $changes_hr } ); $logger->debug( '> filter_hr : ', { filter => \&Dumper, value => $filter_hr } ); $logger->debug( '> target_hr : ', { filter => \&Dumper, value => $target_hr } ); my $cfg_coupling_hr = $self->get_coupling_cfg(); my $v_hr = $cfg_coupling_hr->{$type}; my $c_hr = {}; # create hash ref my $value_hr = $EMPTY_STRING; my $attr_ar = []; # for every object type $o in a given 'order': cipux_share_object, ... foreach my $o ( @{ $v_hr->{order} } ) { $logger->debug("foreach object type [$o] in ordered list:\n"); # additional filter my $filter = $self->_compose_ldap_filter( { filter_hr => $filter_hr->{$o} } ); if ( not exists $target_hr->{$o} ) { my $msg = 'go to next, because target not exists for'; $logger->debug( $msg . q{: }, $o ); next; } if ( not defined $target_hr->{$o} ) { my $msg = 'go to next, because target not defined for'; $logger->debug( $msg . q{: }, $o ); next; } if ( ref $target_hr->{$o} ne 'HASH' ) { my $msg = 'The target definition is not valid!'; $msg .= 'The target should be a HASH reference.'; $logger->debug( $msg . q{: }, $o ); $self->exc( { msg => $msg, value => $o } ); } # if a target=>ABC in param_hr is defined, we # exchange the LDAP attribute from cipux-task.cfgperl target # # 'target' => { # target_hr # 'cipux_role.group' => { # $o # 'memberUid' => 0, # $attr => $aval # 'member' => 'cipux_account.user' # $attr => $aval # }, # }, # # Example: # target=>{ # client=>{ # 'nisNetgroupTriple' => 0, # }, # }, # Changes: # nisNetgroupTriple=>undef # target=>'(myhost,-,-)' OR value=>'(myhost,-,-)' # To: # nisNetgroupTriple=>'(myhost,-,-)' my $value_hr = {}; $logger->debug( 'attr_hr : ', { filter => \&Dumper, value => $attr_hr } ); # TODO: consider replacing userPassword or value # with non generic target if ( not exists $attr_hr->{value} and exists $attr_hr->{userPassword} ) { $logger->debug('early set userPassword'); $attr_hr->{value} = $attr_hr->{userPassword}; my $aval = $target_hr->{$o}->{userPassword}; if ( exists $attr_hr->{sambaLMPassword} ) { $logger->debug('early set sambaLMPassword'); $attr_hr->{sambaLMPassword} = $self->_auto_attr( { attr => 'sambaLMPassword', aval => $aval, value_hr => $value_hr } ); } if ( exists $attr_hr->{sambaNTPassword} ) { $logger->debug('early set sambaNTPassword'); $attr_hr->{sambaNTPassword} = $self->_auto_attr( { attr => 'sambaLMPassword', aval => $aval, value_hr => $value_hr } ); } } # foreach: member, memberUid foreach my $attr ( sort keys %{ $target_hr->{$o} } ) { $logger->debug("target_hr attr: [$attr] (value run)"); # first: take value from named attribute # second: take value from pseudo attribute "value" $value_hr->{$attr} = ( exists $attr_hr->{$attr} and defined $attr_hr->{$attr} ) ? $attr_hr->{$attr} : ( exists $attr_hr->{value} and defined $attr_hr->{value} ) ? $attr_hr->{value} : confess "No value for attribute [$attr] found!"; } $logger->debug( 'value_hr : ', { filter => \&Dumper, value => $value_hr } ); # calulate an apply auto values: foreach my $attr ( sort keys %{ $target_hr->{$o} } ) { $logger->debug("target_hr attr: [$attr] (auto run)"); my $aval = $target_hr->{$o}->{$attr}; push @{$attr_ar}, $self->_auto_attr( { attr => $attr, aval => $aval, value_hr => $value_hr } ); } $logger->debug( 'attr_ar : ', { filter => \&Dumper, value => $attr_ar } ); # from CLI it is an ARRAY reference # from RPC it is a value # only query objects containing the attribute # ex.: cipux_course_share *.group = yes, *.user = no # next if not defined $attr_ar; my $changes = $changes_hr->{$o}; if ( not defined $changes ) { my $msg = 'go to next, because changes not defined for'; $logger->debug( $msg . q{: }, $o ); next; } if ( not( $changes eq 'add' or $changes eq 'delete' or $changes eq 'replace' or $changes eq 'erase' ) ) { my $msg = 'Non valid changes found! '; $msg .= 'Changes should be add|delete|replace. '; $self->exc( { msg => $msg, value => $changes } ); } else { $logger->debug( 'changes is ok: ', $changes ); } # if changes is erase (=> escope=all) then we would like to delete # the LDAP attribute directly. This forces a different syntax on # the LDAP layer. With escope="all" we enable this syntax # CipUX LDAP # changes escope # ====================================== # add none modify changes # delete none modify changes # replace none modify changes # erase all modify delete my $escope = ( $changes eq 'erase' ) ? 'all' : 'none'; my $ldap = CipUX::Storage->new(); # my $object_type_name = $cfg_coupling_hr->{$type}; $value_hr = $ldap->set_value( { type => $o, scope => $scope, escope => $escope, obj => $object, # value => $value, changes => $changes, filter => $filter, attr_ar => $attr_ar, # attr_ar => [], } ); } ## end foreach my $o ( @{ $v_hr->{... # +------------------------------------------------------------------+ # | API $logger->debug('END'); return $value_hr; } ## end sub change_object_attribute_action # +=====================================================================+ # || helper subroutines || # +=====================================================================+ sub _auto_attr { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # attribute: member, memberUid my $attr = exists $arg_r->{attr} ? $arg_r->{attr} : $self->perr('attr'); # attribute value: 0, cipux_account.user my $aval = exists $arg_r->{aval} ? $arg_r->{aval} : $self->perr('aval'); my $value_hr = exists $arg_r->{value_hr} ? $arg_r->{value_hr} : $self->perr('value_hr'); # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); $logger->debug( "ref auto_hr->{attr} ", ref( $auto_hr->{$attr} ) ); my @value = (); my @attr = (); # if CODE the it is a auto calc value if ( exists $auto_hr->{$attr} and ref $auto_hr->{$attr} eq 'CODE' ) { if ( exists $value_hr->{$attr} ) { push @value, $value_hr->{$attr}; } # Example: push @attr, $self->userPassword(); push @attr, $attr; push @attr, $auto_hr->{$attr}( $self, { aval => $aval, value_ar => \@value, } ); } elsif ( exists $value_hr->{$attr} ) { push @attr, $attr; push @attr, $value_hr->{$attr}; } else { push @attr, $attr; push @attr, ''; } return @attr; } sub _compose_ldap_filter { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # 'filter' => { # 'cipux_account.user' => { # 'cipuxRole' => 'role', # 'cipuxIsRole' => 'TRUE', # 'cipuxIsSkel' => 'TRUE', # }, # 'cipux_account.group' => { # 'cipuxRole' => 'role', # 'cipuxIsRole' => 'TRUE', # 'cipuxIsSkel' => 'TRUE', # }, my $filter_hr = exists $arg_r->{filter_hr} ? $arg_r->{filter_hr} : $self->perr('filter_hr'); # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $filter = $EMPTY_STRING; # &(cn=class84) # (objectClass=cipuxAccount) # (cipuxIsShare=TRUE) # (cipuxRole=course) if ( defined $filter_hr ) { foreach my $key ( keys %{$filter_hr} ) { my $value = $filter_hr->{$key}; $filter .= "($key=$value)"; $logger->debug("add search filter [$filter]"); } return $filter; } return $EMPTY_STRING; } # +=====================================================================+ # || Auto attribute sub || # +=====================================================================+ sub userPassword { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $value_ar = exists $arg_r->{value_ar} ? $arg_r->{value_ar} : $self->perr('value_ar'); # if defined $attr_hr->{userPassword} # and ref( $attr_hr->{userPassword} ) eq 'ARRAY' <---- CLI # elsif defined $attr_hr->{userPassword} <---- RPC # else set it <---- RND $attr_hr->{userPassword} = ( defined $attr_hr->{userPassword} and ref( $attr_hr->{userPassword} ) eq 'ARRAY' ) ? $attr_hr->{userPassword}->[0] : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword} : ( defined $value_ar and ref($value_ar) eq 'ARRAY' ) ? $value_ar->[0] : defined $value_ar ? $value_ar : $self->random_password(); my $password_hash = $self->hash_password( { mode => 'crypt', password => $attr_hr->{userPassword} } ); # +------------------------------------------------------------------+ # | API $logger->debug('END'); # save the results # OK $attr_ar = [ $target_hr->{$o} => $value_ar ]; return ["{crypt}$password_hash"]; } sub sambaLMPassword { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $value_ar = exists $arg_r->{value_ar} ? $arg_r->{value_ar} : $self->perr('value_ar'); $attr_hr->{userPassword} = ( defined $attr_hr->{userPassword} and ref( $attr_hr->{userPassword} ) eq 'ARRAY' ) ? $attr_hr->{userPassword}->[0] : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword} : ( defined $value_ar and ref($value_ar) eq 'ARRAY' ) ? $value_ar->[0] : defined $value_ar ? $value_ar : $self->random_password(); my $lm = lmhash( $attr_hr->{userPassword} ); # +------------------------------------------------------------------+ # | API $logger->debug('END'); return $lm; } sub sambaNTPassword { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $value_ar = exists $arg_r->{value_ar} ? $arg_r->{value_ar} : $self->perr('value_ar'); $attr_hr->{userPassword} = ( defined $attr_hr->{userPassword} and ref( $attr_hr->{userPassword} ) eq 'ARRAY' ) ? $attr_hr->{userPassword}->[0] : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword} : ( defined $value_ar and ref($value_ar) eq 'ARRAY' ) ? $value_ar->[0] : defined $value_ar ? $value_ar : $self->random_password(); my $nt = nthash( $attr_hr->{userPassword} ); # +------------------------------------------------------------------+ # | API $logger->debug('END'); return $nt; } sub sambaPasswordHistory { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $nt = '00000000000000000000000000000000000000000000000000000000000000'; # +------------------------------------------------------------------+ # | API $logger->debug('END'); return $nt; } sub sambaPwdLastSet { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $e = $self->date_epoch( { today => 1 } ); # +------------------------------------------------------------------+ # | API $logger->debug('END'); return $e; } sub member { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $aval = exists $arg_r->{aval} ? $self->l( $arg_r->{aval} ) : $self->perr('aval'); my $value_ar = exists $arg_r->{value_ar} ? $arg_r->{value_ar} : $self->perr('value_ar'); my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my @return = (); $logger->debug('target is member'); my $storage = CipUX::Storage->new(); my $structure_cfg_hr = $storage->get_storage_cfg(); my $access_cfg_hr = $storage->get_access_cfg(); my $obj = $aval; # e.g. cipux_account.user $logger->debug("RDN object is: $obj"); my $basedn = $access_cfg_hr->{base_dn}; $logger->debug("Base DN is: $basedn"); my $rdn = $structure_cfg_hr->{$obj}->{struc_rdn}; $logger->debug("RDN is: $rdn"); my $dn_attr = $structure_cfg_hr->{$obj}->{dn_attr}; $logger->debug("dn_attr: $dn_attr"); if ( ref $value_ar eq 'ARRAY' ) { foreach my $uid ( @{$value_ar} ) { if ( ref $uid eq 'ARRAY' ) { foreach my $u ( @{$uid} ) { $logger->debug("value of target is $u"); push @return, "$dn_attr=$u,$rdn,$basedn"; } } else { $logger->debug("value for that target is $uid"); push @return, "$dn_attr=$uid,$rdn,$basedn"; } } } else { push @return, "$dn_attr=$value_ar,$rdn,$basedn"; } # +------------------------------------------------------------------+ # | API $logger->debug('END'); return @return; } } # END INSIDE-OUT CLASS 1; __END__ =pod =head1 NAME CipUX::Object::Action::Attribute::Change - Object layer class for CipUX =head1 VERSION version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object::Action::Attribute::Change; =head1 DESCRIPTION Provides the functions cipux_object_create and cipux_object_destroy as well as some auto-calculated values for example for userPassword. =head1 ABSTRACT The CipUX object layer is a generic abstract class, which can be used by other classes or scripts. The function cipux_object_create may create one or several LDAP nodes according to the configuration structure in /etc/cipux/cipux-object.conf or ~/.cipux/cipux-object.conf. The function cipux_object_destroy tries to remove one or more LDAP nodes. =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Object::Action::Attribute::Change. =head2 change_object_attribute_action Change (add, modify, erase) one or more attribute values. use CipUX::Object::Action::Attribute::Change; my $c = CipUX::Object::Action::Attribute::Change->new(); $c->change_object_attribute_action( { # API 1 args action => $action, type => $type, attr_hr => $attr_hr, # API 2 args object => $object, scope => $scope, changes_hr => $changes_hr, filter_hr => $filter_hr, target_hr => $target_hr, } ); Where as for example: action => 'change_object_attribute_action', type => 'cipux_account_object', attr_hr => $attr_hr, object => 'rpctestadmin', scope => 'one', changes_hr => $changes_hr, filter_hr => $filter_hr, target_hr => $target_hr, =head2 userPassword TODO =head2 sambaNTPassword TODO =head2 sambaLMPassword TODO =head2 sambaPasswordHistory TODO =head2 sambaPwdLastSet TODO =head2 member TODO =head1 DIAGNOSTICS TODO =head1 CONFIGURATION AND ENVIRONMENT TODO =head1 DEPENDENCIES Carp Class:Std CipUX CipUX::Storage Data::Dumper Date::Manip Log::Log4perl Readonly =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut CipUX-Object-3.4.0.5/lib/CipUX/Object/Action/Attribute/List.pm000444001750001750 2115311424662704 24434 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX::Object::Action::Attribute::List || # || || # || CipUX Object Layer Class || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker. All rights reserved! || # || || # || License: GNU GPL version 2 or any later version. || # || || # +==========================================================================+ # $Id: List.pm 5011 2010-07-30 23:31:16Z christian-guest $ # $Revision: 5011 $ # $HeadURL$ # $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $ # $Source$ package CipUX::Object::Action::Attribute::List; use 5.008001; use strict; use warnings; use utf8; use Carp; use Class::Std; use CipUX::Storage; use Data::Dumper; use Log::Log4perl qw(:easy); use Pod::Usage; use Readonly; use base qw(CipUX::Object::Action); { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.5'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe # +======================================================================+ # || CONSTANTS || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; # +======================================================================+ # || OBJECT || # +======================================================================+ #my %cfg_of :ATTR( init_arg => 'cfg'); # store conif file name # +======================================================================+ # || GLOBAL VARS || # +======================================================================+ # +======================================================================+ # || object || # +======================================================================+ # this is the entry point # same as: list_all_attribute_action sub list_object_attribute_action { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $action = exists $arg_r->{action} ? $self->l( $arg_r->{action} ) : $self->perr('action'); my $type = exists $arg_r->{type} ? $self->l( $arg_r->{type} ) : $self->perr('type'); # source here even if we source later for single debug handling # these are the given (CLI) values my %tmp = (); my $tmp_hr = \%tmp; my $attr_hr = exists $arg_r->{attr_hr} ? $self->h( $arg_r->{attr_hr} ) : $tmp_hr; # +------------------------------------------------------------------+ # | prepare my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); # debug API 1 $logger->debug( 'action: ', $action ); $logger->debug( 'type: ', $type ); # TODO: test this output #$logger->debug( 'attr_hr: ', { filter => &Dumper, value => $attr_hr } ); # list object types and check it my $type_ar = $self->list_type(); my %type = (); foreach my $t ( @{$type_ar} ) { $type{$t} = 1; $logger->debug( 'found type: ', $t ); } if ( not defined $type{$type} ) { $self->exc( { msg => 'unknown type', value => $type } ); } $logger->debug( 'ACTION:: ', $action ); # API 2 my $object = undef; if ( $action eq 'list_object_attribute_action' ) { $object = exists $arg_r->{object} ? $self->l( $arg_r->{object} ) : $self->perr('object'); my $msg = 'Parameter "object" is not defined in'; if ( not defined $object ) { $self->exc( { msg => $msg, value => $action } ); } $msg = 'Parameter "object" is empty in'; $msg .= ' list_object_attribute_action'; if ( $object eq $EMPTY_STRING ) { $self->exc( { msg => $msg, value => $action } ); } } my $scope = exists $arg_r->{scope} ? $self->l( $arg_r->{scope} ) : $self->perr('scope'); my $filter_hr = exists $arg_r->{filter_hr} ? $self->h( $arg_r->{filter_hr} ) : $self->perr('filter_hr'); my $target_hr = exists $arg_r->{target_hr} ? $self->h( $arg_r->{target_hr} ) : $self->perr('target_hr'); # debug API 2 $logger->debug( 'object: ', $object ); $logger->debug( 'scope: ', $scope ); my $cfg_coupling_hr = $self->get_coupling_cfg(); my $v_hr = $cfg_coupling_hr->{$type}; # create hash ref my $c_hr = {}; #my $object = $v_hr->{object_attr}; #my $object = $v_hr->{object_attr}; my $value_hr = $EMPTY_STRING; # for every object in 'order': cipux_share_object, ... foreach my $o ( @{ $v_hr->{order} } ) { $logger->debug( 'object to list: ', $o ); # additional filter my $filter = $EMPTY_STRING; # &(cn=class84) # (objectClass=cipuxAccount) # (cipuxIsShare=TRUE) # (cipuxRole=course) if ( defined $filter_hr->{$o} ) { foreach my $key ( keys %{ $filter_hr->{$o} } ) { my $value = $filter_hr->{$o}->{$key}; $filter .= "($key=$value)"; $logger->debug( 'add filter: ', $filter ); } } # attributes to query my @attr = (); foreach my $attr ( sort keys %{ $target_hr->{$o} } ) { push @attr, $attr; } # only query objects containing the attribute # ex.: cipux_course_share *.group = yes, *.user = no next if not scalar @attr; # my $object_type_name = $cfg_coupling_hr->{$type}; my $ldap = CipUX::Storage->new(); $value_hr = $ldap->get_value( { type => $o, scope => $scope, obj => $object, filter => $filter, attr_ar => \@attr } ); } return $value_hr; } } # END INSIDE-OUT CLASS 1; __END__ =pod =head1 NAME CipUX::Object::Action::Attribute::List - list object attribute actions =head1 VERSION version 3.4.0.5 =head1 SYNOPSIS use CipUX::Object::Action::Attribute::List =head1 DESCRIPTION Provides the functions cipux_object_create and cipux_object_destroy as well as some auto-calculated values for example for userPassword. =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Object. =head2 list_object_attribute_action TODO =head1 DIAGNOSTICS TODO =head1 CONFIGURATION AND ENVIRONMENT TODO =head1 DEPENDENCIES Carp Class:Std CipUX CipUX::Storage Pod::Usage Date::Manip =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut CipUX-Object-3.4.0.5/bin000755001750001750 011424662704 15430 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/bin/cipux_object_client000444001750001750 1573611424662704 21560 0ustar00ckuelkerckuelker000000000000#!/usr/bin/perl -w -T # +==========================================================================+ # || cipux_object_client || # || || # || Command line interface for CipUX Object layer. || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker, || # || All rights reserved! || # || || # || License: GNU General Public License - GNU GPL version 2 || # || or (at your opinion) any later version. || # || || # +==========================================================================+ # ID: $Id$ # Revision: $Revision$ # Head URL: $HeadURL$ # Date: $Date$ # Source: $Source$ package cipux_object_client; ## no critic (Capitalization) use 5.008001; use strict; use warnings; use Carp; use CipUX::Object::Client; use version; our $VERSION = qv('3.4.0.3'); delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer # +=============================================================================+ # || MAIN || # +=============================================================================+ my $client = CipUX::Object::Client->new( { name => 'cipux_object_client' } ); $client->run(); exit 0; __END__ =pod =head1 NAME cipux_object_client - create, destroy CipUX objects =head1 VERSION version 3.4.0.3 =head1 SYNOPSIS cipux_object_client [OPTIONS] -a cipux_object_client [OPTIONS] -a list cipux_object_client [OPTIONS] -a create -t -o cipux_object_client [OPTIONS] -a destroy -t -o =head1 OPTIONS -c | --cfg : cipux-object.conf -D | --debug [] : print debug messages for developers -h | --help : print help (this message + options) -l | --list : lists configuration scopes -p | --pretty : nice boxed output -V | --version : print only version --verbose : print more messages =head1 USAGE cipux_object_client [OPTIONS] -l : lists CipUX objects cipux_object_client [OPTIONS] -h : help page cipux_object_client [OPTIONS] -V : prints version =head1 DESCRIPTION TODO =head1 REQUIRED ARGUMENTS One of -l or -h or -V is required. =head1 ARGUMENTS =over 4 =item I<-c> Same as option --cfg. =item I<--cfg> To specify the configuration file, if any. The preset location for the configuration file is: (1) ~/.cipux/cipux-object.conf or (2) /etc/cipux/cipux-object.conf If both are missing, you have to use this option --cfg to specify one. =item I<-D> Same as option --debug. =item I<--debug> To see more output, what the internals is doing, you can enable the --debug and see more messages printed to STDOUT. The suggestion is not to use debug output for production code. =item I<-h> Same as option --help =item I<--help> Prints brief help message. =item B<-l> Same as option --list =item I<--list> Lists all object scopes. The object scopes are read from the configuration file. The preset location of the configuration file is /etc/cipux/cipux-storage-structure.conf. One object type is needed for the --type option. Prints a list of configuration types to STDOUT. No object will be changed. This is useful if (1) you would like to see what kind of objects this layer can handle and (2) if you would like to test the preset or another object layer configuration file. You can use this with all other options, they will be ignored except -p | -pretty or -D | --debug. Example: cipux_object_client -l -p +-----------------------+ | type | +=======================+ | cipux_account | | cipux_share | | cipux_room | | cipux_configuration | | cipux_machines | | netgroup | | cipux_room | +-----------------------+ =item I<-p> Same as option --pretty. =item I<--pretty> On command which produce an output, this option can be used to draw a fancy box around the output. =item I<-V> Same as option --version. =item I<--version> Prints the version and exits. =item I<--verbose> Not implemented jet. =item I<-v> Same as option --verbose. =back =head1 DIAGNOSTICS TODO =head1 EXIT STATUS TODO =head1 CONFIGURATION TODO =head1 DEPENDENCIES Carp CipUX::Object::Client version =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2007 - 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut CipUX-Object-3.4.0.5/doc000755001750001750 011424662704 15425 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/doc/dep000755001750001750 011424662704 16175 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/doc/dep/depgraph.svg000444001750001750 1710211424662704 20666 0ustar00ckuelkerckuelker000000000000 ]> test node1 CipUX::Object::Action node2 CipUX::Object::Action::Attribute::Change node1->node2 node4 CipUX::Object::Action::Attribute::List node1->node4 node5 CipUX::Object::Action::Create node1->node5 node6 CipUX::Object::Action::Destroy node1->node6 node7 CipUX::Object::Action::List node1->node7 node8 CipUX::Object::Client node1->node8 CipUX CipUX CipUX->node1 node3 CipUX::Storage node2->node3 node4->node3 node5->node3 node6->node3 node7->node3 node8->node5 node8->node6 node8->node7 CipUX-Object-3.4.0.5/doc/dep/depgraph.dot000444001750001750 223611424662704 20637 0ustar00ckuelkerckuelker000000000000digraph test { graph [ratio=fill]; node [label="\N"]; node1 [label="CipUX::Object::Action", shape=box]; CipUX [label=CipUX]; node2 [label="CipUX::Object::Action::Attribute::Change", shape=box]; node3 [label="CipUX::Storage"]; node4 [label="CipUX::Object::Action::Attribute::List", shape=box]; node5 [label="CipUX::Object::Action::Create", shape=box]; node6 [label="CipUX::Object::Action::Destroy", shape=box]; node7 [label="CipUX::Object::Action::List", shape=box]; node8 [label="CipUX::Object::Client", shape=box]; CipUX -> node1 [color=red, dir=backward]; node1 -> node2 [color=red, dir=backward]; node1 -> node4 [color=red, dir=backward]; node1 -> node5 [color=red, dir=backward]; node1 -> node6 [color=red, dir=backward]; node1 -> node7 [color=red, dir=backward]; node1 -> node8 [color=red, dir=backward]; node2 -> node3 [color=black, dir=forward]; node4 -> node3 [color=black, dir=forward]; node5 -> node3 [color=black, dir=forward]; node6 -> node3 [color=black, dir=forward]; node7 -> node3 [color=black, dir=forward]; node8 -> node5 [color=black, dir=forward]; node8 -> node6 [color=black, dir=forward]; node8 -> node7 [color=black, dir=forward]; } CipUX-Object-3.4.0.5/doc/dep/depgraph.png000444001750001750 15151311424662704 20700 0ustar00ckuelkerckuelker000000000000PNG  IHDR5bKGDtIMEoR IDATxw\ua8r ykVrffeYw lj[Qݶ\--^ g#w@:xPuq]~lv..\!au󊏏W||Ο?sIRSS3nTt錷[Txq)SFeʔP?9`$ڵK{U\\*..NǎS||.\p)Qʔ)*U( Zj R5B\@8z֬Y7jǎڱcۧtyxx_^TBN:NjJ,)Irww{ZZΜ9#IJOOWBB3:uI>|8#$Ӊ'$IŊSppBBBƍQF dϞ=ZdYF֭z)44TuUHHUfɒ+**J;wΝ;cm߾]4hf͚UVj۶J*5B< $%%_~я?ŋkϞ=[լY35mTUxqKGjZj֮]ŋ WvԮ];5l2(2Kjܹ% f̛vyYZj{޽BBB.BO5k,>}ZZRեK-[nǎ3gΝ})44T c=%JX]!pv~GM8QK.U͚5OG<ˬ[NӦM_|!www[V``եPh`۵`9R7oVv4h o^nnnV24}t}ڷo"""ovV@wU\RM4у>jժi˖-Zh:vHwRJiȐ!֬Yn:'muyh|ɓׯZj2ehÆ ?ׯoui.M=zΝ;G˖-SppLt@b9-poVƏnݺY]Rv9[?~6mHX] xKMMСCչsg=Ê"~~~3f6nܨso… . жm[M:UfҔ)STdI*TׯUV<{(0<.Z||>}7oٳzw. G"ܹs~MUV"'-ܢiVKc,ݮGyD[lʕ+UbEK*r~uYgfA=Pd}GZd;<<zշo_Z].E_#Fh[>H[V)oooUTI7V3 Wxxx?aff_&L8>j(UT)۱DlPhht5nXQΝC}-Yw#!${>|F#FH.??? >.]7(HXN "gΜ9 rz'I'O֡C_1':tj׮1cZfVXaÆ[ ={ԦMo @/&.X@t_hթS'c_;Ie!CrRz4o޼<[ǏWbb^|E 8PӦM{ZBBB: @AA"%%%E;vPXXX/**JTNkݻwgylӦMD 0@Ў;ݻkyVkǎձcG͝;W]tQ```]z5lP7oP:tHTr|_BB$羚,OOOj̘1qu/զMI?׽^UTQ\\%H9}$tr?Gx׽;%Iׯϳk͜9S>>>ݻ֭jϞ=8qbYqqqZjEfS֭||3<M4)cENbbbru+VHZlqK,6|7o[&O[o2eh:qDjQ)))ZbEƾ| !nݺoUjjUdI-\P˗]wݥɓ'СCJKKөSl2uU㕞(kó[oXb:t/^d>}Z3fȑ#ofA;B )SF#GTBBx㍛G\˗+11Q=PEN.]/2_۷k={ׯ////駟Vjjy}嗪VZUVMs̑$),,LjԨnV-_\aaaY5k֨e˖ӧTvm}ZdI'U^] /hbcc5vXIɓ͛7;ݤɓ'{K@&=oBnҤI裏-˹*&777Y]/Сbbb`u9:P$ 8P2dե\tKpxOC% @fjJ}x ˹"&I*ߺѣGXbVKEVӦM5i$=.'ӧO+888UfٷKKKӀn:͟?E?OM0Afң>ju9EŋէO}Z`ZjeuI4 6fgϞ:p^~%{'OTϞ=vZ-YDVˣ&Mҋ/;j*]%:k֬ѣ>*www͟?_aaaV@x{b mڴIaaaZ`%III1b.կ_?} !pMjӦMj޼xuEeh˖-S5n8;V=]!pe*22RK.նmaÆĉVVlذA;vԽޫ0EEEi7 {Ѷm4j(͘1C5j믿Ǐ[]K۰a|A5nXZt+U\(СCw^UjU[֭}k>}ZZң>;J*Vڸq;͙3GSHHz'xB+VD %B<&jҥ;w~%$$(44Tڵӽޫ&MDVy/otR?~\uQnԣGX]"!.^5khҥZx6n(ͦ5o\͚5wܡ:ur9{vءkjժUZj:$???}ݺ{uvV @B8щ'j*[N֯_Dyyy)((H U͚5իRJrss .(..Nqqq?;vh׮]?%I+WVxx6mMQFrZM|tEEEEi׮]ھ}}v8p@$OOOUREzʔ)G%K$[n$(11Qq9sF񊏏ɓ'#Gѣ(QBAAAW֭PիWOUV B<ȑ#:p@F9^uivv>"<<2VbTD,`rTbEըQC k# ٳ=%PsF!G8B<.pqx#\!G8B<.pqx#\!G8B<.pqx#\!G8B<.pqxai ))I*Y<g|N6ƎSv"\'{[ 7, _}^DkN< ٵKWԩ#O= _Љ$uJj==>}&tx@Aӧ=t, ?jԐ.VfCZޚЉ4ժIKn};.mMMO⥧K|X?|o9ĉŋbŊZv] 4ڵk5\3k,yڳgOǏرc:uo߮0} h޽}y8[ZZ֬YRJi…y~}W|8z6MT^=%&&jͪ^zw}ZdI']9l9{4|p9R#F$ >\~~~>|xjسgBBBu'$y:pTjݙ<`;w?Є d_kӦMjذ%䵞={J"##-PЉKL>>޽/^gvQ;vܹsեKx^zzӯ%I+W⽪T"Iڷo_4o<9sF;wzq97uT5J/N3g>8uVhB111ߔ+W*W֭[qnX{p!RJX6lرcνZ.7!I:tҥK+..N{ڷo+V[;v$8qB5jТE4ydkԨQ*[*Uw}WYL;S>>>{9fpwyٝw)IZ~}]0a7o_5(Q$3JΟ?/I*YUu+k.IRŊUtiIYC+VHʾg꽯… վ}崤6jqAAA5h ˱8̩W@K8Bxq2cGAW???yxxd;ԩS[nZZJJ/_-[f[.IZtRSSW8:<}}}3sƎcDxă>(Ij{suxIRr</u1/_>͜9S>>>ݻ֭jϞ=8qb꒤{Gr+Hs,'NH2]vWRxqIRjjj>rɕϛom۶Yk̙3yUKR$e +axgI&e ILLLZlqK,6|7o[&O[o2ehAzgTD 7.kܸq*Yxk2ˉqϞ=9oҤ7j…Ysh۶Kjǔ\RbIڼy$3E(Y.\뮻ɓu!ԩSZlvzեJOOWTT^{5y{{kYy뭷TX1 :T/VrrN>3fhȑz7]wРAzwTBʔ)#G*!!AoF4i"zʕ_j۶VXD%&&ftt9hժ.\xUREkזdB-Z(99Y!!!okf1`Wa紳/K6M{)---l6<<< sSiq%N<hV`)wLw^g! :()))cl>}-8! ӧO+888Ufٷ(ٲeW^ѫjuI <.ȭҥK+**2\ѣG.:G8B<.9/Jubx>RLe^v2/11RJޕt )B<d,EGn]={L.ը!խ+Rp"5k(̰n.iNRZ)ծmºΝ)8X _΂X]LwTե 9B<̐UktdK^^mwo<=pY~-թ#l)+u*Y]"(,N2]u]Lhg. gzR͚u[w/N{yO=%5kfuB dzv9BG%L@WԦ^=zuҁnIc^ٳӥp),L0@Ջ<M#pUG=뢣'NJe!!R& Ul6kk2eg5/I}& * fg5n[]@gKFE屒T 6A+[[el6z!EDD䝐2eޅ^_x%*twzq3#KiiYFE.1ќSr2X$غuM-!A7t7^ms<ԧ`uuǥŋmۤ W/i2iR%kkq8)2R9|.ܻl"/͙cy Ҟ=!ݎ&j2]PcK+WJSH:w6AX6o`_KݺI? ՘n;V.x٩KYZ5 }IߓorK^^Ґ!f-_#9 N:G`s*5ՄG5jduuŭ_w w/AǑ#&Մ7b&Y37^KNZT*VLzQӡעE/M Mddҝ !$%%eu;wfطOxQ06%{NaWO,ʕz5dvly&j1vtWeZfycr'fmJ ^xA*Q"j,B<P=9(3t"=,i svg6iTie?.=`yOd4v޺ՄEqmfHqeK w{֝;g`|+Hބv3fH78LvIIÆI#FX]͕<)Iwޙ`Qj:Ag4C>Ҙ1&-]Z5ܿ x`;y2αg]Tt9^ .[Ǯ0oӥM3!rt=^d%%E 7A~PowK'.>^;W 3# |}qG6]BCM?\ !(۱#sxR`֭k*PAs5͚G[hM y,F>PZV_j\Gt3'qf(e,\XIz=uP$_`]u;vHNܒ9XUd:czL݌|yS驧Ϝ֭3KБQ:c7թλ^a,˖e۷K>k2 =B<v?MG{EG {]u.Xq}6nRCYAo&7/}ոs礯6+W_={[psn2n#ι%IK3!αw]th7#s]W#3=O7lP3BF߾ҢEf魷Z]͍1|/7puHfσr7mK8aN&m+_g6 WͻxQڻ,{.*Jp`BIfy, 43s 3DŽ?n‹l|K2˂[77֭|^K:v*=sBc`|բ E!~))RllP G]l9&UUػ.( {[9S:rĄ}Gsg3Q;y<2SZ; 6uYj^P'oxQ0AzMӍ7}԰a]`)B<]R餻nvi>CTYziW]ݺY.R%q&aK;Jwi%\TjzY]M}4Ka۵3G:={~UR70 4B<Dؑ9 v.SZYUvfGclP*ի͒9sLeN&t>"O> 1Si6&۲EVj Tzt$T))",m毟n&"TJ~X !!.**s?4]Cޙܥ`kfO1.̘a岽{KY]늎Cz%魷&%%I?DW60M3q #"2engv-bx&'OfSw4Cq_߬V-~ ZȄwIŊe}PWjyꊜcIwLXcӧ멩C6m̿.+Ԫ馬T)ok8!Q\\怉]27Ks, 6C'n@^љ]w'NP8~./m$Z]s}4rPNI_~iȬ^m`8a7Su d(bpU/AY;뢣g9eftvY݌Y~FZe&~4p8_Znjm>Wg2ƃs̞ӦICJ_xF!jII.::RX3D@2˥S`/Mi^׮& zEٳRXᇢΝfQ/[]Mѐ&-XuJ scli3bX"6,%//?cĥ%|}q,u}K>+ոA2tix\ۊ&̛?_*]ZtY~4asVWE! e,c~9^Dנ YWTam@^|lٲf㏳\դ2 "ח`~ұ4uF9b>~.)MdZ@"8Gr\qQk bb̒I*_>smev8KzpoalAJ'K61!738X!hau5f˧JjW@QB9'NdvEGg8`6vwU\zm]veZ]=?Y~SqqӮW/3岮mR];it:-lR'&Jŋ[SnΝfoիMWc0+Bpmii%bc͟f;I3]``p NjV8vt"͜)m UjB޽M*\ѣ&hȽ3a.x|>>Շ[_:tHj\zysg <@#d:{6{G]L RR9+g.u  d , I.H?`%KLݵkLRF.w 6o6{u| {o7W4f9X[nܫJ,{ 瞓|R*U P!`2ǽ̾Oue deK+WN/4{>s ~X*V q#{O9 hj TLvfi>OMB(]8|g\9iD\2zj׶L(,JNvs,5wٓ.8X^)(:v4Kmܽ]lu,dfϴG5PpZ%je:ȆaXӵePϡT)-/ 4vjSt)qqrZ(;~EVfر}_~!)Οڴ1U_Kn2Dޝr@A,ֱٓ5&) ,\ۢE{$9O9,-X`:-2O=d6m *l:w֮n5Kq̒[M//s„ yq)LFWr4lfj~8|83stƚziifS9:,ּyf/tbI;v\2<^mT|t z6!O~}M@yvK/O{.(dRK8.Onrw=sK_cc"\F 9::*Urq_ .VGIϛ|y3a%yk|3Tҡ^^&<=:ks!RfW?n.4d~ݜ?lԩݙpB<?ػLΞ;֝?o)S&W>ukg/!uRn hyI-R*VWS88!=YSW^ZfWvq:yu ,0+^~ tnP@(ڒ?}|ÙS@f˗FG}]$e͚Y:ni'N̹RKks=t,g?w.M n]妫nNٜ9fġCM7gΫ B<E7H='=zyBK_L?u~iij̫f`={3{";f~MSWyijݘ1Ґ!8㏥LY PD(z7˗_{m>w7]: w]=ωcb- d3ESV2׼y&KL4]y J6Y]ڻvj1'OO*~ժmⲅxqqqZvUx\f[.uPz)cGIRnݜR_㞜xB.׳ٔn¹t]k@~~m^=-ԤI˸9<#͞mB5r)-L|tǔ)_^ϔTUz5iDW?)-Mj֬|ذ&&?6[tn7ջk@-ě={ziU=I)%HIViIr|etV3_QJZ%-/I'.y9.x,zEVDD"4 K3諯]vݜ׭iŵEFF*""':$JOSz)}ZҫJy?gD -6`RVWm#mْx6[a&֬i۞9JJ2TL7'$t}UKMҹsο?1B<^/`͛>x2 غ5' ~t֪eB! ٳ)Sp%jOKKom¼70>LJIZ4b=\>Ҝ9քgIcƘ=:w6fNx(\ΟyD Ο}^^ҩSP4qf{=fNzΙ 73HI_~>xV鮻+ h IDATﾳ) ,CU ~ B<SH3gJfIժY] yAizU쥹qI;wZ]H"@aiץwtmՕdհld__O2E! SV#6v +ٽJ6_~_N2E! 6][JMBrw"׫eKiJ277)"fm͚رRR(bPY6oTȍƍM 1sF0y3fHVW/!!A}ZnSުT7ng\]„ ff&Lq|ԨQTRcV%dPEEE… jܸΝ;9oݺU}UZbŊ)00PTLLLjժQ'?S6M ksvtp<۰|oذA5k,0ϩk/_{o+=gfu^ ^|WX櫟xC3L,^x_vܹ ]PY+>JIG0];),L?;*kCSb!X-QQ4&6D)hzbF+N[( FQT,(Hq_&" gٿ\ 3;ϙssD'cz۩ujԨկ_|}}AIIIF .:uȶڵ+u֭ԏCDȌC#cccztܹ3:iii:u())NIMhH;wD'bUA2vڵxaffVvG+3///4o;?~Ә;wnzjс޾}5kOKKm(www}̿{{{ <(,<cCϯseeeaرc(r, O3w.p*w/`` :M~*D?11bsWn@@|d^Y4#tҥb͛fCݝ6lHZZZdaaAvʷ[C"@GvQtttu҅vZڵ#tB+::PNd +++%---m… Դi|mɡHWW\\\}[FNNNdhhHTNԩ%$$PΝe|wŵ]۷ǏS||}6P```*O; kCAjՊP (..LRh{;6^x!_9^z;{J>M:::cӧ{m:uD5j j޼9MJJ"777jذ!ihh5jԈzI)))%jI(ڕx^{RߛWAo"85jժUАڷo_dޒP+Kڥ"#J% VG(=^X[JOW!WIWU̾Af&ƍDDDBsR+ )թSPbbbhIM;v$\888?~tܙlll F \ {-Zjά,}6Y[[ڻwom?-\P;!< z}ǍGhʕNV"T-V[%gȠxݻw>Eh5\]e(9_/XU+-i[JO +98MX1R$))RO_Ԕhi0cQ455 eeeKp{ oޏp,]9-- @مnMHSS3O9s>`]׮] ݽ{?NM6Nyr"֭[G_o͛m[,fooO(,,Lvӧ < .vdA{I%96J⎡T<33&++Z('oSSS ʶ)o}o德 ]ޢRvZZZ=zTOh/9ҒƆ(=]LRJW~`U_k[\[JOoTi" N4fLK=~L4i:QǎD!!1ƔT ~\7o[¶}ƒ)uޝо}J]mNNN.t$@k.2{rr25j]ɲBuzyyGzСtϡFo۲fyڵkׯ_bW@-k[K Yc**NE K :ȶ)o}o德,ՖonnN[n2}Šx99DFIY*tE VuyŵViUXoXjuAiE[^1VJEVnݪ MMM}N: ֭[MMM|(u-Z>|X6n[I|SSS &99MM|ۿz PV⢗ZFF?=z@MM jjj=zy,_ MhK__?} %96Jc8zgϞ044*܉׭[ lܸ0tP6m"⾷`r[^Ǯ]0dܽ{ǏG&Mp̙JylXط5F._/XUVs5t) EG_1ƔDr?(߿ V|PnC(dϟׯ_6zzzLte礰8uqÆ Û7o=f͚䞬k)m;+CI**...8s 6nXO___o?tttom~E}o德-Χ~Z}7O>/^Pvv6EFFR˖-zt}444̌BBB(--(""BMZ]|Y2VI٢E ~.::+5m]!^BbICC#I^Aɣ$*,cI&Mڽ{7eff򽻯rw 9*ی &ѿxbjy vZ9Wq/ E^{}o{JMMhjԨQ۵iӆ)==vAήȼ%Qs⥤uDԶ-Q**a0׫n^QmIR~@*lN1c>bܑyn1*G$M:l2ѣծ]I[[5kFC ˗ݻTTvbN&&&IԳg<uu9r$}IuԡCRxxx?N7&dbbB6m'K˖-ʕ+DDԥK<x9ם;whԢE &mmm277'WWW{ngϞM]t=?kצÇӍ7lW_LLLHCC7nLs=z>ijjRiΜ9-[FTF rtt,AAAؘ,X  rի˔%8x " .]6Rȑ#DDFy^S˖-eYZZ۷o΂wo֭[iݻ }ؿ?}C}[ʞG JLL,0[qPI_xE66l W-[ڵkGYfޟѣ^:Y[[CQ"r[U+VȾ(_ӦM m^zN5k֤CRLLLfITjoD"CCE׫V{.->VRSS S6Gň#?CvٳgѣG 66܏#QD}o^2V>WU| %0ocL5UȜx%''Gtr۟*4)$''cԩyn].wR~V0{eL'ܯ+ׯ-nI V;e]1V!Tl޼0aSRRR+W`̘1s犌)x`(xw0%JHBHWݾ /lmE'c "֭[~611)08ŋ1o<|W#10f̟?5kք> CCCq^HFT30l*0+~]ɼy<{N46n._Bބ җ1):aˬ'ORjѢv!:R?2@ץLxh]pו̝;[Ct{JtŲPtJ J<c1ưy3f 矀4rP:`j*:1Bz~DbU.1c1.\N&p1BtXe}hDHܺt89IsFGN#.1c1qÁ1VܑxlLM]aOm_|$&N.1c11RS+jm+qSEaa@ǎS(޽Kooia `& 'Gt2X"c1ci(ݡCc(!Awj\]!ÆIt&-c1*ߒ%Ν@0Dԥ$UK+.`k LNjN+'.1c,-b\x1 t Xų/IX1VF\c1c':371&?HW11BZvKK @t*Xp1cUׯ!CVuDa\ ):j^*u89+1E<c1&jD'bt(C+)k4m[ dc%E<c1&O{ N!wo@__tԻ7p l ]!{Tbp1c֭j؈N-' Dij;|1 YWe`L%z jPe2_QF.\Nk'` ꯿2|cccAΝ92xu7'KEwwi=R1Rh?1_X)0r4qoN#āp1S,I"ccIػvعXsS""Bpp0qqXYYƍCEc t5X[[c՘2e8Mf&п?Pt";v߿?<<<0x`^e O",, ^"""\pݻ7Mrr33`4+$3`\`fo_`JukѩSy\cLvBڵ憩Snݺ1*pY͔'n4lm[iT˗/vZ\/^'|ٳg})w ǜ9sDQ F@@=ׯ_ptt-444JcǀARb;w1y2&S ?Ɗ+n:c„ hJn:̘1/_FvDalo۹=Ztq],[ [lAj0uT̚5 6M)Xhn޼ƍp222pYwEڵaoo''' 0d-<~ 8!ЬbdgKCl00ؖfnTX"c ۷شi|||8::bٳh19JHH@֭1qD,YDt5VZb2iT™3g퍃 Oa`` :RIOOGv`nnC𢣣@={`gg899e˖)) __*TrbVnϞICllV]hJt*T S`9998p.]Pt _|F0VM2AAAuy SF^ր p8&;;Ò%KpEt^^^>|x72G}$:HLLđ#G`|͛7УGTVMZDfe ICl==E0JE<Ɣą tR۷Ƙ9s&L5jᰶƖ-[,:c 8:7nWFFUIIIIظq#|||C|G={6lmmEG2\\\pIDFF*eP 007oD͚51`8^Νas蘬+*QCb;rTUy\cLܻw+Wƍ> HKKChh(/fwg66T9>ʕ+~zdffbҤIpwwGfDGrЪU+L0xHxݿ_ZvvpEv^[^F=}* V$_(h(5cBp1%uaժUȑ# Ęٳg>c?L98 .FT)W\7v ### kJ]dҥKoE;wܹ DPP>5 IDAT}ƍݻ7E'ee?H`<韎TU9\cLeffbƕ+WУGxyyaȐ!PWW1V4XXXgϞؼy8ޭ[@׮0 DAAAXt)BBB`eeٳgc̘1ҼbL=z@VVBCC33`VHs?_|Y8իWhРܬtU+V*xU!!!!Xt)ѴiSxyyzs߸uOTϔKx8н (܅||| Q)#F ""ׯ_a ̞ ܻj8q@|||8fϞ X)šuEQ90thaaaaŀd֫WO9X x̝ lY4o.:cJxǏcʕXnRRRwwwXXXX7nի|S@L p`d$:B6nƍ N_}]-[6m2_@빫:t!!!@Ν1d888]v!wJΝ ƊE<if???Ν;8p п7  ڵ F9SP~ж4 ŋXd ߏ `֬Yaʕ+~:_ǔƍ҂\|'''7Μ9N:1Dcŋņ 0qDq7;@Æ䑓˗/СC Dxx81p@ٰ[#ҸfK<|+Txx8k.DGcL)ݽ{[ƌ#:c%?@߾9/NPRRRe,[ ݃=fϞ>}h֬Yعs'x.Ⴜ~-͛9u*믢+66ɓ']NNNhӦ航!7oŋEWd+V||7oDDD &NN*<36;;[6ёKV|tetU^S1& cr5ټy5kĴiz<-c2011 0sLq+W_I<) eRAIIIؼy3VX 'd`aa3gW%MΟlmUbd9rD66!!fffyp` 8X'obPt**cɓ'Xz5֮]$8;;VVV1&ܒ%K믿Çm [HU1111Xj6l؀ ?h1\gիWU{`"௫ 4*wح?q5jppp!iNSZщT\cUTlݺވF~0{l 8\`*)##fff0a~7q+@^\VNSBCC^zpssɓQNјΆ-p=ٲE:U@ŇmΝo^tDꕴbMjиTU .1䂈d?~pww T&OA0VNi44D'Lݻ޸x"QFAKKKt<$]kkkZ SNyl |4wy-;@ɓ'055ЧO>/.S/=fR]Lq1&wƎ;```ӧ1ر#eQ+\J еg5j#g/_j*cذa@x+s?7ШQ#q*ܹԪ%:""\|@xx8ttte_YK!/\m+-|ѡT cɓ'/޼y1cm۶18>>D R&M7nŋ0Vyoo Nt GD8qqa4if§~ Xr)۷oǘ1cDǑlKPrꔴ+8qBG`ll 8::_~T?VXU X4Ht**c=e˖رc077ƍ'*L%&&+Vg}&:cf̐VuvBaX|9"""ЫW/xxx`Ȑ!PWWUQӧOǞ={u늎#_˗sJYn-:MADz*˗/CGG} U!ۥ/͏g0n-/RĪ.1BDD/_m۶SNϛǔի_ѣG~Nt Yk׮ׯ1zhxxxϑ*ARR,,,`gg;w#?|x?$:M/v{1}ptty$KaʒΣGNXq1P={5k)mk֬""=GG**0<<>>>صk 0m4̘1 b.88ơC$:|89I Y\T.:HKKCHHXԯ__vއ~===1Kb" qf `l,:ceE<ƘBzT޽'''޹s`kkpkNtzZUrrr <| 6T~}xgo lEϞSJhh(|||o>ԯ_nnn2e j׮-:cĈ#p-hhh ;;[v1dqwUxK}HHЫ|T{lL0;wDNNмysDGGCMMW gUaooddeeҠYd"̞-]ћQ.66*]NN`zիaoof͚lq>n8B___gm?O4 qJ"cJA@@|||6m`֬Y?~<4V`ѢEEa(5+οM-NFFF|W$:tO>q prrRYtmO<)tޛ7o¢ WmХKbb=y kjJvUΞ=SSS5_k;g[؎11x*N]]C WSN9s&LLLwɓ'#*ܹsx,: SUw))߯ӧ r-} BPPP&F3fcǎr BBB0tP.*/^D֭ QMMP45>_>>Sٳ 8q~#Gƍ_YYYCnݰdŝ+Q* xjjROQij*c'Ok׮Ebb">xxxcǎ1%W_ѣ * ,,!~(M-+1p@\zO:We2$''cذa ɷB_~ LW,_LMu)#00AAA Azz::vcΝ[b۷/mۆz H]$i޻ѾOSh|YoJ_w2TNO?!&&k֬Axx8:u޽{)6c LUEDHmKWKWȹSѣ䚅1E ;6ϕ~d[А:5 q x@M4 sسgO<@ԩS#G*9q x;̙"cLeikk>q1cĈ077ˑ$:"S"?w" +Hiu=9-,@ff&/\-[믿FDzT_ *꿟55N.Veppp/MV-HLL=̙,"O99-0b`d$ݦ) lRq17ߠQF={6سx uK2죏/ƀ}ԩy ωcx֭[իW裏;>e=z4233w2 ? xlmk..H_޽{7o^e|444 PSSiԨQroll,.\ }3t~w-ZN$uq r.Q%%%}YōJC-w E7PuEFB3- q֭Ȯ^]pPV{q1Ɗ[ `mm OOO5j211'رcGb8)6 {Nwggg웩8K@}| ?DbUرc}<|c)1---=Gƹs &`Μ9pssÔ)SPN1@111+UfX'"= !!zzz]r}6N8ӧ9T޽,: +/6mBpp0PF CWWQttt5kBGG044tqL\ V-iXPx1VBݺuCnիWc_0~xu֢#2BCCۋTQÆI(woX+PZ (:b&MI>U:--{w) -c7nŋÇXhN8KKKѣ|e`mmj c@U1Ƙ|p1H__nnn ׯWܜ={Et IDAT>>x般`nnMM^1c1&_\cJү_?#**  ·~ xyy2uZn-:c1cLp1*9V^8|7سgZh#F̙3RBVD`1c.1Ƙ /q=l߾?FϞ=amm۷#33StDV,ܾ}c1cU .1Ƙ`Op9;w͚5ĉaff #xhР(1c1E<S ]vݻbܸqѸqcL:QQQw$$$ׯ/8 c1cLp1)-Z8,^!!!ĠAp*ٳg:uNc1S\c13f֭[8x 0h i֭CJJ*ŋ"c1cRp1Ɣ:pq\v ]tYиqc|7x*ɓ'SO)c1cLc)mbӦM6n܈&M` OexuXt)###hiizhРlll0ydٶ-/_ BMM jjjhذ!/_.hРAf͚ASSVVVBZZlllPzuhkkcnk駟Yfс.1m4DGGٮYf)SSVͥ9Yq}FyjU?if۷+=ˏcCQ>C-t{ 1Sjiiii&j۶-=z޽{)++Kt*m޼ydggW!;v,;TsjԨկ_|}}AIIIF .:uȶڵ+u֭LPQ C#cccztܹ3:iii:u())Nw_,>-[jժEڴga*"/DpS~۬hMacUȉ'ɉթiӦl2zXU"^bb"!ݿ PvLD`@?춯~RgsU^(555)))diiIzzz[KzzzegҨQhȑ\",KEc(xnC6gTvy(쵹~:꒎=xO"_>ȃ^<1ƪ}СCuwx]=; ȑ#^^^h޼9~w<~ϟӧ1wRkHOO'ݯ///}k֬sVPxm?((,0k,bŊ_ezD>΢L*QYd1^zE/&SSSРaÆѩSDǪ͛G666^gggGҥKnE͛7b鑻;5lؐ‚vڕo(7DDFMڵҥ uڵП۵kGۅ>Vtt4N:ɦAVVVKZZZdiiI۶m#" .PӦM1''{222"]]]rqqM{XX999!S:uSN@;w}woߞ?~L񤦦F]t)1Խ{wU-t"[ZZ[.޽CdbbBKs xZjEAGSL5kQ^g㪪,ʨyr* @,͜e޺\YΩ9~s8( 2pξ9 ū>kOZԩ033A۷TcaQ2uP=>;O[IbbBKKK:zʻB1p@XVVVbϞ=bZ (y=/B) QgW%DD B{җ]k::>r&7n,ǏWx8^ĈquѱcG@۷}K:vY.6]tQK>LP[y999(: Ellܹ o^5]V/~yv˗prrW\ BĈW^ycV:UEǎ;vZZZÇV5=zThiiÇq}ѻwoWwY+֯_/GG _gU?b֬Yb͚5O>BB"++K۷OZ*Temd(gJFFR)S۶m"))Iׯ{PR?T{J8?^vСJ}mcJ>1eJ_RL_}}}hѢXpHNNtXu&x:::@eYY_G@ Meikk 6EEEQN8!H|N)))P1rH@ܹS˗//O?sJ bV5 :T.\?~\Æ +u@hiiU3R޳zVaa d2Yǭ1KR~fQ2u(-&Ҷ򞉮 ݻWCE… g5eʔ2IϫmcJ>1eJ_RL駟 KKKa`` ƍ'\ꌹsj,gnn.ThIE,gff @/ƥ}$$$;;;ѫW/@ر1?Ku٥eggg ̬vgggKJ7iD)))"_===ʼn' j,og+ VTgXgUqJ:neK6Ϩ;}FyY,"NNNbƍ"//CEō7Ѷm[!)666ի}Liԟ>vUK*I<""*QNNXfpvv5Y2HBr&T_Μ9S}*eYٿ?VT;RTC]DGG Piܪ5EE'&&FP[-_󅱱q733jKis(^ku|U{Vϟ}5;fyj/3J>#ѥKi[y$>>^1Bjgee%?^+z/ɨ(qJ/B) ǔծ*}IE:-'NDtt4]]]xzzm۶FVVC7nTQf;//J7-- ФIj?+99M6-x; ;&MB\\\4pĉR?~0x2hѢEm ={S{28vv^!YTW,5J۲/tUggĉXnڵ1%cQwqҶIVk.ܹsHJJ„ t܋ѣGoߎ;wۻJMǔ}LcR߫ξ"#""L&o>`;w.lmm1{lܾ}[!*M6œ'Oɓ?)S`gg˗ի~z٧O(ODDzUlÇh"YFW_|􅵢LSSS,]D̓'OtRaҤIeɓڦ]v֭W޽{1dȐbسgKGiۥKݻwc?:?=+1<==[;f]>}ˈ&a066ɓ=ܺuJ1T^B&a۶mعs'|||tڄ} Kmc?ٗTHQ*/^,lmmGtXBddV{QN+өCI&b"11Q4qA1j(abb"G)VRSSEQQm۶ҥKjt022͛7yyy"==]oy !ĨQĶmۊmĤIԶwUt޽Bk.ahh(z);&Evv8zѣ022{UGuiiijijj*_^Yf .߿/ ڔǏ mmmaoo/9"D^^R zT*Enn~)]UxDDTe B=zcǎbÆ nmHT?*SŰdѧOaii)xWĈ#DPPvvv;;; :::H۷_6x͚5:::qS\|Y_%Zj%[[[믿J]~]-mۊ/ !֭ڗ_ܸqCLDZWO>_d022fff7(:O޵lR,ZHjpBamm-ٲeKr*Ţ<B}nݺ add$z%8 "//O=ӧOmJ\]]ENNNgE>éҚx+~ajj*7o.,Y"ڷo/򜙙Ys/Km%}Ģ>cI ]]]!a`` ڴi#>Re=͛ ---ѨQ#)ܹS=ٳgPYyVK|,} K+M6~v+ӗ<=<~ /ADD5̙3 ¶mиqcL4 'OFf4Zk޼9KL: *D&AKK EEE5vL&AGG BӡP=>~IgcA/"%%-Z\.s >yc&UJn۷oaggqʕ+FA.k:*S*ATן`4D Tu&cN>aÆU:W߱aCce˖XhgϢCxװk׮EC .qY 6 X~=`ر j5"QPP#G`42c"#"bdd?r!䄠 dffj:ė}ujǏokk~Mi˗abb}>sMDT"= CCC̘1ׯG۶m5R>PEh:""d2 AƼy_bܸq>}:ڴi0U^+WcǎBqUMQ+Cj ,Ç#77WӡQ=$ը.] $$rJǥK4^P(8pC!""""zI<""kkk|7HHHqytCDDJC ;vt(DDDDDT1GDDehh & 22 舥K"33S!;vQ$ 2 Ğ={pU :_~%lll0sLܼyS!Hbj'''Xwk.899᭷155֮]Pbj-sss̞=7oDxx8RSS1`o5dڴitRL2Q$zƉ'pyxxx`ҤI×_~h:Dt PbN:aƍLJ~5k֠UVxwqE6g ۰1~x4jԨѳgO1bDۺu+z뭗Ք[֫h҃ТE MATkT:usܿڵkTw1G Qnn.l޼ :~~~1b 5!QP(vrtD4V5Ņ$" xDDԠ#44˖-Cdd$z3g˫Z֏ٵk__j2&P(8pñsNbȑ#9꽤$r\|YawU@WWҨ:UҮe˖j9&񈈈ؽ{7lmm1m4|077N>7nĥKкuj"&>S*8~8°m6gϞ=z4ѼysMHTrssVdʕ+HIIX[[[ŅSljJ#""z͛7~ B;3f̀S=z@WW'N^5GLuxT={aaaزe ߿:`EV4Q}SMq`hhWWWd]ѸqcMMDxDDDĺub cС Ā*ѭ[7x{{_~yISm$ ͛qM899~~~pvvtxD/$33QQQT+8 L{{{"pppe8$Q9J%vڅ ;v nnn1cƌSO1KU IDAT._bT[1Gu۷pDFF=zt")EEES+2x!`ff&С333MND xDDDp%#,, 8q"Lkk c޼y8pچI}` I<ҔX"447n܀F 899i:4nܸX WWWi8r""M#""]OOO ,, }ދNJ+n:`̘1 #&I"-- [nEhh(N8 zzqqqrܾ}JFFFpqq֭SJӡQ$Q>o0g@vv66l؀ aРA Đ!CD&\޽طo  2롄iTj:lLL 󡭭 iTD6mЉb '|_6l(6}VT?DPP> '''wށnī_#44;v@NN xyyT!R5HMMU(dddlllpqqaea""vLO/ a 8vQQQ ¦M`hh &`ԩ&,>t邀E(;;[Z.&&غupssvpss#'"I<""zǘ f͂aOII?+WB`` z{nݺ׼E'h /## #G`bbQF! ҈:UUؘdggDjd LI<""*77K,ŋaiiŋ2P(ضm.]sΡs O!OLLD͡[Kպt .Kd2ܾ}Q~~>ߏٳJÆ C@@^nf )RSS͚5t...033pDDDuxDDD \RRcڵ+.]ݻW8N²e˰c4mSNĉ-;ܹs8sL n5={6 mZZZҥ N>R'O"$$۶mǏѷo_`ԨQtu^^^bbbrQQQ{. ...TXOf49Q$.]YfرcŋaggW} {.VX3f f̘wwbeffJvne˖P*6mmm,_'O`d'gr ,, 1cW>C5qqq4ب(DFF֭[(**>i)A`DDD`Μ9wf͚ٳg9)..>v sssi{NN6n܈ \v ̙31l0i=իWc(**.,,,pAo_gM߿??"Ox<(wb}3g 88$$$`شir9ʲnnn/1'>>^Jԩ ??hӦ <<<Ԧ:88Hz"""yLQ1X|9-Z""00P-I2m4\nnn8|p)tB8pK.šC3f`رٳ'bbbQj:::EDD\#Z֯_CTB[[:4";;'OƦM<UVѴ4l߾6mɓ'ann~ݻwG5ҺuhdfflmmզŅBLQ233|r,YJ3gTK=~ͅ.pȑR3^zAAAظq#>#|ڨFO?~˻&M@P@KK ׯ;ＣjDi'Nwjrssw^lڴ F 2ULK^ߓ7u%&扈vbʕ ,[ J9s&~|RBFWWM6ѣGX0k,BPn޼yXpam?xLMM5RBjٳgCQQ=M6!""0`Ŋ_AAbbb$jJl||<TXUuX+++NDDD/I<"""0U2oҥBjmtuuaff#GXBu͛#//iiiׯ5 ||1cV+7|>:w6SQQnݺH@.C.#..C۶mꪶv]֭Eқc*-##ƍCDDJ*###ŋG"fffH٧P(-6p,),---4k M67oMe˖-Zj++UPPyL&+3|ccctzBϞ=ѷo_й>|> 6l@mmm/xm鈊*66-- ӑJN}8I<"""8t:Ç#-- ޽;z=zcǎ ݺu N:CTTѽ{w4h:uTnaa!VX/P(_GvFIg–UH#""*),,ѣG"..߿? _j =zq so`Ĉ(qߣG?͛7M~^&M`kk+MUUmժ˸,"""j$UB#GuVܹ޽;x 4;vXz!믿o>߿0`||| KKK$$$?֭[S瓈,&񈈈\/^ڵk}vG7lll4SO<޽{m6ݻǍ7t """#""`Xv-Ν;?FB˖-550?>lق;w@KKKjŒXnƎ[c1U'&񈈈HMJJ {Oχ&M={j:4"@bb"~OHNNFΝѳgO!66ׯ_GRRL6 ƚvލʕ+=z4,Yf͚i:,"""j$Qv57/^g}ٳgTaU۷oǜ9s+WGaU -M@DDD|rt .\ :M&W\|}}燬,MFDDD˜#""j`0i$̚5 éStt8IDATkiӦՅ>еkWL0Aj۳gJ 5d2d2$_ʪ{3f̀)d2tttW"//]v> 0rJ`hܸ1ttt`bbm˫R!uXv-ߏ'Ow޸""""z!NKDDL26mBxx8p$.]ˆ#PXXcСF~~>bccq!HII2 O%<~YϿv022wѾ} ǰj*L:o6k+HOO1i$T{a(,,đ#GдiSMDDDDT%L5 k׮ŬY{n_H222ꊜ\t %3̟? ,xj/??nnnHJJBll,رc֮T ǹsйs2ێ9[S i&_T֝;w ?Əp*k5| vZxgoQnk׮QZ:vLe˖Ӄ+ë-N}}},[ 999={6&M_^ѣGR_w o",, 1RRRеkWDDD5лwoz<},w=L8;wFFGGG߿_z/;;ӧOG˖-f͚uߤ5?>5kccc;yyyU/[VpB,XҘ#""jRkG ]zXnvƍj.^ĉ(O-9Çc5jJlT*T*K}j*h?%)7 _]-qS*K,ٳѯ_?9rB$==+WĆ 'm7yfxFI6 Å бcG'зo_ 6 {еO+@&IFSSSdgg#77˃!=zӧsss4innnU'/[Nt(DDDD‘xDDD @FFQFd&&&PYt8w\ݻ B^pQikUXXX7nܸcdؽ{7>2=s #UTqUU*ql_QQZ[hB{J!++KaUxDDD -j#U"ڵkz\HҒ6%NBYtĉoO?AGGsAAA کS'/Xj*1 /z,.\@߾}annb6 O?֭xzzJmTrMLLc{nMJLL """4&񈈈'''iӦZ׆NPyT**-- ӵeaaѴi\\\0i$!88RqJܮ* waʔ)XzP(jJ-qqqDDDDu xDDD ٳb )SL2vvvX|T$ׯ_q?ӧv DDDW^Ŷ?|-š5km_},--7 %%R]t ŶvԩUnUSZUV-^zzzBWWNBTTPTT$\Rof-€СCMBDDDTiL5&L@F0iҤZ7Z {EӦMѷo_YCQQq!x{{ݻ+-- JW^ży󠯯s窵ꫯ`ddYfaǏ~z,X_~eN:~-5k&mĂ /B}nݤD[Iѿ;v,LLL;wj> {{{l߾}~7X))fkN zϿ9>C4n=z4\\\T 3f W_޽{888OiiipqqQO[l^W055ŰapI(+an۷L&~ ХKp03bxuRRR`H199iLN;wN/^ǧD::tH]]]Z*++ӥKl\VUҗ'a-..['OܒUGG֦;w(ؠo߮ǏjhhО={MB!ܷ?M'OT}}l6t1vEd թZWMMٱ~ |>?^oߖօ  |>׫Qjhhx@.KnROONjjjTZZk׮)=z:[%0EϞ=SaaΜ9L={Vftznܸ~)*`}b;-[@@ׯ_իWTQQ'Nr:f1;;w睊IѩSti:;;uM577ӧO*++SmmjkkkvD3jmmUSSݻeUUUĉUbb~)J<Y^^VggҢ ê`vLfVVV۫vuttɓ'jѣ&0%axy^h``@r\PEE˵{nEGG Q_faaA]]]x<ҒURR"rr1400 ׫>IvvUVV 9S(/kϟ+ JBoΝt:arojjJzQ ˗$*??_nۘtڲeJ<~|>544dzJ GNX9991 t|%+kbbBȈFGG522bB!IRTTBri׮]r\r:lQʊ4::aY cbbtmݺUCJKKSjjvRRRdeZM3??P(fAA~}A޽7EYYYr:]S:Nm۶Mqqq&^!F֝?j||X~_㚘Ї@ o>܋UBB#&"ͦ%&&J2fپ>*ŲVVV֜ Ɣϟ5;;kҒB4==p8lvsss߽T99eff*--8v8JOOWFF222`x`C `0577-..EԔɿ5m_}_%%%ikܼy8X,JNNV|| 0Q"\3J< Q"kvOv-IENDB`CipUX-Object-3.4.0.5/expl000755001750001750 011424662704 15630 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/expl/cipux_object_synopsis.pl000555001750001750 71111424662704 22731 0ustar00ckuelkerckuelker000000000000#!/usr/bin/perl -w # Example Synopsis CipUX::Object use CipUX::Object; my $obj = CipUX::Object->new(); # After installation, or you have to copy it there my $cfg = '/usr/share/cipux/etc/cipux-object.perl'; my $cfg_hr = $obj->cfg( { cfg => $cfg } ); my $type_ar = $obj->list_type( { cfg_coupling_hr => $cfg_hr->{coupling}, } ); foreach my $type ( @{$type_ar} ) { print "Valid CipUX Object Type: $type\n" or die 'Can not print to STDOUT!'; } CipUX-Object-3.4.0.5/usr000755001750001750 011424662704 15471 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/usr/share000755001750001750 011424662704 16573 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/usr/share/cipux000755001750001750 011424662704 17723 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/usr/share/cipux/etc000755001750001750 011424662704 20476 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/usr/share/cipux/etc/cipux-object.perl000444001750001750 5426611424662704 24150 0ustar00ckuelkerckuelker000000000000# +=========================================================================+ # || /etc/cipux/cipux-object.conf || # || || # || Example configuration file for the CipUX object layer. It should || # || provide the important information about creating CipUX objects. || # || See manual page for more information. || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker || # || || # || License: GNU General Public License (GNU GPL) version 2 || # || or - at your opinion - any later version. || # || || # +=========================================================================+ # do NOT change the ordering of the configuration sections # +=========================================================================+ # || Local replacement variables || # +=========================================================================+ # TODO: get that from cipux.ini my $cipux_home_directory = '/home/cipux0'; my $cipux_mail_domain = 'tjener'; my $usr_sft_quota = 100000; my $usr_hrd_quota = 200000; my $grp_sft_quota = 300000; my $grp_hrd_quota = 400000; # +=========================================================================+ # || CipUX Object Relation Section || # +=========================================================================+ # $cfg_coupling_hr $cfg = { coupling => { ### cipux_ldap ### 'cipux_ldap_root_node_object' => { order => ['cipux_ldap_root_node'], object_attr => ['ou'], coupling => {}, overwrite => {}, }, ### ldap_orga_node ### 'cipux_ldap_orga_node_object' => { order => ['cipux_ldap_orga_node'], object_attr => ['ou'], coupling => {}, overwrite => { cipux_ldap_orga_node => { 'cipuxRemark' => 'CipUX object layer', }, }, }, ### account ### 'cipux_account_object' => { order => [qw(cipux_account.group cipux_account.user)], coupling => { 'cipux_account.group' => { cn => 'uid', gidNumber => 'uidNumber', }, 'cipux_account.user' => { uid => 'cn', uidNumber => 'gidNumber', }, }, object_attr => [qw(cn uid)], overwrite => { 'cipux_account.group' => { 'cipuxRemark' => 'CipUX object layer', 'cipuxRole' => 'none', 'cipuxSoftQuota' => $grp_sft_quota, 'cipuxHardQuota' => $grp_hrd_quota, }, 'cipux_account.user' => { 'cipuxRemark' => 'CipUX object layer', 'cipuxRole' => 'account', 'cipuxSoftQuota' => $usr_sft_quota, 'cipuxHardQuota' => $usr_hrd_quota, }, }, }, ### share ### 'cipux_share_object' => { order => [qw(cipux_share.group cipux_share.user)], coupling => { 'cipux_share.group' => { cn => 'uid', gidNumber => 'uidNumber', }, 'cipux_share.user' => { uid => 'cn', uidNumber => 'gidNumber', }, }, object_attr => [qw(cn uid)], overwrite => { 'cipux_share.group' => { 'cipuxIsShare' => 'TRUE', cipuxRemark => 'CipUX object layer', }, 'cipux_share.user' => { 'cipuxIsShare' => 'TRUE', cipuxRemark => 'CipUX object layer', }, }, }, ### role ### 'DELcipux_role_object' => { order => [qw(cipux_role.group)], coupling => {}, object_attr => [qw(cn)], overwrite => { 'cipux_role.group' => {}, }, }, 'cipux_role_object' => { order => [qw(cipux_role.group cipux_account.user)], coupling => { 'cipux_role.group' => { cn => 'uid', gidNumber => 'uidNumber', }, 'cipux_account.user' => { uid => 'cn', uidNumber => 'gidNumber', }, }, object_attr => [qw(cn uid)], overwrite => { 'cipux_role.group' => { 'cipuxRemark' => 'CipUX object layer', 'cipuxRole' => 'role', 'cipuxIsRole' => 'TRUE', 'cipuxIsSkel' => 'TRUE', 'cipuxIsShare' => 'FALSE', }, 'cipux_account.user' => { 'cipuxFirstname' => 'role', 'cipuxLastname' => 'role', 'cipuxRemark' => 'CipUX object layer', 'cipuxRole' => 'role', 'cipuxIsRole' => 'TRUE', 'cipuxIsSkel' => 'TRUE', 'cipuxIsShare' => 'FALSE', 'cipuxFirstname' => 'Generic', 'cipuxLastname' => 'Role', }, }, }, # authority role 'authority_role_object' => { order => [qw(authority_account.group)], coupling => {}, object_attr => [qw(cn)], overwrite => { 'authority_account.group' => {}, }, }, ### skel ### 'cipux_skel_object' => { order => [qw(cipux_account.group cipux_account.user)], coupling => { 'cipux_account.group' => { cn => 'uid', gidNumber => 'uidNumber', }, 'cipux_account.user' => { uid => 'cn', uidNumber => 'gidNumber', }, }, object_attr => [qw(cn uid)], overwrite => { 'cipux_account.group' => { 'cipuxRemark' => 'CipUX object layer', 'cipuxRole' => 'role', 'cipuxIsRole' => 'TRUE', 'cipuxIsSkel' => 'TRUE', 'cipuxIsShare' => 'FALSE', }, 'cipux_account.user' => { 'cipuxRemark' => 'CipUX object layer', 'cipuxRole' => 'role', 'cipuxIsRole' => 'TRUE', 'cipuxIsSkel' => 'TRUE', 'cipuxIsShare' => 'FALSE', 'cipuxFirstname' => 'Generic', 'cipuxLastname' => 'Skel', }, }, }, ### CAT module ### 'cipux_cat_module_object' => { order => ['cipux_cat_module'], object_attr => ['cn'], coupling => {}, overwrite => { cipux_cat_module => { 'cipuxRemark' => 'CipUX object layer', }, }, }, ### task ### 'cipux_task_object' => { order => ['cipux_task'], object_attr => ['cn'], coupling => {}, overwrite => { cipux_task => { 'cipuxRemark' => 'CipUX object layer', }, }, }, ### room ### 'cipux_room_object' => { order => ['cipux_room'], object_attr => [qw(cn)], coupling => {}, overwrite => {}, }, ### netgroup ### 'cipux_netgroup_object' => { order => ['cipux_netgroup'], object_attr => ['cn'], coupling => {}, overwrite => {}, }, ### client ### 'cipux_client_object' => { order => ['cipux_client'], object_attr => ['cn'], coupling => {}, overwrite => {}, }, }, # +=========================================================================+ # || CipUX Object LDAP Node Construction Section || # +=========================================================================+ # $cfg_object_hr object => { # 'cipux_ldap_root_node' => { # preset => { # objectClass => [qw(top organizationalUnit cipuxLdapRootNode)], # cipuxRemark => 'CipUX object layer', # }, # auto => { # cipuxCreationDate => 1, # struc_rdn => 1, # base_dn => 1, # }, # mandatory => { ou => 1, }, # rule => { dn => 'dn: ou=,,', }, # alias => {}, # # }, 'cipux_ldap_orga_node' => { preset => { objectClass => [qw(top organizationalUnit cipuxLdapOrgaNode)], cipuxRemark => 'CipUX object layer', }, auto => { cipuxCreationDate => 1, struc_rdn => 1, base_dn => 1, }, mandatory => { ou => 1, }, rule => { dn => 'dn: ou=,', }, alias => {}, }, 'cipux_account.user' => { preset => { objectClass => [ 'posixAccount', 'top', 'shadowAccount', 'imapUser', 'cipuxAccount' ], cipuxFirstname => 'CipUX', cipuxLastname => 'Account', cipuxIsAccount => 'TRUE', loginShell => '/bin/bash', cipuxSoftQuota => '40000', cipuxHardQuota => '50000', cipuxStatus => 'idle', cipuxRole => 'none', cipuxSkeletonUid => ['none'], cipuxInternetStatus => 'accept', cipuxRemark => 'CipUX object layer', }, auto => { uidNumber => 1, userPassword => 1, cipuxCreationDate => 1, struc_rdn => 1, base_dn => 1, }, mandatory => { uid => 1, cipuxFirstname => 1, cipuxLastname => 1, }, rule => { dn => 'dn: uid=,,', cn => ' ', homeDirectory => "$cipux_home_directory/", mailMessageStore => '/var/lib/maildirs/', cipuxMail => "\@$cipux_mail_domain", }, alias => { gidNumber => 'uidNumber', gecos => 'uid' }, }, 'cipux_account.group' => { preset => { objectClass => [ 'top', 'posixGroup', 'cipuxGroup', ], cipuxIsAccount => 'TRUE', cipuxSoftQuota => '40000', cipuxHardQuota => '50000', cipuxRole => 'private', cipuxInternetStatus => 'accept', cipuxRemark => 'CipUX object layer', }, auto => { gidNumber => 1, cipuxCreationDate => 1, struc_rdn => 1, base_dn => 1, }, mandatory => { cn => 1, }, rule => { dn => 'dn: cn=,,', }, alias => { memberUid => 'cn', cipuxGroupLeaderUid => 'cn', }, }, 'cipux_role.group' => { preset => { objectClass => [ 'top', 'posixGroup', 'lisAclGroup', 'groupOfNames', 'lisGroup', 'cipuxGroup', ], cipuxIsAccount => 'TRUE', cipuxSoftQuota => '40000', cipuxHardQuota => '50000', cipuxRole => 'role', cipuxInternetStatus => 'accept', cipuxRemark => 'CipUX object layer', member => '', groupType => 'authority_group', }, auto => { gidNumber => 1, cipuxCreationDate => 1, struc_rdn => 1, base_dn => 1, }, mandatory => { cn => 1, }, rule => { dn => 'dn: cn=,,', }, alias => { memberUid => 'cn', cipuxGroupLeaderUid => 'cn', }, }, 'cipux_share.user' => { preset => { objectClass => [ 'posixAccount', 'top', 'shadowAccount', 'imapUser', 'cipuxAccount' ], cipuxIsShare => 'TRUE', cipuxFirstname => 'CipUX', cipuxLastname => 'share', loginShell => '/bin/bash', cipuxSoftQuota => '40000', cipuxHardQuota => '50000', cipuxStatus => 'idle', cipuxRole => 'share', cipuxSkeletonUid => ['none'], cipuxInternetStatus => 'accept', cipuxRemark => 'CipUX object layer', }, auto => { uidNumber => 1, userPassword => 1, cipuxCreationDate => 1, struc_rdn => 1, base_dn => 1, }, mandatory => { uid => 1, }, rule => { dn => 'dn: uid=,,', cn => ' ', homeDirectory => "$cipux_home_directory/", mailMessageStore => '/var/lib/maildirs/', cipuxMail => "\@$cipux_mail_domain", }, alias => { gidNumber => 'uidNumber', gecos => 'uid' }, }, 'cipux_share.group' => { preset => { objectClass => [ 'top', 'posixGroup', 'cipuxGroup', 'lisGroup', ], cipuxIsShare => 'TRUE', cipuxSoftQuota => '40000', cipuxHardQuota => '50000', cipuxRole => 'private', cipuxInternetStatus => 'accept', cipuxRemark => 'CipUX node layer', groupType => 'school_class', }, auto => { gidNumber => 1, cipuxCreationDate => 1, struc_rdn => 1, base_dn => 1, }, mandatory => { cn => 1, }, rule => { dn => 'dn: cn=,,', }, alias => { memberUid => 'cn', description => 'cn', cipuxGroupLeaderUid => 'cn', }, }, 'cipux_room' => { preset => { objectClass => [ 'top', 'room', 'cipuxRoom', ], description => [' seminar room'], #seeAlso => ['room number'], # invalid per syntax! telephoneNumber => ['000'], roomNumber => ['000'], cipuxAddress => ['Room e51'], cipuxFaculty => ['Sociology'], cipuxImageSlotNumber => [' 1'], cipuxNetworkAddress => [''], cipuxNetworkMask => [''], cipuxGatewayAddress => [''], cipuxGatewayMask => [''], }, auto => { struc_rdn => 1, base_dn => 1, }, mandatory => { cn => 1, }, rule => { dn => 'dn: cn=,,', }, alias => {}, }, 'cipux_netgroup' => { preset => { objectClass => [ 'top', 'nisNetgroup' ], description => ['netgroup'], }, auto => { struc_rdn => 1, base_dn => 1, }, mandatory => { cn => 1, }, rule => { dn => 'dn: cn=,,', }, alias => {}, }, 'cipux_client' => { preset => { objectClass => [ 'top', 'organizationalRole', 'domainRelatedObject', 'ipHost', 'ieee802Device', 'cipuxMachine' ], ipHostNumber => '', }, auto => { struc_rdn => 1, base_dn => 1, }, mandatory => { cn => 1, associatedDomain => 1, ipHostNumber => 1, macAddress => 1, }, rule => { dn => 'dn: cn=,,', ipHostNumber => '', associatedDomain => '', macAddress => '', }, alias => {}, }, 'cipux_cat_module' => { preset => { objectClass => [ 'top', 'cipuxApplication', 'cipuxCatModule', ], cipuxName => ['unkown'], cipuxTemplateDir => => 1, cipuxAuthor => ['Unknown'], cipuxLicense => ['GPLv2 or later'], cipuxScript => ['preset_name.cgi'], cipuxIsEnabled => ['FALSE'], cipuxMemberRid => 'admin', cipuxModality => ['none'], cipuxShortDescription => ['none'], cipuxYear => ['2008'], cipuxTask => ['NULL'], cipuxEntity => ['none'], cipuxIsModuleArray => ['FALSE'], cipuxIcon => ['shell.png'], }, auto => { struc_rdn => 1, base_dn => 1, }, # you have to list all mandatoy attributes, see LDAP schema # otherwise you can not add that object CipUX::Object::mandatory mandatory => { cn => 1, cipuxName => 1, cipuxTemplate => 1, cipuxTemplateDir => 1, cipuxEntity => 1, cipuxModality => 1, cipuxIsModuleArray => 1, cipuxAuthor => 1, cipuxLicense => 1, cipuxScript => 1, cipuxIcon => 1, cipuxYear => 1, cipuxTask => 1, cipuxShortDescription => 1, cipuxMemberRid => 1, cipuxIsEnabled => 1, }, rule => { dn => 'dn: cn=,,', }, # FIXME: merge it alias => { 'cipuxScript' => 'cn', }, alias => { 'cipuxModality' => 'cn', }, alias => { 'cipuxTemplate' => 'cn', }, }, 'cipux_task' => { preset => { objectClass => [ 'top', 'cipuxTask' ], cipuxName => ['unkown'], cipuxIsEnabled => ['TRUE'], cipuxMemberPid => [ 'cipux_rpc_test_client', 'cipux_rpc_test_repetition', ], cipuxShortDescription => ['none'], }, auto => { cipuxCreationDate => 1, struc_rdn => 1, base_dn => 1, }, # you have to list all mandatoy attributes, see LDAP schema # otherwise you can not add that object CipUX::Object::mandatory mandatory => { cn => 1, cipuxName => 1, cipuxIsEnabled => 1, cipuxShortDescription => 1, cipuxShortDescription => 1, }, rule => { dn => 'dn: cn=,,', }, alias => { 'cipuxName' => 'cn', }, }, }, # +=========================================================================+ # || CipUX Object LDAP Node Construction Section || # +=========================================================================+ # $cfg_object_hr2 # TODO: probably better to source that out to cipux.ini basis => { # the start of counting uidNumber, gidNumber for objects oidNumberBegin => 11000, # the stop of counting uidNumber, gidNumber for objects oidNumberEnd => 41000, }, }; CipUX-Object-3.4.0.5/t000755001750001750 011424662704 15123 5ustar00ckuelkerckuelker000000000000CipUX-Object-3.4.0.5/t/perlcriticrc000444001750001750 101611424662704 17666 0ustar00ckuelkerckuelker000000000000# CipUX Perl::Critic Configuration # # SEVERITY NAME ...is equivalent to... SEVERITY NUMBER # ---------------------------------------------------- # gentle 5 # stern 4 # harsh 3 # cruel 2 # brutal 1 severity = stern verbose = 11 CipUX-Object-3.4.0.5/t/pod.t000444001750001750 21411424662704 16204 0ustar00ckuelkerckuelker000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); CipUX-Object-3.4.0.5/t/perlcritic_cpan.t000444001750001750 100711424662704 20604 0ustar00ckuelkerckuelker000000000000#!perl use strict; use warnings; use File::Spec; use Test::More; use English qw(-no_match_vars); if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } eval { require Test::Perl::Critic; }; if ($EVAL_ERROR) { my $msg = 'Test::Perl::Critic required to criticise code'; plan( skip_all => $msg ); } my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); Test::Perl::Critic->import( -profile => $rcfile ); all_critic_ok(); CipUX-Object-3.4.0.5/t/00.load.t000444001750001750 65411424662704 16567 0ustar00ckuelkerckuelker000000000000use Test::More tests => 7; BEGIN { use_ok('CipUX::Object::Action'); use_ok('CipUX::Object::Client'); use_ok('CipUX::Object::Action::Create'); use_ok('CipUX::Object::Action::Destroy'); use_ok('CipUX::Object::Action::List'); use_ok('CipUX::Object::Action::Attribute::List'); use_ok('CipUX::Object::Action::Attribute::Change'); } diag("Testing CipUX::Object::Action $CipUX::Object::Action::VERSION"); CipUX-Object-3.4.0.5/t/pod-coverage.t000444001750001750 26011424662704 17776 0ustar00ckuelkerckuelker000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); CipUX-Object-3.4.0.5/t/refcount.t000444001750001750 437111424662704 17277 0ustar00ckuelkerckuelker000000000000use Test::More tests => 14; use Test::Refcount; use CipUX::Object::Action; use CipUX::Object::Client; use CipUX::Object::Action::Create; use CipUX::Object::Action::Destroy; use CipUX::Object::Action::List; use CipUX::Object::Action::Attribute::List; use CipUX::Object::Action::Attribute::Change; # 1 diag('test CipUX::Object::Action'); my $object1 = CipUX::Object::Action->new( { cache_dir => 'blib/cache' } ); is_oneref( $object1, '$object has a refcount of 1' ); my $otherref1 = $object1; is_refcount( $object1, 2, '$object now has 2 references' ); # 2 diag('test CipUX::Object::Client'); my $object2 = CipUX::Object::Client->new( { name => 'cipux_object_client', cache_dir => 'blib/cache', } ); is_oneref( $object2, '$object has a refcount of 1' ); my $otherref2 = $object2; is_refcount( $object2, 2, '$object now has 2 references' ); # 3 diag('test CipUX::Object::Action::Create'); my $object3 = CipUX::Object::Action::Create->new( { cache_dir => 'blib/cache' } ); is_oneref( $object3, '$object has a refcount of 1' ); my $otherref3 = $object3; is_refcount( $object3, 2, '$object now has 2 references' ); # 4 diag('test CipUX::Object::Action::Destroy'); my $object4 = CipUX::Object::Action::Destroy->new( { cache_dir => 'blib/cache' } ); is_oneref( $object4, '$object has a refcount of 1' ); my $otherref4 = $object4; is_refcount( $object4, 2, '$object now has 2 references' ); # 5 diag('test CipUX::Object::Action::List'); my $object5 = CipUX::Object::Action::List->new( { cache_dir => 'blib/cache' } ); is_oneref( $object5, '$object has a refcount of 1' ); my $otherref5 = $object5; is_refcount( $object5, 2, '$object now has 2 references' ); # 6 diag('test CipUX::Object::Action::Attribute::List'); my $object6 = CipUX::Object::Action::Attribute::List->new( { cache_dir => 'blib/cache' } ); is_oneref( $object6, '$object has a refcount of 1' ); my $otherref6 = $object6; is_refcount( $object6, 2, '$object now has 2 references' ); # 7 diag('test CipUX::Object::Action::Attribute::Change'); my $object7 = CipUX::Object::Action::Attribute::Change->new( { cache_dir => 'blib/cache' } ); is_oneref( $object7, '$object has a refcount of 1' ); my $otherref7 = $object7; is_refcount( $object7, 2, '$object now has 2 references' ); CipUX-Object-3.4.0.5/t/perlcritic.t000444001750001750 43611424662704 17570 0ustar00ckuelkerckuelker000000000000#!perl use strict; use warnings; use Test::More; use English qw(-no_match_vars); eval { require Test::Perl::Critic; }; if ($EVAL_ERROR) { my $msg = 'Test::Perl::Critic required to for testing PBP compliance'; plan( skip_all => $msg ); } Test::Perl::Critic::all_critic_ok();