ARSperl

 view release on metacpan or  search on metacpan

ARS.pm  view on Meta::CPAN

#    Mailing List (must be subscribed to post):
#    arsperl@arsperl.org
#

# Routines for grabbing the current error message "stack" 
# by simply referring to the $ars_errstr scalar.


package ARS::ERRORSTR;
sub TIESCALAR {
    bless {};
}
sub FETCH {
    my($s, $i) = (undef, undef);
    my(%mTypes) = ( 0 => "OK", 1 => "WARNING", 2 => "ERROR", 3 => "FATAL",
		    4 => "INTERNAL ERROR",
		   -1 => "TRACEBACK");
    for($i = 0; $i < $ARS::ars_errhash{numItems}; $i++) {

	# If debugging is not enabled, don't show traceback messages

ARS.xs  view on Meta::CPAN

		hv_store(RETVAL,  "groupList", strlen("groupList") ,
		     perl_ARList( ctrl, 
				 (ARList *)&groupList,
				 (ARS_fn)perl_ARInternalId,
				 sizeof(ARInternalId)), 0);
		hv_store(RETVAL,  "executeMask", strlen("executeMask") , newSViv(executeMask),0);
		hv_store(RETVAL,  "focusField", strlen("focusField") , newSViv(focusField), 0);
		hv_store(RETVAL,  "controlField", strlen("controlField") , 
			newSViv(controlField), 0);
		hv_store(RETVAL,  "enable", strlen("enable") , newSViv(enable), 0);
		/* a bit of a hack -- makes blessed reference to qualifier */
		ref = newSViv(0);
		sv_setref_pv(ref, "ARQualifierStructPtr", (void*)query);
		hv_store(RETVAL,  "query", strlen("query") , ref, 0);
		hv_store(RETVAL,  "actionList", strlen("actionList") ,
		     perl_ARList(ctrl, 
				 (ARList *)&actionList,
				 (ARS_fn)perl_ARActiveLinkActionStruct,
				 sizeof(ARActiveLinkActionStruct)), 0);
		hv_store(RETVAL,  "elseList", strlen("elseList") ,
		     perl_ARList(ctrl, 

ARS.xs  view on Meta::CPAN

	  RETVAL = newHV();
	  sv_2mortal( (SV*) RETVAL );
	    hv_store(RETVAL,  "name", strlen("name") , newSVpv(name, 0), 0);
	    hv_store(RETVAL,  "order", strlen("order") , newSViv(order), 0);
		hv_store(RETVAL,  "schemaList", strlen("schemaList") , /* WorkflowConnectStruct */
			perl_ARNameList(ctrl, schemaList.u.schemaList), 0);
		hv_store(RETVAL,  "objPropList", strlen("objPropList") ,
			perl_ARPropList(ctrl, &objPropList), 0);
	    hv_store(RETVAL,  "opSet", strlen("opSet") , newSViv(opSet), 0);
	    hv_store(RETVAL,  "enable", strlen("enable") , newSViv(enable), 0);
	    /* a bit of a hack -- makes blessed reference to qualifier */
	    ref = newSViv(0);
	    sv_setref_pv(ref, "ARQualifierStructPtr", (void *)query);
	    hv_store(RETVAL,  "query", strlen("query") , ref, 0);
	    hv_store(RETVAL,  "actionList", strlen("actionList") , 
		     perl_ARList(ctrl, 
				 (ARList *)&actionList,
				 (ARS_fn)perl_ARFilterActionStruct,
				 sizeof(ARFilterActionStruct)), 0);
	    hv_store(RETVAL,  "elseList", strlen("elseList") ,
		     perl_ARList(ctrl, 

ARS/OOform.pm  view on Meta::CPAN

# See URL above.
#

package ARS::form;
require Carp;

# new ARS::form(-form => name, -vui => view, -connection => connection)

sub new {
	my ($class, $self) = (shift, {});
	my ($b) = bless($self, $class);
	
	my ($form, $vui, $connection) =  
	  ARS::rearrange([FORM,VUI,CONNECTION],@_);
	
	$connection->pushMessage(&ARS::AR_RETURN_ERROR,
				 81000,
				 "usage: new ARS::form(-form => name, -vui => vui, -connection => connection)\nform and connection parameters are required."
				)    
	  if(!defined($form) || !defined($connection));
	

ARS/OOsup.pm  view on Meta::CPAN

#    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?

ARS/OOsup.pm  view on Meta::CPAN

      $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'};