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

#+##############################################################################
#                                                                              #
# File: Net/STOMP/Client/Receipt.pm                                            #
#                                                                              #
# Description: Receipt support for Net::STOMP::Client                          #
#                                                                              #
#-##############################################################################

#
# module definition
#

package Net::STOMP::Client::Receipt;
use strict;
use warnings;
our $VERSION  = "2.5";
our $REVISION = sprintf("%d.%02d", q$Revision: 2.2 $ =~ /(\d+)\.(\d+)/);

#
# used modules
#

use No::Worries::Die qw(dief);
use No::Worries::Export qw(export_control);

#
# return the list of not-yet-received receipts
#

sub receipts : method {
    my($self) = @_;
    my(@list);

    @list = keys(%{ $self->{"receipts"} }) if $self->{"receipts"};
    return(@list);
}

#
# wait for all receipts to be received
#

sub wait_for_receipts : method {
    my($self, %option) = @_;

    return(0) unless $self->receipts();
    $option{callback} = sub { return($self->receipts() == 0) };
    return($self->wait_for_frames(%option));
}

#
# hook for all client frames
#

sub _client_hook ($$) {
    my($self, $frame) = @_;
    my($value);

    $value = $frame->header("receipt");
    return unless defined($value);
    dief("duplicate receipt: %s", $value) if $self->{"receipts"}{$value}++;
}

#
# hook for the RECEIPT frame
#

sub _receipt_hook ($$) {
    my($self, $frame) = @_;
    my($value);

    $value = $frame->header("receipt-id");
    dief("missing receipt-id in RECEIPT frame") unless defined($value);
    dief("unexpected receipt: %s", $value)
        unless $self->{"receipts"} and $self->{"receipts"}{$value};
    delete($self->{"receipts"}{$value});
}

#
# register the hooks
#

foreach my $frame (qw(ABORT ACK BEGIN COMMIT DISCONNECT NACK
                      SEND SUBSCRIBE UNSUBSCRIBE)) {
    $Net::STOMP::Client::Hook{$frame}{"receipt"} = \&_client_hook;
}
$Net::STOMP::Client::Hook{"RECEIPT"}{"receipt"} = \&_receipt_hook;

#
# export control
#

sub import : method {
    my($pkg, %exported);

    $pkg = shift(@_);
    grep($exported{$_}++, qw(receipts wait_for_receipts));
    export_control(scalar(caller()), $pkg, \%exported, @_);
}

1;

__END__