The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package XAS::Lib::Connector;

our $VERSION = '0.01';

use POE;
use Try::Tiny;

use XAS::Class
  version => $VERSION,
  base    => 'POE::Component::Client::Stomp XAS::Base',
  utils   => 'trim',
  messages => {
      connected  => "%s: connected to %s on %s",
      subscribed => "%s: subscribed to %s",
      recverr    => "%s: received an error message: %s",
      recvrpt    => "%s: received a receipt: %s",
      recvmsg    => "%s: received a message #%s",
      received   => "%s: received message #%s of type \"%s\" from %s",
      unknownerr => "%s: %s",
      knownerr   => "%s: %s, %s",
      shutdown   => "%s: shutdown - disconnecting for the server",
      nologger   => "no Logger was defined",
      nologin    => "no Login was defined",
      nopasscode => "no Passcode was defined",
  }
;

use Data::Dumper;

# ---------------------------------------------------------------------
# Public Events
# ---------------------------------------------------------------------

sub handle_connection {
    my ($kernel, $self) = @_[KERNEL, OBJECT];

    my $alias = $self->config('Alias');

    $self->log($kernel, 'debug', "$alias: entering handle_connection()");

    my $frame = $self->stomp->connect(
        {
            login    => $self->config('Login'),
            passcode => $self->config('Passcode')
        }
    );

    $self->log($kernel, 'info', $self->message('connected', $alias, $self->host, $self->port));

    $kernel->yield('send_data', $frame);
    $kernel->yield('connection_up');

    $self->log($kernel, 'debug', "$alias: leaving handle_connection()");

}

sub handle_receipt {
    my ($kernel, $self, $frame) = @_[KERNEL, OBJECT, ARG0];

    my $alias = $self->config('Alias');
    my $message = $self->message('recvrpt', $alias, $frame->{headers}->{'message-id'});

    $self->log($kernel, 'error', $message);

}

sub handle_error {
    my ($kernel, $self, $frame) = @_[KERNEL, OBJECT, ARG0];

    my $alias = $self->config('Alias');
    my $message = $self->message('recverr', $alias, trim($frame->body));

    $self->log($kernel, 'error', $message);

}

sub handle_message {
    my ($kernel, $self, $frame) = @_[KERNEL, OBJECT, ARG0];

    my $alias = $self->config('Alias');
    my $message = $self->message('recvmsg', $alias, $frame->{headers}->{'message-id'});

    $self->log($kernel, 'error', $message);

}

# ---------------------------------------------------------------------
# Public Methods
# ---------------------------------------------------------------------

sub spawn {
    my $class = shift;

    my %args = @_;
    my $self = $class->SUPER::spawn(@_);

    unless (defined($args{'Logger'})) {

        $self->throw_msg(
            'xas.lib.connector.spawn.nologger',
            'nologger'
        );

    }

    unless (defined($args{'Login'})) {

        $self->throw_msg(
            'xas.lib.connector.spawn.nologin',
            'nologin'
        );

    }

    unless (defined($args{'Passcode'})) {

        $self->throw_msg(
            'xas.lib.connector.spawn.nopasscode',
            'nopasscode'
        );

    }

    return $self;

}

sub log {
    my ($self, $kernel, $level, @args) = @_;

    my $logger = $self->config('Logger');

    $kernel->post($logger, $level, @args);

}

sub handle_shutdown {
    my ($self, $kernel, $session) = @_;

    my $alias = $self->config('Alias');
    my $frame = $self->stomp->disconnect();
    my $message = $self->message('shutdown', $alias);

    $kernel->call($session, 'send_data', $frame);

    $self->log($kernel, 'warn', $message);

}

sub exception_handler {
    my ($self, $ex) = @_;

    my $ref = ref($ex);
    my $alias = $self->config('Alias');

    if ($ref && $ex->isa('XAS::Exception')) {

        my $type = $ex->type;
        my $text = $ex->info;

        $self->log($poe_kernel, 'error', $self->message('knownerr', $alias, $type, $text));

    } else {

        $self->log($poe_kernel, 'error', $self->message('unknownerr', $alias, $ex));

    }

}

# ---------------------------------------------------------------------
# Private Methods
# ---------------------------------------------------------------------

1;

__END__

=head1 NAME

XAS::Lib::Connector - Perl extension for the XAS environment

=head1 SYNOPSIS

  use XAS::Lib::Connector;

  my $connection = XAS::Lib::Connector->spawn(
     Logger   => 'logger',
     Login    => 'xas',
     Passcode => 'xas'
  );

=head1 DESCRIPTION

This module is the base class used for connecting to STOMP v1.0 message queue
servers. 

=head1 PUBLIC METHODS

=head2 spawn

This method creates the initial session, and checks for the following
parameters:

=over 

=item B<Logger>

The name of the logging session.

=item B<Login>

The login name to be used on the message queue server.

=item B<Passcode>

The passcode to be used on the message queue server.

=back

=head2 log($kernel, $level, $message)

Provides a logging method for POE::Component::Client::Stomp. 

=over

=item B<$kernel>

A pointer to the POE kernel.

=item B<$level>

A logging level that is compatiable to your logger.

=item B<@args>

The line that is to be written to the log.

=back

=head2 reload($kernel, $session)

This module will handle the HUP signal. It currently executes POE's 
sig_handled() method.

=over

=item B<$kernel>

A pointer to the POE kernel.

=item B<$session>

A point to the current POE session.

=back

=head2 exception_handler($ex)

Provide a default exception handler.

=over

=item B<$ex>

The exception to handle.

=back

=head1 SEE ALSO

 POE::Component::Client::Stomp

L<XAS|XAS>

=head1 AUTHOR

Kevin L. Esteb, E<lt>kevin@kesteb.usE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Kevin L. Esteb

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut