package HTML::FormHandler::TraitFor::DBICFields; # ABSTRACT: role to get fields from DBIx::Class result source use Moose::Role; requires ('source', 'schema'); use HTML::FormHandler::Model::DBIC::TypeMap; has 'fields_from_model' => ( is => 'ro', default => 1 ); has 'includes' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef[Str]', default => sub {[]}, handles => { all_includes => 'elements', has_includes => 'count', } ); has 'excludes' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef[Str]', default => sub {[]}, handles => { has_excludes => 'count', } ); has 'rels' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef[Str]', default => sub {[]}, handles => { has_rels => 'count', } ); has 'type_map_class' => ( is => 'ro', isa => 'Str', default => 'HTML::FormHandler::Model::DBIC::TypeMap' ); has 'type_map_args' => ( is => 'ro', isa => 'HashRef', default => sub {{}} ); has 'type_map' => ( is => 'ro', lazy => 1, builder => 'build_type_map', handles => ['type_for_column', 'type_for_rel'], ); sub build_type_map { my $self = shift; my $class = $self->type_map_class; return $class->new( $self->type_map_args ); } sub model_fields { my $self = shift; my $fields = $self->get_fields( $self->source_name, 0, @{$self->excludes} ); return $fields; } sub get_fields { my( $self, $class, $level, @exclude ) = @_; my $source = $self->schema->source( $class ); my %primary_columns = map {$_ => 1} $source->primary_columns; my @fields; my @columns = $self->has_includes ? $self->all_includes : $source->columns; for my $col ( @columns ) { next if grep { $_ eq $col } @exclude; my $info = $source->column_info($col); my @field; if( $primary_columns{$col} && ( $info->{is_auto_increment} || $self->is_SQLite_auto_pk( $source, $info ))){ # for PK in the root use item_id, here only PKs for related rows push @field, ( $col => { type => 'Hidden' } ) if $level > 1; } else{ unshift @field, ( $col => $self->type_for_column( $info ) ); } push @fields, @field; } return \@fields; } # in SQLite integer primary key is computed automatically just like auto increment sub is_SQLite_auto_pk { my ( $self, $source, $info ) = @_; return if $self->schema->storage->sqlt_type ne 'SQLite'; return if ( ! lc( $info->{data_type} ) =~ /^int/ ); my @pks = $source->primary_columns; return if scalar @pks > 1; return 1; } # not yet implemented sub field_for_rel { my ( $self, $name, $info ) = @_; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::FormHandler::TraitFor::DBICFields - role to get fields from DBIx::Class result source =head1 VERSION version 0.29 =head1 SYNOPSIS This is a role to pull fields from a DBIx::Class result source. Requires existence of a 'source' attribute. This feature is new. It doesn't handle relationships yet, and the interfaces are still subject to change. my $form = HTML::FormHandler::Model::DBIC->new_with_traits( traits => ['HTML::FormHandler::TraitFor::DBICFields'], item => $book ); for my $rel( $source->relationships ) { next if grep { $_ eq $rel } @exclude; next if grep { $_->[1] eq $rel } $self->m2m_for_class($class); my $info = $source->relationship_info($rel); push @exclude, get_self_cols( $info->{cond} ); my $rel_class = _strip_class( $info->{class} ); my $elem_conf; if ( ! ( $info->{attrs}{accessor} eq 'multi' ) ) { push @fields, "has_field '$rel' => ( type => 'Select', );" } elsif( $level < 1 ) { my @new_exclude = get_foreign_cols ( $info->{cond} ); my $config = $self->get_fields ( $rel_class, 1, ); my $target_class = $rel_class; $target_class = $self->class_prefix . '::' . $rel_class if $self->class_prefix; $config->{class} = $target_class; $config->{name} = $rel; # $self->set_field_class_data( $target_class => $config ) if !$self->exists_field_class( $target_class ); my $field_def = ''; # if( defined $self->style && $self->style eq 'single' ){ # $field_def .= '# '; # } $field_def .= "has_field '$rel' => ( type => '+${target_class}Field', );"; push @fields, $field_def; } } =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Gerda Shank. 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