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

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

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


=head2 DEMOLISH

Inherit from CipUX::Object. Will called autmatically.

B<Syntax:>

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