package PerlBean;

use 5.005;
use strict;
use warnings;
use AutoLoader qw(AUTOLOAD);
use Error qw(:try);
use PerlBean::Dependency::Require;
use PerlBean::Dependency::Use;
use PerlBean::Method;
use PerlBean::Method::Constructor;
use PerlBean::Style qw(:codegen);
use PerlBean::Symbol;

# Variable to not confuse AutoLoader
our $END = '__END__';

# Legacy count variable
our $LEGACY_COUNT = 0;

# Used by _value_is_allowed
our %ALLOW_ISA = (
    'collection' => [ 'PerlBean::Collection' ],
    'dependency' => [ 'PerlBean::Dependency' ],
    'export_tag_description' => [ 'PerlBean::Described::ExportTag' ],
    'method' => [ 'PerlBean::Method' ],
    'method_factory' => [ 'PerlBean::Method::Factory' ],
    'symbol' => [ 'PerlBean::Symbol' ],
);

# Used by _value_is_allowed
our %ALLOW_REF = (
);

# Used by _value_is_allowed
our %ALLOW_RX = (
    'abstract' => [ '^.*$' ],
    'base' => [ '^\S+$' ],
    'license' => [ '.*' ],
    'synopsis' => [ '.*' ],
    'use_perl_version' => [ '^v?\d+(\.[\d_]+)*' ],
);

# Used by _value_is_allowed
our %ALLOW_VALUE = (
);

# Used by _initialize
our %DEFAULT_VALUE = (
    '_finalized_' => 0,
    '_has_exports_' => 0,
    'autoloaded' => 1,
    'exception_class' => 'Error::Simple',
    'short_description' => 'NO DESCRIPTION AVAILABLE',
    'singleton' => 0,
    'use_perl_version' => $],
);

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

# Month names array
our @MON = qw(
    January
    February
    March
    April
    May
    June
    July
    August
    September
    October
    November
    December
);

1;

__END__

=head1 NAME

PerlBean - Package to generate bean like Perl modules

=head1 SYNOPSIS

 use strict;
 use PerlBean;
 use PerlBean::Attribute::Factory;
 
 my $bean = PerlBean->new( {
     package => 'MyPackage',
 } );
 my $factory = PerlBean::Attribute::Factory->new();
 my $attr = $factory->create_attribute( {
     method_factory_name => 'true',
     short_description => 'something is true',
 } );
 $bean->add_method_factory($attr);
 
 use IO::File;
 -d 'tmp' || mkdir('tmp');
 my $fh = IO::File->new('> tmp/PerlBean.pl.out');
 $bean->write($fh);

=head1 ABSTRACT

Code generation for bean like Perl modules

=head1 DESCRIPTION

The C<PerlBean> class models a Perl module with one package. After adding different components to the C<PerlBean>, the Perl module can be generated.

The following sections in the code generated by a C<PerlBean> are used to explain the concept.

=over

=item C<PerlBean> module file header section

 package Circle;
 
 use 5.008;
 use base qw( Shape Exporter );
 use strict;
 use warnings;
 use Error qw(:try);
 require Exporter;

=over

=item C<set_package()>

is used to set the package name in C<package Circle>.

=item C<add_dependency()> or C<set_dependency()>

are used to add C<PerlBean::Dependency> objects like the C<use> and C<require> lines in the example. Note however that except for C<use base> all C<use> dependencies in the example above are set by default when initializing a C<PerlBean> object without specifying a C<dependency> option.

=item C<set_use_perl_version()>

is used to set the version number in the C<use 5.008> dependency. By default the version number is set to C<\$]>. This is an exception to the C<PerlBean::Dependency> mechanism.

=item C<push_base()>, C<set_base()> or C<unshift_base()>

are used to express inheritance relationships. When the C<PerlBean> is written, the inheritance relationships -like C<Shape> in this example- appear in the C<use base> list. The C<Exporter> bit is there because symbols are exported by C<package Circle>.

=back

=item C<PerlBean> symbols:

=over

=item C<add_symbol()> or C<set_symbol()>

are used to add C<PerlBean::Symbol> objects. C<PerlBean::Symbol> objects are described in their own manual pages.

=back

=item C<PerlBean> complimentary symbols:

 # Used by _value_is_allowed
 our %ALLOW_ISA = (
 );
 
 # Used by _value_is_allowed
 our %ALLOW_REF = (
 );
 
 # Used by _value_is_allowed
 our %ALLOW_RX = (
     'radius' => [ '^\d*(\.\d+)?$' ],
 );

 # Used by _value_is_allowed
 our %ALLOW_VALUE = (
 );
 
 # Used by _initialize
 our %DEFAULT_VALUE = (
 );

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

The C<our %ALLOW.*> symbols above are used by the generated class to check rules that apply to the C<PerlBean>'s attributes. They are not exported. You could theoretically overwrite them. But don't do that!

The C<our %DEFAULT_VALUE> symbol above is used at class instantiation to set the attribute's default values of the C<PerlBean>. It is not exported. Sometimes you need to overwrite values. That's not particularly nice and should be addressed.

The C<our ($VERSION)> is there to allow versioning through CVS. You could overwrite it.

=item Preloaded section end

 1;
 
 __END__

If the C<PerlBean> is C<autoloaded> then the code above is generated in order to autoload the methods that follow. The method C<set_autoloaded()> is used to change the autoload behavior of a C<PerlBean>. NOTE: In my experience it pays to first have C<PerlBean>s preloaded and to switch to autoload after debugging.

=item NAME section

 =head1 NAME
 
 Circle - circle shape

The package name ( which was set through C<set_package()> ) is put in C<Circle ->.

=over

=item C<set_short_description()>

is used to set a short package description in C<- circle shape>.

=back

=item ABSTRACT section

 =head1 ABSTRACT
 
 circle shape

=over

=item C<set_abstract()>

is used to set the abstract information in C<circle shape>.

=back

=item DESCRIPTION section

 =head1 DESCRIPTION
 
 circle shape

=over

=item C<set_description()>

is used to set the description information C<circle shape>. If no description is set then C<CE<lt>CircleE<gt> TODO> would be shown.

=back

=item EXPORT section

This section describes all exported C<PerlBean::Symbol> objects like in the following example.

 =head1 EXPORT
 
 By default nothing is exported.
 
 =head2 geo
 
 Geometric constants
 
 =over
 
 =item $PI
 
 The PI constant
 
 =back

=item CONSTRUCTOR section

All constructors are documented in alphabetical order in this section. C<PerlBean> by default generates documentation for the C<new()> constructor. In theory you can overwrite the C<new()> constructor and hence alter the documentation thereof. Before you do so, I suggest you thoroughly contemplate this. You can of course add a C<PerlBean::Method::Constructor> object ( e.g. C<new_from_file> ) in order to customize construction.

=item METHODS section

All methods that aren't constructors are documented in alphabetical order in this section. C<PerlBean::Method> objects in the C<PerlBean> by default generate documentation for the methods. In theory you can overwrite the methods. Again, I suggest you thoroughly contemplate the consequences.

=item SEE ALSO section

 L<Rectangle>,
 L<Shape>,
 L<Square>

All C<PerlBean> objects inside a C<PerlBean::Collection> are referred in this section as listed.

=item BUGS section

 None known (yet.)

This section always has C<None known (yet.)> in it.

=item HISTORY section

 First development: September 2003
 Last update: September 2003

This section always has C<First development: CE<lt>current_dateE<gt> Last update: CE<lt>current_dateE<gt>> in it.

=item AUTHOR section

 Vincenzo Zocca

This section always has the B<GECOS> field from the C<passwd> file.

=item COPYRIGHT section

 Copyright 2003 by Vincenzo Zocca

This section always contains the above message with the C<current_year> and the B<GECOS> field from the C<passwd> file.

=item LICENSE section

 This code is licensed under B<GNU GENERAL PUBLIC LICENSE>.
 Details on L<http://gnu.org>.

This section either contains:

1) The license of the C<PerlBean> which set through method C<set_license()>

2) The license of the C<PerlBean::Collection>

3) The text C<TODO>

=item Implementation section

This section contains the implementation of the methods and constructors. First listed are the constructors which are ordered alphabetically and C<new()> and C<_initialize()> are kept near to each-other. Then the normal methods are listed alphabetically.

=item End of file

 1;

If the C<PerlBean> is not C<autoloaded> then the code above is generated in order to close the file the I<Perl> way. The method C<set_autoloaded()> is used to change the autoload behavior of a C<PerlBean>. NOTE: In my experience it pays to first have C<PerlBean>s preloaded and to switch to autoload after debugging.

=back

=head1 CONSTRUCTOR

=over

=item new(OPT_HASH_REF)

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

Options for C<OPT_HASH_REF> may include:

=over

=item B<C<abstract>>

Passed to L<set_abstract()>.

=item B<C<autoloaded>>

Passed to L<set_autoloaded()>. Defaults to B<1>.

=item B<C<base>>

Passed to L<set_base()>. Must be an C<ARRAY> reference.

=item B<C<collection>>

Passed to L<set_collection()>.

=item B<C<dependency>>

Passed to L<set_dependency()>. Must be an C<ARRAY> reference. Defaults to a set of C<PerlBean::Dependency> objects that yields to:

 use strict;
 use warnings;
 use Error qw(:try);

=item B<C<description>>

Passed to L<set_description()>.

=item B<C<exception_class>>

Passed to L<set_exception_class()>. Defaults to B<'Error::Simple'>.

=item B<C<export_tag_description>>

Passed to L<set_export_tag_description()>. Must be an C<ARRAY> reference.

=item B<C<license>>

Passed to L<set_license()>.

=item B<C<method>>

Passed to L<set_method()>. Must be an C<ARRAY> reference.

=item B<C<method_factory>>

Passed to L<set_method_factory()>. Must be an C<ARRAY> reference.

=item B<C<package>>

Passed to L<set_package()>. Mandatory option.

=item B<C<short_description>>

Passed to L<set_short_description()>. Defaults to B<'NO DESCRIPTION AVAILABLE'>.

=item B<C<singleton>>

Passed to L<set_singleton()>. Defaults to B<0>.

=item B<C<symbol>>

Passed to L<set_symbol()>. Must be an C<ARRAY> reference.

=item B<C<synopsis>>

Passed to L<set_synopsis()>.

=item B<C<use_perl_version>>

Passed to L<set_use_perl_version()>. Defaults to B<$]>.

=back

=back

=head1 METHODS

=over

=item add_attribute( See add_method_factory() )

Legacy method. Writes a warning to STDERR and calls C<add_method_factory()>. Will be discontinued from the 4th of April 2004 on.

=item add_dependency( [ VALUE ... ] )

Add additional values on the list of 'PerlBean::Dependency' objects. Each C<VALUE> is an object out of which the id is obtained through method C<get_dependency_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Dependency

=back

=back

=item add_export_tag_description( [ VALUE ... ] )

Add additional values on the list of 'PerlBean::Described::ExportTag' objects. Each C<VALUE> is an object out of which the id is obtained through method C<get_export_tag_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Described::ExportTag

=back

=back

=item add_method( [ VALUE ... ] )

Add additional values on the list of 'PerlBean::Method' objects. Each C<VALUE> is an object out of which the id is obtained through method C<get_method_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Method

=back

=back

=item add_method_factory( [ VALUE ... ] )

Add additional values on the list of 'PerlBean::Method::Factory' objects. Each C<VALUE> is an object out of which the id is obtained through method C<get_method_factory_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Method::Factory

=back

=back

=item add_symbol( [ VALUE ... ] )

Add additional values on the list of 'PerlBean::Symbol' objects. Each C<VALUE> is an object out of which the id is obtained through method C<get_symbol_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Symbol

=back

=back

=item delete_attribute( See delete_method_factory() )

Legacy method. Writes a warning to STDERR and calls C<delete_method_factory()>. Will be discontinued from the 4th of April 2004 on.

=item delete_dependency(ARRAY)

Delete elements from the list of 'PerlBean::Dependency' objects. Returns the number of deleted elements. On error an exception C<Error::Simple> is thrown.

=item delete_export_tag_description(ARRAY)

Delete elements from the list of 'PerlBean::Described::ExportTag' objects. Returns the number of deleted elements. On error an exception C<Error::Simple> is thrown.

=item delete_method(ARRAY)

Delete elements from the list of 'PerlBean::Method' objects. Returns the number of deleted elements. On error an exception C<Error::Simple> is thrown.

=item delete_method_factory(ARRAY)

Delete elements from the list of 'PerlBean::Method::Factory' objects. Returns the number of deleted elements. On error an exception C<Error::Simple> is thrown.

=item delete_symbol(ARRAY)

Delete elements from the list of 'PerlBean::Symbol' objects. Returns the number of deleted elements. On error an exception C<Error::Simple> is thrown.

=item exists_attribute( See exists_method_factory() )

Legacy method. Writes a warning to STDERR and calls C<exists_method_factory()>. Will be discontinued from the 4th of April 2004 on.

=item exists_base(ARRAY)

Returns the count of items in C<ARRAY> that are in the list of class names in use base.

=item exists_dependency(ARRAY)

Returns the count of items in C<ARRAY> that are in the list of 'PerlBean::Dependency' objects.

=item exists_export_tag_description(ARRAY)

Returns the count of items in C<ARRAY> that are in the list of 'PerlBean::Described::ExportTag' objects.

=item exists_method(ARRAY)

Returns the count of items in C<ARRAY> that are in the list of 'PerlBean::Method' objects.

=item exists_method_factory(ARRAY)

Returns the count of items in C<ARRAY> that are in the list of 'PerlBean::Method::Factory' objects.

=item exists_symbol(ARRAY)

Returns the count of items in C<ARRAY> that are in the list of 'PerlBean::Symbol' objects.

=item get_abstract()

Returns the PerlBean's abstract (a one line description of the module).

=item get_base( [ INDEX_ARRAY ] )

Returns an C<ARRAY> containing the list of class names in use base. C<INDEX_ARRAY> is an optional list of indexes which when specified causes only the indexed elements in the ordered list to be returned. If not specified, all elements are returned.

=item get_collection()

Returns class to throw when exception occurs.

=item get_description()

Returns the PerlBean description.

=item get_exception_class()

Returns class to throw when exception occurs.

=item get_license()

Returns the software license for the PerlBean.

=item get_package()

Returns package name.

=item get_short_description()

Returns the short PerlBean description.

=item get_synopsis()

Returns the synopsis for the PerlBean.

=item get_use_perl_version()

Returns the Perl version to use.

=item is_autoloaded()

Returns whether the methods in the PerlBean are autoloaded or not.

=item is_singleton()

Returns whether the package is a singleton and an C<instance()> method is implemented or not.

=item keys_attribute( See keys_method_factory() )

Legacy method. Writes a warning to STDERR and calls C<keys_method_factory()>. Will be discontinued from the 4th of April 2004 on.

=item keys_dependency()

Returns an C<ARRAY> containing the keys of the list of 'PerlBean::Dependency' objects.

=item keys_export_tag_description()

Returns an C<ARRAY> containing the keys of the list of 'PerlBean::Described::ExportTag' objects.

=item keys_method()

Returns an C<ARRAY> containing the keys of the list of 'PerlBean::Method' objects.

=item keys_method_factory()

Returns an C<ARRAY> containing the keys of the list of 'PerlBean::Method::Factory' objects.

=item keys_symbol()

Returns an C<ARRAY> containing the keys of the list of 'PerlBean::Symbol' objects.

=item pop_base()

Pop and return an element off the list of class names in use base. On error an exception C<Error::Simple> is thrown.

=item push_base(ARRAY)

Push additional values on the list of class names in use base. C<ARRAY> is the list value. The push may not yield to multiple identical elements in the list. Hence, multiple occurrences of the same element are ignored. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must match regular expression:

=over

=item ^\S+$

=back

=back

=item set_abstract(VALUE)

Set the PerlBean's abstract (a one line description of the module). C<VALUE> is the value. On error an exception C<Error::Simple> is thrown.

=over

=item VALUE must match regular expression:

=over

=item ^.*$

=back

=back

=item set_attribute( See set_method_factory() )

Legacy method. Writes a warning to STDERR and calls C<set_method_factory()>. Will be discontinued from the 4th of April 2004 on.

=item set_autoloaded(VALUE)

State that the methods in the PerlBean are autoloaded. C<VALUE> is the value. Default value at initialization is C<1>. On error an exception C<Error::Simple> is thrown.

=item set_base(ARRAY)

Set the list of class names in use base absolutely. C<ARRAY> is the list value. Each element in the list is allowed to occur only once. Multiple occurrences of the same element yield in the first occurring element to be inserted and the rest to be ignored. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must match regular expression:

=over

=item ^\S+$

=back

=back

=item set_collection(VALUE)

Set class to throw when exception occurs. C<VALUE> is the value. On error an exception C<Error::Simple> is thrown.

=over

=item VALUE must be a (sub)class of:

=over

=item PerlBean::Collection

=back

=back

=item set_dependency( [ VALUE ... ] )

Set the list of 'PerlBean::Dependency' objects absolutely using values. Each C<VALUE> is an object out of which the id is obtained through method C<get_dependency_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.
Defaults value at initialization is a set of C<PerlBean::Dependency> objects that yields to:

 use strict;
 use warnings;
 use Error qw(:try);

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Dependency

=back

=back

=item set_description(VALUE)

Set the PerlBean description. C<VALUE> is the value. On error an exception C<Error::Simple> is thrown.

=item set_exception_class(VALUE)

Set class to throw when exception occurs. C<VALUE> is the value. Default value at initialization is C<Error::Simple>. C<VALUE> may not be C<undef>. On error an exception C<Error::Simple> is thrown.

=item set_export_tag_description( [ VALUE ... ] )

Set the list of 'PerlBean::Described::ExportTag' objects absolutely using values. Each C<VALUE> is an object out of which the id is obtained through method C<get_export_tag_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Described::ExportTag

=back

=back

=item set_license(VALUE)

Set the software license for the PerlBean. C<VALUE> is the value. On error an exception C<Error::Simple> is thrown.

=over

=item VALUE must match regular expression:

=over

=item .*

=back

=back

=item set_method( [ VALUE ... ] )

Set the list of 'PerlBean::Method' objects absolutely using values. Each C<VALUE> is an object out of which the id is obtained through method C<get_method_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Method

=back

=back

=item set_method_factory( [ VALUE ... ] )

Set the list of 'PerlBean::Method::Factory' objects absolutely using values. Each C<VALUE> is an object out of which the id is obtained through method C<get_method_factory_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Method::Factory

=back

=back

=item set_package(VALUE)

Set package name. C<VALUE> is the value. C<VALUE> may not be C<undef>. On error an exception C<Error::Simple> is thrown.

=item set_short_description(VALUE)

Set the short PerlBean description. C<VALUE> is the value. Default value at initialization is C<NO DESCRIPTION AVAILABLE>. On error an exception C<Error::Simple> is thrown.

=item set_singleton(VALUE)

State that the package is a singleton and an C<instance()> method is implemented. C<VALUE> is the value. Default value at initialization is C<0>. On error an exception C<Error::Simple> is thrown.

=item set_symbol( [ VALUE ... ] )

Set the list of 'PerlBean::Symbol' objects absolutely using values. Each C<VALUE> is an object out of which the id is obtained through method C<get_symbol_name()>. The obtained B<key> is used to store the value and may be used for deletion and to fetch the value. 0 or more values may be supplied. Multiple occurrences of the same key yield in the last occurring key to be inserted and the rest to be ignored. Each key of the specified values is allowed to occur only once. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must be a (sub)class of:

=over

=item PerlBean::Symbol

=back

=back

=item set_synopsis(VALUE)

Set the synopsis for the PerlBean. C<VALUE> is the value. On error an exception C<Error::Simple> is thrown.

=over

=item VALUE must match regular expression:

=over

=item .*

=back

=back

=item set_use_perl_version(VALUE)

Set the Perl version to use. C<VALUE> is the value. Default value at initialization is C<$]>. C<VALUE> may not be C<undef>. On error an exception C<Error::Simple> is thrown.

=over

=item VALUE must match regular expression:

=over

=item ^v?\d+(\.[\d_]+)*

=back

=back

=item shift_base()

Shift and return an element off the list of class names in use base. On error an exception C<Error::Simple> is thrown.

=item unshift_base(ARRAY)

Unshift additional values on the list of class names in use base. C<ARRAY> is the list value. The push may not yield to multiple identical elements in the list. Hence, multiple occurrences of the same element are ignored. On error an exception C<Error::Simple> is thrown.

=over

=item The values in C<ARRAY> must match regular expression:

=over

=item ^\S+$

=back

=back

=item values_attribute( See values_method_factory() )

Legacy method. Writes a warning to STDERR and calls C<values_method_factory()>. Will be discontinued from the 4th of April 2004 on.

=item values_dependency( [ KEY_ARRAY ] )

Returns an C<ARRAY> containing the values of the list of 'PerlBean::Dependency' objects. If C<KEY_ARRAY> contains one or more C<KEY>s the values related to the C<KEY>s are returned. If no C<KEY>s specified all values are returned.

=item values_export_tag_description( [ KEY_ARRAY ] )

Returns an C<ARRAY> containing the values of the list of 'PerlBean::Described::ExportTag' objects. If C<KEY_ARRAY> contains one or more C<KEY>s the values related to the C<KEY>s are returned. If no C<KEY>s specified all values are returned.

=item values_method( [ KEY_ARRAY ] )

Returns an C<ARRAY> containing the values of the list of 'PerlBean::Method' objects. If C<KEY_ARRAY> contains one or more C<KEY>s the values related to the C<KEY>s are returned. If no C<KEY>s specified all values are returned.

=item values_method_factory( [ KEY_ARRAY ] )

Returns an C<ARRAY> containing the values of the list of 'PerlBean::Method::Factory' objects. If C<KEY_ARRAY> contains one or more C<KEY>s the values related to the C<KEY>s are returned. If no C<KEY>s specified all values are returned.

=item values_symbol( [ KEY_ARRAY ] )

Returns an C<ARRAY> containing the values of the list of 'PerlBean::Symbol' objects. If C<KEY_ARRAY> contains one or more C<KEY>s the values related to the C<KEY>s are returned. If no C<KEY>s specified all values are returned.

=item write(FILEHANDLE)

Write the Perl class code to C<FILEHANDLE>. C<FILEHANDLE> is an C<IO::Handle> object. On error an exception C<Error::Simple> is thrown.

=back

=head1 SEE ALSO

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

=head1 BUGS

=over

=item OS dependency

C<PerlBean> is written on/for Unix. File handling and system file access should be enhanced to be OS independent.

=item PerlBean rules

=over

=item Symbols

I am not satisfied with the C<our %ALLOW.*> symbols that are used to check rules that apply to the C<PerlBean>'s attributes. They pollute the class' name space. Also there are too many symbols in use. Once I will restructure these into B<one> hash ( e.g. C<_RULES_> ).

=back

=item PerlBean::Attribute

=over

=item Default values

Currently, default values can only be defined fixed. Expressions that are evaluated at module load and expressions that are evaluated at class instantiation would make sense.

Also, their representations in code and in pod have issues with special characters.

=item Allow/deny undef

Currently, allow/deny of C<undef> is handled poorly by C<_value_is_allowed()>. That has to get better.

=item A lock property

In order to deny attributes being changed after they are set.

=back

=item SEE ALSO section

I am not satisfied with the long lists in the B<SEE ALSO> section. C<PerlBean> objects must get a documentation scope or some other restriction scheme. I don't know exactly yet.

=item BUGS section

The B<BUGS> section always has C<None known (yet.)> in it. That must improve.

=item HISTORY section

The C<HISTORY> section always has C<First development: CE<lt>current_dateE<gt> Last update: CE<lt>current_dateE<gt>> in it. That must improve.

=item TODO section

I need a C<TODO> section.

=back

=head1 HISTORY

First development: November 2002
Last update: September 2003

=head1 AUTHOR

Vincenzo Zocca

=head1 COPYRIGHT

Copyright 2002, 2003 by Vincenzo Zocca

=head1 LICENSE

This file is part of the C<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

=cut

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::_initialize, first argument must be 'HASH' reference.");

    # _export_tag_, MULTI
    if ( exists( $opt->{_export_tag_} ) ) {
        ref( $opt->{_export_tag_} ) eq 'ARRAY' || throw Error::Simple("ERROR: PerlBean::_initialize, specified value for option '_export_tag_' must be an 'ARRAY' reference.");
        $self->set__export_tag_( @{ $opt->{_export_tag_} } );
    }
    else {
        $self->set__export_tag_();
    }

    # _finalized_, BOOLEAN, with default value
    $self->set__finalized_( exists( $opt->{_finalized_} ) ? $opt->{_finalized_} : $DEFAULT_VALUE{_finalized_} );

    # _has_exports_, BOOLEAN, with default value
    $self->set__has_exports_( exists( $opt->{_has_exports_} ) ? $opt->{_has_exports_} : $DEFAULT_VALUE{_has_exports_} );

    # abstract, SINGLE
    exists( $opt->{abstract} ) && $self->set_abstract( $opt->{abstract} );

    # autoloaded, BOOLEAN, with default value
    $self->set_autoloaded( exists( $opt->{autoloaded} ) ? $opt->{autoloaded} : $DEFAULT_VALUE{autoloaded} );

    # base, MULTI
    if ( exists( $opt->{base} ) ) {
        ref( $opt->{base} ) eq 'ARRAY' || throw Error::Simple("ERROR: PerlBean::_initialize, specified value for option 'base' must be an 'ARRAY' reference.");
        $self->set_base( @{ $opt->{base} } );
    }
    else {
        $self->set_base();
    }

    # collection, SINGLE
    exists( $opt->{collection} ) && $self->set_collection( $opt->{collection} );

    # dependency, MULTI, with default value
    if ( exists( $opt->{dependency} ) ) {
        ref( $opt->{dependency} ) eq 'ARRAY' || throw Error::Simple("ERROR: PerlBean::_initialize, specified value for option 'dependency' must be an 'ARRAY' reference.");
        $self->set_dependency( @{ $opt->{dependency} } );
    }
    else {

        # Empty the dependency list
        $self->set_dependency();

        # Add 'use strict'
        $self->add_dependency( PerlBean::Dependency::Use->new( {
            dependency_name => 'strict',
        } ) );

        # Add 'use warnings'
        $self->add_dependency( PerlBean::Dependency::Use->new( {
            dependency_name => 'warnings',
        } ) );

        # Add 'use Error qw(:try)'
        $self->add_dependency( PerlBean::Dependency::Use->new( {
            dependency_name => 'Error',
            import_list => [ 'qw(:try)' ],
        } ) );

    }

    # description, SINGLE
    exists( $opt->{description} ) && $self->set_description( $opt->{description} );

    # exception_class, SINGLE, with default value
    $self->set_exception_class( exists( $opt->{exception_class} ) ? $opt->{exception_class} : $DEFAULT_VALUE{exception_class} );

    # export_tag_description, MULTI
    if ( exists( $opt->{export_tag_description} ) ) {
        ref( $opt->{export_tag_description} ) eq 'ARRAY' || throw Error::Simple("ERROR: PerlBean::_initialize, specified value for option 'export_tag_description' must be an 'ARRAY' reference.");
        $self->set_export_tag_description( @{ $opt->{export_tag_description} } );
    }
    else {
        $self->set_export_tag_description();
    }

    # license, SINGLE
    exists( $opt->{license} ) && $self->set_license( $opt->{license} );

    # method, MULTI
    if ( exists( $opt->{method} ) ) {
        ref( $opt->{method} ) eq 'ARRAY' || throw Error::Simple("ERROR: PerlBean::_initialize, specified value for option 'method' must be an 'ARRAY' reference.");
        $self->set_method( @{ $opt->{method} } );
    }
    else {
        $self->set_method();
    }

    # method_factory, MULTI
    if ( exists( $opt->{method_factory} ) ) {
        ref( $opt->{method_factory} ) eq 'ARRAY' || throw Error::Simple("ERROR: PerlBean::_initialize, specified value for option 'method_factory' must be an 'ARRAY' reference.");
        $self->set_method_factory( @{ $opt->{method_factory} } );
    }
    else {
        $self->set_method_factory();
    }

    # package, SINGLE, mandatory
    exists( $opt->{package} ) || throw Error::Simple("ERROR: PerlBean::_initialize, option 'package' is mandatory.");
    $self->set_package( $opt->{package} );

    # short_description, SINGLE, with default value
    $self->set_short_description( exists( $opt->{short_description} ) ? $opt->{short_description} : $DEFAULT_VALUE{short_description} );

    # singleton, BOOLEAN, with default value
    $self->set_singleton( exists( $opt->{singleton} ) ? $opt->{singleton} : $DEFAULT_VALUE{singleton} );

    # symbol, MULTI
    if ( exists( $opt->{symbol} ) ) {
        ref( $opt->{symbol} ) eq 'ARRAY' || throw Error::Simple("ERROR: PerlBean::_initialize, specified value for option 'symbol' must be an 'ARRAY' reference.");
        $self->set_symbol( @{ $opt->{symbol} } );
    }
    else {
        $self->set_symbol();
    }

    # synopsis, SINGLE
    exists( $opt->{synopsis} ) && $self->set_synopsis( $opt->{synopsis} );

    # use_perl_version, SINGLE, with default value
    $self->set_use_perl_version( exists( $opt->{use_perl_version} ) ? $opt->{use_perl_version} : $DEFAULT_VALUE{use_perl_version} );

    # Return $self
    return($self);
}

sub _by_pragma {
    if ($a =~ /^[a-z]/ && $b !~ /^[a-z]/ ) {
        return(-1);
    }
    elsif ($a !~ /^[a-z]/ && $b =~ /^[a-z]/ ) {
        return(1);
    }
    else {
        return($a cmp $b );
    }
}

sub _finalize {
    my $self = shift;

    # Remove all volatile dependencies
    $self->_rm_volatile_dependencies();

    # Remove all volatile methods
    $self->_rm_volatile_methods();

    # Remove all volatile symbols
    $self->_rm_volatile_symbols();

    # Check if exporter is needed
    $self->_mk__has_exports_();

    # Finalize constructor
    $self->_finalize_constructor();

    # Finalize singleton
    $self->_finalize_singleton();

    # Finalize autoload
    $self->_finalize_autoload();

    # Finalize allowed
    $self->_finalize_allowed();

    # Finalize default values
    $self->_finalize_default();

    # Finalize 'use base'
    $self->_finalize_use_base();

    # Finalize exports
    $self->_finalize_exports();

    # Finalize version
    $self->_finalize_version();

    # Finalize method factories
    $self->_finalize_method_factories();

    # Remember this object is finalized
    $self->set__finalized_(1);
}

sub _finalize_allowed {
    my $self = shift;

    # Check for constraints
    my $constraints = 0;
    my $has_attributes = 0;
    foreach my $method_factory ( $self->values_method_factory() ) {
        # Only check attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        # Remember we actually found attributes
        $has_attributes = 1;

        # Check for constraints
        $constraints =
            $method_factory->write_allow_isa() ||
            $method_factory->write_allow_ref() ||
            $method_factory->write_allow_rx() ||
            $method_factory->write_allow_value();
        $constraints && last;
    }

    # Make _value_allowed
    $self->_mk_value_allowed_method($constraints, $has_attributes);

    # Delete the allow symbols if no constraints
    $constraints ||
        $self->delete_symbol( qw( %ALLOW_ISA %ALLOW_REF
                                        %ALLOW_RX %ALLOW_VALUE ) );

    # Return if no constraints
    $constraints || return();

    # %ALLOW_ISA symbol
    my $assignment = "(\n";
    foreach my $name ( sort( $self->keys_method_factory() ) ) {
        # Make method factory out of name
        my $method_factory = ( $self->values_method_factory($name) )[0];

        # Only do attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        $assignment .= $method_factory->write_allow_isa();
    }
    $assignment .= ");\n";
    $self->add_symbol( PerlBean::Symbol->new( {
        symbol_name => '%ALLOW_ISA',
        assignment => $assignment,
        comment => "# Used by _value_is_allowed\n",
        volatile => 1,
    } ) );

    # %ALLOW_REF symbol
    $assignment = "(\n";
    foreach my $name ( sort( $self->keys_method_factory() ) ) {
        # Make method factory out of name
        my $method_factory = ( $self->values_method_factory($name) )[0];

        # Only do attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        $assignment .= $method_factory->write_allow_ref();
    }
    $assignment .= ");\n";
    $self->add_symbol( PerlBean::Symbol->new( {
        symbol_name => '%ALLOW_REF',
        assignment => $assignment,
        comment => "# Used by _value_is_allowed\n",
        volatile => 1,
    } ) );

    # %ALLOW_RX symbol
    $assignment = "(\n";
    foreach my $name ( sort( $self->keys_method_factory() ) ) {
        # Make method factory out of name
        my $method_factory = ( $self->values_method_factory($name) )[0];

        # Only do attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        $assignment .= $method_factory->write_allow_rx();
    }
    $assignment .= ");\n";
    $self->add_symbol( PerlBean::Symbol->new( {
        symbol_name => '%ALLOW_RX',
        assignment => $assignment,
        comment => "# Used by _value_is_allowed\n",
        volatile => 1,
    } ) );

    # %ALLOW_VALUE symbol
    $assignment = "(\n";
    foreach my $name ( sort( $self->keys_method_factory() ) ) {
        # Make method factory out of name
        my $method_factory = ( $self->values_method_factory($name) )[0];

        # Only do attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        $assignment .= $method_factory->write_allow_value();
    }
    $assignment .= ");\n";
    $self->add_symbol( PerlBean::Symbol->new( {
        symbol_name => '%ALLOW_VALUE',
        assignment => $assignment,
        comment => "# Used by _value_is_allowed\n",
        volatile => 1,
    } ) );
}

sub _finalize_autoload {
    my $self = shift;

    # Remove AutoLoader dependency if not autoloaded
    $self->is_autoloaded() || $self->delete_dependency('AutoLoader');

    # Return if not autoloaded
    $self->is_autoloaded() || return;

    # Return if AutoLoader dependency already exists
    $self->exists_dependency('AutoLoader') && return;

    # Add AutoLoader dependency
    $self->add_dependency( PerlBean::Dependency::Use->new( {
            dependency_name => 'AutoLoader',
            import_list => [ 'qw(AUTOLOAD)' ],
            volatile => 1,
    } ) );
}

sub _finalize_constructor {
    my $self = shift;

    # Do nothing if new() and _initialize() exist already.
    ! $self->exists_method('new') ||
        ! $self->exists_method('_initialize') ||
            return;

    # The own attributes
    my %own_attr = ();
    foreach my $method_factory ( $self->values_method_factory() ) {

        # Only do attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        # Remember the attribute by name
        $own_attr{ $method_factory->get_method_factory_name() } =
            $method_factory;
    }

    # Get the effective attributes for this bean, remember if one or more
    # attributes are mandatory and remember all package names
    $self->_get_effective_attributes( \my %eff_attr );
    my $mand = 0;
    my %eff_pkg = ();
    foreach my $attr ( values(%eff_attr) ) {
        # Is the attribute mandatory?
        $mand ||= $attr->is_mandatory();

        # Remember the package name
        $eff_pkg{ $attr->get_package() }{ $attr->get_method_factory_name() } =
            $attr;
    }

    # Make if new() method if it doesn't already exists
    $self->exists_method('new') ||
        $self->_finalize_constructor_new( \%own_attr, \%eff_pkg, $mand );

    # Make if _initialize() method if it doesn't already exists
    $self->exists_method('_initialize') ||
        $self->_finalize_constructor_initialize( \%own_attr );
}

sub _finalize_constructor_initialize {
    my $self = shift;
    my $own_attr = shift;

    # Implement _initialize() only if:
    # 1) the PerlBean has own attributes
    # 2) the PerlBean is not derived
    # 3) the PerlBean has more than one superclass
    # 4) the one superclass of the PerlBean's is not in the collection
    # 1)
    my $do_implement = scalar( keys( %{$own_attr} ) );
    # 2)
    $do_implement ||= ! scalar( $self->get_base() );
    # 3)
    $do_implement ||= scalar( $self->get_base() ) > 1;
    # 4)
    if ( ! $do_implement &&
            defined( $self->get_collection() ) &&
                scalar( $self->get_base() ) ) {
        my $super_in_collection = 1;
        foreach my $base ( $self->get_base() ) {
            $super_in_collection &&= scalar( $self->get_collection()->
                                                    values_perl_bean($base) );
        }
        $do_implement = ! $super_in_collection;
    }
    $do_implement || return;

    my $pkg = $self->get_package();
    my $ec = $self->get_exception_class();

    my $body = <<EOF;
${IND}my \$self${AO}=${AO}shift;
${IND}my \$opt${AO}=${AO}defined${BFP}(\$_[0])${AO}?${AO}shift${AO}:${AO}\{};

${IND}# Check \$opt
${IND}ref${BFP}(\$opt)${AO}eq${AO}'HASH'${AO}||${AO}throw $ec${BFP}("ERROR: ${pkg}::_initialize, first argument must be 'HASH' reference.");

EOF

    # Add code for own attributes
    foreach my $name ( sort( keys( %{$own_attr} ) ) ) {
        $body .= $own_attr->{$name}->write_constructor_option_code();
    }

    # superclass' _initialize
    if ( scalar ( $self->get_base() ) == 1 ) {
        $body .= <<EOF;
${IND}# Call the superclass' _initialize
${IND}\$self->SUPER::_initialize${BFP}(\$opt);

EOF
    }
    elsif ( scalar ( $self->get_base() ) ) {
        $body .= <<EOF;
${IND}# Call the superclass' _initialize
EOF
        foreach my $super ( $self->get_base() ) {
        $body .= <<EOF;
${IND}\$self->${super}::_initialize${BFP}(\$opt);
EOF
        }
        $body .= "\n";
    }

    # Code to return $self
    $body .= <<EOF;
${IND}# Return \$self
${IND}return${BFP}(\$self);
EOF

    # Make and add the method
    $self->add_method( PerlBean::Method->new( {
        method_name => '_initialize',
        documented => 0,
        volatile => 1,
        body => $body,
    } ) );
}

sub _finalize_constructor_new {
    my $self = shift;
    my $own_attr = shift;
    my $eff_pkg = shift;
    my $mand = shift;

    # Implement new() only if:
    # 1) the PerlBean is not derived
    # 2) not all the PerlBean's superclasses are in the collection
    my $do_implement = ! scalar( $self->get_base() );
    if ( ! $do_implement &&
            defined( $self->get_collection() ) &&
                scalar( $self->get_base() ) ) {
        my $super_in_collection = 1;
        foreach my $base ( $self->get_base() ) {
            $super_in_collection &&= scalar( $self->get_collection()->
                                                    values_perl_bean($base) );
        }
        $do_implement = ! $super_in_collection;
    }

    my $pkg = $self->get_package();
    my $ec = $self->get_exception_class();

    # Describe OPT_HASH_REF if the PerlBean has attributes or its superclasses
    # have.
    my $do_opt_hash_ref = scalar( keys( %{$eff_pkg} ) );

    # Start the description
    my $desc = "Creates a new C<$pkg> object.";
    $desc .= ! $do_opt_hash_ref ? '' :
        " C<OPT_HASH_REF> is a hash reference used to pass initialization options.";

    # If this PerlBean or its superclass PerlBeans have 'mandatory' attributes,
    # then the OPT_HASH_REF parameter is mandatory
    my $parameter_description = '';
    if (! $do_opt_hash_ref) {
        $desc .= "\n";
    }
    else {
        $parameter_description = "${ACS}\[${ACS}OPT_HASH_REF${ACS}\]${ACS}";
        if ($mand) {
            $desc .= ' C<OPT_HASH_REF> is mandatory.';
            $parameter_description = 'OPT_HASH_REF';
        }

        # Add exception message to the description
        $desc .= <<EOF;
 On error an exception C<$ec> is thrown.
EOF

        # Add pod for own attributes
        if ( scalar( keys( %{$own_attr} ) ) ) {
            $desc .= <<EOF;

Options for C<OPT_HASH_REF> may include:

\=over
EOF
            foreach my $name ( sort( keys( %{$own_attr} ) ) ) {
                $desc .= $own_attr->{$name}->write_constructor_option_doc();
            }

            # Close =over
            $desc .= <<EOF;

\=back
EOF

        }

        # Add pod for inherited attributes
        foreach my $pkg_name ( sort( keys( %{$eff_pkg} ) ) ) {
            # Don't do own package
            $pkg_name eq $self->get_package() && next;

            $desc .= <<EOF;

Options for C<OPT_HASH_REF> inherited through package B<C<$pkg_name>> may include:

\=over
EOF

            foreach my $attr_name ( sort( keys( %{$eff_pkg->{$pkg_name}} ) ) ) {
                $desc .= $eff_pkg->{$pkg_name}{$attr_name}->
                                                write_constructor_option_doc();
            }

            # Close =over
            $desc .= <<EOF;

\=back
EOF
        }
    }

    # Make the body
    my $body = <<EOF;
${IND}my \$class${AO}=${AO}shift;

${IND}my \$self${AO}=${AO}\{};
${IND}bless${BFP}(${ACS}\$self,${AC}(${ACS}ref${BFP}(\$class)${AO}||${AO}\$class${ACS})${ACS});
${IND}return${BFP}(${ACS}\$self->_initialize${BFP}(\@_)${ACS});
EOF

    # Make and add the method
    $self->add_method( PerlBean::Method::Constructor->new( {
        method_name => 'new',
        parameter_description => $parameter_description,
        volatile => 1,
        description => $desc,
        implemented => $do_implement,
        body => $body,
    } ) );
}

sub _finalize_default {
    my $self = shift;

    # Don't add the '%DEFAULT_VALUE' if it exists already
    $self->exists_symbol( '%DEFAULT_VALUE' ) && return();

    # %DEFAULT_VALUE symbol
    my $has_default_value = '';
    my $assignment = "(\n";
    foreach my $name ( sort( $self->keys_method_factory() ) ) {
        # Make method factory out of name
        my $method_factory = ( $self->values_method_factory($name) )[0];

        # Only do attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        $assignment .= $method_factory->write_default_value();
        $has_default_value ||= $method_factory->write_default_value();
    }
    $assignment .= ");\n";

    # Don't add the '%DEFAULT_VALUE' if there aren't any default values
    $has_default_value || return();

    # Add the symbol
    $self->add_symbol( PerlBean::Symbol->new( {
        symbol_name => '%DEFAULT_VALUE',
        assignment => $assignment,
        comment => "# Used by _initialize\n",
        volatile => 1,
    } ) );
}

sub _finalize_exports {
    my $self = shift;

    # Delete the require Exporter dependency
    $self->delete_dependency('Exporter');

    # Delete %EXPORT_TAGS @EXPORT_OK @EXPORT if not exported
    $self->is__has_exports_() ||
        $self->delete_symbol( qw( %EXPORT_TAGS @EXPORT_OK @EXPORT ) );

    # That's it if no exports
    $self->is__has_exports_() || return;

    # require Exporter
    $self->add_dependency( PerlBean::Dependency::Require->new( {
        dependency_name => 'Exporter',
        volatile => 1,
    } ) );

    # Get all export tags
    $self->set__export_tag_();
    foreach my $sym ( $self->values_symbol() ) {
        foreach my $tag ( $sym->values_export_tag() ) {
            $self->exists__export_tag_($tag) ||
                                            $self->add__export_tag_($tag, []);
            push( @{ ( $self->values__export_tag_($tag) )[0] }, $sym );
        }
    }


    # Add %EXPORT_TAGS symbol if it doesn't already exist
    if ( ! $self->exists_symbol('%EXPORT_TAGS') ) {
        my $assignment = "(\n";
        foreach my $tag ( sort( $self->keys__export_tag_() ) ) {

            # The %EXPORT_TAGS assignment head for this tag
            $assignment .= "${IND}'$tag' => [ qw(\n";

            # Fill out the lines alphabetically
            foreach my $name ( sort( $self->keys_symbol() ) ) {

                 # Get the symbol
                 my $sym = ( $self->values_symbol($name) )[0];

                 # Skip if not in tag
                 $sym->exists_export_tag($tag) || next;

                 # Add the line
                 $assignment .= "${IND}${IND}$name\n";
            }

            # The %EXPORT_TAGS assignment tail for this tag
            $assignment .= "${IND}) ],\n";
        }

        # The %EXPORT_TAGS assignment tail
        $assignment .= ");\n";

        # Make and add the symbols %EXPORT_TAGS
        $self->add_symbol( PerlBean::Symbol->new( {
            symbol_name => '%EXPORT_TAGS',
            assignment => $assignment,
            comment => "# Exporter variable\n",
            volatile => 1,
        } ) );
    }


    # The @EXPORT_OK assignment head
    my $EOA = "qw(\n";

    # The @EXPORT assignment head
    my $EA = "qw(\n";

    # Fill $EOA and $EA
    foreach my $name ( sort( $self->keys_symbol() ) ) {
         # Get the symbol
         my $sym = ( $self->values_symbol($name) )[0];

         # Next if no tag
         $sym->values_export_tag() || next;

         # Add the line to $EOA
         $EOA .= "${IND}$name\n";

         # Next if no default tag
         $sym->exists_export_tag('default') || next;

         # Add the line to $EA
         $EA .= "${IND}$name\n";

    }

    # The @EXPORT_OK assignment tail
    $EOA .= ");\n";

    # The @EXPORT assignment tail
    $EA .= ");\n";

    # Add @EXPORT_OK symbol if it doesn't already exist
    ! $self->exists_symbol('@EXPORT_OK') &&
        $self->add_symbol( PerlBean::Symbol->new( {
            symbol_name => '@EXPORT_OK',
            assignment => $EOA,
            comment => "# Exporter variable\n",
            volatile => 1,
        } ) );

    # Add @EXPORT symbol if it doesn't already exist
    ! $self->exists_symbol('@EXPORT') &&
        $self->add_symbol( PerlBean::Symbol->new( {
            symbol_name => '@EXPORT',
            assignment => $EA,
            comment => "# Exporter variable\n",
            volatile => 1,
        } ) );
}

sub _finalize_method_factories {
    my $self = shift;

    # Add all methods from all method factories
    foreach my $method_factory ( $self->values_method_factory() ) {

        # Try adding each method from the factory
        foreach my $meth ( $method_factory->create_methods() ) {
            # Don't add the method if already present
            $self->exists_method( $meth->get_method_name() ) && next;

            # Add the method
            $self->add_method( $meth );
        }
    }
}

sub _finalize_singleton {
    my $self = shift;

    $self->is_singleton() || return;

    # Make the $SINGLETON symbol if it doesn't exist already
    $self->exists_symbol('$SINGLETON') ||
        $self->add_symbol( PerlBean::Symbol->new( {
            symbol_name => '$SINGLETON',
            assignment => "undef;\n",
            comment => "# Singleton variable\n",
            volatile => 1,
        } ) );

    # Return if the instance() method already exists
    $self->exists_method('instance') && return();

    # Package name
    my $pkg = $self->get_package();

    # Make the instance() method
    $self->add_method( PerlBean::Method->new( {
        method_name => 'instance',
        parameter_description => ' [ CONSTR_OPT ] ',
        volatile => 1,
        description => <<EOF,
Always returns the same C<${pkg}> -singleton- object instance. The first time it is called, parameters C<CONSTR_OPT> -if specified- are passed to the constructor.
EOF
                body => <<EOF,
${IND}# Allow calls like:
${IND}# - ${pkg}::instance()
${IND}# - ${pkg}->instance()
${IND}# - \$variable->instance()
${IND}if${BCP}(${ACS}ref${BFP}(\$_[0])${AO}&&${AO}&UNIVERSAL::isa(${ACS}\$_[0], '${pkg}'${ACS})${ACS}) {
${IND}${IND}shift;
${IND}}${PBCC[1]}elsif${BCP}(${ACS}!${AO}ref${BFP}(\$_[0])${AO}&&${AO}\$_[0]${AO}eq${AO}'${pkg}'${ACS})${PBOC[1]}{
${IND}${IND}shift;
${IND}}

${IND}# If \$SINGLETON is defined return it
${IND}defined${BFP}(\$SINGLETON) && return${BFP}(\$SINGLETON);

${IND}# Create the object and set \$SINGLETON
${IND}\$SINGLETON${AO}=${AO}${pkg}->new${BFP}();

${IND}# Initialize the object separately as the initialization might
${IND}# depend on \$SINGLETON being set.
${IND}\$SINGLETON->_initialize${BFP}(\@_);

${IND}# Return \$SINGLETON
${IND}return${BFP}(\$SINGLETON);
EOF
    } ) );
}

sub _finalize_use_base {
    my $self = shift;

    my @base = $self->get_base();
    $self->is__has_exports_() && push( @base, 'Exporter' );
    if ( scalar(@base) ) {
        my $dep = PerlBean::Dependency::Use->new( {
            dependency_name => 'base',
            import_list => [ "qw( @base )" ],
            volatile => 1,
        } );
        $self->add_dependency($dep);
    }
}

sub _finalize_version {
    my $self = shift;

    # Return if '$VERSION' or '($VERSION)' exists
    ( $self->exists_symbol('$VERSION') ||
                            $self->exists_symbol('($VERSION)') ) && return();

    # Make the $VERSION symbol
    my $va = '\'$';
    $va .= 'Revision: 0.0.0.0';
    $va .= " \$'${AO}=~${AO}/\\\$";
    $va .= 'Revision:\\s+([^\\s]+)/;';
    $va .= "\n";

    # Add the ($VERSION) symbol
    $self->add_symbol( PerlBean::Symbol->new( {
        symbol_name => '($VERSION)',
        assignment => $va,
        comment => "# Package version\n",
        volatile =>1,
    } ) );
}

sub _get_effective_attributes {
    my $self = shift;
    my $done = shift;
    my $loop_stop = shift || {};

    # Check for a loop
    my $pkg = $self->get_package();
    exists( $loop_stop->{$pkg} ) && throw Error::Simple("ERROR: PerlBean::_get_effective_attributes, loop detected for bean '$pkg'.");
    $loop_stop->{$pkg} = 1;

    # Add own attributes
    foreach my $method_factory ( $self->values_method_factory() ) {
        # Only do attributes
        $method_factory->isa( 'PerlBean::Attribute' ) || next;

        # Only do not done
        exists( $done->{ $method_factory->get_method_factory_name() } ) && next;

        # Remember the attribute by name
        $done->{ $method_factory->get_method_factory_name() } = $method_factory;
    }

    # Add attributes from super classes
    foreach my $super_pkg ($self->get_base()) {
        # Get the super class bean
        my $super_bean = ($self->get_collection()->values_perl_bean($super_pkg))[0];

        # If the super package is not in the collection, well too bad (for now anyway)
        defined($super_bean) || next;

        # See if the super class bean has an attribute
        $super_bean->_get_effective_attributes( $done, $loop_stop );
    }
}

sub _get_effective_methods {
    my $self = shift;
    my $eff_meth = shift;
    my $loop_stop = shift || {};

    # Check for a loop
    my $pkg = $self->get_package();
    exists( $loop_stop->{$pkg} ) && throw Error::Simple("ERROR: PerlBean::_get_effective_methods, loop detected for bean '$pkg'.");
    $loop_stop->{$pkg} = 1;

    # Add own methods
    foreach my $meth ( $self->values_method() ) {
        exists( $eff_meth->{ $meth->get_method_name() } ) && next;
        $eff_meth->{ $meth->get_method_name() } = $meth;
    }

    # End if collection not set
    defined( $self->get_collection() ) || return;

    # Add methods from super classes
    foreach my $super_pkg ( $self->get_base() ) {
        # Get the super class bean
        my $super_bean = ( $self->get_collection()->values_perl_bean($super_pkg) )[0];

        # If the super package is not in the collection, well too bad (for now anyway)
        defined($super_bean) || next;

        # See if the super class bean has an attribute
        $super_bean->_get_effective_methods( $eff_meth, $loop_stop );
    }
}

sub _get_overloaded_attribute {
    my $self = shift;
    my $match_attr = shift;
    my $loop_stop = shift;

    # Check for a loop
    my $pkg = $self->get_package();
    exists( $loop_stop->{$pkg} ) && throw Error::Simple("ERROR: PerlBean::_get_overloaded_attribute, loop detected in inheritance at bean '$pkg'.");
    $loop_stop->{$pkg} = 1;

    # Check and return attribute if found in this bean
    my $found_attr = ( $self->values_method_factory( $match_attr->get_method_factory_name() ) )[0];
    if ( defined($found_attr) ) {
        # Get the reference type of the attribute to match
        my $match_attr_ref = ref($match_attr);

        # Get the reference type of the found attribute
        my $found_attr_ref = ref($found_attr);

        # Match found if the reference types of the attribute to match and the found attribute are identical.
        ( $match_attr_ref eq $found_attr_ref ) && return($found_attr);

        # The reference types of the attribute to match and the found attribute are different. Throw a usable exception.
        my $name = $found_attr->get_method_factory_name();
        my $match_attr_pkg = $match_attr->get_perl_bean()->get_package();
        throw Error::Simple("ERROR: PerlBean::_get_overloaded_attribute, found an attribute named '$name' in package '$pkg' but the reference type '$found_attr_ref' was not as in package '$match_attr_pkg' ($match_attr_ref).");
    }

    # Check super classes
    foreach my $super_pkg ($self->get_base()) {
        # Get the super class bean
        my $super_bean = ( $self->get_collection()->values_perl_bean($super_pkg) )[0];

        # If the super class bean has no bean in the collection then no attribute is found
        defined($super_bean) || return(undef);

        # See if the super class bean has an attribute
        my $attr_over = $super_bean->_get_overloaded_attribute( $match_attr, $loop_stop );

        # Return the overloaded bean if found
        defined($attr_over) && return($attr_over);
    }

    # Nothing found
    return(undef);
}

sub _get_super_method {
    my $self = shift;
    my $match_meth = shift;
    my $loop_stop = shift;

    # Check for a loop
    my $pkg = $self->get_package();
    exists( $loop_stop->{$pkg} ) && throw Error::Simple("ERROR: PerlBean::_get_super_method, loop detected in inheritance at bean '$pkg'.");
    $loop_stop->{$pkg} = 1;

    # Check and return method if found in this bean
    my $found_meth = ( $self->values_method( $match_meth->get_method_name() ) )[0];
    defined($found_meth) && return($found_meth);

    # Check super classes
    foreach my $super_pkg ($self->get_base()) {
        # Get the super class bean
        my $super_bean = ( $self->get_collection()->values_perl_bean($super_pkg) )[0];

        # If the super class bean has no bean in the collection then no method is found
        defined($super_bean) || return(undef);

        # See if the super class bean has the method
        my $found_meth = $super_bean->_get_super_method( $match_meth, $loop_stop );

        # Return the overloaded bean if found
        defined($found_meth) && return($found_meth);
    }

    # Nothing found
    return(undef);
}

sub _mk__has_exports_ {
    my $self = shift;

    # Check all symbols
    foreach my $sym ( $self->values_symbol() ) {

        # But discard the export symbols
        if ( $sym->get_symbol_name() eq '%EXPORT_TAGS' ||
                $sym->get_symbol_name() eq '@EXPORT_OK' ||
                $sym->get_symbol_name() eq '@EXPORT' ) {
            next;
        }

        # Check if the symbol is exported
        if ( scalar( $sym->values_export_tag() ) ) {
            $self->set__has_exports_(1);
            return;
        }
    }

    # Nothing found to export
    $self->set__has_exports_(0);
}

sub _mk_value_allowed_method {
    my $self = shift;
    my $constraints = shift;
    my $has_attributes = shift;

    # Do nothing of not attributes
    $has_attributes || return();

    my $body = ! $constraints ? "${IND}return${BFP}(1);\n" : <<EOF;
${IND}my \$name${AO}=${AO}shift;

${IND}# Value is allowed if no ALLOW clauses exist for the named attribute
${IND}if${BCP}(${ACS}!${AO}exists${BFP}(${ACS}\$ALLOW_ISA{\$name}${ACS})${AO}&&${AO}!${AO}exists${BFP}(${ACS}\$ALLOW_REF{\$name}${ACS})${AO}&&${AO}!${AO}exists${BFP}(${ACS}\$ALLOW_RX{\$name}${ACS})${AO}&&${AO}!${AO}exists${BFP}(${ACS}\$ALLOW_VALUE{\$name}${ACS})${ACS})${PBOC[1]}{
${IND}${IND}return${BFP}(1);
${IND}}

${IND}# At this point, all values in \@_ must to be allowed
${IND}CHECK_VALUES:
${IND}foreach my \$val (\@_)${PBOC[1]}{
${IND}${IND}# Check ALLOW_ISA
${IND}${IND}if${BCP}(${ACS}ref${BFP}(\$val)${AO}&&${AO}exists${BFP}(${ACS}\$ALLOW_ISA{\$name}${ACS})${ACS})${PBOC[2]}{
${IND}${IND}${IND}foreach my \$class (${ACS}\@{${ACS}\$ALLOW_ISA{\$name}${ACS}}${ACS})${PBOC[3]}{
${IND}${IND}${IND}${IND}&UNIVERSAL::isa${BFP}(${ACS}\$val,${AC}\$class${ACS})${AO}&&${AO}next CHECK_VALUES;
${IND}${IND}${IND}}
${IND}${IND}}

${IND}${IND}# Check ALLOW_REF
${IND}${IND}if${BCP}(${ACS}ref${BFP}(\$val)${AO}&&${AO}exists${BFP}(${ACS}\$ALLOW_REF{\$name}${ACS})${ACS})${PBOC[2]}{
${IND}${IND}${IND}exists${BFP}(${ACS}\$ALLOW_REF{\$name}{${ACS}ref${BFP}(\$val)${ACS}}${ACS})${AO}&&${AO}next CHECK_VALUES;
${IND}${IND}}

${IND}${IND}# Check ALLOW_RX
${IND}${IND}if${BCP}(${ACS}defined${BFP}(\$val)${AO}&&${AO}!${AO}ref${BFP}(\$val)${AO}&&${AO}exists${BFP}(${ACS}\$ALLOW_RX{\$name}${ACS})${ACS})${PBOC[2]}{
${IND}${IND}${IND}foreach my \$rx (${ACS}\@{${ACS}\$ALLOW_RX{\$name}${ACS}}${ACS})${PBOC[3]}{
${IND}${IND}${IND}${IND}\$val${AO}=~${AO}/\$rx/${AO}&&${AO}next CHECK_VALUES;
${IND}${IND}${IND}}
${IND}${IND}}

${IND}${IND}# Check ALLOW_VALUE
${IND}${IND}if${BCP}(${ACS}!${AO}ref${BFP}(\$val)${AO}&&${AO}exists${BFP}(${ACS}\$ALLOW_VALUE{\$name}${ACS})${ACS})${PBOC[2]}{
${IND}${IND}${IND}exists${BFP}(${ACS}\$ALLOW_VALUE{\$name}{\$val}${ACS})${AO}&&${AO}next CHECK_VALUES;
${IND}${IND}}

${IND}${IND}# We caught a not allowed value
${IND}${IND}return${BFP}(0);
${IND}}

${IND}# OK, all values are allowed
${IND}return${BFP}(1);
EOF
    $self->add_method( PerlBean::Method->new( {
        method_name => '_value_is_allowed',
        volatile => 1,
        documented => 0,
        body => $body,
    } ) );
}

sub _rm_volatile_dependencies {
    my $self = shift;

    # Remove all dependencies that are volatile
    foreach my $dependency ( $self->values_dependency() ) {
        $dependency->is_volatile() || next;
        $self->delete_dependency( $dependency->get_dependency_name() );
    }
}

sub _rm_volatile_methods {
    my $self = shift;

    # Remove all methods that are volatile
    foreach my $method ( $self->values_method() ) {
        $method->is_volatile() || next;
        $self->delete_method( $method->get_method_name() );
    }
}

sub _rm_volatile_symbols {
    my $self = shift;

    # Remove all symbols that are volatile
    foreach my $symbol ( $self->values_symbol() ) {
        $symbol->is_volatile() || next;
        $self->delete_symbol( $symbol->get_symbol_name() );
    }
}

sub _unfinalize {
    my $self = shift;

    # Remove all volatile dependencies
    $self->_rm_volatile_dependencies();

    # Remove all volatile methods
    $self->_rm_volatile_methods();

    # Remove all volatile symbols
    $self->_rm_volatile_symbols();

    # Remember this object is not finalized
    $self->set__finalized_(0);
}

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 _write_constructors_doc {
    my $self = shift;
    my $fh = shift;
    my $eff_meth = shift;

    # Start section
    $fh->print(<<EOF);
\=head1 CONSTRUCTOR

EOF

    # Do we have constructors?
    my $do_constructors = 0;
    foreach my $method ( values( %{$eff_meth} ) ) {
        $do_constructors ||= $method->isa('PerlBean::Method::Constructor');
        $do_constructors && last;
    }

    # If no constructors
    if (! $do_constructors) {
    $fh->print(<<EOF);
None

EOF

        return;
    }

    $fh->print(<<EOF);
\=over

EOF
    # Write constructors documentation
    foreach my $name ( sort( keys( ( %{$eff_meth} ) ) ) ) {
        my $method = $eff_meth->{$name};
        $method->isa('PerlBean::Method::Constructor') || next;
        $method->write_pod( $fh, $self->get_package() );
    }

    # Close =over
    $fh->print(<<EOF);
\=back

EOF
}

sub _write_declared_symbols {
    my $self = shift;
    my $fh = shift;

    foreach my $name ( sort( $self->keys_symbol() ) ) {
        my $symbol = ( $self->values_symbol($name) )[0];

        $symbol->write($fh);
    }
}

sub _write_dependencies {
    my $self = shift;
    my $fh = shift;

    # Perl version
    my $pv = $self->get_use_perl_version();
    $fh->print("use $pv;\n");

    # Write PerlBean::Dependency::Use
    foreach my $dependency_name ( sort {&_by_pragma}
                                            ( $self->keys_dependency() ) ) {
        my $dep = ( $self->values_dependency($dependency_name) )[0];

        $dep->isa('PerlBean::Dependency::Use') || next;

        $dep->write($fh);
    }

    # Write PerlBean::Dependency::Require
    foreach my $dependency_name ( sort {&_by_pragma}
                                            ( $self->keys_dependency() ) ) {
        my $dep = ( $self->values_dependency($dependency_name) )[0];

        $dep->isa('PerlBean::Dependency::Require') || next;

        $dep->write($fh);
    }

    # Write PerlBean::Dependency::Import
    foreach my $dependency_name ( sort {&_by_pragma}
                                            ( $self->keys_dependency() ) ) {
        my $dep = ( $self->values_dependency($dependency_name) )[0];

        $dep->isa('PerlBean::Dependency::Import') || next;

        $dep->write($fh);
    }

    $fh->print("\n");
}

sub _write_doc_export {
    my $self = shift;
    my $fh = shift;

    # Stop if no exports
    $self->is__has_exports_() || return;

    $fh->print( "=head1 EXPORT\n\n" );

    if ( ! $self->exists_export_tag_description('default') ) {
        $fh->print( "By default nothing is exported.\n\n" );
    }

    foreach my $tag ( sort( $self->keys__export_tag_() ) ) {

        $fh->print( "=head2 $tag\n\n" );

        if ( $self->exists_export_tag_description($tag) ) {
            my $tdesc = ( $self->values_export_tag_description($tag) )[0];
            $fh->print( $tdesc->get_description(), "\n" );
        } else {
            $fh->print( "TODO\n\n" );
        }

        $fh->print( "=over\n\n" );

        foreach my $name ( sort( $self->keys_symbol() ) ) {

             # Get the symbol
             my $sym = ( $self->values_symbol($name) )[0];

             # Skip if not in tag
             $sym->exists_export_tag($tag) || next;

             # Add the lines
             $fh->print( "=item $name\n\n" );

             $fh->print( $sym->get_description(), "\n" );
        }

        $fh->print( "=back\n\n" );
    }
}

sub _write_doc_head {
    my $self = shift;
    my $fh = shift;

    my $pkg = $self->get_package();
    my $sdesc = $self->get_short_description();

    my $desc = defined($self->get_description()) ?
                            $self->get_description() : "C<$pkg> TODO\n";

    my $syn = defined($self->get_synopsis()) ?
                            $self->get_synopsis() : " TODO\n";

    my $abs = defined($self->get_abstract()) ?
                            $self->get_abstract() : 'TODO';

    $fh->print( "=head1 NAME\n\n" );
    $fh->print( "${pkg} - ${sdesc}\n\n" );

    $fh->print( "=head1 SYNOPSIS\n\n" );
    $fh->print( "${syn}\n" );

    $fh->print( "=head1 ABSTRACT\n\n" );
    $fh->print( "${abs}\n\n" );

    $fh->print( "=head1 DESCRIPTION\n\n" );
    $fh->print( "${desc}\n" );
}

sub _write_doc_tail {
    my $self = shift;
    my $fh = shift;

    my $m = $MON[(localtime())[4]];
    my $y = (localtime())[5] + 1900;
    my $p = (getpwuid($>))[6];

    my $also = 'TODO';
    if (defined($self->get_collection())) {
        $also = '';
        foreach my $pkg (sort($self->get_collection()->keys_perl_bean())) {
            next if ($pkg eq $self->get_package());
            $also .= "L<$pkg>,\n";
        }
        chop($also);
        chop($also);
        $also = $also ? $also : 'NONE';
    }

    my $lic = 'TODO';
    if (defined($self->get_license())) {
        $lic = $self->get_license();
    }
    elsif (defined($self->get_collection()) && defined($self->get_collection()->get_license())) {
        $lic = $self->get_collection()->get_license();
    }

    $fh->print(<<EOF);
\=head1 SEE ALSO

$also

\=head1 BUGS

None known (yet.)

\=head1 HISTORY

First development: ${m} ${y}
Last update: ${m} ${y}

\=head1 AUTHOR

${p}

\=head1 COPYRIGHT

Copyright ${y} by ${p}

\=head1 LICENSE

$lic
\=cut

EOF
}

sub _write_file_end {
    my $self = shift;
    my $fh = shift;

    # Close the file with a '1;' only if not autoloaded
    $self->is_autoloaded() && return;

    $fh->print("1;\n");
}

sub _write_methods_doc {
    my $self = shift;
    my $fh = shift;
    my $eff_meth = shift;

    # Start section
    $fh->print(<<EOF);
\=head1 METHODS

EOF

    # Do we have methods?
    my $do_methods = 0;
    foreach my $method ( values( %{$eff_meth} ) ) {
        $do_methods ||= ! $method->isa('PerlBean::Method::Constructor');
        $do_methods && last;
    }

    # If no methods
    if (! $do_methods) {
    $fh->print(<<EOF);
None

EOF

        return;
    }

    $fh->print(<<EOF);
\=over

EOF
    # Write constructors documentation
    foreach my $name ( sort( keys( ( %{$eff_meth} ) ) ) ) {
        my $method = $eff_meth->{$name};
        $method->isa('PerlBean::Method::Constructor') && next;
        $method->write_pod( $fh, $self->get_package() );
    }

    # Close =over
    $fh->print(<<EOF);
\=back

EOF
}

sub _write_package_head {
    my $self = shift;
    my $fh = shift;

    my $pkg = $self->get_package();
    $fh->print("package $pkg;\n\n");
}

sub _write_preloaded_end {
    my $self = shift;
    my $fh = shift;

    # End preload only for non autoloaded beans
    $self->is_autoloaded() || return;

    $fh->print(<<EOF);
1;

$END

EOF
}

sub add__export_tag_ {
    my $self = shift;

    # Separate keys/values
    my @key = ();
    my @value = ();
    while ( my $key = shift(@_) ) {
        push( @key, $key );
        push( @value, shift(@_) );
    }

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( '_export_tag_', @value ) || throw Error::Simple("ERROR: PerlBean::add__export_tag_, one or more specified value(s) '@value' is/are not allowed.");

    # Add keys/values
    foreach my $key (@key) {
        $self->{PerlBean}{_export_tag_}{$key} = shift(@value);
    }
}

sub add_attribute {
    my $self = shift;

    $LEGACY_COUNT++;
    ( $LEGACY_COUNT < 4 ) && print STDERR "WARNING: PerlBean::add_attribute, this is a legacy support method and will be discontinued from the 4th of April 2004 on. Change your code to use add_method_factory().\nNOW!\n";
    ( $LEGACY_COUNT == 3 ) && print STDERR "Oh bother...\n";

    return( $self->add_method_factory(@_) );
}

sub add_dependency {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'dependency', @_ ) || throw Error::Simple("ERROR: PerlBean::add_dependency, one or more specified value(s) '@_' is/are not allowed.");

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{dependency}{ $val->get_dependency_name() } = $val;
    }
}

sub add_export_tag_description {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'export_tag_description', @_ ) || throw Error::Simple("ERROR: PerlBean::add_export_tag_description, one or more specified value(s) '@_' is/are not allowed.");

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{export_tag_description}{ $val->get_export_tag_name() } = $val;
    }
}

sub add_method {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'method', @_ ) || throw Error::Simple("ERROR: PerlBean::add_method, one or more specified value(s) '@_' is/are not allowed.");

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{method}{ $val->get_method_name() } = $val;
        $val->set_perl_bean($self);
    }
}

sub add_method_factory {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'method_factory', @_ ) || throw Error::Simple("ERROR: PerlBean::add_method_factory, one or more specified value(s) '@_' is/are not allowed.");

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{method_factory}{ $val->get_method_factory_name() } = $val;
        $val->set_perl_bean($self);
    }
}

sub add_symbol {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'symbol', @_ ) || throw Error::Simple("ERROR: PerlBean::add_symbol, one or more specified value(s) '@_' is/are not allowed.");

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{symbol}{ $val->get_symbol_name() } = $val;
    }
}

sub delete__export_tag_ {
    my $self = shift;

    # Delete values
    my $del = 0;
    foreach my $val (@_) {
        exists( $self->{PerlBean}{_export_tag_}{$val} ) || next;
        delete( $self->{PerlBean}{_export_tag_}{$val} );
        $del ++;
    }
    return($del);
}

sub delete_attribute {
    my $self = shift;

    $LEGACY_COUNT++;
    ( $LEGACY_COUNT < 4 ) && print STDERR "WARNING: PerlBean::delete_attribute, this is a legacy support method and will be discontinued from the 4th of April 2004 on. Change your code to use delete_method_factory().\nNOW!\n";
    ( $LEGACY_COUNT == 3 ) && print STDERR "Oh bother...\n";

    return( $self->delete_method_factory(@_) );
}

sub delete_dependency {
    my $self = shift;

    # Delete values
    my $del = 0;
    foreach my $val (@_) {
        exists( $self->{PerlBean}{dependency}{$val} ) || next;
        delete( $self->{PerlBean}{dependency}{$val} );
        $del ++;
    }
    return($del);
}

sub delete_export_tag_description {
    my $self = shift;

    # Delete values
    my $del = 0;
    foreach my $val (@_) {
        exists( $self->{PerlBean}{export_tag_description}{$val} ) || next;
        delete( $self->{PerlBean}{export_tag_description}{$val} );
        $del ++;
    }
    return($del);
}

sub delete_method {
    my $self = shift;

    # Delete values
    my $del = 0;
    foreach my $val (@_) {
        exists( $self->{PerlBean}{method}{$val} ) || next;
        delete( $self->{PerlBean}{method}{$val} );
        $del ++;
    }
    return($del);
}

sub delete_method_factory {
    my $self = shift;

    # Delete values
    my $del = 0;
    foreach my $val (@_) {
        exists( $self->{PerlBean}{method_factory}{$val} ) || next;
        delete( $self->{PerlBean}{method_factory}{$val} );
        $del ++;
    }
    return($del);
}

sub delete_symbol {
    my $self = shift;

    # Delete values
    my $del = 0;
    foreach my $val (@_) {
        exists( $self->{PerlBean}{symbol}{$val} ) || next;
        delete( $self->{PerlBean}{symbol}{$val} );
        $del ++;
    }
    return($del);
}

sub exists__export_tag_ {
    my $self = shift;

    # Count occurrences
    my $count = 0;
    foreach my $val (@_) {
        $count += exists( $self->{PerlBean}{_export_tag_}{$val} );
    }
    return($count);
}

sub exists_attribute {
    my $self = shift;

    $LEGACY_COUNT++;
    ( $LEGACY_COUNT < 4 ) && print STDERR "WARNING: PerlBean::exists_attribute, this is a legacy support method and will be discontinued from the 4th of April 2004 on. Change your code to use exists_method_factory().\nNOW!\n";
    ( $LEGACY_COUNT == 3 ) && print STDERR "Oh bother...\n";

    return( $self->exists_method_factory(@_) );
}

sub exists_base {
    my $self = shift;

    # Count occurrences
    my $count = 0;
    foreach my $val (@_) {
        $count += exists( $self->{PerlBean}{base}{HASH}{$val} );
    }
    return($count);
}

sub exists_dependency {
    my $self = shift;

    # Count occurrences
    my $count = 0;
    foreach my $val (@_) {
        $count += exists( $self->{PerlBean}{dependency}{$val} );
    }
    return($count);
}

sub exists_export_tag_description {
    my $self = shift;

    # Count occurrences
    my $count = 0;
    foreach my $val (@_) {
        $count += exists( $self->{PerlBean}{export_tag_description}{$val} );
    }
    return($count);
}

sub exists_method {
    my $self = shift;

    # Count occurrences
    my $count = 0;
    foreach my $val (@_) {
        $count += exists( $self->{PerlBean}{method}{$val} );
    }
    return($count);
}

sub exists_method_factory {
    my $self = shift;

    # Count occurrences
    my $count = 0;
    foreach my $val (@_) {
        $count += exists( $self->{PerlBean}{method_factory}{$val} );
    }
    return($count);
}

sub exists_symbol {
    my $self = shift;

    # Count occurrences
    my $count = 0;
    foreach my $val (@_) {
        $count += exists( $self->{PerlBean}{symbol}{$val} );
    }
    return($count);
}

sub get_abstract {
    my $self = shift;

    return( $self->{PerlBean}{abstract} );
}

sub get_base {
    my $self = shift;

    if ( scalar(@_) ) {
        my @ret = ();
        foreach my $i (@_) {
            push( @ret, $self->{PerlBean}{base}{ARRAY}[ int($i) ] );
        }
        return(@ret);
    }
    else {
        # Return the list
        return( @{ $self->{PerlBean}{base}{ARRAY} } );
    }
}

sub get_collection {
    my $self = shift;

    return( $self->{PerlBean}{collection} );
}

sub get_description {
    my $self = shift;

    return( $self->{PerlBean}{description} );
}

sub get_exception_class {
    my $self = shift;

    return( $self->{PerlBean}{exception_class} );
}

sub get_license {
    my $self = shift;

    return( $self->{PerlBean}{license} );
}

sub get_package {
    my $self = shift;

    return( $self->{PerlBean}{package} );
}

sub get_short_description {
    my $self = shift;

    return( $self->{PerlBean}{short_description} );
}

sub get_synopsis {
    my $self = shift;

    return( $self->{PerlBean}{synopsis} );
}

sub get_use_perl_version {
    my $self = shift;

    return( $self->{PerlBean}{use_perl_version} );
}

sub is__finalized_ {
    my $self = shift;

    if ( $self->{PerlBean}{_finalized_} ) {
        return(1);
    }
    else {
        return(0);
    }
}

sub is__has_exports_ {
    my $self = shift;

    if ( $self->{PerlBean}{_has_exports_} ) {
        return(1);
    }
    else {
        return(0);
    }
}

sub is_autoloaded {
    my $self = shift;

    if ( $self->{PerlBean}{autoloaded} ) {
        return(1);
    }
    else {
        return(0);
    }
}

sub is_singleton {
    my $self = shift;

    if ( $self->{PerlBean}{singleton} ) {
        return(1);
    }
    else {
        return(0);
    }
}

sub keys__export_tag_ {
    my $self = shift;

    # Return all keys
    return( keys( %{ $self->{PerlBean}{_export_tag_} } ) );
}

sub keys_attribute {
    my $self = shift;

    $LEGACY_COUNT++;
    ( $LEGACY_COUNT < 4 ) && print STDERR "WARNING: PerlBean::keys_attribute, this is a legacy support method and will be discontinued from the 4th of April 2004 on. Change your code to use keys_method_factory().\nNOW!\n";
    ( $LEGACY_COUNT == 3 ) && print STDERR "Oh bother...\n";

    return( $self->keys_method_factory(@_) );
}

sub keys_dependency {
    my $self = shift;

    # Return all keys
    return( keys( %{ $self->{PerlBean}{dependency} } ) );
}

sub keys_export_tag_description {
    my $self = shift;

    # Return all keys
    return( keys( %{ $self->{PerlBean}{export_tag_description} } ) );
}

sub keys_method {
    my $self = shift;

    # Return all keys
    return( keys( %{ $self->{PerlBean}{method} } ) );
}

sub keys_method_factory {
    my $self = shift;

    # Return all keys
    return( keys( %{ $self->{PerlBean}{method_factory} } ) );
}

sub keys_symbol {
    my $self = shift;

    # Return all keys
    return( keys( %{ $self->{PerlBean}{symbol} } ) );
}

sub pop_base {
    my $self = shift;

    # Pop value
    my $val = pop( @{ $self->{PerlBean}{base}{ARRAY} } );
    delete( $self->{PerlBean}{base}{HASH}{$val} );
    return($val);
}

sub push_base {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'base', @_ ) || throw Error::Simple("ERROR: PerlBean::push_base, one or more specified value(s) '@_' is/are not allowed.");

    # Push values
    foreach my $val (@_) {
        next if ( exists( $self->{PerlBean}{base}{HASH}{$val} ) );
        push( @{ $self->{PerlBean}{base}{ARRAY} }, $val );
        $self->{PerlBean}{base}{HASH}{$val} = $val;
    }
}

sub set__export_tag_ {
    my $self = shift;

    # Separate keys/values
    my @key = ();
    my @value = ();
    while ( my $key = shift(@_) ) {
        push( @key, $key );
        push( @value, shift(@_) );
    }

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( '_export_tag_', @value ) || throw Error::Simple("ERROR: PerlBean::set__export_tag_, one or more specified value(s) '@value' is/are not allowed.");

    # Empty list
    $self->{PerlBean}{_export_tag_} = {};

    # Add keys/values
    foreach my $key (@key) {
        $self->{PerlBean}{_export_tag_}{$key} = shift(@value);
    }
}

sub set__finalized_ {
    my $self = shift;

    if (shift) {
        $self->{PerlBean}{_finalized_} = 1;
    }
    else {
        $self->{PerlBean}{_finalized_} = 0;
    }
}

sub set__has_exports_ {
    my $self = shift;

    if (shift) {
        $self->{PerlBean}{_has_exports_} = 1;
    }
    else {
        $self->{PerlBean}{_has_exports_} = 0;
    }
}

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

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

    # Assignment
    $self->{PerlBean}{abstract} = $val;
}

sub set_attribute {
    my $self = shift;

    $LEGACY_COUNT++;
    ( $LEGACY_COUNT < 4 ) && print STDERR "WARNING: PerlBean::set_attribute, this is a legacy support method and will be discontinued from the 4th of April 2004 on. Change your code to use set_method_factory().\nNOW!\n";
    ( $LEGACY_COUNT == 3 ) && print STDERR "Oh bother...\n";

    return( $self->set_method_factory(@_) );
}

sub set_autoloaded {
    my $self = shift;

    if (shift) {
        $self->{PerlBean}{autoloaded} = 1;
    }
    else {
        $self->{PerlBean}{autoloaded} = 0;
    }
}

sub set_base {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'base', @_ ) || throw Error::Simple("ERROR: PerlBean::set_base, one or more specified value(s) '@_' is/are not allowed.");

    # Empty list
    $self->{PerlBean}{base}{ARRAY} = [];
    $self->{PerlBean}{base}{HASH} = {};

    # Push values
    foreach my $val (@_) {
        next if ( exists( $self->{PerlBean}{base}{HASH}{$val} ) );
        push( @{ $self->{PerlBean}{base}{ARRAY} }, $val );
        $self->{PerlBean}{base}{HASH}{$val} = $val;
    }
}

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

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

    # Assignment
    $self->{PerlBean}{collection} = $val;
}

sub set_dependency {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'dependency', @_ ) || throw Error::Simple("ERROR: PerlBean::set_dependency, one or more specified value(s) '@_' is/are not allowed.");

    # Empty list
    $self->{PerlBean}{dependency} = {};

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{dependency}{ $val->get_dependency_name() } = $val;
    }
}

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

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

    # Assignment
    $self->{PerlBean}{description} = $val;
}

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

    # Value for 'exception_class' is not allowed to be empty
    defined($val) || throw Error::Simple("ERROR: PerlBean::set_exception_class, value may not be empty.");

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

    # Assignment
    $self->{PerlBean}{exception_class} = $val;
}

sub set_export_tag_description {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'export_tag_description', @_ ) || throw Error::Simple("ERROR: PerlBean::set_export_tag_description, one or more specified value(s) '@_' is/are not allowed.");

    # Empty list
    $self->{PerlBean}{export_tag_description} = {};

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{export_tag_description}{ $val->get_export_tag_name() } = $val;
    }
}

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

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

    # Assignment
    $self->{PerlBean}{license} = $val;
}

sub set_method {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'method', @_ ) || throw Error::Simple("ERROR: PerlBean::set_method, one or more specified value(s) '@_' is/are not allowed.");

    # Empty list
    $self->{PerlBean}{method} = {};

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{method}{ $val->get_method_name() } = $val;
        $val->set_perl_bean($self);
    }
}

sub set_method_factory {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'method_factory', @_ ) || throw Error::Simple("ERROR: PerlBean::set_method_factory, one or more specified value(s) '@_' is/are not allowed.");

    # Empty list
    $self->{PerlBean}{method_factory} = {};

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{method_factory}{ $val->get_method_factory_name() } = $val;
        $val->set_perl_bean($self);
    }
}

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

    # Value for 'package' is not allowed to be empty
    defined($val) || throw Error::Simple("ERROR: PerlBean::set_package, value may not be empty.");

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

    # Assignment
    $self->{PerlBean}{package} = $val;
}

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

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

    # Assignment
    $self->{PerlBean}{short_description} = $val;
}

sub set_singleton {
    my $self = shift;

    if (shift) {
        $self->{PerlBean}{singleton} = 1;
    }
    else {
        $self->{PerlBean}{singleton} = 0;
    }
}

sub set_symbol {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'symbol', @_ ) || throw Error::Simple("ERROR: PerlBean::set_symbol, one or more specified value(s) '@_' is/are not allowed.");

    # Empty list
    $self->{PerlBean}{symbol} = {};

    # Add keys/values
    foreach my $val (@_) {
        $self->{PerlBean}{symbol}{ $val->get_symbol_name() } = $val;
    }
}

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

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

    # Assignment
    $self->{PerlBean}{synopsis} = $val;
}

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

    # Value for 'use_perl_version' is not allowed to be empty
    defined($val) || throw Error::Simple("ERROR: PerlBean::set_use_perl_version, value may not be empty.");

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

    # Assignment
    $self->{PerlBean}{use_perl_version} = $val;
}

sub shift_base {
    my $self = shift;

    # Shift value
    my $val = shift( @{ $self->{PerlBean}{base}{ARRAY} } );
    delete( $self->{PerlBean}{base}{HASH}{$val} );
    return($val);
}

sub unshift_base {
    my $self = shift;

    # Check if isas/refs/rxs/values are allowed
    &_value_is_allowed( 'base', @_ ) || throw Error::Simple("ERROR: PerlBean::unshift_base, one or more specified value(s) '@_' is/are not allowed.");

    # Unshift values
    foreach my $val ( reverse(@_) ) {
        next if ( exists( $self->{PerlBean}{base}{HASH}{$val} ) );
        unshift( @{ $self->{PerlBean}{base}{ARRAY} }, $val );
        $self->{PerlBean}{base}{HASH}{$val} = $val;
    }
}

sub values__export_tag_ {
    my $self = shift;

    if ( scalar(@_) ) {
        my @ret = ();
        foreach my $key (@_) {
            exists( $self->{PerlBean}{_export_tag_}{$key} ) && push( @ret, $self->{PerlBean}{_export_tag_}{$key} );
        }
        return(@ret);
    }
    else {
        # Return all values
        return( values( %{ $self->{PerlBean}{_export_tag_} } ) );
    }
}

sub values_attribute {
    my $self = shift;

    $LEGACY_COUNT++;
    ( $LEGACY_COUNT < 4 ) && print STDERR "WARNING: PerlBean::values_attribute, this is a legacy support method and will be discontinued from the 4th of April 2004 on. Change your code to use values_method_factory().\nNOW!\n";
    ( $LEGACY_COUNT == 3 ) && print STDERR "Oh bother...\n";

    return( $self->values_method_factory(@_) );
}

sub values_dependency {
    my $self = shift;

    if ( scalar(@_) ) {
        my @ret = ();
        foreach my $key (@_) {
            exists( $self->{PerlBean}{dependency}{$key} ) && push( @ret, $self->{PerlBean}{dependency}{$key} );
        }
        return(@ret);
    }
    else {
        # Return all values
        return( values( %{ $self->{PerlBean}{dependency} } ) );
    }
}

sub values_export_tag_description {
    my $self = shift;

    if ( scalar(@_) ) {
        my @ret = ();
        foreach my $key (@_) {
            exists( $self->{PerlBean}{export_tag_description}{$key} ) && push( @ret, $self->{PerlBean}{export_tag_description}{$key} );
        }
        return(@ret);
    }
    else {
        # Return all values
        return( values( %{ $self->{PerlBean}{export_tag_description} } ) );
    }
}

sub values_method {
    my $self = shift;

    if ( scalar(@_) ) {
        my @ret = ();
        foreach my $key (@_) {
            exists( $self->{PerlBean}{method}{$key} ) && push( @ret, $self->{PerlBean}{method}{$key} );
        }
        return(@ret);
    }
    else {
        # Return all values
        return( values( %{ $self->{PerlBean}{method} } ) );
    }
}

sub values_method_factory {
    my $self = shift;

    if ( scalar(@_) ) {
        my @ret = ();
        foreach my $key (@_) {
            exists( $self->{PerlBean}{method_factory}{$key} ) && push( @ret, $self->{PerlBean}{method_factory}{$key} );
        }
        return(@ret);
    }
    else {
        # Return all values
        return( values( %{ $self->{PerlBean}{method_factory} } ) );
    }
}

sub values_symbol {
    my $self = shift;

    if ( scalar(@_) ) {
        my @ret = ();
        foreach my $key (@_) {
            exists( $self->{PerlBean}{symbol}{$key} ) && push( @ret, $self->{PerlBean}{symbol}{$key} );
        }
        return(@ret);
    }
    else {
        # Return all values
        return( values( %{ $self->{PerlBean}{symbol} } ) );
    }
}

sub write {
    my $self = shift;
    my $fh = shift;

    # Finalize the package if necessary
    my $was_finalized = $self->is__finalized_();
    $self->is__finalized_() || $self->_finalize();

    # Package heading
    $self->_write_package_head($fh);

    # Dependencies
    $self->_write_dependencies($fh);

    # Declared symbols
    $self->_write_declared_symbols($fh);

    # End of preloaded methods
    $self->_write_preloaded_end($fh);

    # Start pod documentation
    $self->_write_doc_head($fh);

    # Write EXPORT documentation
    $self->_write_doc_export($fh);

    # Get all methods that are callable from this package
    $self->_get_effective_methods( \my %eff_meth );

    # Write CONSTRUCTOR documentation
    $self->_write_constructors_doc($fh, \%eff_meth);

    # Write METHODS documentation
    $self->_write_methods_doc($fh, \%eff_meth);

    # Finish pod documentation
    $self->_write_doc_tail($fh);

    # All constructor methods from this bean
    my %all_meth_ref = ();
    foreach my $name ( sort( $self->keys_method() ) ) {
        my $method = ( $self->values_method($name) )[0];
        $method->isa('PerlBean::Method::Constructor') || next;
        $method->write_code($fh);
        $all_meth_ref{$name} = $method;
    }

    # The _initialize method from this bean
    scalar( $self->values_method('_initialize') ) &&
        ( $self->values_method('_initialize') )[0]->write_code($fh);

    # All methods from this bean
    foreach my $name ( sort( $self->keys_method() ) ) {
        $name eq '_initialize' && next;
        my $method = ( $self->values_method($name) )[0];
        $method->isa('PerlBean::Method::Constructor') && next;
        $method->write_code($fh);
        $all_meth_ref{$name} = $method;
    }

    # End of file
    $self->_write_file_end($fh);

    # Un-finalize the package if necessary
    $was_finalized || $self->_unfinalize();
}

