1package Test2::API::Context; 2use strict; 3use warnings; 4 5our $VERSION = '1.302133'; 6 7 8use Carp qw/confess croak/; 9use Scalar::Util qw/weaken blessed/; 10use Test2::Util qw/get_tid try pkg_to_file get_tid/; 11 12use Test2::EventFacet::Trace(); 13use Test2::API(); 14 15# Preload some key event types 16my %LOADED = ( 17 map { 18 my $pkg = "Test2::Event::$_"; 19 my $file = "Test2/Event/$_.pm"; 20 require $file unless $INC{$file}; 21 ( $pkg => $pkg, $_ => $pkg ) 22 } qw/Ok Diag Note Plan Bail Exception Waiting Skip Subtest Pass Fail V2/ 23); 24 25use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/; 26use Test2::Util::HashBase qw{ 27 stack hub trace _on_release _depth _is_canon _is_spawn _aborted 28 errno eval_error child_error thrown 29}; 30 31# Private, not package vars 32# It is safe to cache these. 33my $ON_RELEASE = Test2::API::_context_release_callbacks_ref(); 34my $CONTEXTS = Test2::API::_contexts_ref(); 35 36sub init { 37 my $self = shift; 38 39 confess "The 'trace' attribute is required" 40 unless $self->{+TRACE}; 41 42 confess "The 'hub' attribute is required" 43 unless $self->{+HUB}; 44 45 $self->{+_DEPTH} = 0 unless defined $self->{+_DEPTH}; 46 47 $self->{+ERRNO} = $! unless exists $self->{+ERRNO}; 48 $self->{+EVAL_ERROR} = $@ unless exists $self->{+EVAL_ERROR}; 49 $self->{+CHILD_ERROR} = $? unless exists $self->{+CHILD_ERROR}; 50} 51 52sub snapshot { bless {%{$_[0]}, _is_canon => undef, _is_spawn => undef, _aborted => undef}, __PACKAGE__ } 53 54sub restore_error_vars { 55 my $self = shift; 56 ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR}; 57} 58 59sub DESTROY { 60 return unless $_[0]->{+_IS_CANON} || $_[0]->{+_IS_SPAWN}; 61 return if $_[0]->{+_ABORTED} && ${$_[0]->{+_ABORTED}}; 62 my ($self) = @_; 63 64 my $hub = $self->{+HUB}; 65 my $hid = $hub->{hid}; 66 67 # Do not show the warning if it looks like an exception has been thrown, or 68 # if the context is not local to this process or thread. 69 { 70 # Sometimes $@ is uninitialized, not a problem in this case so do not 71 # show the warning about using eq. 72 no warnings 'uninitialized'; 73 if($self->{+EVAL_ERROR} eq $@ && $hub->is_local) { 74 my $frame = $self->{+_IS_SPAWN} || $self->{+TRACE}->frame; 75 warn <<" EOT"; 76A context appears to have been destroyed without first calling release(). 77Based on \$@ it does not look like an exception was thrown (this is not always 78a reliable test) 79 80This is a problem because the global error variables (\$!, \$@, and \$?) will 81not be restored. In addition some release callbacks will not work properly from 82inside a DESTROY method. 83 84Here are the context creation details, just in case a tool forgot to call 85release(): 86 File: $frame->[1] 87 Line: $frame->[2] 88 Tool: $frame->[3] 89 90Cleaning up the CONTEXT stack... 91 EOT 92 } 93 } 94 95 return if $self->{+_IS_SPAWN}; 96 97 # Remove the key itself to avoid a slow memory leak 98 delete $CONTEXTS->{$hid}; 99 $self->{+_IS_CANON} = undef; 100 101 if (my $cbk = $self->{+_ON_RELEASE}) { 102 $_->($self) for reverse @$cbk; 103 } 104 if (my $hcbk = $hub->{_context_release}) { 105 $_->($self) for reverse @$hcbk; 106 } 107 $_->($self) for reverse @$ON_RELEASE; 108} 109 110# release exists to implement behaviors like die-on-fail. In die-on-fail you 111# want to die after a failure, but only after diagnostics have been reported. 112# The ideal time for the die to happen is when the context is released. 113# Unfortunately die does not work in a DESTROY block. 114sub release { 115 my ($self) = @_; 116 117 ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return if $self->{+THROWN}; 118 119 ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return $self->{+_IS_SPAWN} = undef 120 if $self->{+_IS_SPAWN}; 121 122 croak "release() should not be called on context that is neither canon nor a child" 123 unless $self->{+_IS_CANON}; 124 125 my $hub = $self->{+HUB}; 126 my $hid = $hub->{hid}; 127 128 croak "context thinks it is canon, but it is not" 129 unless $CONTEXTS->{$hid} && $CONTEXTS->{$hid} == $self; 130 131 # Remove the key itself to avoid a slow memory leak 132 $self->{+_IS_CANON} = undef; 133 delete $CONTEXTS->{$hid}; 134 135 if (my $cbk = $self->{+_ON_RELEASE}) { 136 $_->($self) for reverse @$cbk; 137 } 138 if (my $hcbk = $hub->{_context_release}) { 139 $_->($self) for reverse @$hcbk; 140 } 141 $_->($self) for reverse @$ON_RELEASE; 142 143 # Do this last so that nothing else changes them. 144 # If one of the hooks dies then these do not get restored, this is 145 # intentional 146 ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR}; 147 148 return; 149} 150 151sub do_in_context { 152 my $self = shift; 153 my ($sub, @args) = @_; 154 155 # We need to update the pid/tid and error vars. 156 my $clone = $self->snapshot; 157 @$clone{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} = ($!, $@, $?); 158 $clone->{+TRACE} = $clone->{+TRACE}->snapshot(pid => $$, tid => get_tid()); 159 160 my $hub = $clone->{+HUB}; 161 my $hid = $hub->hid; 162 163 my $old = $CONTEXTS->{$hid}; 164 165 $clone->{+_IS_CANON} = 1; 166 $CONTEXTS->{$hid} = $clone; 167 weaken($CONTEXTS->{$hid}); 168 my ($ok, $err) = &try($sub, @args); 169 my ($rok, $rerr) = try { $clone->release }; 170 delete $clone->{+_IS_CANON}; 171 172 if ($old) { 173 $CONTEXTS->{$hid} = $old; 174 weaken($CONTEXTS->{$hid}); 175 } 176 else { 177 delete $CONTEXTS->{$hid}; 178 } 179 180 die $err unless $ok; 181 die $rerr unless $rok; 182} 183 184sub done_testing { 185 my $self = shift; 186 $self->hub->finalize($self->trace, 1); 187 return; 188} 189 190sub throw { 191 my ($self, $msg) = @_; 192 $self->{+THROWN} = 1; 193 ${$self->{+_ABORTED}}++ if $self->{+_ABORTED}; 194 $self->release if $self->{+_IS_CANON} || $self->{+_IS_SPAWN}; 195 $self->trace->throw($msg); 196} 197 198sub alert { 199 my ($self, $msg) = @_; 200 $self->trace->alert($msg); 201} 202 203sub send_ev2_and_release { 204 my $self = shift; 205 my $out = $self->send_ev2(@_); 206 $self->release; 207 return $out; 208} 209 210sub send_ev2 { 211 my $self = shift; 212 213 my $e; 214 { 215 local $Carp::CarpLevel = $Carp::CarpLevel + 1; 216 $e = Test2::Event::V2->new( 217 trace => $self->{+TRACE}->snapshot, 218 @_, 219 ); 220 } 221 222 if ($self->{+_ABORTED}) { 223 my $f = $e->facet_data; 224 ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate); 225 } 226 $self->{+HUB}->send($e); 227} 228 229sub build_ev2 { 230 my $self = shift; 231 232 local $Carp::CarpLevel = $Carp::CarpLevel + 1; 233 Test2::Event::V2->new( 234 trace => $self->{+TRACE}->snapshot, 235 @_, 236 ); 237} 238 239sub send_event_and_release { 240 my $self = shift; 241 my $out = $self->send_event(@_); 242 $self->release; 243 return $out; 244} 245 246sub send_event { 247 my $self = shift; 248 my $event = shift; 249 my %args = @_; 250 251 my $pkg = $LOADED{$event} || $self->_parse_event($event); 252 253 my $e; 254 { 255 local $Carp::CarpLevel = $Carp::CarpLevel + 1; 256 $e = $pkg->new( 257 trace => $self->{+TRACE}->snapshot, 258 %args, 259 ); 260 } 261 262 if ($self->{+_ABORTED}) { 263 my $f = $e->facet_data; 264 ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate); 265 } 266 $self->{+HUB}->send($e); 267} 268 269sub build_event { 270 my $self = shift; 271 my $event = shift; 272 my %args = @_; 273 274 my $pkg = $LOADED{$event} || $self->_parse_event($event); 275 276 local $Carp::CarpLevel = $Carp::CarpLevel + 1; 277 $pkg->new( 278 trace => $self->{+TRACE}->snapshot, 279 %args, 280 ); 281} 282 283sub pass { 284 my $self = shift; 285 my ($name) = @_; 286 287 my $e = bless( 288 { 289 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'), 290 name => $name, 291 }, 292 "Test2::Event::Pass" 293 ); 294 295 $self->{+HUB}->send($e); 296 return $e; 297} 298 299sub pass_and_release { 300 my $self = shift; 301 my ($name) = @_; 302 303 my $e = bless( 304 { 305 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'), 306 name => $name, 307 }, 308 "Test2::Event::Pass" 309 ); 310 311 $self->{+HUB}->send($e); 312 $self->release; 313 return 1; 314} 315 316sub fail { 317 my $self = shift; 318 my ($name, @diag) = @_; 319 320 my $e = bless( 321 { 322 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'), 323 name => $name, 324 }, 325 "Test2::Event::Fail" 326 ); 327 328 $e->add_info({tag => 'DIAG', debug => 1, details => $_}) for @diag; 329 $self->{+HUB}->send($e); 330 return $e; 331} 332 333sub fail_and_release { 334 my $self = shift; 335 my ($name, @diag) = @_; 336 337 my $e = bless( 338 { 339 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'), 340 name => $name, 341 }, 342 "Test2::Event::Fail" 343 ); 344 345 $e->add_info({tag => 'DIAG', debug => 1, details => $_}) for @diag; 346 $self->{+HUB}->send($e); 347 $self->release; 348 return 0; 349} 350 351sub ok { 352 my $self = shift; 353 my ($pass, $name, $on_fail) = @_; 354 355 my $hub = $self->{+HUB}; 356 357 my $e = bless { 358 trace => bless( {%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'), 359 pass => $pass, 360 name => $name, 361 }, 'Test2::Event::Ok'; 362 $e->init; 363 364 $hub->send($e); 365 return $e if $pass; 366 367 $self->failure_diag($e); 368 369 if ($on_fail && @$on_fail) { 370 $self->diag($_) for @$on_fail; 371 } 372 373 return $e; 374} 375 376sub failure_diag { 377 my $self = shift; 378 my ($e) = @_; 379 380 # Figure out the debug info, this is typically the file name and line 381 # number, but can also be a custom message. If no trace object is provided 382 # then we have nothing useful to display. 383 my $name = $e->name; 384 my $trace = $e->trace; 385 my $debug = $trace ? $trace->debug : "[No trace info available]"; 386 387 # Create the initial diagnostics. If the test has a name we put the debug 388 # info on a second line, this behavior is inherited from Test::Builder. 389 my $msg = defined($name) 390 ? qq[Failed test '$name'\n$debug.\n] 391 : qq[Failed test $debug.\n]; 392 393 $self->diag($msg); 394} 395 396sub skip { 397 my $self = shift; 398 my ($name, $reason, @extra) = @_; 399 $self->send_event( 400 'Skip', 401 name => $name, 402 reason => $reason, 403 pass => 1, 404 @extra, 405 ); 406} 407 408sub note { 409 my $self = shift; 410 my ($message) = @_; 411 $self->send_event('Note', message => $message); 412} 413 414sub diag { 415 my $self = shift; 416 my ($message) = @_; 417 my $hub = $self->{+HUB}; 418 $self->send_event( 419 'Diag', 420 message => $message, 421 ); 422} 423 424sub plan { 425 my ($self, $max, $directive, $reason) = @_; 426 $self->send_event('Plan', max => $max, directive => $directive, reason => $reason); 427} 428 429sub bail { 430 my ($self, $reason) = @_; 431 $self->send_event('Bail', reason => $reason); 432} 433 434sub _parse_event { 435 my $self = shift; 436 my $event = shift; 437 438 my $pkg; 439 if ($event =~ m/^\+(.*)/) { 440 $pkg = $1; 441 } 442 else { 443 $pkg = "Test2::Event::$event"; 444 } 445 446 unless ($LOADED{$pkg}) { 447 my $file = pkg_to_file($pkg); 448 my ($ok, $err) = try { require $file }; 449 $self->throw("Could not load event module '$pkg': $err") 450 unless $ok; 451 452 $LOADED{$pkg} = $pkg; 453 } 454 455 confess "'$pkg' is not a subclass of 'Test2::Event'" 456 unless $pkg->isa('Test2::Event'); 457 458 $LOADED{$event} = $pkg; 459 460 return $pkg; 461} 462 4631; 464 465__END__ 466 467=pod 468 469=encoding UTF-8 470 471=head1 NAME 472 473Test2::API::Context - Object to represent a testing context. 474 475=head1 DESCRIPTION 476 477The context object is the primary interface for authors of testing tools 478written with L<Test2>. The context object represents the context in 479which a test takes place (File and Line Number), and provides a quick way to 480generate events from that context. The context object also takes care of 481sending events to the correct L<Test2::Hub> instance. 482 483=head1 SYNOPSIS 484 485In general you will not be creating contexts directly. To obtain a context you 486should always use C<context()> which is exported by the L<Test2::API> module. 487 488 use Test2::API qw/context/; 489 490 sub my_ok { 491 my ($bool, $name) = @_; 492 my $ctx = context(); 493 $ctx->ok($bool, $name); 494 $ctx->release; # You MUST do this! 495 return $bool; 496 } 497 498Context objects make it easy to wrap other tools that also use context. Once 499you grab a context, any tool you call before releasing your context will 500inherit it: 501 502 sub wrapper { 503 my ($bool, $name) = @_; 504 my $ctx = context(); 505 $ctx->diag("wrapping my_ok"); 506 507 my $out = my_ok($bool, $name); 508 $ctx->release; # You MUST do this! 509 return $out; 510 } 511 512=head1 CRITICAL DETAILS 513 514=over 4 515 516=item you MUST always use the context() sub from Test2::API 517 518Creating your own context via C<< Test2::API::Context->new() >> will almost never 519produce a desirable result. Use C<context()> which is exported by L<Test2::API>. 520 521There are a handful of cases where a tool author may want to create a new 522context by hand, which is why the C<new> method exists. Unless you really know 523what you are doing you should avoid this. 524 525=item You MUST always release the context when done with it 526 527Releasing the context tells the system you are done with it. This gives it a 528chance to run any necessary callbacks or cleanup tasks. If you forget to 529release the context it will try to detect the problem and warn you about it. 530 531=item You MUST NOT pass context objects around 532 533When you obtain a context object it is made specifically for your tool and any 534tools nested within. If you pass a context around you run the risk of polluting 535other tools with incorrect context information. 536 537If you are certain that you want a different tool to use the same context you 538may pass it a snapshot. C<< $ctx->snapshot >> will give you a shallow clone of 539the context that is safe to pass around or store. 540 541=item You MUST NOT store or cache a context for later 542 543As long as a context exists for a given hub, all tools that try to get a 544context will get the existing instance. If you try to store the context you 545will pollute other tools with incorrect context information. 546 547If you are certain that you want to save the context for later, you can use a 548snapshot. C<< $ctx->snapshot >> will give you a shallow clone of the context 549that is safe to pass around or store. 550 551C<context()> has some mechanisms to protect you if you do cause a context to 552persist beyond the scope in which it was obtained. In practice you should not 553rely on these protections, and they are fairly noisy with warnings. 554 555=item You SHOULD obtain your context as soon as possible in a given tool 556 557You never know what tools you call from within your own tool will need a 558context. Obtaining the context early ensures that nested tools can find the 559context you want them to find. 560 561=back 562 563=head1 METHODS 564 565=over 4 566 567=item $ctx->done_testing; 568 569Note that testing is finished. If no plan has been set this will generate a 570Plan event. 571 572=item $clone = $ctx->snapshot() 573 574This will return a shallow clone of the context. The shallow clone is safe to 575store for later. 576 577=item $ctx->release() 578 579This will release the context. This runs cleanup tasks, and several important 580hooks. It will also restore C<$!>, C<$?>, and C<$@> to what they were when the 581context was created. 582 583B<Note:> If a context is acquired more than once an internal refcount is kept. 584C<release()> decrements the ref count, none of the other actions of 585C<release()> will occur unless the refcount hits 0. This means only the last 586call to C<release()> will reset C<$?>, C<$!>, C<$@>,and run the cleanup tasks. 587 588=item $ctx->throw($message) 589 590This will throw an exception reporting to the file and line number of the 591context. This will also release the context for you. 592 593=item $ctx->alert($message) 594 595This will issue a warning from the file and line number of the context. 596 597=item $stack = $ctx->stack() 598 599This will return the L<Test2::API::Stack> instance the context used to find 600the current hub. 601 602=item $hub = $ctx->hub() 603 604This will return the L<Test2::Hub> instance the context recognizes as the 605current one to which all events should be sent. 606 607=item $dbg = $ctx->trace() 608 609This will return the L<Test2::EventFacet::Trace> instance used by the context. 610 611=item $ctx->do_in_context(\&code, @args); 612 613Sometimes you have a context that is not current, and you want things to use it 614as the current one. In these cases you can call 615C<< $ctx->do_in_context(sub { ... }) >>. The codeblock will be run, and 616anything inside of it that looks for a context will find the one on which the 617method was called. 618 619This B<DOES NOT> affect context on other hubs, only the hub used by the context 620will be affected. 621 622 my $ctx = ...; 623 $ctx->do_in_context(sub { 624 my $ctx = context(); # returns the $ctx the sub is called on 625 }); 626 627B<Note:> The context will actually be cloned, the clone will be used instead of 628the original. This allows the thread id, process id, and error variables to be correct without 629modifying the original context. 630 631=item $ctx->restore_error_vars() 632 633This will set C<$!>, C<$?>, and C<$@> to what they were when the context was 634created. There is no localization or anything done here, calling this method 635will actually set these vars. 636 637=item $! = $ctx->errno() 638 639The (numeric) value of C<$!> when the context was created. 640 641=item $? = $ctx->child_error() 642 643The value of C<$?> when the context was created. 644 645=item $@ = $ctx->eval_error() 646 647The value of C<$@> when the context was created. 648 649=back 650 651=head2 EVENT PRODUCTION METHODS 652 653B<Which one do I use?> 654 655The C<pass*> and C<fail*> are optimal if they meet your situation, using one of 656them will always be the most optimal. That said they are optimal by eliminating 657many features. 658 659Method such as C<ok>, and C<note> are shortcuts for generating common 1-task 660events based on the old API, however they are forward compatible, and easy to 661use. If these meet your needs then go ahead and use them, but please check back 662often for alternatives that may be added. 663 664If you want to generate new style events, events that do many things at once, 665then you want the C<*ev2*> methods. These let you directly specify which facets 666you wish to use. 667 668=over 4 669 670=item $event = $ctx->pass() 671 672=item $event = $ctx->pass($name) 673 674This will send and return an L<Test2::Event::Pass> event. You may optionally 675provide a C<$name> for the assertion. 676 677The L<Test2::Event::Pass> is a specially crafted and optimized event, using 678this will help the performance of passing tests. 679 680=item $true = $ctx->pass_and_release() 681 682=item $true = $ctx->pass_and_release($name) 683 684This is a combination of C<pass()> and C<release()>. You can use this if you do 685not plan to do anything with the context after sending the event. This helps 686write more clear and compact code. 687 688 sub shorthand { 689 my ($bool, $name) = @_; 690 my $ctx = context(); 691 return $ctx->pass_and_release($name) if $bool; 692 693 ... Handle a failure ... 694 } 695 696 sub longform { 697 my ($bool, $name) = @_; 698 my $ctx = context(); 699 700 if ($bool) { 701 $ctx->pass($name); 702 $ctx->release; 703 return 1; 704 } 705 706 ... Handle a failure ... 707 } 708 709=item my $event = $ctx->fail() 710 711=item my $event = $ctx->fail($name) 712 713=item my $event = $ctx->fail($name, @diagnostics) 714 715This lets you send an L<Test2::Event::Fail> event. You may optionally provide a 716C<$name> and C<@diagnostics> messages. 717 718=item my $false = $ctx->fail_and_release() 719 720=item my $false = $ctx->fail_and_release($name) 721 722=item my $false = $ctx->fail_and_release($name, @diagnostics) 723 724This is a combination of C<fail()> and C<release()>. This can be used to write 725clearer and shorter code. 726 727 sub shorthand { 728 my ($bool, $name) = @_; 729 my $ctx = context(); 730 return $ctx->fail_and_release($name) unless $bool; 731 732 ... Handle a success ... 733 } 734 735 sub longform { 736 my ($bool, $name) = @_; 737 my $ctx = context(); 738 739 unless ($bool) { 740 $ctx->pass($name); 741 $ctx->release; 742 return 1; 743 } 744 745 ... Handle a success ... 746 } 747 748 749=item $event = $ctx->ok($bool, $name) 750 751=item $event = $ctx->ok($bool, $name, \@on_fail) 752 753B<NOTE:> Use of this method is discouraged in favor of C<pass()> and C<fail()> 754which produce L<Test2::Event::Pass> and L<Test2::Event::Fail> events. These 755newer event types are faster and less crufty. 756 757This will create an L<Test2::Event::Ok> object for you. If C<$bool> is false 758then an L<Test2::Event::Diag> event will be sent as well with details about the 759failure. If you do not want automatic diagnostics you should use the 760C<send_event()> method directly. 761 762The third argument C<\@on_fail>) is an optional set of diagnostics to be sent in 763the event of a test failure. 764 765=item $event = $ctx->note($message) 766 767Send an L<Test2::Event::Note>. This event prints a message to STDOUT. 768 769=item $event = $ctx->diag($message) 770 771Send an L<Test2::Event::Diag>. This event prints a message to STDERR. 772 773=item $event = $ctx->plan($max) 774 775=item $event = $ctx->plan(0, 'SKIP', $reason) 776 777This can be used to send an L<Test2::Event::Plan> event. This event 778usually takes either a number of tests you expect to run. Optionally you can 779set the expected count to 0 and give the 'SKIP' directive with a reason to 780cause all tests to be skipped. 781 782=item $event = $ctx->skip($name, $reason); 783 784Send an L<Test2::Event::Skip> event. 785 786=item $event = $ctx->bail($reason) 787 788This sends an L<Test2::Event::Bail> event. This event will completely 789terminate all testing. 790 791=item $event = $ctx->send_ev2(%facets) 792 793This lets you build and send a V2 event directly from facets. The event is 794returned after it is sent. 795 796This example sends a single assertion, a note (comment for stdout in 797Test::Builder talk) and sets the plan to 1. 798 799 my $event = $ctx->send_event( 800 plan => {count => 1}, 801 assert => {pass => 1, details => "A passing assert"}, 802 info => [{tag => 'NOTE', details => "This is a note"}], 803 ); 804 805=item $event = $ctx->build_e2(%facets) 806 807This is the same as C<send_ev2()>, except it builds and returns the event 808without sending it. 809 810=item $event = $ctx->send_ev2_and_release($Type, %parameters) 811 812This is a combination of C<send_ev2()> and C<release()>. 813 814 sub shorthand { 815 my $ctx = context(); 816 return $ctx->send_ev2_and_release(assert => {pass => 1, details => 'foo'}); 817 } 818 819 sub longform { 820 my $ctx = context(); 821 my $event = $ctx->send_ev2(assert => {pass => 1, details => 'foo'}); 822 $ctx->release; 823 return $event; 824 } 825 826=item $event = $ctx->send_event($Type, %parameters) 827 828B<It is better to use send_ev2() in new code.> 829 830This lets you build and send an event of any type. The C<$Type> argument should 831be the event package name with C<Test2::Event::> left off, or a fully 832qualified package name prefixed with a '+'. The event is returned after it is 833sent. 834 835 my $event = $ctx->send_event('Ok', ...); 836 837or 838 839 my $event = $ctx->send_event('+Test2::Event::Ok', ...); 840 841=item $event = $ctx->build_event($Type, %parameters) 842 843B<It is better to use build_ev2() in new code.> 844 845This is the same as C<send_event()>, except it builds and returns the event 846without sending it. 847 848=item $event = $ctx->send_event_and_release($Type, %parameters) 849 850B<It is better to use send_ev2_and_release() in new code.> 851 852This is a combination of C<send_event()> and C<release()>. 853 854 sub shorthand { 855 my $ctx = context(); 856 return $ctx->send_event_and_release(Pass => { name => 'foo' }); 857 } 858 859 sub longform { 860 my $ctx = context(); 861 my $event = $ctx->send_event(Pass => { name => 'foo' }); 862 $ctx->release; 863 return $event; 864 } 865 866=back 867 868=head1 HOOKS 869 870There are 2 types of hooks, init hooks, and release hooks. As the names 871suggest, these hooks are triggered when contexts are created or released. 872 873=head2 INIT HOOKS 874 875These are called whenever a context is initialized. That means when a new 876instance is created. These hooks are B<NOT> called every time something 877requests a context, just when a new one is created. 878 879=head3 GLOBAL 880 881This is how you add a global init callback. Global callbacks happen for every 882context for any hub or stack. 883 884 Test2::API::test2_add_callback_context_init(sub { 885 my $ctx = shift; 886 ... 887 }); 888 889=head3 PER HUB 890 891This is how you add an init callback for all contexts created for a given hub. 892These callbacks will not run for other hubs. 893 894 $hub->add_context_init(sub { 895 my $ctx = shift; 896 ... 897 }); 898 899=head3 PER CONTEXT 900 901This is how you specify an init hook that will only run if your call to 902C<context()> generates a new context. The callback will be ignored if 903C<context()> is returning an existing context. 904 905 my $ctx = context(on_init => sub { 906 my $ctx = shift; 907 ... 908 }); 909 910=head2 RELEASE HOOKS 911 912These are called whenever a context is released. That means when the last 913reference to the instance is about to be destroyed. These hooks are B<NOT> 914called every time C<< $ctx->release >> is called. 915 916=head3 GLOBAL 917 918This is how you add a global release callback. Global callbacks happen for every 919context for any hub or stack. 920 921 Test2::API::test2_add_callback_context_release(sub { 922 my $ctx = shift; 923 ... 924 }); 925 926=head3 PER HUB 927 928This is how you add a release callback for all contexts created for a given 929hub. These callbacks will not run for other hubs. 930 931 $hub->add_context_release(sub { 932 my $ctx = shift; 933 ... 934 }); 935 936=head3 PER CONTEXT 937 938This is how you add release callbacks directly to a context. The callback will 939B<ALWAYS> be added to the context that gets returned, it does not matter if a 940new one is generated, or if an existing one is returned. 941 942 my $ctx = context(on_release => sub { 943 my $ctx = shift; 944 ... 945 }); 946 947=head1 THIRD PARTY META-DATA 948 949This object consumes L<Test2::Util::ExternalMeta> which provides a consistent 950way for you to attach meta-data to instances of this class. This is useful for 951tools, plugins, and other extensions. 952 953=head1 SOURCE 954 955The source code repository for Test2 can be found at 956F<http://github.com/Test-More/test-more/>. 957 958=head1 MAINTAINERS 959 960=over 4 961 962=item Chad Granum E<lt>exodist@cpan.orgE<gt> 963 964=back 965 966=head1 AUTHORS 967 968=over 4 969 970=item Chad Granum E<lt>exodist@cpan.orgE<gt> 971 972=item Kent Fredric E<lt>kentnl@cpan.orgE<gt> 973 974=back 975 976=head1 COPYRIGHT 977 978Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. 979 980This program is free software; you can redistribute it and/or 981modify it under the same terms as Perl itself. 982 983See F<http://dev.perl.org/licenses/> 984 985=cut 986