PerlBean::Dependency - Dependency in a Perl bean


PerlBean documentation Contained in the PerlBean distribution.

Index


Code Index:

NAME

Top

PerlBean::Dependency - Dependency in a Perl bean

SYNOPSIS

Top

None, this is an abstract class.

ABSTRACT

Top

Dependency (use, require or import) in a Perl bean

DESCRIPTION

Top

PerlBean::Dependency is an abstract class to express dependencies to classes/modules/files in a PerlBean.

CONSTRUCTOR

Top

new( [ OPT_HASH_REF ] )

Creates a new PerlBean::Dependency object. OPT_HASH_REF is a hash reference used to pass initialization options. On error an exception Error::Simple is thrown.

Options for OPT_HASH_REF may include:

dependency_name

Passed to set_dependency_name().

volatile

Passed to set_volatile().

METHODS

Top

get_dependency_name()

Returns the dependency name.

is_volatile()

Returns whether the dependency is volatile or not.

set_dependency_name(VALUE)

Set the dependency name. VALUE is the value. On error an exception Error::Simple is thrown.

VALUE must match regular expression:

^.*[a-zA-Z].*$

set_volatile(VALUE)

State that the dependency is volatile. VALUE is the value. On error an exception Error::Simple is thrown.

write(FILEHANDLE)

This is an interface method. Writes code for the dependency. FILEHANDLE is an IO::Handle object.

SEE ALSO

Top

PerlBean, PerlBean::Attribute, PerlBean::Attribute::Boolean, PerlBean::Attribute::Factory, PerlBean::Attribute::Multi, PerlBean::Attribute::Multi::Ordered, PerlBean::Attribute::Multi::Unique, PerlBean::Attribute::Multi::Unique::Associative, PerlBean::Attribute::Multi::Unique::Associative::MethodKey, PerlBean::Attribute::Multi::Unique::Ordered, PerlBean::Attribute::Single, PerlBean::Collection, PerlBean::Dependency::Import, PerlBean::Dependency::Require, PerlBean::Dependency::Use, PerlBean::Described, PerlBean::Described::ExportTag, PerlBean::Method, PerlBean::Method::Constructor, PerlBean::Method::Factory, PerlBean::Style, PerlBean::Symbol

BUGS

Top

None known (yet.)

HISTORY

Top

First development: March 2003 Last update: September 2003

AUTHOR

Top

Vincenzo Zocca

COPYRIGHT

Top

LICENSE

Top

This file is part of the PerlBean module hierarchy for Perl by Vincenzo Zocca.

The PerlBean module hierarchy 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 of the License, or (at your option) any later version.

The PerlBean module hierarchy 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 the PerlBean module hierarchy; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA


PerlBean documentation Contained in the PerlBean distribution.

package PerlBean::Dependency;

use 5.005;
use strict;
use warnings;
use AutoLoader qw(AUTOLOAD);
use Error qw(:try);

# Used by _value_is_allowed
our %ALLOW_ISA = (
);

# Used by _value_is_allowed
our %ALLOW_REF = (
);

# Used by _value_is_allowed
our %ALLOW_RX = (
    'dependency_name' => [ '^.*[a-zA-Z].*$' ],
);

# Used by _value_is_allowed
our %ALLOW_VALUE = (
);

# Package version
our ($VERSION) = '$Revision: 1.0 $' =~ /\$Revision:\s+([^\s]+)/;

1;

__END__

sub new {
    my $class = shift;

    my $self = {};
    bless( $self, ( ref($class) || $class ) );
    return( $self->_initialize(@_) );
}

sub _initialize {
    my $self = shift;
    my $opt = defined($_[0]) ? shift : {};

    # Check $opt
    ref($opt) eq 'HASH' || throw Error::Simple("ERROR: PerlBean::Dependency::_initialize, first argument must be 'HASH' reference.");

    # dependency_name, SINGLE
    exists( $opt->{dependency_name} ) && $self->set_dependency_name( $opt->{dependency_name} );

    # volatile, BOOLEAN
    exists( $opt->{volatile} ) && $self->set_volatile( $opt->{volatile} );

    # Return $self
    return($self);
}

sub _value_is_allowed {
    my $name = shift;

    # Value is allowed if no ALLOW clauses exist for the named attribute
    if ( ! exists( $ALLOW_ISA{$name} ) && ! exists( $ALLOW_REF{$name} ) && ! exists( $ALLOW_RX{$name} ) && ! exists( $ALLOW_VALUE{$name} ) ) {
        return(1);
    }

    # At this point, all values in @_ must to be allowed
    CHECK_VALUES:
    foreach my $val (@_) {
        # Check ALLOW_ISA
        if ( ref($val) && exists( $ALLOW_ISA{$name} ) ) {
            foreach my $class ( @{ $ALLOW_ISA{$name} } ) {
                &UNIVERSAL::isa( $val, $class ) && next CHECK_VALUES;
            }
        }

        # Check ALLOW_REF
        if ( ref($val) && exists( $ALLOW_REF{$name} ) ) {
            exists( $ALLOW_REF{$name}{ ref($val) } ) && next CHECK_VALUES;
        }

        # Check ALLOW_RX
        if ( defined($val) && ! ref($val) && exists( $ALLOW_RX{$name} ) ) {
            foreach my $rx ( @{ $ALLOW_RX{$name} } ) {
                $val =~ /$rx/ && next CHECK_VALUES;
            }
        }

        # Check ALLOW_VALUE
        if ( ! ref($val) && exists( $ALLOW_VALUE{$name} ) ) {
            exists( $ALLOW_VALUE{$name}{$val} ) && next CHECK_VALUES;
        }

        # We caught a not allowed value
        return(0);
    }

    # OK, all values are allowed
    return(1);
}

sub get_dependency_name {
    my $self = shift;

    return( $self->{PerlBean_Dependency}{dependency_name} );
}

sub is_volatile {
    my $self = shift;

    if ( $self->{PerlBean_Dependency}{volatile} ) {
        return(1);
    }
    else {
        return(0);
    }
}

sub set_dependency_name {
    my $self = shift;
    my $val = shift;

    # Check if isa/ref/rx/value is allowed
    &_value_is_allowed( 'dependency_name', $val ) || throw Error::Simple("ERROR: PerlBean::Dependency::set_dependency_name, the specified value '$val' is not allowed.");

    # Assignment
    $self->{PerlBean_Dependency}{dependency_name} = $val;
}

sub set_volatile {
    my $self = shift;

    if (shift) {
        $self->{PerlBean_Dependency}{volatile} = 1;
    }
    else {
        $self->{PerlBean_Dependency}{volatile} = 0;
    }
}

sub write {
    throw Error::Simple("ERROR: PerlBean::Dependency::write, call this method in a subclass that has implemented it.");
}