/[Frey]/trunk/lib/Frey/Web/Button.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

Diff of /trunk/lib/Frey/Web/Button.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 96 by dpavlin, Fri Jul 11 12:47:50 2008 UTC revision 141 by dpavlin, Wed Jul 16 14:12:43 2008 UTC
# Line 8  Frey::Web::Button - render buttons with Line 8  Frey::Web::Button - render buttons with
8    
9  =head1 SYNOPSIS  =head1 SYNOPSIS
10    
11    extends 'Frey::Web::Button';    with 'Frey::Web::Button';
12    
13  =head1 DESCRIPTION  =head1 DESCRIPTION
14    
# Line 17  Don't quite know what this will be yet. Line 17  Don't quite know what this will be yet.
17  =cut  =cut
18    
19  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
20  use Data::UUID;  use Moose::Role;
 use Moose;  
 with 'Frey::Web::Coro';  
21    
22  # List of callbacks, buttons for now  # List of callbacks, buttons for now
23  has callback => ( is => 'rw', default => sub {{}} );  has callback => ( is => 'rw', isa => 'HashRef', default => sub {{}} );
24  has callback_order => ( is => 'rw', isa => 'ArrayRef', default => sub { [] });  has callback_order => ( is => 'rw', isa => 'ArrayRef', default => sub { [] });
25    
 has 'uuid'   => (  
   is      => 'ro',  
   isa     => 'Str',  
   default => sub { Data::UUID->new->create_str }  
 );  
   
 # Given a name generate a unique field ID  
 sub field_name {  
   my ($self, $name) = @_;  
   return $self->uuid . '-' . $name;  
 }  
   
 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;  
 }  
   
26  sub add_button {  sub add_button {
27    my ($self, $name, $callback) = @_;          my ($self, $name, $callback) = @_;
28    $self->callback->{$name} = $callback;          $self->callback->{$name} = $callback;
29    push @{ $self->callback_order }, $name;          push @{ $self->callback_order }, $name;
30    warn "## callback_order = ",dump( $self->callback_order );          warn "## callback_order = ",dump( $self->callback_order ) if $self->debug;
31  }  }
32    
33  sub remove_button {  sub remove_button {
34          my ( $self, $name ) = @_;          my ( $self, $name ) = @_;
35          delete( $self->callback->{$name} );          delete( $self->callback->{$name} );
36          my @order = grep { !/^\Q$name\E$/ } @{ $self->callback_order };          my @order = grep { !/^\Q$name\E$/ } @{ $self->callback_order };
37          warn "# remove_button $name order = ",dump( @order );          warn "# remove_button $name order = ",dump( @order ) if $self->debug;
38          $self->callback_order( \@order );          $self->callback_order( \@order );
39  }  }
40    
# Line 72  sub rename_button { Line 42  sub rename_button {
42          my ( $self, $from, $to ) = @_;          my ( $self, $from, $to ) = @_;
43          $self->callback->{$to} = delete( $self->callback->{$from} );          $self->callback->{$to} = delete( $self->callback->{$from} );
44          my @order = ( map { s/^\Q$from\E$/$to/; $_ } @{ $self->callback_order } );          my @order = ( map { s/^\Q$from\E$/$to/; $_ } @{ $self->callback_order } );
45          warn "# rename_button $from => $to order = ",dump( @order );          warn "# rename_button $from => $to order = ",dump( @order ) if $self->debug;
46          $self->callback_order( \@order );          $self->callback_order( \@order );
47  }  }
48    
49  sub render_buttons {  sub render_callbacks {
50    my ($self) = @_;          my ($self) = @_;
51    my $out = '';          my $out = '';
52    foreach my $name ( @{ $self->callback_order } ) {          foreach my $name ( @{ $self->callback_order } ) {
53      my $btn_name = $self->field_name($name);                  my $btn_name = $self->field_name($name);
54      $out .= qq{                  $out .= qq|<input type="submit" name="@{[$btn_name]}" value="$name">|;
55        <input type="submit" name="@{[$btn_name]}" value="$name">          }
56      };          return $out;
   }  
   return $out;  
57  }  }
58    
59  sub exec_buttons {  sub exec_callbacks {
60    my ($self, $f) = @_;          my ($self, $f) = @_;
61    foreach my $name (keys %{$self->callback}) {          foreach my $name (keys %{$self->callback}) {
62      my $btn_name = $self->field_name($name);                  my $btn_name = $self->field_name($name);
63      if($f->{$btn_name}) {                  if($f->{$btn_name}) {
64        $self->callback->{$name}->($f);                          $self->callback->{$name}->($f);
65      }                  }
66    }          }
67  }  }
68    
69  =head1 SEE ALSO  =head1 SEE ALSO
Legend:
Removed from v.96  
changed lines
  Added in v.141
  ViewVC Help
Powered by ViewVC 1.1.26