| line | stmt | bran | cond | sub | pod | time | code | 
| 1 | 1 |  |  | 1 |  | 616 | use 5.008; | 
|  | 1 |  |  |  |  | 5 |  | 
|  | 1 |  |  |  |  | 43 |  | 
| 2 | 1 |  |  | 1 |  | 8 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 28 |  | 
| 3 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 47 |  | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | package Data::Conveyor::Ticket::Payload::Item; | 
| 6 |  |  |  |  |  |  | BEGIN { | 
| 7 | 1 |  |  | 1 |  | 20 | $Data::Conveyor::Ticket::Payload::Item::VERSION = '1.103130'; | 
| 8 |  |  |  |  |  |  | } | 
| 9 |  |  |  |  |  |  | # ABSTRACT: Stage-based conveyor-belt-like ticket handling system | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | # | 
| 12 |  |  |  |  |  |  | # Base class for Data::Conveyor::Ticket::Payload::* items | 
| 13 | 1 |  |  | 1 |  | 8 | use parent 'Class::Scaffold::Storable'; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 14 |  |  |  |  |  |  | __PACKAGE__->mk_abstract_accessors(qw(DATA_PROPERTY)) | 
| 15 |  |  |  |  |  |  | ->mk_framework_object_accessors(exception_container => 'exception_container') | 
| 16 |  |  |  |  |  |  | ->mk_boolean_accessors(qw(implicit)); | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | # implicit(): was this item created implicitly by txsel? | 
| 19 |  |  |  |  |  |  | sub check { | 
| 20 | 0 |  |  | 0 | 1 | 0 | my ($self, $ticket) = @_; | 
| 21 | 0 |  |  |  |  | 0 | $self->data->check($self->exception_container, $ticket); | 
| 22 |  |  |  |  |  |  | } | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | sub data { | 
| 25 | 0 |  |  | 0 | 1 | 0 | my $property = $_[0]->DATA_PROPERTY; | 
| 26 | 0 | 0 |  |  |  | 0 | return $_[0]->$property if @_ == 1; | 
| 27 | 0 |  |  |  |  | 0 | $_[0]->$property($_[1]); | 
| 28 |  |  |  |  |  |  | } | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | # For rc() and status(), we pass the payload item's owning ticket object to | 
| 31 |  |  |  |  |  |  | # the exception container. The container needs to ask the ticket whether to | 
| 32 |  |  |  |  |  |  | # ignore an exception. Why do the payload object and the payload items have an | 
| 33 |  |  |  |  |  |  | # owning ticket, but the exception container does not? Because exception | 
| 34 |  |  |  |  |  |  | # containers are filled from various places, and are passed around. In | 
| 35 |  |  |  |  |  |  | # contrast, payload containers and payload items are always tied to a ticket. | 
| 36 |  |  |  |  |  |  | # | 
| 37 |  |  |  |  |  |  | # We also pass the payload item itself because it will eventually be passed to | 
| 38 |  |  |  |  |  |  | # the exception handler, which uses it to decide the rc and status of each | 
| 39 |  |  |  |  |  |  | # exception it is ask to handle. That is, the rc and exception aren't | 
| 40 |  |  |  |  |  |  | # determined by the exception type alone. The same exception can have | 
| 41 |  |  |  |  |  |  | # different rc and status values depending on which object type and command it | 
| 42 |  |  |  |  |  |  | # is associated with. | 
| 43 |  |  |  |  |  |  | sub rc { | 
| 44 | 5 |  |  | 5 | 1 | 7 | my ($self, $ticket) = @_; | 
| 45 | 5 |  |  |  |  | 21 | $self->exception_container->rc($ticket, $self); | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | sub status { | 
| 49 | 6 |  |  | 6 | 1 | 9 | my ($self, $ticket) = @_; | 
| 50 | 6 |  |  |  |  | 21 | $self->exception_container->status($ticket, $self); | 
| 51 |  |  |  |  |  |  | } | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | sub has_problematic_exceptions { | 
| 54 | 0 |  |  | 0 | 1 |  | my ($self, $ticket) = @_; | 
| 55 | 0 |  |  |  |  |  | $self->exception_container->has_problematic_exceptions($ticket, $self); | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | sub prepare_comparable { | 
| 59 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 60 | 0 |  |  |  |  |  | $self->SUPER::prepare_comparable(@_); | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | # Touch various accessors that will autovivify hash keys so we can be sure | 
| 63 |  |  |  |  |  |  | # they exist, which is a kind of normalization for the purpose of | 
| 64 |  |  |  |  |  |  | # comparing two objects of this class. | 
| 65 | 0 |  |  |  |  |  | $self->exception_container; | 
| 66 | 0 |  |  |  |  |  | $self->implicit; | 
| 67 |  |  |  |  |  |  | } | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | # do nothing here; business objects will override | 
| 70 | 0 |  |  | 0 | 1 |  | sub apply_instruction_container { } | 
| 71 |  |  |  |  |  |  | 1; | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | __END__ |