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


  my $cipux_object = CipUX::Object::Action::Create->new({});


=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 preset_auto_mandatory_rule_alias

Creates a CipUX object

B<Syntax:>

 $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<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

