Frey/Web/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 id {
        my $self = shift;
        carp "LEGACY: called ->id";
        $self->fey->id if $self->fey;
}

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 render_iterator {
        confess "BACKWARD INCOMATIBLE CHANGE: render_iterator works ONLY with 2 params!" unless $#_ == 1;
        my ($self, $iterator) = @_;
        my $out;
#       my %attrmap = %{ $self->meta->get_attribute_map };
#       while( my ($name, $attr) = each %attrmap ) {
#               my $reader = $attr->get_read_method;
#               my $val = $self->$reader || '';
        foreach my $name ( @{ $self->display_columns } ) {
                $out .= $self->render_field( $name, $iterator )
        }
        return $out;
}

sub render_field {
        my ($self, $name, $iterator) = @_;
        my $field_name = $self->field_name($name);
        my $val;
        $val = $self->fey->$name if $self->fey && $self->fey->can($name);
        $iterator->( $name, $field_name, ucfirst($name), $val ) || '';  # || '' to shut warnings
}

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

        warn "# ",$self->uuid, " [", $self->id ,"] 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 render_edit {
        my $self = shift;
        warn "# render_edit ",$self->id," ",$self->uuid, " ", $self->layout, "\n";
        my $out = $self->render_iterator( sub {
                #warn "# edit render_iterator ",dump( @_ );
                my ( $name, $field_name, $label, $val ) = @_;
                return if $name =~ /^_/;
                $val ||= '';
                return 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>
                | if $self->layout eq 'table';
                return qq|
                        <td class="field">
                                <input type=text id="$field_name" name="$field_name" value="$val">
                        </td>
                | if $self->layout eq 'columns';
                return 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->id," ",$self->uuid," ", $self->layout,"\n";
        my $out = $self->render_iterator( sub {
                #warn "# view render_iterator ",dump( @_ );
                my ( $name, $field_name, $label, $val ) = @_;
                return if $name =~ /^_/;
                $val ||= '';
                return qq|<tr><td>$label</td><td>$val</td></tr>| if $self->layout eq 'table';
                return qq|<td>$val</td>| if $self->layout eq 'columns';
                return 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 id {
42			my $self = shift;
43			carp "LEGACY: called ->id";
44			$self->fey->id if $self->fey;
45			}
46
47			sub set_from_hash {
48			my ($self, $f) = @_;
49			my $attrmap = $self->fey->meta->get_attribute_map if $self->fey;
50			my $hash;
51			foreach my $name ( @{ $self->display_columns } ) {
52			my $field_name = $self->field_name($name);
53			if(defined $f->{$field_name}) {
54			$hash->{ $name } = $f->{$field_name};
55
56			if ( defined $attrmap->{$name} ) {
57			my $writer = $attrmap->{$name}->get_write_method;
58			$self->fey->$writer($f->{$field_name});
59			} else {
60			warn "can't store value back into fey->$name";
61			}
62			}
63			}
64			warn "# set_from_hash ", $self->uuid," produced hash = ",dump( $hash ) if $hash;
65			return $hash;
66			}
67
68	dpavlin	96	sub render_iterator {
69			confess "BACKWARD INCOMATIBLE CHANGE: render_iterator works ONLY with 2 params!" unless $#_ == 1;
70			my ($self, $iterator) = @_;
71			my $out;
72	dpavlin	98	# my %attrmap = %{ $self->meta->get_attribute_map };
73			# while( my ($name, $attr) = each %attrmap ) {
74			# my $reader = $attr->get_read_method;
75			# my $val = $self->$reader \|\| '';
76			foreach my $name ( @{ $self->display_columns } ) {
77	dpavlin	129	$out .= $self->render_field( $name, $iterator )
78	dpavlin	96	}
79			return $out;
80			}
81
82	dpavlin	129	sub render_field {
83			my ($self, $name, $iterator) = @_;
84			my $field_name = $self->field_name($name);
85			my $val;
86			$val = $self->fey->$name if $self->fey && $self->fey->can($name);
87			$iterator->( $name, $field_name, ucfirst($name), $val ) \|\| ''; # \|\| '' to shut warnings
88			}
89
90	dpavlin	74	sub main {
91			my ( $self ) = @_;
92
93	dpavlin	98	warn "# ",$self->uuid, " [", $self->id ,"] fey = ",dump( $self->fey );
94	dpavlin	79
95	dpavlin	74	while(1) {
96	dpavlin	79	my $out;
97	dpavlin	98	if ( $self->render_as eq 'edit' ) {
98	dpavlin	86	$out .= $self->render_edit;
99	dpavlin	98	} elsif ( $self->render_as eq 'view' ) {
100	dpavlin	86	$out .= $self->render_view;
101	dpavlin	79	} else {
102	dpavlin	98	warn "no renderer ",dump( $self->render_as ), " skipping...";
103	dpavlin	79	}
104
105	dpavlin	74	warn $@ if $@;
106	dpavlin	82	warn ">>> ",length($out),"\n";
107	dpavlin	71	my $f = $self->next($out);
108	dpavlin	74	$self->set_from_hash($f);
109	dpavlin	129	$self->exec_callbacks($f);
110	dpavlin	74	}
111	dpavlin	71	};
112
113	dpavlin	86	sub render_edit {
114			my $self = shift;
115	dpavlin	98	warn "# render_edit ",$self->id," ",$self->uuid, " ", $self->layout, "\n";
116	dpavlin	89	my $out = $self->render_iterator( sub {
117			#warn "# edit render_iterator ",dump( @_ );
118			my ( $name, $field_name, $label, $val ) = @_;
119			return if $name =~ /^_/;
120	dpavlin	105	$val \|\|= '';
121	dpavlin	89	return qq\|
122	dpavlin	90	<tr class="editform">
123			<td class="label">$label</td>
124			<td class="field">
125	dpavlin	89	<input type=text id="$field_name" name="$field_name" value="$val">
126			</td>
127			</tr>
128	dpavlin	98	\| if $self->layout eq 'table';
129	dpavlin	89	return qq\|
130	dpavlin	95	<td class="field">
131			<input type=text id="$field_name" name="$field_name" value="$val">
132			</td>
133	dpavlin	98	\| if $self->layout eq 'columns';
134	dpavlin	95	return qq\|
135	dpavlin	89	<div class=fieldholder>
136	dpavlin	90	<label for="$field_name">$label</label>
137	dpavlin	89	<div class=field>
138			<input type=text id="$field_name" name="$field_name" value="$val">
139	dpavlin	86	</div>
140	dpavlin	89	</div>
141			\|;
142			});
143	dpavlin	95
144	dpavlin	129	return qq\|<tr class="editform">$out<td>\| . $self->render_callbacks . qq\|</td></tr>\| if $self->layout eq 'columns';
145	dpavlin	95
146	dpavlin	89	$self->render_wrapper_class( $out, 'editform' );
147	dpavlin	86	}
148
149			sub render_view {
150			my $self = shift;
151	dpavlin	98	warn "# render_view ",$self->id," ",$self->uuid," ", $self->layout,"\n";
152	dpavlin	89	my $out = $self->render_iterator( sub {
153			#warn "# view render_iterator ",dump( @_ );
154			my ( $name, $field_name, $label, $val ) = @_;
155			return if $name =~ /^_/;
156	dpavlin	108	$val \|\|= '';
157	dpavlin	98	return qq\|<tr><td>$label</td><td>$val</td></tr>\| if $self->layout eq 'table';
158			return qq\|<td>$val</td>\| if $self->layout eq 'columns';
159	dpavlin	89	return qq\|
160			<div class=fieldholder>
161			<div class=label>$label</div>
162			<div class=field>$val</div>
163	dpavlin	86	</div>
164	dpavlin	89	</div>
165			\|;
166			});
167	dpavlin	129	return qq\|<tr>$out<td>\| . $self->render_callbacks . qq\|</td></tr>\| if $self->layout eq 'columns';
168	dpavlin	89	$self->render_wrapper_class( $out, 'view' );
169	dpavlin	86	}
170
171	dpavlin	89	sub render_wrapper_class {
172			my ( $self, $out, $class ) = @_;
173			if ( length($out) == 0 ) {
174			carp "no output, skipping";
175			return '<!-- no output -->';
176			}
177	dpavlin	90	$out =~ s/^\t+//mg; # XXX compress output
178	dpavlin	129	return $out . qq\|<tr><td colspan=2>\| . $self->render_callbacks . qq\|</td></tr>\| if $self->layout eq 'table';
179			return qq\|<div class="$class">\| . $out . $self->render_callbacks . qq\|</div>\|;
180	dpavlin	89	}
181
182	dpavlin	98	sub _build_display_columns {
183			my $self = shift;
184	dpavlin	63
185	dpavlin	101	my $m = $self->fey_class->meta;
186	dpavlin	74
187	dpavlin	98	my @cols;
188	dpavlin	63
189	dpavlin	98	foreach ( $m->get_attribute_list ) {
190			my $attr = $m->get_attribute( $_ );
191	dpavlin	111	warn "_build_display_columns $_\n" if $self->debug;
192	dpavlin	98	# FIXME primary key would have to be read-only!
193			push @cols, $_;
194			}
195
196	dpavlin	105	warn "## display_columns ",dump( @cols ) if $self->debug;
197	dpavlin	98
198			return \@cols;
199	dpavlin	63	}
200
201			1;