view release on metacpan or  search on metacpan

lib/DBIx/Class/TemporalRelations.pm  view on Meta::CPAN

package DBIx::Class::TemporalRelations;
use Modern::Perl;
our $VERSION = '0.9000'; # VERSION
our $AUTHORITY = 'cpan:GEEKRUTH'; # AUTHORITY
# ABSTRACT: Establish and introspect time-based relationships between tables.
use Carp qw(carp croak);

use parent 'DBIx::Class::Relationship::Base';
use DBIx::Class::Candy::Exports;
use Lingua::EN::Inflexion;
use Sub::Quote qw(quote_sub);

# Exports for DBIx::Class::Candy
export_methods [qw/make_temporal_relationship make_temporal_relationships/];

sub make_temporal_relationships {
   my ( $self, %relationships ) = @_;
   foreach my $verb ( keys %relationships ) {
      my $params = $relationships{$verb};
      $params = [$params] if ( ref $params->[0] ne 'ARRAY' );
      foreach my $temporal_ar (@$params) {
         $self->make_temporal_relationship( $verb, $temporal_ar );
      }
   }
}

sub make_temporal_relationship {
   my ( $self, $verb, @args ) = @_;
   @args = @{ $args[0] } if ref $args[0] eq 'ARRAY';
   my $info  = $self->source_info();
   my $table = $args[0];
   $info->{temporal_relationships} //= {};
   $info->{temporal_relationships}->{$table} //= [];
   push @{ $info->{temporal_relationships}->{$table} },
       {
      temporal_column => $args[1],
      verb            => $verb,
      singular        => $args[2],
      plural          => $args[3],
       };

   $self->source_info($info);
}

sub new {
   my ( $class, $attrs ) = @_;
   my $new = $class->next::method($attrs);
   $new->_register_temporal_methods();
   return $new;
}

sub _inflect_nouns {
   my ( $class, $noun, $verb ) = @_;
   ($noun) = split /_/, $noun;
   if ( noun($noun)->is_plural ) {
      return ( noun($noun)->singular, $noun );
   }
   return ( $noun, noun($noun)->plural );
}

sub _register_temporal_methods {
   my $class         = shift;