The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Fey::ORM::Policy;
{
  $Fey::ORM::Policy::VERSION = '0.45';
}

use strict;
use warnings;

use Fey::Object::Policy;

{
    my @subs;

    BEGIN {
        @subs = qw(
            Policy
            transform_all
            matching
            inflate
            deflate
            has_one_namer
            has_many_namer
        );
    }

    use Sub::Exporter -setup => {
        exports => \@subs,
        groups  => { default => \@subs },
    };
}

# I could use MooseX::ClassAttribute and add a class attribute to the
# calling class, but really, that class doesn't need to use Moose,
# since it's just a name we can use to find the associated policy
# object.
{
    my %Policies;

    sub Policy {
        my $caller = shift;

        return $Policies{$caller} ||= Fey::Object::Policy->new();
    }
}

sub transform_all {
    my $class = caller();

    $class->Policy()->add_transform( {@_} );
}

sub matching (&) {
    return ( matching => $_[0] );
}

sub inflate (&) {
    return ( inflate => $_[0] );
}

sub deflate (&) {
    return ( deflate => $_[0] );
}

sub has_one_namer (&) {
    my $class = caller();

    $class->Policy()->set_has_one_namer( $_[0] );
}

sub has_many_namer (&) {
    my $class = caller();

    $class->Policy()->set_has_many_namer( $_[0] );
}

1;

# ABSTRACT: Declarative policies for Fey::ORM using classes

__END__

=pod

=head1 NAME

Fey::ORM::Policy - Declarative policies for Fey::ORM using classes

=head1 VERSION

version 0.45

=head1 SYNOPSIS

  package MyApp::Policy;

  use strict;
  use warnings;

  use Fey::ORM::Policy;
  use Lingua::EN::Inflect qw( PL_N );

  transform_all
         matching { $_[0]->type() eq 'date' }

      => inflate  { return unless defined $_[1];
                    return DateTime::Format::Pg->parse_date( $_[1] ) }

      => deflate  { defined $_[1] && ref $_[1]
                      ? DateTime::Format::Pg->format_date( $_[1] )
                      : $_[1] };

  transform_all
         matching { $_[0]->name() eq 'email_address' }

      => inflate  { return unless defined $_[1];
                    return Email::Address->parse( $_[1] ) }

      => deflate  { defined $_[1] && ref $_[1]
                      ? Email::Address->as_string
                      : $_[1] };

  has_one_namer  { my $name = $_[0]->name();
                   my @parts = map { lc } ( $name =~ /([A-Z][a-z]+)/g );

                   return join q{_}, @parts; };

  has_many_namer { my $name = $_[0]->name();
                   my @parts = map { lc } ( $name =~ /([A-Z][a-z]+)/g );

                   $parts[-1] = PL_N( $parts[-1] );

                   return join q{_}, @parts; };

  package User;

  use Fey::ORM::Table;

  has_policy 'MyApp::Policy';

  has_table ...;

=head1 DESCRIPTION

This module allows you to declare a policy for your
L<Fey::ORM::Table>-using classes.

A policy can define transform rules which can be applied to matching
columns, as well as a naming scheme for has_one and has_many
methods. This allows you to spare yourself some drudgery, and allows
you to consolidate decisions (like "all date type columns return a
C<DateTime> object") in a single place.

=head1 FUNCTIONS

This module exports a bunch of sugar functions into your namespace so
you can define your policy in a declarative manner:

=head2 transform_all

This should be followed by a C<matching> sub reference, and one of an
C<inflate> or C<deflate> sub.

=head2 matching { ... }

This function takes a subroutine reference that will be called and
passed a L<Fey::Column> object as its argument. This sub should look
at the column and return true if the associated inflate/deflate should
be applied to the column.

Note that the matching subs are checked in the order they are defined
by C<transform_all()>, and the first one wins.

=head2 inflate { ... }

An inflator sub for the associated transform. See L<Fey::ORM::Table>
for more details on transforms.

=head2 deflate { ... }

A deflator sub for the associated transform. See L<Fey::ORM::Table>
for more details on transforms.

=head2 has_one_namer { ... }

A subroutine reference which will be used to generate a name for
C<has_one()> methods when a name is not explicitly provided.

This sub will receive the foreign table as its first argument, and the
associate L<Fey::Meta::FK> object as the second argument. In most
cases, the foreign table will probably be sufficient to generate a
name.

=head2 has_many_namer { ... }

Just like the C<has_one_namer()>, but is called for naming
C<has_many()> methods.

=head2 Policy

This methods returns the L<Fey::Object::Policy> object for your policy
class. This method allows L<Fey::ORM::Table> to go get a policy object
from a policy class name.

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Dave Rolsky.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut