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

# +==========================================================================+
# || 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<coupling_cfg> );
    my %object_cfg : ATTR( :get<object_cfg> );
    my %basis_cfg : ATTR( :get<basis_cfg> );

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

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