Frey/ORM/Item.pm

package Frey::ORM::Item;

use Data::Dump qw/dump/;
use Carp qw/carp/;

use Moose;
extends 'Frey';
with 'Frey::ORM::Field';
with 'Frey::ORM::Layout';
with 'Frey::Storage';
#with 'BonusTypes';

use Moose::Util::TypeConstraints;

enum 'Render_as' => qw( view edit none );
has render_as => (
        is => 'rw',
        isa => 'Render_as',
        required => 1,
        default => 'view',
);

has fey => (
        is => 'rw',
        isa => 'Object',        # FIXME Strix::User?
#       required => 1,          # XXX if we require it we can't have Add form
);

has fey_class => (
        is => 'rw',
        isa => 'Str',
        required => 1,
);

has 'display_columns' => (
        is => 'rw',
        isa => 'ArrayRef[Str]',
        lazy_build => 1,
);

has 'labels' => (
        is => 'rw',
        isa => 'HashRef[Str]',
        default => sub {
                my $self = shift;
                $self->load( 'var/design/' . $self->fey_class . '-labels' ) || {}
        },
);


sub set_from_hash {
        my ($self, $f) = @_;
        my $attrmap = $self->fey->meta->get_attribute_map if $self->fey;
        my $hash;
        foreach my $name ( @{ $self->display_columns } ) {
                my $field_name = $self->field_name($name);
                if(defined $f->{$field_name}) {
                        $hash->{ $name } = $f->{$field_name};

                        if ( defined $attrmap->{$name} ) {
                                my $writer = $attrmap->{$name}->get_write_method;
                                $self->fey->$writer($f->{$field_name});
                        } else {
                                warn "can't store value back into fey->$name";
                        }
                }
        }
        warn "# set_from_hash ", $self->uuid," produced hash = ",dump( $hash ) if $hash;
        return $hash;
}

sub main {
        my ( $self ) = @_;

        warn "# item ",$self->uuid, " fey = ",dump( $self->fey ) if $self->debug;

        my $out;
        if ( $self->render_as eq 'edit' ) {
                $out .= $self->render_edit;
        } elsif ( $self->render_as eq 'view' ) {
                $out .= $self->render_view;
        } else {
                warn "no renderer ",dump( $self->render_as ), " skipping...";
        }

        warn $@ if $@;
        warn ">>> ",length($out),"\n";

        return $out;
};

sub field_value {
        my ( $self, $name ) = @_;
        my $val = '';
        $val = $self->fey->$name if $self->fey && $self->fey->can($name);
        return $val;
}

sub field_label {
        my ( $self, $name ) = @_;
        my $new_labels = $self->reload( 'var/design/' . $self->fey_class . '-labels' );
        $self->labels( $new_labels ) if $new_labels;
        my $label = $self->labels->{$name} || ucfirst($name);
        return $label;
}

sub _build_display_columns {
        my $self = shift;

        my $m = $self->fey_class->meta;

        my @cols;

        foreach ( $m->get_attribute_list ) {
                my $attr = $m->get_attribute( $_ );
                warn "_build_display_columns $_\n" if $self->debug;
                # FIXME primary key would have to be read-only!
                push @cols, $_;
        }

        warn "## display_columns ",dump( @cols ) if $self->debug;

        return \@cols;
}

1;
1	dpavlin	969	package Frey::ORM::Item;
2	dpavlin	63
3	dpavlin	71	use Data::Dump qw/dump/;
4	dpavlin	89	use Carp qw/carp/;
5	dpavlin	71
6	dpavlin	143	use Moose;
7			extends 'Frey';
8	dpavlin	969	with 'Frey::ORM::Field';
9			with 'Frey::ORM::Layout';
10	dpavlin	153	with 'Frey::Storage';
11	dpavlin	63	#with 'BonusTypes';
12
13	dpavlin	97	use Moose::Util::TypeConstraints;
14	dpavlin	96
15	dpavlin	97	enum 'Render_as' => qw( view edit none );
16	dpavlin	969	has render_as => (
17			is => 'rw',
18			isa => 'Render_as',
19			required => 1,
20			default => 'view',
21			);
22	dpavlin	97
23	dpavlin	98	has fey => (
24	dpavlin	97	is => 'rw',
25	dpavlin	98	isa => 'Object', # FIXME Strix::User?
26			# required => 1, # XXX if we require it we can't have Add form
27	dpavlin	97	);
28
29	dpavlin	101	has fey_class => (
30			is => 'rw',
31			isa => 'Str',
32			required => 1,
33			);
34
35	dpavlin	98	has 'display_columns' => (
36			is => 'rw',
37			isa => 'ArrayRef[Str]',
38			lazy_build => 1,
39			);
40
41	dpavlin	153	has 'labels' => (
42			is => 'rw',
43			isa => 'HashRef[Str]',
44			default => sub {
45			my $self = shift;
46			$self->load( 'var/design/' . $self->fey_class . '-labels' ) \|\| {}
47			},
48			);
49
50
51	dpavlin	98	sub set_from_hash {
52			my ($self, $f) = @_;
53			my $attrmap = $self->fey->meta->get_attribute_map if $self->fey;
54			my $hash;
55			foreach my $name ( @{ $self->display_columns } ) {
56			my $field_name = $self->field_name($name);
57			if(defined $f->{$field_name}) {
58			$hash->{ $name } = $f->{$field_name};
59
60			if ( defined $attrmap->{$name} ) {
61			my $writer = $attrmap->{$name}->get_write_method;
62			$self->fey->$writer($f->{$field_name});
63			} else {
64			warn "can't store value back into fey->$name";
65			}
66			}
67			}
68			warn "# set_from_hash ", $self->uuid," produced hash = ",dump( $hash ) if $hash;
69			return $hash;
70			}
71
72	dpavlin	74	sub main {
73			my ( $self ) = @_;
74
75	dpavlin	143	warn "# item ",$self->uuid, " fey = ",dump( $self->fey ) if $self->debug;
76	dpavlin	79
77	dpavlin	969	my $out;
78			if ( $self->render_as eq 'edit' ) {
79			$out .= $self->render_edit;
80			} elsif ( $self->render_as eq 'view' ) {
81			$out .= $self->render_view;
82			} else {
83			warn "no renderer ",dump( $self->render_as ), " skipping...";
84			}
85	dpavlin	79
86	dpavlin	969	warn $@ if $@;
87			warn ">>> ",length($out),"\n";
88
89			return $out;
90	dpavlin	71	};
91
92	dpavlin	135	sub field_value {
93			my ( $self, $name ) = @_;
94			my $val = '';
95			$val = $self->fey->$name if $self->fey && $self->fey->can($name);
96			return $val;
97			}
98
99			sub field_label {
100			my ( $self, $name ) = @_;
101	dpavlin	153	my $new_labels = $self->reload( 'var/design/' . $self->fey_class . '-labels' );
102			$self->labels( $new_labels ) if $new_labels;
103			my $label = $self->labels->{$name} \|\| ucfirst($name);
104	dpavlin	135	return $label;
105			}
106
107	dpavlin	98	sub _build_display_columns {
108			my $self = shift;
109	dpavlin	63
110	dpavlin	101	my $m = $self->fey_class->meta;
111	dpavlin	74
112	dpavlin	98	my @cols;
113	dpavlin	63
114	dpavlin	98	foreach ( $m->get_attribute_list ) {
115			my $attr = $m->get_attribute( $_ );
116	dpavlin	111	warn "_build_display_columns $_\n" if $self->debug;
117	dpavlin	98	# FIXME primary key would have to be read-only!
118			push @cols, $_;
119			}
120
121	dpavlin	105	warn "## display_columns ",dump( @cols ) if $self->debug;
122	dpavlin	98
123			return \@cols;
124	dpavlin	63	}
125
126			1;