view release on metacpan or  search on metacpan

lib/Alzabo/MethodMaker.pm  view on Meta::CPAN

                  insert_hooks
                  update_hooks
                  select_hooks
                  delete_hooks
                );

sub import
{
    my $class = shift;

    validate( @_, { schema     => { type => SCALAR },
                    class_root => { type => SCALAR,
                                    optional => 1 },
                    name_maker => { type => CODEREF,
                                    optional => 1 },
                    ( map { $_ => { optional => 1 } } 'all', @options ) } );
    my %p = @_;

    return unless exists $p{schema};
    return unless grep { exists $p{$_} && $p{$_} } 'all', @options;

    my $maker = $class->new(%p);

    $maker->make;
}

sub new
{
    my $class = shift;
    my %p = @_;

    if ( delete $p{all} )
    {
        foreach (@options)
        {
            $p{$_} = 1 unless exists $p{$_} && ! $p{$_};
        }
    }

    my $s = Alzabo::Runtime::Schema->load_from_file( name => delete $p{schema} );

    my $class_root;
    if ( $p{class_root} )
    {
        $class_root = $p{class_root};
    }
    else
    {
        my $x = 0;
        do
        {
            $class_root = caller($x++);
            die "No base class could be determined\n" unless $class_root;
        } while ( $class_root->isa(__PACKAGE__) );
    }

    my $self;

    $p{name_maker} = sub { $self->name(@_) } unless ref $p{name_maker};

    $self = bless { opts => \%p,
                    class_root => $class_root,
                    schema => $s,
                  }, $class;

    return $self;
}

sub make
{
    my $self = shift;

    $self->{schema_class} = join '::', $self->{class_root}, 'Schema';
    bless $self->{schema}, $self->{schema_class};

    $self->eval_schema_class;
    $self->load_class( $self->{schema_class} );

   {
       # Users can add methods to these superclasses
       no strict 'refs';
       foreach my $thing ( qw( Table Row ) )
       {
           @{ "$self->{class_root}::${thing}::ISA" }
               = ( "Alzabo::Runtime::$thing", "Alzabo::DocumentationContainer" );
       }
    }

    foreach my $t ( sort { $a->name cmp $b->name  } $self->{schema}->tables )
    {
        $self->{table_class} = join '::', $self->{class_root}, 'Table', $t->name;
        $self->{row_class} = join '::', $self->{class_root}, 'Row', $t->name;

        bless $t, $self->{table_class};
        $self->eval_table_class;
        $self->{schema}->add_contained_class( table => $self->{table_class} );

        $self->eval_row_class;
        $t->add_contained_class( row => $self->{row_class} );

        if ( $self->{opts}{tables} )
        {
            $self->make_table_method($t);
        }

        $self->load_class( $self->{table_class} );
        $self->load_class( $self->{row_class} );

        if ( $self->{opts}{table_columns} )
        {
            $self->make_table_column_methods($t);
        }

        if ( $self->{opts}{row_columns} )
        {
            $self->make_row_column_methods($t);
        }
        if ( grep { $self->{opts}{$_} } qw( foreign_keys linking_tables lookup_columns ) )
        {
            $self->make_foreign_key_methods($t);
        }

        foreach ( qw( insert update select delete ) )
        {
            if ( $self->{opts}{"$_\_hooks"} )
            {
                $self->make_hooks($t, $_);
            }
        }
    }
}

sub eval_schema_class
{
    my $self = shift;

    eval <<"EOF";
package $self->{schema_class};

use base qw( Alzabo::Runtime::Schema Alzabo::DocumentationContainer );
EOF

    Alzabo::Exception::Eval->throw( error => $@ ) if $@;
}

sub eval_table_class
{
    my $self = shift;

    eval <<"EOF";
package $self->{table_class};

use base qw( $self->{class_root}::Table );

lib/Alzabo/MethodMaker.pm  view on Meta::CPAN

sub contained_docs
{
    my $self = shift;

    return map { $_->docs_as_pod(1) } $self->contained_classes;
}

package Alzabo::Docs;

sub group { shift->{group} }
sub description { shift->{description} }

# copied from Params::ValidatePP
{
    my %type_to_string =
        ( Params::Validate::SCALAR()    => 'scalar',
          Params::Validate::ARRAYREF()  => 'arrayref',
          Params::Validate::HASHREF()   => 'hashref',
          Params::Validate::CODEREF()   => 'coderef',
          Params::Validate::GLOB()      => 'glob',
          Params::Validate::GLOBREF()   => 'globref',
          Params::Validate::SCALARREF() => 'scalarref',
          Params::Validate::UNDEF()     => 'undef',
          Params::Validate::OBJECT()    => 'object',
        );

    sub _typemask_to_strings
    {
        shift;
        my $mask = shift;

        my @types;
        foreach ( Params::Validate::SCALAR, Params::Validate::ARRAYREF,
                  Params::Validate::HASHREF, Params::Validate::CODEREF,
                  Params::Validate::GLOB, Params::Validate::GLOBREF,
                  Params::Validate::SCALARREF, Params::Validate::UNDEF,
                  Params::Validate::OBJECT )
        {
            push @types, $type_to_string{$_} if $mask & $_;
        }
        return @types ? @types : ('unknown');
    }
}

package Alzabo::MethodDocs;

use Params::Validate qw( validate SCALAR ARRAYREF HASHREF );

use base qw(Alzabo::Docs);

sub new
{
    my $class = shift;
    my %p = validate( @_, { name    => { type => SCALAR },
                            group   => { type => SCALAR },
                            description => { type => SCALAR },
                            spec    => { type => SCALAR | ARRAYREF | HASHREF,
                                         default => undef },
                          } );

    return bless \%p, $class;
}

sub name { shift->{name} }
sub spec { shift->{spec} }

sub as_pod
{
    my $self = shift;

    my $desc = ucfirst $self->{description};

    my $spec = $self->spec;

    my $params;
    if ( defined $spec )
    {
        if ( Alzabo::Utils::is_arrayref( $spec ) )
        {
            $params = "=over 4\n\n";

            foreach my $p (@$spec)
            {
                $params .= "=item * ";
                if ( exists $p->{type} )
                {
                    # hack!
                    my $types =
                        join ', ', $self->_typemask_to_strings( $p->{type} );
                    $params .= "($types)";
                }
                $params .= "\n\n";
            }

            $params .= "=back\n\n";
        }
        elsif ( Alzabo::Utils::is_hashref($spec) )
        {
            $params = "=over 4\n\n";

            while ( my ($name, $p) = each %$spec )
            {
                $params .= "=item * $name ";
                if ( exists $p->{type} )
                {
                    # hack!
                    my $types =
                        join ', ', $self->_typemask_to_strings( $p->{type} );
                    $params .= "($types)";
                }
                $params .= "\n\n";
            }

            $params .= "=back\n\n";
        }
        else
        {
            $params = "Parameters: $spec\n\n";
        }
    }

    my $pod = <<"EOF";
=head3 $self->{name}

$desc

EOF
    $pod .= $params if $params;

    return $pod;
}


package Alzabo::ClassDocs;

use Params::Validate qw( validate SCALAR );

use base qw(Alzabo::Docs);

sub new
{
    my $class = shift;
    my %p = validate( @_, { group   => { type => SCALAR },
                            description => { type => SCALAR },
                          } );

    return bless \%p, $class;
}

sub as_pod
{
    my $self = shift;

    return ucfirst "$self->{description}\n\n";
}

1;


__END__

=head1 NAME

Alzabo::MethodMaker - Auto-generate useful methods based on an existing schema

=head1 SYNOPSIS

  use Alzabo::MethodMaker ( schema => 'schema_name', all => 1 );

=head1 DESCRIPTION

This module can take an existing schema and generate a number of
useful methods for this schema and its tables and rows.  The method
making is controlled by the parameters given along with the use
statement, as seen in the L<SYNOPSIS
section|Alzabo::MethodMaker/SYNOPSIS>.

=head1 PARAMETERS

These parameters are all passed to the module when it is imported via
C<use>.

=over 4

=item * schema => $schema_name

This parameter is B<required>.

=item * class_root => $class_name

If given, this will be used as the root of the class names generated
by this module.  This root should not end in '::'.  If none is given,
then the calling module's name is used as the root.  See L<New Class
Names|"New Class Names"> for more information.

=item * all => $bool

This tells this module to make all of the methods it possibly can.
See L<METHOD CREATION OPTIONS|"METHOD CREATION OPTIONS"> for more
details.

If individual method creation options are set as false, then that
setting will be respected, so you could use

  use Alzabo::MethodMaker( schema => 'foo', all => 1, tables => 0 );

to turn on all of the regular options B<except> for "tables".

=item * name_maker => \&naming_sub

If provided, then this callback will be called any time a method name
needs to be generated.  This allows you to have full control over the
resulting names.  Otherwise names are generated as described in the
documentation.

The callback is expected to return a name for the method to be used.
This name should not be fully qualified or contain any class
designation as this will be handled by MethodMaker.

It is important that none of the names returned conflict with existing
methods for the object the method is being added to.

For example, when adding methods that return column objects to a
table, if you have a column called 'name' and try to use that as the
method name, it won't work.  C<Alzabo::Table> objects already have
such a method, which returns the name of the table.  See the relevant
documentation of the schema, table, and row objects for a list of
methods they contain.

The L<NAMING SUB PARAMETERS|"NAMING SUB PARAMETERS"> section contains
the details of what parameters are passed to this callback.

I<Please note> that if you have a large complex schema you will almost
certainly need to provide a custom naming subroutine to avoid name
conflicts.

=back

=head1 EFFECTS

Using this module has several effects on your schema's objects.

=head2 New Class Names

Your schema, table, and row objects to be blessed into subclasses of
L<C<Alzabo::Runtime::Schema>|Alzabo::Runtime::Schema>,
L<C<Alzabo::Runtime::Table>|Alzabo::Runtime::Table>,
L<C<Alzabo::Runtime::Row>|Alzabo::Runtime::Row>, respectively.  These
subclasses contain the various methods created by this module.  The
new class names are formed by using the
L<"class_root"|Alzabo::MethodMaker/PARAMETERS> parameter and adding
onto it.

In order to make it convenient to add new methods to the table and row
classes, the created table classes are all subclasses of a new class
based on your class root, and the same thing is done for all created
row classes.


=over 4

=item * Schema

  <class root>::Schema

=item * Tables

  <class root>::Table::<table name>

All tables will be subclasses of:

  <class root>::Table

=item * Rows

  <class root>::Row::<table name>

All rows will be subclasses of:

  <class root>::Row

=back

With a root of "My::MovieDB", and a schema with only two tables,
"Movie" and "Image", this would result in the following class names:

 My::MovieDB::Schema

 My::MovieDB::Table::Movie - subclass of My::MovieDB::Table
 My::MovieDB::Row::Movie   - subclass of My::MovieDB::Row

 My::MovieDB::Table::Image - subclass of My::MovieDB::Table
 My::MovieDB::Row::Image   - subclass of My::MovieDB::Row

=head2 Loading Classes

For each class into which an object is blessed, this module will
attempt to load that class via a C<use> statement.  If there is no
module found this will not cause an error.  If this class defines any
methods that have the same name as those this module generates, then
this module will not attempt to generate them.

=head1 METHOD CREATION OPTIONS

When using Alzabo::MethodMaker, you may specify any of the following
parameters.  Specifying "all" causes all of them to be used.

=head2 Schema object methods

=over 4

=item * tables => $bool

Creates methods for the schema that return the table object matching
the name of the method.

For example, given a schema containing tables named "Movie" and
"Image", this would create methods that could be called as C<<
$schema->Movie >> and C<< $schema->Image >>.

=back

=head2 Table object methods.

=over 4

=item * table_columns => $bool

Creates methods for the tables that return the column object matching
the name of the method.  This is quite similar to the C<tables> option
for schemas.  So if our "Movie" table had a column called "title", we
could write C<< $schema->Movie->title >>.

=item * insert_hooks => $bool

Look for hooks to wrap around the C<insert()> method in
L<C<Alzabo::Runtime::Table>|Alzabo::Runtime::Table>.  See L<Loading
Classes> for more details.  You have to define either a
C<pre_insert()> and/or C<post_insert()> method for the generated table
class or this parameter will not do anything.  See the
L<HOOKS|/"HOOKS"> section for more details.

=back

=head2 Row object methods

=over 4

=item * row_columns => $bool

This tells MethodMaker to create get/set methods for each column a row
has.  These methods take a single optional argument, which if given
will cause that column to be updated for the row.

=item * update_hooks => $bool

Look for hooks to wrap around the C<update> method in