File Coverage

blib/lib/Net/STOMP/Client/Receipt.pm
Criterion Covered Total %
statement 16 37 43.2
branch 0 12 0.0
condition 0 3 0.0
subroutine 5 10 50.0
pod 2 2 100.0
total 23 64 35.9


line stmt bran cond sub pod time code
1             #+##############################################################################
2             # #
3             # File: Net/STOMP/Client/Receipt.pm #
4             # #
5             # Description: Receipt support for Net::STOMP::Client #
6             # #
7             #-##############################################################################
8              
9             #
10             # module definition
11             #
12              
13             package Net::STOMP::Client::Receipt;
14 1     1   7 use strict;
  1         2  
  1         30  
15 1     1   5 use warnings;
  1         2  
  1         73  
16             our $VERSION = "2.4";
17             our $REVISION = sprintf("%d.%02d", q$Revision: 2.2 $ =~ /(\d+)\.(\d+)/);
18              
19             #
20             # used modules
21             #
22              
23 1     1   8 use No::Worries::Die qw(dief);
  1         2  
  1         6  
24 1     1   117 use No::Worries::Export qw(export_control);
  1         2  
  1         6  
25              
26             #
27             # return the list of not-yet-received receipts
28             #
29              
30             sub receipts : method {
31 0     0 1 0 my($self) = @_;
32 0         0 my(@list);
33              
34 0 0       0 @list = keys(%{ $self->{"receipts"} }) if $self->{"receipts"};
  0         0  
35 0         0 return(@list);
36             }
37              
38             #
39             # wait for all receipts to be received
40             #
41              
42             sub wait_for_receipts : method {
43 0     0 1 0 my($self, %option) = @_;
44              
45 0 0       0 return(0) unless $self->receipts();
46 0     0   0 $option{callback} = sub { return($self->receipts() == 0) };
  0         0  
47 0         0 return($self->wait_for_frames(%option));
48             }
49              
50             #
51             # hook for all client frames
52             #
53              
54             sub _client_hook ($$) {
55 0     0   0 my($self, $frame) = @_;
56 0         0 my($value);
57              
58 0         0 $value = $frame->header("receipt");
59 0 0       0 return unless defined($value);
60 0 0       0 dief("duplicate receipt: %s", $value) if $self->{"receipts"}{$value}++;
61             }
62              
63             #
64             # hook for the RECEIPT frame
65             #
66              
67             sub _receipt_hook ($$) {
68 0     0   0 my($self, $frame) = @_;
69 0         0 my($value);
70              
71 0         0 $value = $frame->header("receipt-id");
72 0 0       0 dief("missing receipt-id in RECEIPT frame") unless defined($value);
73             dief("unexpected receipt: %s", $value)
74 0 0 0     0 unless $self->{"receipts"} and $self->{"receipts"}{$value};
75 0         0 delete($self->{"receipts"}{$value});
76             }
77              
78             #
79             # register the hooks
80             #
81              
82             foreach my $frame (qw(ABORT ACK BEGIN COMMIT DISCONNECT NACK
83             SEND SUBSCRIBE UNSUBSCRIBE)) {
84             $Net::STOMP::Client::Hook{$frame}{"receipt"} = \&_client_hook;
85             }
86             $Net::STOMP::Client::Hook{"RECEIPT"}{"receipt"} = \&_receipt_hook;
87              
88             #
89             # export control
90             #
91              
92             sub import : method {
93 1     1   3 my($pkg, %exported);
94              
95 1         3 $pkg = shift(@_);
96 1         5 grep($exported{$_}++, qw(receipts wait_for_receipts));
97 1         5 export_control(scalar(caller()), $pkg, \%exported, @_);
98             }
99              
100             1;
101              
102             __END__