# # 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 new { my ($class, @p) = (shift, @_); my ($self) = {}; my ($blessed) = bless($self, $class); my ($server, $username, $password, $catch, $ctrl, $dbg) = rearrange([SERVER,USERNAME,PASSWORD,CATCH,CTRL,DEBUG],@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); $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 { my $this = shift; my($cacheId, $operationTime, $user, $password, $lang, $server) = ars_GetControlStructFields($this->{'ctrl'}); print "connection object details:\n"; print "\tcacheId = $cacheId\n"; print "\toperationTime = ".localtime($operationTime)."\n"; print "\tuser = $user\n"; print "\tpassword = $password\n"; print "\tserver = $server\n"; print "\tlang = $lang\n"; } sub availableSchemas { my $this = shift; my ($changedSince, $schemaType, $name) = rearrange([CHANGEDSINCE,SCHEMATYPE,NAME],@_); $changedSince = 0 unless defined($changedSince); $schemaType = ARS::AR_LIST_SCHEMA_ALL unless defined($schemaType); $name = "" unless defined($name); return ars_GetListSchema($this->{'ctrl'}, $changedSince, $schemaType, $name); } sub openForm { my $this = shift; my($form, $vui) = rearrange([FORM,VUI], @_); $this->pushMessage(&ARS::AR_RETURN_ERROR, 81000, "usage: c->openForm(-form => name, -vui => vui)\nform parameter is required.") if(!defined($form) || ($form eq "")); $this->tryCatch(); return new ARS::form(-form => $form, -vui => $vui, -connection => $this); } 1;