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