/[Frey]/trunk/lib/Continuity/Widget.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/lib/Continuity/Widget.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 87 - (hide annotations)
Thu Jul 10 19:36:39 2008 UTC (15 years, 8 months ago) by dpavlin
File size: 4789 byte(s)
simplify render_iterator
1 dpavlin 69 package Continuity::Widget;
2    
3     our $VERSION = '0.01';
4    
5     =head1 NAME
6    
7     Continuity::Widget - Handy Moose-based Widget Thingie for Continuity Apps
8    
9     =head1 SYNOPSIS
10    
11     use Continuity::Widget;
12    
13     =head1 DESCRIPTION
14    
15     Don't quite know what this will be yet.
16    
17     =cut
18    
19 dpavlin 70 use Data::Dump qw/dump/;
20 dpavlin 69 use Data::UUID;
21     use Moose;
22     with 'Continuity::Coro::Moose';
23    
24     # List of callbacks, buttons for now
25     has callback => ( is => 'rw', default => sub {{}} );
26 dpavlin 84 has callback_order => ( is => 'rw', isa => 'ArrayRef', default => sub { [] });
27 dpavlin 69
28     has renderer => ( is => 'rw', isa => 'HashRef', default => sub {{}});
29    
30     has 'uuid' => (
31     is => 'ro',
32     isa => 'Str',
33     default => sub { Data::UUID->new->create_str }
34     );
35    
36 dpavlin 73 has render_as => ( is => 'rw', isa => 'Str', required => 1, default => 'view' );
37    
38 dpavlin 69 # Given a name generate a unique field ID
39     sub field_name {
40     my ($self, $name) = @_;
41     return $self->uuid . '-' . $name;
42     }
43    
44 dpavlin 79 sub render_iterator {
45 dpavlin 87 confess "BACKWARD INCOMATIBLE CHANGE: render_iterator works ONLY with 2 params!" unless $#_ == 1;
46     my ($self, $iterator) = @_;
47 dpavlin 79 my %attrmap = %{ $self->meta->get_attribute_map };
48 dpavlin 87 my $out;
49 dpavlin 79 while( my ($name, $attr) = each %attrmap ) {
50     my $reader = $attr->get_read_method;
51     my $val = $self->$reader || '';
52     my $field_name = $self->field_name($name);
53 dpavlin 87 $out .= $iterator->( $name, $field_name, $attr->label, $val ) || ''; # || '' to shut warnings
54 dpavlin 79 }
55 dpavlin 87 return $out;
56 dpavlin 79 }
57    
58    
59 dpavlin 69 # This renders an input form. Need to make the renderer selection dynamic
60     sub render_edit {
61     my ($self) = @_;
62     my $out = '<div class="editform">';
63     my %attrmap = %{ $self->meta->get_attribute_map };
64     while( my ($name, $attr) = each %attrmap ) {
65 dpavlin 70 next if $name =~ /^_/;
66 dpavlin 69 my $reader = $attr->get_read_method;
67     my $val = $self->$reader || '';
68     my $field_name = $self->field_name($name);
69     $out .= qq|
70     <div class=fieldholder>
71     <div class=label> @{[$attr->label]} </div>
72     <div class=field>
73     <input type=text id="$field_name" name="$field_name" value="@{[$val]}">
74     </div>
75     </div>
76     |;
77     }
78     $out .= $self->render_buttons;
79     $out .= '</div>';
80     return $out;
81     }
82    
83     sub render_view {
84     my ($self) = @_;
85     my $out = '<div class="view">';
86     my %attrmap = %{ $self->meta->get_attribute_map };
87     while( my ($name, $attr) = each %attrmap ) {
88 dpavlin 70 #next if $name =~ /^_/;
89 dpavlin 69 my $reader = $attr->get_read_method;
90     my $val = $self->$reader || '';
91     my $field_name = $self->field_name($name);
92     $out .= qq|
93     <div class=fieldholder>
94     <div class=label> @{[$attr->label]} </div>
95     <div class=field>
96     @{[$val]}
97     </div>
98     </div>
99     |;
100     }
101     $out .= $self->render_buttons;
102     $out .= '</div>';
103     return $out;
104     }
105    
106     sub set_from_hash {
107 dpavlin 82 my ($self, $f) = @_;
108 dpavlin 70 my %attrmap = %{ $self->meta->get_attribute_map };
109     my $hash;
110     while( my ($name, $attr) = each %attrmap ) {
111     my $field_name = $self->field_name($name);
112     if(defined $f->{$field_name}) {
113     my $writer = $attr->get_write_method;
114     $self->$writer($f->{$field_name});
115     $hash->{ $name } = $f->{$field_name};
116     }
117     }
118 dpavlin 82 warn "# set_from_hash ", $self->uuid," produced hash = ",dump( $hash ) if $hash;
119     return $hash;
120 dpavlin 69 }
121    
122     sub add_button {
123     my ($self, $name, $callback) = @_;
124     $self->callback->{$name} = $callback;
125 dpavlin 84 push @{ $self->callback_order }, $name;
126     warn "## callback_order = ",dump( $self->callback_order );
127 dpavlin 69 }
128    
129 dpavlin 82 sub remove_button {
130     my ( $self, $name ) = @_;
131     delete( $self->callback->{$name} );
132 dpavlin 85 my @new_order = grep { !/\Q$name\E/ } @{ $self->callback_order };
133     warn "# remove_button $name new order = ",dump( @new_order );
134     $self->callback_order( \@new_order );
135 dpavlin 82 }
136    
137 dpavlin 69 sub render_buttons {
138     my ($self) = @_;
139     my $out = '';
140 dpavlin 84 foreach my $name ( @{ $self->callback_order } ) {
141 dpavlin 69 my $btn_name = $self->field_name($name);
142     $out .= qq{
143     <input type="submit" name="@{[$btn_name]}" value="$name">
144     };
145     }
146     return $out;
147     }
148    
149     sub exec_buttons {
150     my ($self, $f) = @_;
151     foreach my $name (keys %{$self->callback}) {
152     my $btn_name = $self->field_name($name);
153     if($f->{$btn_name}) {
154     $self->callback->{$name}->($f);
155     }
156     }
157     }
158    
159     sub main {
160     my ($self) = @_;
161     $self->renderer->{view} = \&render_view;
162     $self->renderer->{edit} = \&render_edit;
163     while(1) {
164 dpavlin 73 my $out = $self->renderer->{ $self->render_as }->($self);
165 dpavlin 69 my $f = $self->next($out);
166     $self->set_from_hash($f);
167     $self->exec_buttons($f);
168     }
169     }
170    
171     =head1 SEE ALSO
172    
173     L<Continuity>, http://continuity.tlt42.org/
174    
175     =head1 AUTHOR
176    
177     awwaiid, E<lt>awwaiid@thelackthereof.orgE<gt>, L<http://thelackthereof.org/>
178    
179     =head1 COPYRIGHT AND LICENSE
180    
181     Copyright (C) 2008 by Brock Wilcox
182    
183     This library is free software; you can redistribute it and/or modify
184     it under the same terms as Perl itself, either Perl version 5.10.0 or,
185     at your option, any later version of Perl 5 you may have available.
186    
187     =cut
188    
189     1;
190    

  ViewVC Help
Powered by ViewVC 1.1.26