Frey/Web/Item.pm

package Frey::Web::Item;

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

use Moose;
extends 'Frey';
with 'Frey::Web::Field';
with 'Frey::Web::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;

        while(1) {
        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";
                my $f = $self->next($out);
                $self->set_from_hash($f);
                $self->exec_callbacks($f) if $self->can('exec_callbacks');
        }
};

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