Frey/ORM/Item.pm

package Frey::Web::Item;

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

use Moose::Role;
with 'Frey::Web::Field';
#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,
);

enum 'Layouts' => qw( div table columns );
has layout => (
        is => 'rw',
        isa => 'Layouts',
        default => 'div',
        required => 1,
);

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

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 "# ",$self->uuid, " fey = ",dump( $self->fey );

        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);
        }
};

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 $label = ucfirst($name);
        return $label;
}

sub render_edit {
        my $self = shift;
        warn "# render_edit ",$self->uuid, " ", $self->layout, "\n";
        my $out;
        foreach my $name ( @{ $self->display_columns } ) {
                next if $name =~ /^_/;

                my $field_name = $self->field_name( $name );
                my $label = $self->field_label( $name );
                my $val = $self->field_value( $name );

                if ( $self->layout eq 'table' ) {
                        $out .= qq|
                        <tr class="editform">
                        <td class="label">$label</td>
                        <td class="field">
                                <input type=text id="$field_name" name="$field_name" value="$val">
                        </td>
                        </tr>
                        |;
                } elsif ( $self->layout eq 'columns' ) {
                        $out .= qq|
                        <td class="field">
                                <input type=text id="$field_name" name="$field_name" value="$val">
                        </td>
                        |;
                } else {
                        $out .= qq|
                        <div class=fieldholder>
                                <label for="$field_name">$label</label>
                                <div class=field>
                                        <input type=text id="$field_name" name="$field_name" value="$val">
                                </div>
                        </div>
                        |;
                }
        };

        return qq|<tr class="editform">$out<td>| . $self->render_callbacks . qq|</td></tr>| if $self->layout eq 'columns';

        $self->render_wrapper_class( $out, 'editform' );
}

sub render_view {
        my $self = shift;
        warn "# render_view ",$self->uuid," ", $self->layout,"\n";
        my $out;
        foreach my $name ( @{ $self->display_columns } ) {
                next if $name =~ /^_/;
                
                my $field_name = $self->field_name( $name );
                my $label = $self->field_label( $name );
                my $val = $self->field_value( $name );

                if ( $self->layout eq 'table' ) {
                        $out .= qq|<tr><td>$label</td><td>$val</td></tr>|;
                } elsif ( $self->layout eq 'columns' ) {
                        $out .= qq|<td>$val</td>|;
                } else {
                        $out .= qq|
                        <div class=fieldholder>
                                <div class=label>$label</div>
                                <div class=field>$val</div>
                                </div>
                        </div>
                        |;
                }
        };
        return qq|<tr>$out<td>| . $self->render_callbacks . qq|</td></tr>| if $self->layout eq 'columns';
        $self->render_wrapper_class( $out, 'view' );
}

sub render_wrapper_class {
        my ( $self, $out, $class ) = @_;
        if ( length($out) == 0 ) {
                carp "no output, skipping";
                return '<!-- no output -->';
        }
        $out =~ s/^\t+//mg;     # XXX compress output
        return $out . qq|<tr><td colspan=2>| . $self->render_callbacks . qq|</td></tr>| if $self->layout eq 'table';
        return qq|<div class="$class">| . $out . $self->render_callbacks . qq|</div>|;
}

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	129	use Moose::Role;
7			with 'Frey::Web::Field';
8	dpavlin	63	#with 'BonusTypes';
9
10	dpavlin	97	use Moose::Util::TypeConstraints;
11	dpavlin	96
12	dpavlin	97	enum 'Render_as' => qw( view edit none );
13	dpavlin	98	has render_as => ( is => 'rw', isa => 'Render_as', required => 1, default => 'view' );
14	dpavlin	97
15	dpavlin	98	has fey => (
16	dpavlin	97	is => 'rw',
17	dpavlin	98	isa => 'Object', # FIXME Strix::User?
18			# required => 1, # XXX if we require it we can't have Add form
19	dpavlin	97	);
20
21	dpavlin	101	has fey_class => (
22			is => 'rw',
23			isa => 'Str',
24			required => 1,
25			);
26
27	dpavlin	97	enum 'Layouts' => qw( div table columns );
28	dpavlin	98	has layout => (
29	dpavlin	97	is => 'rw',
30			isa => 'Layouts',
31			default => 'div',
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			sub set_from_hash {
42			my ($self, $f) = @_;
43			my $attrmap = $self->fey->meta->get_attribute_map if $self->fey;
44			my $hash;
45			foreach my $name ( @{ $self->display_columns } ) {
46			my $field_name = $self->field_name($name);
47			if(defined $f->{$field_name}) {
48			$hash->{ $name } = $f->{$field_name};
49
50			if ( defined $attrmap->{$name} ) {
51			my $writer = $attrmap->{$name}->get_write_method;
52			$self->fey->$writer($f->{$field_name});
53			} else {
54			warn "can't store value back into fey->$name";
55			}
56			}
57			}
58			warn "# set_from_hash ", $self->uuid," produced hash = ",dump( $hash ) if $hash;
59			return $hash;
60			}
61
62	dpavlin	74	sub main {
63			my ( $self ) = @_;
64
65	dpavlin	135	warn "# ",$self->uuid, " fey = ",dump( $self->fey );
66	dpavlin	79
67	dpavlin	74	while(1) {
68	dpavlin	79	my $out;
69	dpavlin	98	if ( $self->render_as eq 'edit' ) {
70	dpavlin	86	$out .= $self->render_edit;
71	dpavlin	98	} elsif ( $self->render_as eq 'view' ) {
72	dpavlin	86	$out .= $self->render_view;
73	dpavlin	79	} else {
74	dpavlin	98	warn "no renderer ",dump( $self->render_as ), " skipping...";
75	dpavlin	79	}
76
77	dpavlin	74	warn $@ if $@;
78	dpavlin	82	warn ">>> ",length($out),"\n";
79	dpavlin	71	my $f = $self->next($out);
80	dpavlin	74	$self->set_from_hash($f);
81	dpavlin	129	$self->exec_callbacks($f);
82	dpavlin	74	}
83	dpavlin	71	};
84
85	dpavlin	135	sub field_value {
86			my ( $self, $name ) = @_;
87			my $val = '';
88			$val = $self->fey->$name if $self->fey && $self->fey->can($name);
89			return $val;
90			}
91
92			sub field_label {
93			my ( $self, $name ) = @_;
94			my $label = ucfirst($name);
95			return $label;
96			}
97
98	dpavlin	86	sub render_edit {
99			my $self = shift;
100	dpavlin	135	warn "# render_edit ",$self->uuid, " ", $self->layout, "\n";
101			my $out;
102			foreach my $name ( @{ $self->display_columns } ) {
103			next if $name =~ /^_/;
104
105			my $field_name = $self->field_name( $name );
106			my $label = $self->field_label( $name );
107			my $val = $self->field_value( $name );
108
109			if ( $self->layout eq 'table' ) {
110			$out .= qq\|
111	dpavlin	90	<tr class="editform">
112			<td class="label">$label</td>
113			<td class="field">
114	dpavlin	89	<input type=text id="$field_name" name="$field_name" value="$val">
115			</td>
116			</tr>
117	dpavlin	135	\|;
118			} elsif ( $self->layout eq 'columns' ) {
119			$out .= qq\|
120	dpavlin	95	<td class="field">
121			<input type=text id="$field_name" name="$field_name" value="$val">
122			</td>
123	dpavlin	135	\|;
124			} else {
125			$out .= qq\|
126	dpavlin	89	<div class=fieldholder>
127	dpavlin	90	<label for="$field_name">$label</label>
128	dpavlin	89	<div class=field>
129			<input type=text id="$field_name" name="$field_name" value="$val">
130	dpavlin	86	</div>
131	dpavlin	89	</div>
132	dpavlin	135	\|;
133			}
134			};
135	dpavlin	95
136	dpavlin	129	return qq\|<tr class="editform">$out<td>\| . $self->render_callbacks . qq\|</td></tr>\| if $self->layout eq 'columns';
137	dpavlin	95
138	dpavlin	89	$self->render_wrapper_class( $out, 'editform' );
139	dpavlin	86	}
140
141			sub render_view {
142			my $self = shift;
143	dpavlin	135	warn "# render_view ",$self->uuid," ", $self->layout,"\n";
144			my $out;
145			foreach my $name ( @{ $self->display_columns } ) {
146			next if $name =~ /^_/;
147
148			my $field_name = $self->field_name( $name );
149			my $label = $self->field_label( $name );
150			my $val = $self->field_value( $name );
151
152			if ( $self->layout eq 'table' ) {
153			$out .= qq\|<tr><td>$label</td><td>$val</td></tr>\|;
154			} elsif ( $self->layout eq 'columns' ) {
155			$out .= qq\|<td>$val</td>\|;
156			} else {
157			$out .= qq\|
158	dpavlin	89	<div class=fieldholder>
159			<div class=label>$label</div>
160			<div class=field>$val</div>
161	dpavlin	86	</div>
162	dpavlin	89	</div>
163	dpavlin	135	\|;
164			}
165			};
166	dpavlin	129	return qq\|<tr>$out<td>\| . $self->render_callbacks . qq\|</td></tr>\| if $self->layout eq 'columns';
167	dpavlin	89	$self->render_wrapper_class( $out, 'view' );
168	dpavlin	86	}
169
170	dpavlin	89	sub render_wrapper_class {
171			my ( $self, $out, $class ) = @_;
172			if ( length($out) == 0 ) {
173			carp "no output, skipping";
174			return '<!-- no output -->';
175			}
176	dpavlin	90	$out =~ s/^\t+//mg; # XXX compress output
177	dpavlin	129	return $out . qq\|<tr><td colspan=2>\| . $self->render_callbacks . qq\|</td></tr>\| if $self->layout eq 'table';
178			return qq\|<div class="$class">\| . $out . $self->render_callbacks . qq\|</div>\|;
179	dpavlin	89	}
180
181	dpavlin	98	sub _build_display_columns {
182			my $self = shift;
183	dpavlin	63
184	dpavlin	101	my $m = $self->fey_class->meta;
185	dpavlin	74
186	dpavlin	98	my @cols;
187	dpavlin	63
188	dpavlin	98	foreach ( $m->get_attribute_list ) {
189			my $attr = $m->get_attribute( $_ );
190	dpavlin	111	warn "_build_display_columns $_\n" if $self->debug;
191	dpavlin	98	# FIXME primary key would have to be read-only!
192			push @cols, $_;
193			}
194
195	dpavlin	105	warn "## display_columns ",dump( @cols ) if $self->debug;
196	dpavlin	98
197			return \@cols;
198	dpavlin	63	}
199
200			1;