libcipux-object-perl 3.4.0.5-2build1 / usr / share / perl5 / CipUX / Object / Action / List.pm

# +==========================================================================+
# || 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<Syntax:>


  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<Description:>

I<cfg>

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</etc/cipux/cipux-object.conf>

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<Syntax:>

   $i10n->DESTROY();


=head2 list_type

Creates a CipUX object

B<Syntax:>

 $object->list_type({

                              });

=head2 preset

Creates a CipUX object

B<Syntax:>

 $object->preset({

                              });


=head2 auto

Creates a CipUX object

B<Syntax:>

 $object->auto({

                              });

=head2 mandatory

Creates a CipUX object

B<Syntax:>

 $object->mandatory({

                              });

=head2 rule

Creates a CipUX object

B<Syntax:>

 $object->rule({

                              });

=head2 alias

Creates a CipUX object

B<Syntax:>

 $object->alias({

                              });

=head2 list_object_action

TODO


=head2 preset_auto_mandatory_rule_alias

Creates a CipUX object

B<Syntax:>

 $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<http://www.cipux.org>

See the mailing list L<http://sympa.cipworx.org/wws/info/cipux-devel>

=head1 AUTHOR

Christian Kuelker  E<lt>christian.kuelker@cipworx.orgE<gt>

=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