File Coverage

blib/lib/Net/Stomp/Receipt.pm
Criterion Covered Total %
statement 9 46 19.5
branch 0 6 0.0
condition 0 3 0.0
subroutine 3 7 42.8
pod 2 3 66.6
total 14 65 21.5


line stmt bran cond sub pod time code
1             package Net::Stomp::Receipt;
2              
3 1     1   71951 use strict;
  1         11  
  1         31  
4 1     1   5 use warnings;
  1         2  
  1         33  
5              
6             #
7             # Subclass of Net::Stomp for adding "transactional sends"
8             # with receipt and commit.
9             #
10             # Author: Hugo Salgado
11             #
12 1     1   9 use base 'Net::Stomp';
  1         1  
  1         724  
13              
14             #
15             # I start the version in sync with Net::Stomp
16             # (and hopes to keep it in that way)
17             our $VERSION = '0.40';
18              
19              
20             # Added a new configuration variable on creation,
21             # so we need to subclass the constructor
22             sub new {
23 0     0 1   my ($class, $conf) = @_;
24              
25             my $self = $class->SUPER::new({
26             hostname => $conf->{'hostname'},
27 0           port => $conf->{'port'},
28             });
29              
30             # to keep the session id, as will be given from the server
31 0           $self->{'sessionid'} = undef;
32             # to keep an incremental for the transaction and receipt ids
33 0           $self->{'serial'} = 0;
34              
35             # and we add the persistent feature on constructor
36 0 0         $self->{'PERSISTENT'} = 1 if $conf->{'PERSISTENT'};
37              
38 0           bless $self, $class;
39              
40 0           return $self;
41             }
42              
43             # We need to set the sessionid on connection time
44             sub connect {
45 0     0 1   my ( $self, $conf ) = @_;
46              
47 0           my $frame = $self->SUPER::connect( $conf );
48              
49             # Setting initial values for session id, as given from
50             # the stomp server
51 0           $self->{'sessionid'} = $frame->headers->{'session'};
52              
53 0           return $frame;
54             }
55              
56             # Internal method for autoincremental serial id
57             sub _getSerial {
58 0     0     my $self = shift;
59              
60 0           $self->{'serial'}++;
61              
62 0           return $self->{'serial'};
63             }
64              
65             # The new method. We don't override the original "send", so
66             # we can use one or another.
67             sub send_safe {
68 0     0 0   my ( $self, $conf ) = @_;
69 0           my $body = $conf->{body};
70 0           delete $conf->{body};
71              
72             # Transaction begins
73 0           $conf->{transaction} = $self->{'sessionid'} . '-' . $self->_getSerial;
74 0           my $frame = Net::Stomp::Frame->new(
75             { command => 'BEGIN', headers => $conf } );
76 0           $self->send_frame($frame);
77 0           undef $frame;
78              
79             # Sending the message, with receipt header
80 0           my $receipt_id = $self->{'sessionid'} . '-' . $self->_getSerial;
81 0           $conf->{receipt} = $receipt_id;
82 0 0         $conf->{persistent} = 'true' if $self->{'PERSISTENT'};
83 0           $frame = Net::Stomp::Frame->new(
84             { command => 'SEND', headers => $conf, body => $body } );
85 0           $self->send_frame($frame);
86 0           undef $frame;
87 0           delete $conf->{receipt};
88 0           delete $conf->{persistent};
89              
90             # Checking the server for the right receipt
91             # If it's OK -> commit the transaction
92 0           $frame = $self->receive_frame;
93 0 0 0       if (($frame->command eq 'RECEIPT') and
94             ($frame->headers->{'receipt-id'} eq $receipt_id)) {
95 0           my $frame_commit = Net::Stomp::Frame->new(
96             { command => 'COMMIT', headers => $conf } );
97 0           $self->send_frame($frame_commit);
98              
99 0           return 1;
100             }
101              
102             # whatever else, abort transaction
103 0           my $frame_abort = Net::Stomp::Frame->new(
104             { command => 'ABORT', headers => $conf } );
105 0           $self->send_frame($frame_abort);
106              
107 0           return 0;
108             }
109              
110              
111             1;
112              
113             __END__