File Coverage

blib/lib/Net/BEEP/Lite/BaseProfile.pm

Criterion	Covered	Total	%
statement	24	67	35.8
branch	3	20	15.0
condition	1	3	33.3
subroutine	6	13	46.1
pod	10	10	100.0
total	44	113	38.9

# $Id: BaseProfile.pm,v 1.7 2003/09/11 19:57:31 davidb Exp $
#
# Copyright (C) 2003 Verisign, Inc.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
# USA

package Net::BEEP::Lite::BaseProfile;

=head1 NAME

Net::BEEP::Lite::BaseProfile

=head1 SYNOPIS

  $profile = Net::BEEP::Lite::BaseProfile->new();

  my $uri = $profile->uri();

  if ($message->isa('Net::BEEP::Lite::Message') {
    $profile->handle_message($session, $message);
  }

=head1 DESCRIPTION

"Net::BEEP::Lite::BaseProfile" is the base class Net::BEEP::Lite profiles
should inherit from/implement.  It is not intended to be instantiated
on its own.  This class provides the basic structure of profile.

In general, subclasses only need to override the constructor (for
additional initialization parameters, if any) and the various message
handler methods (MSG(), RPY(), etc.).

Note that in general BEEP "client" applications generally do not need
to create profiles (although they may if they wish).  "Server"
applications generally do need to create profiles.

Normally profiles are designed to be shared between Sessions. This
primarily means that no session or channel base state is stored in the
profile object itself.  Designers of profiles need not stick to this
constraint, however.  In this framework, most often each Session is in
a different process and thus not actually shared amongst Sessions.

=cut

use Carp;

use strict;
use warnings;

=head1 CONSTRUCTOR

=over 4

=item new( I )

This constructor currently has no valid arguments.

=back

=cut

sub new {
  my $this = shift;
  my $class = ref($this) || $this;

  my $self = {};

  bless $self, $class;

  $self->initialize(@_);

  $self;
}

=head1 METHODS

=over 4

=item initialize( I )

This method initializes the object.  The arguments are named value
pairs, although currently none are defined.  Users of this class do
not call this method, as it is invoked by the constructor.
Subclasses, however, should invoke this in their constructors. (i.e.,
as $self->SUPER::initialize(@_)).

=cut

sub initialize {
  my $self  = shift;
  my %args = @_;

  $self->{debug} = 0;
  $self->{trace} = 0;

  for (keys %args) {
    my $val = $args{$_};
    /^debug/io and do {
      $self->{debug} = $val;
      next;
    };
    /^trace/io and do {
      $self->{trace} = $val;
      next;
    };
  }
}

=item uri([$va])

This returns the profile\'s identifying URI (e.g.,
http://iana.org/beep/SASL/PLAIN).  If passed an optional value, it
sets that to the profile's URI.

=cut

sub uri {
  my $self = shift;
  my $val  = shift;

  $self->{uri} = $val if $val;
  $self->{uri} || confess "profile has no URI!\n";
}

=item handle_message($session, $message)

Handle a BEEP message based on its type.  This just invokes the
profile's various handler functions (MSG(), ERR(), etc.).  Returns
whatever the handler method returns (generally the original message).

=cut

sub handle_message {
  my $self    = shift;
  my $session = shift;
  my $message = shift;

  if ($message->type() eq "MSG") {
    $self->MSG($session, $message);
  } elsif ($message->type() eq "RPY") {
    $self->RPY($session, $message);
  } elsif ($message->type() eq "ERR") {
    $self->ERR($session, $message);
  } elsif ($message->type() eq "ANS") {
    $self->ANS($session, $message);
  } elsif ($message->type() eq "NUL") {
    $self->NUL($session, $message);
  } else {
    croak $message->type(), " is unknown";
  }
}

=item start_channel_request($session, $message, $data)

Handle a start channel request.  This is a place for profiles to
control what happens when a start channel request for this profile is
handled by the management profile.  $session is the session the
request was received by, $message is the original request, and $data
is the data contained within the  element, extracted and
decoded from base64 (if necessary).

This method must return one of the following responses:

=over 4

=item undef

This means that the caller (the management profile) will return a
normal  response with no included data and start the channel
This is what the base version of this method will return.

=item ('RPY', $content, [$encode])

This means that the caller should return a  response with the
included content.  If $encode is true, it should base64 encode the
content first.

=item ('ERR', $code, $content)

This means that the caller should return this error instead of
starting the channel.

=item 'NUL'

This means that the caller should do nothing (don't send a response,
don't start the channel), this routine has handled the start channel
request.

=back

If not overridden, this routine will return undef, and will stow the
data in $session->{start_channel_data}, if there was any.

=cut

sub start_channel_request {
  my $self    = shift;
  my $session = shift;
  my $message = shift;
  my $data    = shift;

  $session->{start_channel_data} = $data if $data;

  return undef;
}

=item MSG($session, $message)

Handle MSG type messages.  This should be overridden by the subclass.
Subclasses should have this method return the original method.  This
version will simply croak if invoked.

=cut

sub MSG {
  my $self    = shift;
  my $session = shift;
  my $message = shift;

  croak "MSG handling not implemented\n";
}

=item RPY($session, $message)

Handle RPY type messages.  This should be overridden by the subclass.
Subclasses should have this method return the original method.  This
version will simply croak if invoked.

=cut

sub RPY {
  my $self    = shift;
  my $session = shift;
  my $message = shift;

  croak "RPY handling not implemented\n";
}

=item ERR($session, $message)

Handle ERR type messages.  This should be overridden by the subclass.
Subclasses should have this method return the original method.  This
version will simply croak if invoked.

=cut

sub ERR {
  my $self    = shift;
  my $session = shift;
  my $message = shift;

  croak "ERR handling not implemented\n";
}

=item ANS($session, $message)

Handle ANS type messages.  This should be overridden by the subclass.
Subclasses should have this method return the original method.  This
version will simply croak if invoked.

=cut

sub ANS {
  my $self    = shift;
  my $session = shift;
  my $message = shift;

  croak "ANS handling not implemented\n";
}

=item NUL($message)

Handle NUL type messages.  This should be overridden by the subclass.
Subclasses should have this method return the original method.  This
version will simply croak if invoked.

=cut

sub NUL {
  my $self    = shift;
  my $session = shift;
  my $message = shift;

  croak "NUL handling not implemented\n";
}

=pod

=back

=head1 SEE ALSO

=over 4

=item L

=item L

=back

=cut

1;