lib/Strix/View.pm

package Strix::View;

use strict;
use warnings;

use Template::Declare::Tags; # defaults to 'HTML'
use base 'Template::Declare';
use Data::Dump qw/dump/;

=head1 NAME

Strix::View - examine Strix data

=cut

=head1 METHODS

=head2 user

=cut

use Strix::User;
use Frey::HTML;

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;

template 'user' => sub {
        my ( $self, $req ) = @_;
        my $id = $req->param('id');

        my $continue = 1;
        while ( $continue ) {

                my $user = eval { Strix::User->new( id => $id ); };
                warn "## user $id: $@", dump( $user );

                if ( ! $user ) {
                        $req->conn->send_status_line( 404, "user $id" );
                        $req->print( Frey::HTML->page( 'error', $req, "Can't find user with id $id\n$@" ) );
                } else {
                        $req->print( Frey::HTML->page( 'show-user', $req, $user ) );
#                       $req->print( '<pre>' . dump( $user ) . '</pre>' );
                };

                @callbacks = ();
                $req->print('<tt>'.join('&nbsp;',
                        $id,
                        gen_link('+' => sub { $id++ }),
                        gen_link('-' => sub { $id-- }),
                        gen_link('X' => sub { $continue = 0 }),
                ).'</tt>');
                $req->print('<pre>'.Dumper( @callbacks ).'</pre>');
                $req->next;
                process_links($req);
        }
};

template 'show-user' => sub {
        my ( $self, $req, $user ) = @_;
        table {
                foreach my $f ( keys %$user ) {
                        row {
                                cell { $f }
                                cell { $user->{$f} }
                        }
                }
        }
};

1;
1	dpavlin	19	package Strix::View;
2
3			use strict;
4			use warnings;
5
6			use Template::Declare::Tags; # defaults to 'HTML'
7			use base 'Template::Declare';
8			use Data::Dump qw/dump/;
9
10	dpavlin	32	=head1 NAME
11
12			Strix::View - examine Strix data
13
14			=cut
15
16			=head1 METHODS
17
18			=head2 user
19
20			=cut
21
22			use Strix::User;
23	dpavlin	39	use Frey::HTML;
24	dpavlin	32
25	dpavlin	38	my @callbacks;
26
27			sub gen_link {
28			my ($text, $code) = @_;
29			push @callbacks, $code;
30	dpavlin	42	return qq{<a href="?cb=$#callbacks">$text</a>};
31	dpavlin	38	}
32
33			sub process_links {
34			my $request = shift;
35			my $cb = $request->param('cb');
36			if (exists $callbacks[$cb]) {
37			$callbacks[$cb]->($request);
38			delete $callbacks[$cb];
39			}
40			}
41
42			use Data::Dumper;
43			$Data::Dumper::Deparse = 1;
44
45	dpavlin	32	template 'user' => sub {
46			my ( $self, $req ) = @_;
47			my $id = $req->param('id');
48
49	dpavlin	38	my $continue = 1;
50			while ( $continue ) {
51	dpavlin	32
52	dpavlin	38	my $user = eval { Strix::User->new( id => $id ); };
53			warn "## user $id: $@", dump( $user );
54
55			if ( ! $user ) {
56			$req->conn->send_status_line( 404, "user $id" );
57	dpavlin	42	$req->print( Frey::HTML->page( 'error', $req, "Can't find user with id $id\n$@" ) );
58	dpavlin	38	} else {
59	dpavlin	39	$req->print( Frey::HTML->page( 'show-user', $req, $user ) );
60			# $req->print( '<pre>' . dump( $user ) . '</pre>' );
61	dpavlin	38	};
62
63			@callbacks = ();
64			$req->print('<tt>'.join(' ',
65	dpavlin	42	$id,
66	dpavlin	38	gen_link('+' => sub { $id++ }),
67			gen_link('-' => sub { $id-- }),
68			gen_link('X' => sub { $continue = 0 }),
69			).'</tt>');
70			$req->print('<pre>'.Dumper( @callbacks ).'</pre>');
71			$req->next;
72			process_links($req);
73			}
74	dpavlin	32	};
75
76	dpavlin	23	template 'show-user' => sub {
77			my ( $self, $req, $user ) = @_;
78	dpavlin	32	table {
79			foreach my $f ( keys %$user ) {
80			row {
81			cell { $f }
82			cell { $user->{$f} }
83			}
84			}
85	dpavlin	19	}
86			};
87
88			1;