1package Data::Object::Code; 2 3use 5.014; 4 5use strict; 6use warnings; 7use routines; 8 9use Carp (); 10use Scalar::Util (); 11 12use Role::Tiny::With; 13 14use parent 'Data::Object::Kind'; 15 16with 'Data::Object::Role::Dumpable'; 17with 'Data::Object::Role::Proxyable'; 18with 'Data::Object::Role::Throwable'; 19 20use overload ( 21 '""' => 'detract', 22 '~~' => 'detract', 23 '&{}' => 'self', 24 fallback => 1 25); 26 27our $VERSION = '2.05'; # VERSION 28 29# BUILD 30 31method new($data = sub{}) { 32 if (Scalar::Util::blessed($data)) { 33 $data = $data->detract if $data->can('detract'); 34 } 35 36 unless (ref($data) eq 'CODE') { 37 Carp::confess('Instantiation Error: Not a CodeRef'); 38 } 39 40 return bless $data, $self; 41} 42 43# PROXY 44 45method build_proxy($package, $method, @args) { 46 my $plugin = $self->plugin($method) or return undef; 47 48 return sub { 49 use Try::Tiny; 50 51 my $is_func = $plugin->package->can('mapping'); 52 53 try { 54 my $instance = $plugin->build($is_func ? ($self, @args) : [$self, @args]); 55 56 return $instance->execute; 57 } 58 catch { 59 my $error = $_; 60 my $class = $self->class; 61 my $arity = $is_func ? 'mapping' : 'argslist'; 62 my $message = ref($error) ? $error->{message} : "$error"; 63 my $signature = "${class}::${method}(@{[join(', ', $plugin->package->$arity)]})"; 64 65 Carp::confess("$signature: $error"); 66 }; 67 }; 68} 69 70# PLUGIN 71 72method plugin($name, @args) { 73 my $plugin; 74 75 my $space = $self->space; 76 77 return undef if !$name; 78 79 if ($plugin = eval { $space->child('plugin')->child($name)->load }) { 80 81 return undef unless $plugin->can('argslist'); 82 83 return $space->child('plugin')->child($name); 84 } 85 86 if ($plugin = $space->child('func')->child($name)->load) { 87 88 return undef unless $plugin->can('mapping'); 89 90 return $space->child('func')->child($name); 91 } 92 93 return undef; 94} 95 96# METHODS 97 98method self() { 99 100 return $self; 101} 102 1031; 104 105=encoding utf8 106 107=head1 NAME 108 109Data::Object::Code 110 111=cut 112 113=head1 ABSTRACT 114 115Code Class for Perl 5 116 117=cut 118 119=head1 SYNOPSIS 120 121 package main; 122 123 use Data::Object::Code; 124 125 my $code = Data::Object::Code->new(sub { $_[0] + 1 }); 126 127=cut 128 129=head1 DESCRIPTION 130 131This package provides methods for manipulating code data. 132 133=cut 134 135=head1 INHERITS 136 137This package inherits behaviors from: 138 139L<Data::Object::Kind> 140 141=cut 142 143=head1 INTEGRATES 144 145This package integrates behaviors from: 146 147L<Data::Object::Role::Dumpable> 148 149L<Data::Object::Role::Proxyable> 150 151L<Data::Object::Role::Throwable> 152 153=cut 154 155=head1 LIBRARIES 156 157This package uses type constraints from: 158 159L<Data::Object::Types> 160 161=cut 162 163=head1 METHODS 164 165This package implements the following methods: 166 167=cut 168 169=head2 call 170 171 call(Any $arg1) : Any 172 173The call method executes and returns the result of the code. 174 175=over 4 176 177=item call example #1 178 179 my $code = Data::Object::Code->new(sub { ($_[0] // 0) + 1 }); 180 181 $code->call; # 1 182 183=back 184 185=over 4 186 187=item call example #2 188 189 my $code = Data::Object::Code->new(sub { ($_[0] // 0) + 1 }); 190 191 $code->call(0); # 1 192 193=back 194 195=over 4 196 197=item call example #3 198 199 my $code = Data::Object::Code->new(sub { ($_[0] // 0) + 1 }); 200 201 $code->call(1); # 2 202 203=back 204 205=over 4 206 207=item call example #4 208 209 my $code = Data::Object::Code->new(sub { ($_[0] // 0) + 1 }); 210 211 $code->call(2); # 3 212 213=back 214 215=cut 216 217=head2 compose 218 219 compose(CodeRef $arg1, Any $arg2) : CodeLike 220 221The compose method creates a code reference which executes the first argument 222(another code reference) using the result from executing the code as it's 223argument, and returns a code reference which executes the created code 224reference passing it the remaining arguments when executed. 225 226=over 4 227 228=item compose example #1 229 230 my $code = Data::Object::Code->new(sub { [@_] }); 231 232 $code->compose($code, 1,2,3); 233 234 # $code->(4,5,6); # [[1,2,3,4,5,6]] 235 236=back 237 238=cut 239 240=head2 conjoin 241 242 conjoin(CodeRef $arg1) : CodeLike 243 244The conjoin method creates a code reference which execute the code and the 245argument in a logical AND operation having the code as the lvalue and the 246argument as the rvalue. 247 248=over 4 249 250=item conjoin example #1 251 252 my $code = Data::Object::Code->new(sub { $_[0] % 2 }); 253 254 $code = $code->conjoin(sub { 1 }); 255 256 # $code->(0); # 0 257 # $code->(1); # 1 258 # $code->(2); # 0 259 # $code->(3); # 1 260 # $code->(4); # 0 261 262=back 263 264=cut 265 266=head2 curry 267 268 curry(CodeRef $arg1) : CodeLike 269 270The curry method returns a code reference which executes the code passing it 271the arguments and any additional parameters when executed. 272 273=over 4 274 275=item curry example #1 276 277 my $code = Data::Object::Code->new(sub { [@_] }); 278 279 $code = $code->curry(1,2,3); 280 281 # $code->(4,5,6); # [1,2,3,4,5,6] 282 283=back 284 285=cut 286 287=head2 defined 288 289 defined() : Num 290 291The defined method returns true if the object represents a value that meets the 292criteria for being defined, otherwise it returns false. 293 294=over 4 295 296=item defined example #1 297 298 my $code = Data::Object::Code->new; 299 300 $code->defined; # 1 301 302=back 303 304=cut 305 306=head2 disjoin 307 308 disjoin(CodeRef $arg1) : CodeRef 309 310The disjoin method creates a code reference which execute the code and the 311argument in a logical OR operation having the code as the lvalue and the 312argument as the rvalue. 313 314=over 4 315 316=item disjoin example #1 317 318 my $code = Data::Object::Code->new(sub { $_[0] % 2 }); 319 320 $code = $code->disjoin(sub { -1 }); 321 322 # $code->(0); # -1 323 # $code->(1); # 1 324 # $code->(2); # -1 325 # $code->(3); # 1 326 # $code->(4); # -1 327 328=back 329 330=cut 331 332=head2 next 333 334 next(Any $arg1) : Any 335 336The next method is an alias to the call method. The naming is especially useful 337(i.e. helps with readability) when used with closure-based iterators. 338 339=over 4 340 341=item next example #1 342 343 my $code = Data::Object::Code->new(sub { $_[0] * 2 }); 344 345 $code->next(72); # 144 346 347=back 348 349=cut 350 351=head2 rcurry 352 353 rcurry(Any $arg1) : CodeLike 354 355The rcurry method returns a code reference which executes the code passing it 356the any additional parameters and any arguments when executed. 357 358=over 4 359 360=item rcurry example #1 361 362 my $code = Data::Object::Code->new(sub { [@_] }); 363 364 $code = $code->rcurry(1,2,3); 365 366 # $code->(4,5,6); # [4,5,6,1,2,3] 367 368=back 369 370=cut 371 372=head1 AUTHOR 373 374Al Newkirk, C<awncorp@cpan.org> 375 376=head1 LICENSE 377 378Copyright (C) 2011-2019, Al Newkirk, et al. 379 380This is free software; you can redistribute it and/or modify it under the terms 381of the The Apache License, Version 2.0, as elucidated in the L<"license 382file"|https://github.com/iamalnewkirk/data-object/blob/master/LICENSE>. 383 384=head1 PROJECT 385 386L<Wiki|https://github.com/iamalnewkirk/data-object/wiki> 387 388L<Project|https://github.com/iamalnewkirk/data-object> 389 390L<Initiatives|https://github.com/iamalnewkirk/data-object/projects> 391 392L<Milestones|https://github.com/iamalnewkirk/data-object/milestones> 393 394L<Contributing|https://github.com/iamalnewkirk/data-object/blob/master/CONTRIBUTE.md> 395 396L<Issues|https://github.com/iamalnewkirk/data-object/issues> 397 398=cut 399