lib/Reaction/UI/WidgetClass.pm

   1 package Reaction::UI::WidgetClass;
   2
   3 use Reaction::ClassExporter;
   4 use Reaction::Class;
   5 use Reaction::UI::Widget;
   6 use Data::Dumper;
   7 use Devel::Declare;
   8 use aliased 'Reaction::UI::WidgetClass::_OVER';
   9
  10 no warnings 'once';
  11
  12 class WidgetClass, which {
  13
  14   # for local() for fragment wrap
  15   our ($next_call, $fragment_args, $current_widget, $do_render, $new_args);
  16
  17   after 'do_import' => sub {
  18     my ($self, $package) = @_;
  19     Devel::Declare->install_declarator(
  20       $package, 'fragment', DECLARE_NAME,
  21       sub { },
  22       sub {
  23         WidgetClass->handle_fragment(@_);
  24       }
  25     );
  26   };
  27
  28   after 'setup_and_cleanup' => sub {
  29     my ($self, $package) = @_;
  30     {
  31       no strict 'refs';
  32       delete ${"${package}::"}{'fragment'};
  33     }
  34     #Devel::Declare->teardown_for($package);
  35   };
  36
  37   overrides exports_for_package => sub {
  38     my ($self, $package) = @_;
  39     return (super(),
  40       over => sub {
  41         my ($collection) = @_;
  42         confess "too many args, should be: over \$collection" if @_ > 1;
  43         _OVER->new(collection => $collection);
  44       },
  45       render => sub {
  46         my ($name, $over) = @_;
  47
  48         my $sig = "should be: render 'name' or render 'name' => over \$coll";
  49         if (!defined $name) { confess "name undefined: $sig"; }
  50         if (ref $name) { confess "name not string: $sig"; }
  51         if (defined $over && !(blessed($over) && $over->isa(_OVER))) {
  52           confess "invalid args after name, $sig";
  53         }
  54         $do_render->($package, $current_widget, $name, $over);
  55       },
  56       arg => sub {
  57         my ($name, $value) = @_;
  58
  59         my $sig = "should be: arg 'name' => \$value";
  60         if (@_ < 2) { confess "Not enough arguments, $sig"; }
  61         if (!defined $name) { confess "name undefined, $sig"; }
  62         if (ref $name) { confess "name is not a string, $sig"; }
  63
  64         $new_args->{$name} = $value;
  65       },
  66       call_next => sub {
  67         confess "args passed, should be just call_next; or call_next();"
  68           if @_;
  69         $next_call->(@$fragment_args);
  70       },
  71       event_id => sub {
  72         my ($name) = @_;
  73         $_{viewport}->event_id_for($name);
  74       },
  75       event_uri => sub {
  76         my ($events) = @_;
  77         my $vp = $_{viewport};
  78         my %args = map{ $vp->event_id_for($_) => $events->{$_} } keys %$events;
  79         $vp->ctx->req->uri_with(\%args);
  80       },
  81     );
  82   };
  83
  84   overrides default_base => sub { ('Reaction::UI::Widget') };
  85
  86   implements handle_fragment => as {
  87     my ($self, $name, $proto, $code) = @_;
  88 #warn ($self, $name, $code);
  89     return ("_fragment_${name}" => $self->wrap_as_fragment($code));
  90   };
  91
  92   implements wrap_as_fragment => as {
  93     my ($self, $code) = @_;
  94     return sub {
  95       local $next_call;
  96       if (ref $_[0] eq 'CODE') { # inside 'around' modifier
  97         $next_call = shift;
  98       }
  99       local $fragment_args = \@_;
 100
 101       # $self->$method($do_render, \%_, $new_args)
 102       local $current_widget = $_[0];
 103       local $do_render = $_[1];
 104       local *_ = \%{$_[2]};
 105       local $_ = $_[2]->{_};
 106       local $new_args = $_[3];
 107       $code->(@_);
 108     };
 109   };
 110
 111 };
 112
 113 1;
 114
 115 =head1 NAME
 116
 117 Reaction::UI::WidgetClass
 118
 119 =head1 DESCRIPTION
 120
 121 =head1 AUTHORS
 122
 123 See L<Reaction::Class> for authors.
 124
 125 =head1 LICENSE
 126
 127 See L<Reaction::Class> for the license.
 128
 129 =cut