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 - Create a new widget class
 136
 137 =head1 DESCRIPTION
 138
 139 Turns the importing package into a widget class. It will export:
 140
 141 =over 4
 142
 143 =item All of L<Moose>
 144
 145 =item All of L<Reaction::Class>
 146
 147 =item L<strict> and L<warnings>
 148
 149 =item See L</EXPORTS> for this package's own exports
 150
 151 =back
 152
 153 It will also set the value of C<default_base> as new superclass. The default is
 154 C<Reaction::UI::Widget>.
 155
 156 =head1 EXPORTS
 157
 158 =head2 over
 159
 160   over $collection
 161
 162 Used in combination with L</render> to render a fragment for a series of values:
 163
 164   render fragment_name => over [1, 2, 3];
 165
 166 =head2 render
 167
 168   render $fragment_name;
 169   render $fragment_name, $over;
 170
 171 With only the fragment name as argument, it renders that fragment. If an C<$over>
 172 collection is specified with the L</over> keyword, the fragment is rendered once
 173 for every value in the collection. The value will be accessible in the topic
 174 argument C<_>.
 175
 176 =head2 arg
 177
 178   arg $arg_name, $arg_value;
 179
 180 Sets the fragment argument C<$arg_name> to C<$arg_value>;
 181
 182 =head2 localized
 183
 184   localize $value;
 185
 186 Calls the view's C<localize> method to localize the passed value.
 187
 188 =head2 call_next
 189
 190   call_next;
 191
 192 Calls the parent fragment.
 193
 194 =head2 event_id
 195
 196   event_id $event_name;
 197
 198 Fetches the event id for the event C<$event_name> from the viewport via its C<event_id_for>
 199 method.
 200
 201 =head2 event_uri
 202
 203   event_uri \%events;
 204
 205 Returns an L<URI> object with the event ids corresponding to the keys in the C<%events>
 206 argument and the values being the values of the hash reference.
 207
 208 =head2 attrs
 209
 210   attrs \%attrs;
 211
 212 Builds a string of rendered element attributes out of the C<%attrs> hash reference argument.
 213
 214 =head2 implements
 215
 216   implements fragment foo { ... };
 217   implements bar => sub { ... };
 218
 219 Implements a method or a fragment in the widget class.
 220
 221 =head2 fragment
 222
 223   fragment foo { ... };
 224
 225 Creates a new fragment named C<foo> with a implementation in the block.
 226
 227 =head1 AUTHORS
 228
 229 See L<Reaction::Class> for authors.
 230
 231 =head1 LICENSE
 232
 233 See L<Reaction::Class> for the license.
 234
 235 =cut