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;

my @callbacks;

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

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( "Can't find user with id $id\n$@" );
                } else {
#                       $req->print( show( 'show-user', $req, $user ) );
                        $req->print( '<pre>' . dump( $user ) . '</pre>' );
                };

                @callbacks = ();
                $req->print('<tt>'.join('&nbsp;',
                        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
24	dpavlin	38	my @callbacks;
25
26			sub gen_link {
27			my ($text, $code) = @_;
28			push @callbacks, $code;
29			my $out = qq{<a href="?cb=$#callbacks">$text</a>};
30			return $out;
31			}
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			$req->print( "Can't find user with id $id\n$@" );
58			} else {
59			# $req->print( show( 'show-user', $req, $user ) );
60			$req->print( '<pre>' . dump( $user ) . '</pre>' );
61			};
62
63			@callbacks = ();
64			$req->print('<tt>'.join(' ',
65			gen_link('+' => sub { $id++ }),
66			gen_link('-' => sub { $id-- }),
67			gen_link('X' => sub { $continue = 0 }),
68			).'</tt>');
69			$req->print('<pre>'.Dumper( @callbacks ).'</pre>');
70			$req->next;
71			process_links($req);
72			}
73	dpavlin	32	};
74
75	dpavlin	23	template 'show-user' => sub {
76			my ( $self, $req, $user ) = @_;
77	dpavlin	32	table {
78			foreach my $f ( keys %$user ) {
79			row {
80			cell { $f }
81			cell { $user->{$f} }
82			}
83			}
84	dpavlin	19	}
85			};
86
87			1;