lib/Scope/Context.pm

   1 package Scope::Context;
   2
   3 use 5.006;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Carp         ();
   9 use Scalar::Util ();
  10
  11 use Scope::Upper 0.21 ();
  12
  13 =head1 NAME
  14
  15 Scope::Context - Object-oriented interface for inspecting or acting upon upper scope frames.
  16
  17 =head1 VERSION
  18
  19 Version 0.01
  20
  21 =cut
  22
  23 our $VERSION = '0.01';
  24
  25 =head1 SYNOPSIS
  26
  27     use Scope::Context;
  28
  29     for (1 .. 5) {
  30      sub {
  31       eval {
  32        # Create Scope::Context objects for different upper frames.
  33        my ($block, $sub, $eval, $loop);
  34        {
  35         $block = Scope::Context->new;
  36         $sub   = $block->sub;    # = $block->up
  37         $eval  = $block->eval;   # = $block->up(2)
  38         $loop  = $eval->up;      # = $block->up(3)
  39        }
  40
  41        eval {
  42         # This will throw an exception, since $block has expired.
  43         $block->localize('$x' => 1);
  44        };
  45
  46        # This prints "hello" when the eval block above ends.
  47        $eval->reap(sub { print "hello\n" });
  48
  49        # Ignore $SIG{__DIE__} just for the loop body.
  50        $loop->localize_delete('%SIG', '__DIE__');
  51
  52        # Execute the callback as if it ran in place of the sub.
  53        my @values = $sub->uplevel(sub {
  54         return @_, 2;
  55        }, 1);
  56
  57        # Immediately return (1, 2, 3) from the sub, bypassing the eval.
  58        $sub->unwind(@values, 3);
  59
  60        # Not reached.
  61       }
  62
  63       # Not reached.
  64      }->();
  65
  66      # unwind() returns here. "hello\n" was printed, and now
  67      # $SIG{__DIE__} is undefined.
  68     }
  69
  70 =head1 DESCRIPTION
  71
  72 This class provides an object-oriented interface to L<Scope::Upper>'s functionalities.
  73 A L<Scope::Context> object represents a currently active dynamic scope (or context), and encapsulates the corresponding L<Scope::Upper>-compatible context identifier.
  74 All of L<Scope::Upper>'s functions are then made available as methods.
  75 This gives you a prettier and safer interface when you are not reaching for extreme performance, but rest assured that the overhead of this module is minimal anyway.
  76
  77 The L<Scope::Context> methods actually do more than their subroutine counterparts from L<Scope::Upper> : before each call, the target context will be checked to ensure it is still active (which means that it is still present in the current call stack), and an exception will be thrown if you attempt to act on a context that has already expired.
  78 This means that :
  79
  80     my $cxt;
  81     {
  82      $cxt = Scope::Context->new;
  83     }
  84     $cxt->reap(sub { print "hello\n });
  85
  86 will croak when L</reap> is called.
  87
  88 =head1 METHODS
  89
  90 =head2 C<new>
  91
  92     my $cxt = Scope::Context->new;
  93     my $cxt = Scope::Context->new($scope_upper_cxt);
  94
  95 Creates a new immutable L<Scope::Context> object from the L<Scope::Upper>-comptabile context identifier C<$context>.
  96 If omitted, C<$context> defaults to the current context.
  97
  98 =cut
  99
 100 sub new {
 101  my ($self, $cxt) = @_;
 102
 103  my $class = Scalar::Util::blessed($self);
 104  unless (defined $class) {
 105   $class = defined $self ? $self : __PACKAGE__;
 106  }
 107
 108  $cxt = Scope::Upper::UP() unless defined $cxt;
 109
 110  bless {
 111   cxt => $cxt,
 112   uid => Scope::Upper::uid($cxt),
 113  }, $class;
 114 }
 115
 116 =head2 C<here>
 117
 118 A synonym for L</new>.
 119
 120 =cut
 121
 122 BEGIN {
 123  *here = \&new;
 124 }
 125
 126 sub _croak {
 127  shift;
 128  require Carp;
 129  Carp::croak(@_);
 130 }
 131
 132 =head2 C<cxt>
 133
 134     my $scope_upper_cxt = $cxt->cxt;
 135
 136 Read-only accessor to the L<Scope::Upper> context identifier associated with the invocant.
 137
 138 =head2 C<uid>
 139
 140     my $uid = $cxt->uid;
 141
 142 Read-only accessor to the L<Scope::Upper> unique identifier representing the L<Scope::Upper> context associated with the invocant.
 143
 144 =cut
 145
 146 BEGIN {
 147  local $@;
 148  eval "sub $_ { \$_[0]->{$_} }; 1" or die $@ for qw<cxt uid>;
 149 }
 150
 151 =pod
 152
 153 This class also overloads the C<==> operator, which will return true if and only if its two operands are L<Scope::Context> objects that have the same UID.
 154
 155 =cut
 156
 157 use overload (
 158  '==' => sub {
 159   my ($left, $right) = @_;
 160
 161   unless (Scalar::Util::blessed($right) and $right->isa(__PACKAGE__)) {
 162    $left->_croak('Cannot compare a Scope::Context object with something else');
 163   }
 164
 165   $left->uid eq $right->uid;
 166  },
 167  fallback => 1,
 168 );
 169
 170 =head2 C<is_valid>
 171
 172     my $is_valid = $cxt->is_valid;
 173
 174 Returns true if and only if the invocant is still valid (that is, it designates a scope that is higher on the call stack than the current scope).
 175
 176 =cut
 177
 178 sub is_valid { Scope::Upper::validate_uid($_[0]->uid) }
 179
 180 =head2 C<assert_valid>
 181
 182     $cxt->assert_valid;
 183
 184 Throws an exception if the invocant has expired and is no longer valid.
 185 Returns true otherwise.
 186
 187 =cut
 188
 189 sub assert_valid {
 190  my $self = shift;
 191
 192  $self->_croak('Context has expired') unless $self->is_valid;
 193
 194  1;
 195 }
 196
 197 =head2 C<want>
 198
 199     my $want = $cxt->want;
 200
 201 Returns the Perl context (in the sense of C<wantarray> : C<undef> for void context, C<''> for scalar context, and true for list context) in which is executed the scope pointed by the invocant.
 202
 203 =cut
 204
 205 sub want {
 206  my $self = shift;
 207
 208  $self->assert_valid;
 209
 210  Scope::Upper::want_at($self->cxt);
 211 }
 212
 213 =head2 C<up>
 214
 215     my $up_cxt = $cxt->up;
 216     my $up_cxt = $cxt->up($frames);
 217     my $up_cxt = Scope::Context->up;
 218
 219 Returns a new L<Scope::Context> object pointing to the C<$frames>-th upper scope above the scope pointed by the invocant.
 220
 221 This method can also be invoked as a class method, in which case it is equivalent to calling L</up> on a L<Scope::Context> object representing the current context.
 222
 223 If omitted, C<$frames> defaults to C<1>.
 224
 225     sub {
 226      {
 227       {
 228        my $up = Scope::Context->new->up(2); # = Scope::Context->up(2)
 229        # $up points two contextes above this one, which is the sub.
 230       }
 231      }
 232     }
 233
 234 =cut
 235
 236 sub up {
 237  my ($self, $frames) = @_;
 238
 239  my $cxt;
 240  if (Scalar::Util::blessed($self)) {
 241   $self->assert_valid;
 242   $cxt = $self->cxt;
 243  } else {
 244   $cxt = Scope::Upper::UP(Scope::Upper::SUB());
 245  }
 246
 247  $frames = 1 unless defined $frames;
 248
 249  $cxt = Scope::Upper::UP($cxt) for 1 .. $frames;
 250
 251  $self->new($cxt);
 252 }
 253
 254 =head2 C<sub>
 255
 256     my $sub_cxt = $cxt->sub;
 257     my $sub_cxt = $cxt->sub($frames);
 258     my $sub_cxt = Scope::Context->sub;
 259
 260 Returns a new L<Scope::Context> object pointing to the C<$frames>-th subroutine scope above the scope pointed by the invocant.
 261
 262 This method can also be invoked as a class method, in which case it is equivalent to calling L</sub> on a L<Scope::Context> object for the current context.
 263
 264 If omitted, C<$frames> defaults to C<0>, which results in the closest sub enclosing the scope pointed by the invocant.
 265
 266     outer();
 267
 268     sub outer {
 269      inner();
 270     }
 271
 272     sub inner {
 273      my $sub = Scope::Context->new->sub(1); # = Scope::Context->sub(1)
 274      # $sub points to the context for the outer() sub.
 275     }
 276
 277 =cut
 278
 279 sub sub {
 280  my ($self, $frames) = @_;
 281
 282  my $cxt;
 283  if (Scalar::Util::blessed($self)) {
 284   $self->assert_valid;
 285   $cxt = $self->cxt;
 286  } else {
 287   $cxt = Scope::Upper::UP(Scope::Upper::SUB());
 288  }
 289
 290  $frames = 0 unless defined $frames;
 291
 292  $cxt = Scope::Upper::SUB($cxt);
 293  $cxt = Scope::Upper::SUB(Scope::Upper::UP($cxt)) for 1 .. $frames;
 294
 295  $self->new($cxt);
 296 }
 297
 298 =head2 C<eval>
 299
 300     my $eval_cxt = $cxt->eval;
 301     my $eval_cxt = $cxt->eval($frames);
 302     my $eval_cxt = Scope::Context->eval;
 303
 304 Returns a new L<Scope::Context> object pointing to the C<$frames>-th C<eval> scope above the scope pointed by the invocant.
 305
 306 This method can also be invoked as a class method, in which case it is equivalent to calling L</eval> on a L<Scope::Context> object for the current context.
 307
 308 If omitted, C<$frames> defaults to C<0>, which results in the closest eval enclosing the scope pointed by the invocant.
 309
 310     eval {
 311      sub {
 312       my $eval = Scope::Context->new->eval; # = Scope::Context->eval
 313       # $eval points to the eval context.
 314      }->()
 315     }
 316
 317 =cut
 318
 319 sub eval {
 320  my ($self, $frames) = @_;
 321
 322  my $cxt;
 323  if (Scalar::Util::blessed($self)) {
 324   $self->assert_valid;
 325   $cxt = $self->cxt;
 326  } else {
 327   $cxt = Scope::Upper::UP(Scope::Upper::SUB());
 328  }
 329
 330  $frames = 0 unless defined $frames;
 331
 332  $cxt = Scope::Upper::EVAL($cxt);
 333  $cxt = Scope::Upper::EVAL(Scope::Upper::UP($cxt)) for 1 .. $frames;
 334
 335  $self->new($cxt);
 336 }
 337
 338 =head2 C<reap>
 339
 340     $cxt->reap($code);
 341
 342 Execute C<$code> when the scope pointed by the invocant ends.
 343
 344 See L<Scope::Upper/reap> for details.
 345
 346 =cut
 347
 348 sub reap {
 349  my ($self, $code) = @_;
 350
 351  $self->assert_valid;
 352
 353  &Scope::Upper::reap($code, $self->cxt);
 354 }
 355
 356 =head2 C<localize>
 357
 358     $cxt->localize($what, $value);
 359
 360 Localize the variable described by C<$what> to the value C<$value> when the control flow returns to the scope pointed by the invocant.
 361
 362 See L<Scope::Upper/localize> for details.
 363
 364 =cut
 365
 366 sub localize {
 367  my ($self, $what, $value) = @_;
 368
 369  $self->assert_valid;
 370
 371  Scope::Upper::localize($what, $value, $self->cxt);
 372 }
 373
 374 =head2 C<localize_elem>
 375
 376     $cxt->localize_elem($what, $key, $value);
 377
 378 Localize the element C<$key> of the variable C<$what> to the value C<$value> when the control flow returns to the scope pointed by the invocant.
 379
 380 See L<Scope::Upper/localize_elem> for details.
 381
 382 =cut
 383
 384 sub localize_elem {
 385  my ($self, $what, $key, $value) = @_;
 386
 387  $self->assert_valid;
 388
 389  Scope::Upper::localize_elem($what, $key, $value, $self->cxt);
 390 }
 391
 392 =head2 C<localize_delete>
 393
 394     $cxt->localize_delete($what, $key);
 395
 396 Delete the element C<$key> from the variable C<$what> when the control flow returns to the scope pointed by the invocant.
 397
 398 See L<Scope::Upper/localize_delete> for details.
 399
 400 =cut
 401
 402 sub localize_delete {
 403  my ($self, $what, $key) = @_;
 404
 405  $self->assert_valid;
 406
 407  Scope::Upper::localize_delete($what, $key, $self->cxt);
 408 }
 409
 410 =head2 C<unwind>
 411
 412     $cxt->unwind(@values);
 413
 414 Immediately returns the scalars listed in C<@values> from the closest subroutine enclosing the scope pointed by the invocant.
 415
 416 See L<Scope::Upper/unwind> for details.
 417
 418 =cut
 419
 420 sub unwind {
 421  my $self = shift;
 422
 423  $self->assert_valid;
 424
 425  Scope::Upper::unwind(@_ => $self->cxt);
 426 }
 427
 428 =head2 C<yield>
 429
 430     $cxt->yield(@values);
 431
 432 Immediately returns the scalars listed in C<@values> from the scope pointed by the invocant, whatever it may be (except a substitution eval context).
 433
 434 See L<Scope::Upper/yield> for details.
 435
 436 =cut
 437
 438 sub yield {
 439  my $self = shift;
 440
 441  $self->assert_valid;
 442
 443  Scope::Upper::yield(@_ => $self->cxt);
 444 }
 445
 446 =head2 C<uplevel>
 447
 448     my @ret = $cxt->uplevel($code, @args);
 449
 450 Executes the code reference C<$code> with arguments C<@args> in the same setting as the closest subroutine enclosing the scope pointed by the invocant, then returns to the current scope the values returned by C<$code>.
 451
 452 See L<Scope::Upper/uplevel> for details.
 453
 454 =cut
 455
 456 sub uplevel {
 457  my $self = shift;
 458  my $code = shift;
 459
 460  $self->assert_valid;
 461
 462  &Scope::Upper::uplevel($code => @_ => $self->cxt);
 463 }
 464
 465 =head1 DEPENDENCIES
 466
 467 L<Carp> (core module since perl 5), L<Scalar::Util> (since 5.7.3).
 468
 469 L<Scope::Upper> 0.21.
 470
 471 =head1 SEE ALSO
 472
 473 L<Scope::Upper>.
 474
 475 L<Continuation::Escape>.
 476
 477 =head1 AUTHOR
 478
 479 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 480
 481 You can contact me by mail or on C<irc.perl.org> (vincent).
 482
 483 =head1 BUGS
 484
 485 Please report any bugs or feature requests to C<bug-scope-context at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Scope-Context>.
 486 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 487
 488 =head1 SUPPORT
 489
 490 You can find documentation for this module with the perldoc command.
 491
 492     perldoc Scope::Context
 493
 494 =head1 COPYRIGHT & LICENSE
 495
 496 Copyright 2011,2012,2013 Vincent Pit, all rights reserved.
 497
 498 This program is free software; you can redistribute it and/or modify it
 499 under the same terms as Perl itself.
 500
 501 =cut
 502
 503 1; # End of Scope::Context