view release on metacpan or  search on metacpan

ARS/OOsup.pm  view on Meta::CPAN

#
#    ARSperl - An ARS v2-v4 / Perl5 Integration Kit
#
#    Copyright (C) 1995-1999 Joel Murphy, jmurphy@acsu.buffalo.edu
#                            Jeff Murphy, jcmurphy@acsu.buffalo.edu
# 
#    This program is free software; you can redistribute it and/or modify
#    it under the terms as Perl itself. 
#    
#    Refer to the file called "Artistic" that accompanies the source distribution 
#    of ARSperl (or the one that accompanies the source distribution of Perl
#    itself) for a full description.
#
#    Official Home Page: 
#    http://www.arsperl.org
#
#    Mailing List (must be subscribed to post):
#    See URL above.
#



# Object Oriented Hoopla

sub newObject {
  my ($class, @p) = (shift, @_);
  my ($self) = {};
  my ($blessed) = bless($self, $class);
  my ($server, $username, $password, $catch, $ctrl, $dbg, $tcpport) = 
    rearrange([SERVER,USERNAME,PASSWORD,CATCH,CTRL,DEBUG,TCPPORT],@p);
  # should the OO layer emit debugging information?

  $self->{'.debug'} = 0;
  $self->{'.debug'} = 1 if(defined($dbg));

  $self->initCatch();

  # what error handlers should be called automatically by the OO layer?
  # if a handler is 'undef' then the OO layer will ignore that type of
  # exception (warning, error or fatal). it is then upto the user to
  # check ->hasErrors(), etc. 
  # this should be a hash ref.

  if(defined($catch) && ref($catch) ne "HASH") {
      $self->pushMessage(&ARS::AR_RETURN_ERROR,
			  81000,
			  "catch parameter should be a HASH reference. (you gave me ".ref($catch)." reference)"
			 );
  }

  $self->{'.catch'} = $catch if (defined($catch));


  # if we've received a ctrl parameter, then we'll used that
  # and ignore the other three parameters. in addition, we'll
  # leave it upto the user to call ars_Logoff() since they must've
  # called ars_Login() in order to pass us the ctrl parameter.
  # this allows the user to mix-and-match OO and non-OO ARS module
  # routines with greater ease.

  if(defined($ctrl)) {
      print "new connection object: reusing existing ctrl struct.\n"
	  if $self->{'.debug'};
      if(ref($ctrl) ne "ARControlStructPtr") {
	  $self->pushMessage(&ARS::AR_RETURN_ERROR,
			     81000,
			     "ctrl parameter should be an ARControlStructPtr reference. you passed a ".ref($ctrl)." reference."
			     );

      }
      $self->{'ctrl'} = $ctrl;
      $self->{'.nologoff'} = 1;
  } else {
      print "new connection object: ($server, $username, $password)\n" 
	  if $self->{'.debug'};
      $self->{'ctrl'} = ars_Login($server, $username, $password, "","", $tcpport);
      $self->{'.nologoff'} = 0;
      $self->tryCatch();
  }

  return $blessed;
}

sub DESTROY {
	my ($self) = shift;
	print "destroying connection object: " if $self->{'.debug'};
	if(defined($self->{'.nologoff'}) && $self->{'.nologoff'} == 0) {
		print "ars_Logoff called.\n" if $self->{'.debug'};
		ars_Logoff($self->{'ctrl'}) if defined($self->{'ctrl'});
	} else {
		print "ars_Logoff suppressed.\n" if $self->{'.debug'};
	}
}

sub ctrl {
	my $this = shift;
	return $this->{'ctrl'};
}

sub print {