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;
use Frey::Web::Links;

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

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

        my @w;
        my $pager;

        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->{page} || $f->{per_page} ) {
                        my $s;
                        ( $s, $pager ) = $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 ), " from total of ", $s->handle->rows;
                }

                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 =
                        qq|<div class="layout">layout: | .
                        Frey::Web::Links->new(
                                name => 'layout',
                                current => $layout,
                                values => [ 'div', 'table', 'columns' ],
                        )->links .
                        qq|</div>|
                ;

                my $pager = join( ' ',
                        qq|<div class="notice">|,
                        'Showing',
                        $pager->first, '-', $pager->last,
                        'of',
                        $pager->total_entries,
                        'results<br>',
#                       'page', $pager->current_page, '/', $pager->last_page,
                        Frey::Web::Links->new(
                                name => 'page',
                                current => $pager->current_page,
                                values => [ $pager->first_page .. $pager->last_page ],
                        )->links,
                        qq|</div>|
                );

            my $html = dom2html(
                        html => [
                                head => [
                                        link  => { rel=>"stylesheet", href=>"/static/form.css", type=>"text/css" }
                                ],
                                body => [
                                        h1 => [ $self->fey_class ],
                                        $layout_picker,
                                        $pager,
                                        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	111	use Frey::Web::Links;
36	dpavlin	72
37	dpavlin	60	sub html {
38			my ( $self, $req ) = @_;
39
40	dpavlin	89	my $f = { $req->params };
41			my $layout = delete( $f->{layout} ) \|\| 'div';
42
43	dpavlin	68	my @w;
44	dpavlin	111	my $pager;
45	dpavlin	68
46			while ( 1 ) {
47	dpavlin	75
48	dpavlin	82	warn "<<< GOT REQUEST ",dump( $f );
49	dpavlin	75
50	dpavlin	89	# re-apply (changed?) layout to elements
51			if ( defined $f->{layout} ) {
52			$layout = delete( $f->{layout} );
53			warn "# new layout = $layout\n";
54			}
55	dpavlin	82
56	dpavlin	111	if ( ! @w \|\| $f->{page} \|\| $f->{per_page} ) {
57			my $s;
58			( $s, $pager ) = $self->fey_class->collection( $f );
59	dpavlin	109	warn "# s ",$self->fey_class," = ",dump( $s ) if $self->debug;
60
61			@w = ();
62
63			while ( my $u = $s->next ) {
64			my $w = Frey::Web::Row->new( fey_class => $self->fey_class, fey => $u, layout => $layout );
65			warn "# w = ",dump( $w ) if $self->debug;
66			push @w, $w;
67			}
68
69	dpavlin	111	warn "# got $#w elements: ",dump( map { $_->id } @w ), " from total of ", $s->handle->rows;
70	dpavlin	109	}
71
72	dpavlin	95	my $rows_delimiter = '';
73			$rows_delimiter = '<hr/>' if $layout eq 'div';
74	dpavlin	89
75			my $form = join($rows_delimiter, map {
76	dpavlin	100	$_->layout( $layout ); # FIXME do we need this still?
77	dpavlin	89	$_->process($f) \|\| ''
78			} @w );
79
80	dpavlin	100	if ( $w[ $#w ]->fey ) {
81	dpavlin	89	warn "+++ added new item widget\n";
82	dpavlin	101	my $w = Frey::Web::Row->new( fey_class => $self->fey_class, render_as => 'edit', layout => $layout );
83	dpavlin	89	$form .= $rows_delimiter . $w->process;
84			push @w, $w;
85	dpavlin	82	}
86
87	dpavlin	89	$form = qq\|<table>$form</table>\| if $layout eq 'table';
88
89	dpavlin	95	if ( $layout eq 'columns' ) {
90			# add header to table
91			my $header = $w[0]->render_iterator( sub {
92			my ( $name, $field_name, $label, $val ) = @_;
93			return if $name =~ /^_/;
94			return qq\|<th>$label</th>\|;
95			});
96			$form = qq\|<table><tr>$header</tr>$form</table>\|;
97			}
98
99	dpavlin	111	my $layout_picker =
100			qq\|<div class="layout">layout: \| .
101			Frey::Web::Links->new(
102			name => 'layout',
103			current => $layout,
104			values => [ 'div', 'table', 'columns' ],
105			)->links .
106			qq\|</div>\|
107			;
108
109			my $pager = join( ' ',
110			qq\|<div class="notice">\|,
111			'Showing',
112			$pager->first, '-', $pager->last,
113			'of',
114			$pager->total_entries,
115			'results<br>',
116			# 'page', $pager->current_page, '/', $pager->last_page,
117			Frey::Web::Links->new(
118			name => 'page',
119			current => $pager->current_page,
120			values => [ $pager->first_page .. $pager->last_page ],
121			)->links,
122			qq\|</div>\|
123	dpavlin	94	);
124	dpavlin	89
125	dpavlin	100	my $html = dom2html(
126	dpavlin	72	html => [
127			head => [
128	dpavlin	78	link => { rel=>"stylesheet", href=>"/static/form.css", type=>"text/css" }
129	dpavlin	72	],
130			body => [
131	dpavlin	101	h1 => [ $self->fey_class ],
132	dpavlin	94	$layout_picker,
133	dpavlin	111	$pager,
134	dpavlin	72	form => { method=>'post' } => [
135	dpavlin	75	$form,
136	dpavlin	72	],
137			],
138			]
139	dpavlin	100	);
140	dpavlin	72
141	dpavlin	100	warn ">>> $layout ",length( $html ),"\n";
142	dpavlin	93
143	dpavlin	100	$req->print( $html );
144	dpavlin	68	$req->next;
145	dpavlin	72
146			$f = { $req->params };
147	dpavlin	93
148			process_links( $req );
149	dpavlin	68	}
150
151			warn "NO WAY OUT!";
152	dpavlin	60	};
153
154			1;