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 use namespace::clean -except => [ qw(meta) ];
  13
  14
  15 # for local() for fragment wrap
  16 our ($next_call, $fragment_args, $current_widget, $do_render, $new_args);
  17
  18 after 'do_import' => sub {
  19   my ($self, $package) = @_;
  20   Devel::Declare->install_declarator(
  21     $package, 'fragment', DECLARE_NAME,
  22     sub { },
  23     sub {
  24       WidgetClass->handle_fragment(@_);
  25     }
  26   );
  27 };
  28
  29 after 'setup_and_cleanup' => sub {
  30   my ($self, $package) = @_;
  31   {
  32     no strict 'refs';
  33     delete ${"${package}::"}{'fragment'};
  34   }
  35   #Devel::Declare->teardown_for($package);
  36 };
  37 override 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     attrs => sub {
  82       my ($attrs) = @_;
  83       return join(' ', map {
  84         my $text = $attrs->{$_};
  85         for ($text) {
  86             s/&/&amp;/g;
  87             s/</&lt;/g;
  88             s/>/&gt;/g;
  89             s/"/&quot;/g;
  90         }
  91         qq{$_="${text}"};
  92       } keys %$attrs);
  93     },
  94   );
  95 };
  96 override default_base => sub { ('Reaction::UI::Widget') };
  97 sub handle_fragment {
  98   my ($self, $name, $proto, $code) = @_;
  99 #warn ($self, $name, $code);
 100   return ("_fragment_${name}" => $self->wrap_as_fragment($code));
 101 };
 102 sub wrap_as_fragment {
 103   my ($self, $code) = @_;
 104   return sub {
 105     local $next_call;
 106     if (ref $_[0] eq 'CODE') { # inside 'around' modifier
 107       $next_call = shift;
 108     }
 109     local $fragment_args = \@_;
 110
 111     # $self->$method($do_render, \%_, $new_args)
 112     local $current_widget = $_[0];
 113     local $do_render = $_[1];
 114     local *_ = \%{$_[2]};
 115     local $_ = $_[2]->{_};
 116     local $new_args = $_[3];
 117     $code->(@_);
 118   };
 119 };
 120
 121 __PACKAGE__->meta->make_immutable;
 122
 123
 124 1;
 125
 126 =head1 NAME
 127
 128 Reaction::UI::WidgetClass
 129
 130 =head1 DESCRIPTION
 131
 132 =head1 AUTHORS
 133
 134 See L<Reaction::Class> for authors.
 135
 136 =head1 LICENSE
 137
 138 See L<Reaction::Class> for the license.
 139
 140 =cut