lib/Frey/ObjectBrowser.pm

package Frey::ObjectBrowser;
use Moose;

extends 'Frey';
with 'Frey::Web';

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

my @callbacks;

sub gen_link {
        my ($text, $code) = @_;
        push @callbacks, $code;
        return qq{<a href="?cb=$#callbacks">$text</a>};
}

sub process_links {
        my $request = shift;
        my $cb = $request->param('cb');
        if (exists $callbacks[$cb]) {
                $callbacks[$cb]->($request);
                delete $callbacks[$cb];
        }
}

#use Data::Dumper;
#$Data::Dumper::Deparse = 1;
use Data::Dump qw/dump/;

use Frey::Web::Row;

sub html {
        my ( $self, $req ) = @_;

        my $f = { $req->params };
        my $layout = delete( $f->{layout} ) || 'div';

        my @w;

        while ( 1 ) {
        
                warn "<<< GOT REQUEST ",dump( $f );

                # re-apply (changed?) layout to elements
                if ( defined $f->{layout} ) {
                        $layout = delete( $f->{layout} );
                        warn "# new layout = $layout\n";
                }

                if ( ! @w || $f->{limit} || $f->{offset} ) {
                        my $s = $self->fey_class->collection( $f );
                        warn "# s ",$self->fey_class," = ",dump( $s ) if $self->debug;

                        @w = ();

                        while ( my $u = $s->next ) {
                                my $w = Frey::Web::Row->new( fey_class => $self->fey_class, fey => $u, layout => $layout );
                                warn "# w = ",dump( $w ) if $self->debug;
                                push @w, $w;
                        }

                        warn "# got $#w elements: ",dump( map { $_->id } @w );
                }

                my $rows_delimiter = '';
                $rows_delimiter = '<hr/>' if $layout eq 'div';

                my $form = join($rows_delimiter, map {
                        $_->layout( $layout );          # FIXME do we need this still?
                        $_->process($f) || ''
                } @w );

                if ( $w[ $#w ]->fey ) {
                        warn "+++ added new item widget\n";
                        my $w = Frey::Web::Row->new( fey_class => $self->fey_class, render_as => 'edit', layout => $layout );
                        $form .= $rows_delimiter . $w->process;
                        push @w, $w;
                }

                $form = qq|<table>$form</table>| if $layout eq 'table';

                if ( $layout eq 'columns' ) {
                        # add header to table
                        my $header = $w[0]->render_iterator( sub {
                                my ( $name, $field_name, $label, $val ) = @_;
                                return if $name =~ /^_/;
                                return qq|<th>$label</th>|;
                        });
                        $form = qq|<table><tr>$header</tr>$form</table>|;
                }

                my $layout_picker = join(' ',
                        qq|<div class="layout">layout:|,
                        map {
                                if ( $layout eq $_ ) {
                                        qq|<em>$_</em>|;
                                } else {
                                        qq|<a href="?layout=$_">$_</a>|;
                                }
                        } ( 'div', 'table', 'columns' ),
                        qq|</div>|,
                );

            my $html = dom2html(
                        html => [
                                head => [
                                        link  => { rel=>"stylesheet", href=>"/static/form.css", type=>"text/css" }
                                ],
                                body => [
                                        h1 => [ $self->fey_class ],
                                        $layout_picker,
                                        form => { method=>'post' } => [
                                                $form,
                                        ],
                                ],
                        ]
                );

                warn ">>> $layout ",length( $html ),"\n";

                $req->print( $html );
                $req->next;

                $f = { $req->params };

                process_links( $req );
        }

        warn "NO WAY OUT!";
};

1;
1	dpavlin	60	package Frey::ObjectBrowser;
2			use Moose;
3
4			extends 'Frey';
5	dpavlin	100	with 'Frey::Web';
6	dpavlin	60
7	dpavlin	101	has 'fey_class' => (
8			is => 'rw',
9			isa => 'Str',
10			required => 1,
11			);
12
13	dpavlin	60	my @callbacks;
14
15			sub gen_link {
16			my ($text, $code) = @_;
17			push @callbacks, $code;
18			return qq{<a href="?cb=$#callbacks">$text</a>};
19			}
20
21			sub process_links {
22			my $request = shift;
23			my $cb = $request->param('cb');
24			if (exists $callbacks[$cb]) {
25			$callbacks[$cb]->($request);
26			delete $callbacks[$cb];
27			}
28			}
29
30	dpavlin	68	#use Data::Dumper;
31			#$Data::Dumper::Deparse = 1;
32			use Data::Dump qw/dump/;
33	dpavlin	60
34	dpavlin	98	use Frey::Web::Row;
35	dpavlin	72
36	dpavlin	60	sub html {
37			my ( $self, $req ) = @_;
38
39	dpavlin	89	my $f = { $req->params };
40			my $layout = delete( $f->{layout} ) \|\| 'div';
41
42	dpavlin	68	my @w;
43
44			while ( 1 ) {
45	dpavlin	75
46	dpavlin	82	warn "<<< GOT REQUEST ",dump( $f );
47	dpavlin	75
48	dpavlin	89	# re-apply (changed?) layout to elements
49			if ( defined $f->{layout} ) {
50			$layout = delete( $f->{layout} );
51			warn "# new layout = $layout\n";
52			}
53	dpavlin	82
54	dpavlin	109	if ( ! @w \|\| $f->{limit} \|\| $f->{offset} ) {
55			my $s = $self->fey_class->collection( $f );
56			warn "# s ",$self->fey_class," = ",dump( $s ) if $self->debug;
57
58			@w = ();
59
60			while ( my $u = $s->next ) {
61			my $w = Frey::Web::Row->new( fey_class => $self->fey_class, fey => $u, layout => $layout );
62			warn "# w = ",dump( $w ) if $self->debug;
63			push @w, $w;
64			}
65
66			warn "# got $#w elements: ",dump( map { $_->id } @w );
67			}
68
69	dpavlin	95	my $rows_delimiter = '';
70			$rows_delimiter = '<hr/>' if $layout eq 'div';
71	dpavlin	89
72			my $form = join($rows_delimiter, map {
73	dpavlin	100	$_->layout( $layout ); # FIXME do we need this still?
74	dpavlin	89	$_->process($f) \|\| ''
75			} @w );
76
77	dpavlin	100	if ( $w[ $#w ]->fey ) {
78	dpavlin	89	warn "+++ added new item widget\n";
79	dpavlin	101	my $w = Frey::Web::Row->new( fey_class => $self->fey_class, render_as => 'edit', layout => $layout );
80	dpavlin	89	$form .= $rows_delimiter . $w->process;
81			push @w, $w;
82	dpavlin	82	}
83
84	dpavlin	89	$form = qq\|<table>$form</table>\| if $layout eq 'table';
85
86	dpavlin	95	if ( $layout eq 'columns' ) {
87			# add header to table
88			my $header = $w[0]->render_iterator( sub {
89			my ( $name, $field_name, $label, $val ) = @_;
90			return if $name =~ /^_/;
91			return qq\|<th>$label</th>\|;
92			});
93			$form = qq\|<table><tr>$header</tr>$form</table>\|;
94			}
95
96	dpavlin	94	my $layout_picker = join(' ',
97			qq\|<div class="layout">layout:\|,
98			map {
99			if ( $layout eq $_ ) {
100			qq\|<em>$_</em>\|;
101			} else {
102			qq\|<a href="?layout=$_">$_</a>\|;
103			}
104	dpavlin	95	} ( 'div', 'table', 'columns' ),
105	dpavlin	94	qq\|</div>\|,
106			);
107	dpavlin	89
108	dpavlin	100	my $html = dom2html(
109	dpavlin	72	html => [
110			head => [
111	dpavlin	78	link => { rel=>"stylesheet", href=>"/static/form.css", type=>"text/css" }
112	dpavlin	72	],
113			body => [
114	dpavlin	101	h1 => [ $self->fey_class ],
115	dpavlin	94	$layout_picker,
116	dpavlin	72	form => { method=>'post' } => [
117	dpavlin	75	$form,
118	dpavlin	72	],
119			],
120			]
121	dpavlin	100	);
122	dpavlin	72
123	dpavlin	100	warn ">>> $layout ",length( $html ),"\n";
124	dpavlin	93
125	dpavlin	100	$req->print( $html );
126	dpavlin	68	$req->next;
127	dpavlin	72
128			$f = { $req->params };
129	dpavlin	93
130			process_links( $req );
131	dpavlin	68	}
132
133			warn "NO WAY OUT!";
134	dpavlin	60	};
135
136			1;