lib/Continuity/Widget.pm

package Continuity::Widget;

our $VERSION = '0.01';

=head1 NAME

Continuity::Widget - Handy Moose-based Widget Thingie for Continuity Apps

=head1 SYNOPSIS

  use Continuity::Widget;

=head1 DESCRIPTION

Don't quite know what this will be yet.

=cut

use Data::Dump qw/dump/;
use Data::UUID;
use Moose;
with 'Continuity::Coro::Moose';

# List of callbacks, buttons for now
has callback => ( is => 'rw', default => sub {{}} );
has callback_order => ( is => 'rw', isa => 'ArrayRef', default => sub { [] });

has renderer => ( is => 'rw', isa => 'HashRef', default => sub {{}});

has 'uuid'   => (
  is      => 'ro', 
  isa     => 'Str', 
  default => sub { Data::UUID->new->create_str }
);

has render_as => ( is => 'rw', isa => 'Str', required => 1, default => 'view' );

# Given a name generate a unique field ID
sub field_name {
  my ($self, $name) = @_;
  return $self->uuid . '-' . $name;
}

sub render_iterator {
        my ($self, $before, $iterator, $after) = @_;
        my %attrmap = %{ $self->meta->get_attribute_map };
        my $middle;
        while( my ($name, $attr) = each %attrmap ) {
                my $reader = $attr->get_read_method;
                my $val = $self->$reader || '';
                my $field_name = $self->field_name($name);
                $middle .= $iterator->( $name, $field_name, $attr->label, $val ) || '';
        }
        if ( $middle ) {
                return $before . $middle . $self->render_buttons . $after;
        } else {
                warn "iterator didn't produce output, skipping";
                return "<!-- empty -->";
        }
}
        

# This renders an input form. Need to make the renderer selection dynamic
sub render_edit {
  my ($self) = @_;
  my $out = '<div class="editform">';
  my %attrmap = %{ $self->meta->get_attribute_map };
  while( my ($name, $attr) = each %attrmap ) {
        next if $name =~ /^_/;
    my $reader = $attr->get_read_method;
    my $val = $self->$reader || '';
    my $field_name = $self->field_name($name);
    $out .= qq|
      <div class=fieldholder>
        <div class=label> @{[$attr->label]} </div>
        <div class=field>
          <input type=text id="$field_name" name="$field_name" value="@{[$val]}">
        </div>
      </div>
    |;
  }
  $out .= $self->render_buttons;
  $out .= '</div>';
  return $out;
}

sub render_view {
  my ($self) = @_;
  my $out = '<div class="view">';
  my %attrmap = %{ $self->meta->get_attribute_map };
  while( my ($name, $attr) = each %attrmap ) {
        #next if $name =~ /^_/;
    my $reader = $attr->get_read_method;
    my $val = $self->$reader || '';
    my $field_name = $self->field_name($name);
    $out .= qq|
      <div class=fieldholder>
        <div class=label> @{[$attr->label]} </div>
        <div class=field>
          @{[$val]}
        </div>
      </div>
    |;
  }
  $out .= $self->render_buttons;
  $out .= '</div>';
  return $out;
}

sub set_from_hash {
        my ($self, $f) = @_;
        my %attrmap = %{ $self->meta->get_attribute_map };
        my $hash;
        while( my ($name, $attr) = each %attrmap ) {
                my $field_name = $self->field_name($name);
                if(defined $f->{$field_name}) {
                        my $writer = $attr->get_write_method;
                        $self->$writer($f->{$field_name});
                        $hash->{ $name } = $f->{$field_name};
                }
        }
        warn "# set_from_hash ", $self->uuid," produced hash = ",dump( $hash ) if $hash;
        return $hash;
}

sub add_button {
  my ($self, $name, $callback) = @_;
  $self->callback->{$name} = $callback;
  push @{ $self->callback_order }, $name;
  warn "## callback_order = ",dump( $self->callback_order );
}

sub remove_button {
        my ( $self, $name ) = @_;
        delete( $self->callback->{$name} );
        my @new_order = grep { !/\Q$name\E/ } @{ $self->callback_order };
        warn "# remove_button $name new order = ",dump( @new_order );
        $self->callback_order( \@new_order );
}

sub render_buttons {
  my ($self) = @_;
  my $out = '';
  foreach my $name ( @{ $self->callback_order } ) {
    my $btn_name = $self->field_name($name);
    $out .= qq{
      <input type="submit" name="@{[$btn_name]}" value="$name">
    };
  }
  return $out;
}

sub exec_buttons {
  my ($self, $f) = @_;
  foreach my $name (keys %{$self->callback}) {
    my $btn_name = $self->field_name($name);
    if($f->{$btn_name}) {
      $self->callback->{$name}->($f);
    }
  }
}

sub main {
  my ($self) = @_;
  $self->renderer->{view} = \&render_view;
  $self->renderer->{edit} = \&render_edit;
  while(1) {
    my $out = $self->renderer->{ $self->render_as }->($self);
    my $f = $self->next($out);
    $self->set_from_hash($f);
    $self->exec_buttons($f);
  }
}

=head1 SEE ALSO

L<Continuity>, http://continuity.tlt42.org/

=head1 AUTHOR

awwaiid, E<lt>awwaiid@thelackthereof.orgE<gt>, L<http://thelackthereof.org/>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Brock Wilcox

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;

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			my ($self, $before, $iterator, $after) = @_;
46			my %attrmap = %{ $self->meta->get_attribute_map };
47			my $middle;
48			while( my ($name, $attr) = each %attrmap ) {
49			my $reader = $attr->get_read_method;
50			my $val = $self->$reader \|\| '';
51			my $field_name = $self->field_name($name);
52			$middle .= $iterator->( $name, $field_name, $attr->label, $val ) \|\| '';
53			}
54			if ( $middle ) {
55			return $before . $middle . $self->render_buttons . $after;
56			} else {
57			warn "iterator didn't produce output, skipping";
58			return "<!-- empty -->";
59			}
60			}
61
62
63	dpavlin	69	# This renders an input form. Need to make the renderer selection dynamic
64			sub render_edit {
65			my ($self) = @_;
66			my $out = '<div class="editform">';
67			my %attrmap = %{ $self->meta->get_attribute_map };
68			while( my ($name, $attr) = each %attrmap ) {
69	dpavlin	70	next if $name =~ /^_/;
70	dpavlin	69	my $reader = $attr->get_read_method;
71			my $val = $self->$reader \|\| '';
72			my $field_name = $self->field_name($name);
73			$out .= qq\|
74			<div class=fieldholder>
75			<div class=label> @{[$attr->label]} </div>
76			<div class=field>
77			<input type=text id="$field_name" name="$field_name" value="@{[$val]}">
78			</div>
79			</div>
80			\|;
81			}
82			$out .= $self->render_buttons;
83			$out .= '</div>';
84			return $out;
85			}
86
87			sub render_view {
88			my ($self) = @_;
89			my $out = '<div class="view">';
90			my %attrmap = %{ $self->meta->get_attribute_map };
91			while( my ($name, $attr) = each %attrmap ) {
92	dpavlin	70	#next if $name =~ /^_/;
93	dpavlin	69	my $reader = $attr->get_read_method;
94			my $val = $self->$reader \|\| '';
95			my $field_name = $self->field_name($name);
96			$out .= qq\|
97			<div class=fieldholder>
98			<div class=label> @{[$attr->label]} </div>
99			<div class=field>
100			@{[$val]}
101			</div>
102			</div>
103			\|;
104			}
105			$out .= $self->render_buttons;
106			$out .= '</div>';
107			return $out;
108			}
109
110			sub set_from_hash {
111	dpavlin	82	my ($self, $f) = @_;
112	dpavlin	70	my %attrmap = %{ $self->meta->get_attribute_map };
113			my $hash;
114			while( my ($name, $attr) = each %attrmap ) {
115			my $field_name = $self->field_name($name);
116			if(defined $f->{$field_name}) {
117			my $writer = $attr->get_write_method;
118			$self->$writer($f->{$field_name});
119			$hash->{ $name } = $f->{$field_name};
120			}
121			}
122	dpavlin	82	warn "# set_from_hash ", $self->uuid," produced hash = ",dump( $hash ) if $hash;
123			return $hash;
124	dpavlin	69	}
125
126			sub add_button {
127			my ($self, $name, $callback) = @_;
128			$self->callback->{$name} = $callback;
129	dpavlin	84	push @{ $self->callback_order }, $name;
130			warn "## callback_order = ",dump( $self->callback_order );
131	dpavlin	69	}
132
133	dpavlin	82	sub remove_button {
134			my ( $self, $name ) = @_;
135			delete( $self->callback->{$name} );
136	dpavlin	85	my @new_order = grep { !/\Q$name\E/ } @{ $self->callback_order };
137			warn "# remove_button $name new order = ",dump( @new_order );
138			$self->callback_order( \@new_order );
139	dpavlin	82	}
140
141	dpavlin	69	sub render_buttons {
142			my ($self) = @_;
143			my $out = '';
144	dpavlin	84	foreach my $name ( @{ $self->callback_order } ) {
145	dpavlin	69	my $btn_name = $self->field_name($name);
146			$out .= qq{
147			<input type="submit" name="@{[$btn_name]}" value="$name">
148			};
149			}
150			return $out;
151			}
152
153			sub exec_buttons {
154			my ($self, $f) = @_;
155			foreach my $name (keys %{$self->callback}) {
156			my $btn_name = $self->field_name($name);
157			if($f->{$btn_name}) {
158			$self->callback->{$name}->($f);
159			}
160			}
161			}
162
163			sub main {
164			my ($self) = @_;
165			$self->renderer->{view} = \&render_view;
166			$self->renderer->{edit} = \&render_edit;
167			while(1) {
168	dpavlin	73	my $out = $self->renderer->{ $self->render_as }->($self);
169	dpavlin	69	my $f = $self->next($out);
170			$self->set_from_hash($f);
171			$self->exec_buttons($f);
172			}
173			}
174
175			=head1 SEE ALSO
176
177			L<Continuity>, http://continuity.tlt42.org/
178
179			=head1 AUTHOR
180
181			awwaiid, E<lt>awwaiid@thelackthereof.orgE<gt>, L<http://thelackthereof.org/>
182
183			=head1 COPYRIGHT AND LICENSE
184
185			Copyright (C) 2008 by Brock Wilcox
186
187			This library is free software; you can redistribute it and/or modify
188			it under the same terms as Perl itself, either Perl version 5.10.0 or,
189			at your option, any later version of Perl 5 you may have available.
190
191			=cut
192
193			1;
194