MoFedge::Data::DBIC::Schemaのソースはっつけてみた

はてダでシンタックスハイライトがでけるようになったので！

package MoFedge::Data::DBIC::Schema;
use strict;
use warnings;
use base qw/MoFedge DBIx::Class::Schema/;

our $VERSION = '0.02';

use UNIVERSAL::require;
use Switch;
use Data::Page::Navigation;
use Lingua::EN::Inflect;

__PACKAGE__->load_components(qw/
    +MoFedge::Data::DBIC::AutoSet
    +MoFedge::Data::DBIC::FromSledge
    +MoFedge::Data::DBIC::AutoInflateDateTime
    AsFdat
    PK::Auto
    Core
/);

sub datetime {
    my $class = shift;
    my $datetime_class = $class->base_name . '::DateTime';
    $datetime_class->use or die $@;
    return $datetime_class;
}

# date issues.
sub register_column {
    my ($class, $column) = @_;

    $class->next::method($column);

    switch ($column) {
        case /^created_on$/ { $class->datetime_column($column)     }
        case /^updated_on$/ { $class->datetime_column($column)     }
        case /_on$/         { $class->date_column($column)         }
        case /_at$/         { $class->datetime_column($column)     }
        case 'id'           {
            $class->set_primary_key('id');
            $class->resultset_attributes({ order_by => 'me.id DESC'});
        }
        case 'rid'          { $class->add_unique_constraint([$column]) }
    }
}

sub load_classes {
    my ($class, @args) = @_;

    $class->next::method(@args);

    for my $source_moniker ($class->sources) {
        my $source = $class->class($source_moniker);
        my @ordered_sources = $class->_ordered_sources;

        for my $column ($source->columns) {
            if ($column =~ /^(.+)_id$/) {
                my $column_head = $1;

                $class->_auto_relationship(\@ordered_sources, $source, $column, $column_head);

            }
        }
    }
}

sub _auto_relationship {
    my ($class, $ordered_sources, $source, $column, $column_head) = @_;

    for my $foreign_source (@$ordered_sources) {
        if ($column_head =~ $foreign_source->table) {

            $source->belongs_to($column, $foreign_source);

            # $self->user_id => $self->user
            no strict 'refs';
            *{"$source\::$column_head"} = *{"$source\::$column"};

            $foreign_source->has_many(Lingua::EN::Inflect::PL($source->table), $source, $column);

            last;
        }
    }
}

# sort sources order by table name length.
sub _ordered_sources {
    my $class = shift;

    return          map  { $_->[0] }
            reverse sort { $a->[1] <=> $b->[1] }
                    map  { [ $_, length($_->table)] }
                    map  { $class->class($_) }
                           $class->sources;
}

1;
__END__

=head1 NAME

MoFedge::Data::DBIC::Schema -  easy to use DBIx::Class from MoFedge.

=head1 SYNOPSIS

    package Your::Schema;
    use base 'MoFedge::Data::DBIC::Schema';
    __PACKAGE__->load_classes( );

=head1 DESCRIPTION

DBIx::Class is easily used from MoFedge. 

=head1 METHODS

=head2 register_column

hook point.

=head2 load_classes
=head2 _auto_relationship
=head2 _ordered_sources

=head2 datetime

hmm... this is utility method for MoFedge.

This method will move to MoFedge.pm

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

=head1 AUTHOR

Atsushi Kobayashi  C<< <atsushi __at__ mobilefactory.jp> >>

Tokuhiro Matsuno C<< tokuhirom aaaatttt mobilefactory.jp> >>

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2006, Atsushi Kobayashi C<< <atsushi __at__ mobilefactory.jp> >>. All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.