data results from the CPAN

data

ARSperl

view release on metacpan or search on metacpan

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

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));
	
	$vui = "Default Admin View" unless defined $vui;
	
	$self->{'form'}       = $form;
	$self->{'connection'} = $connection;
	$self->{'vui'}        = $vui;
	my %f = ARS::ars_GetFieldTable($connection->{'ctrl'}, 
				       $form);
	
	$connection->tryCatch();
	$self->{'fields'}     = \%f;
	
	my %rev = reverse %f; # convenient
	$self->{'fields_rev'} = \%rev;
	
	my(%t, %enums);
	
	foreach (keys %f) {
		print "caching field: $_\n" if $self->{'connection'}->{'.debug'};
		my $fv = ARS::ars_GetField($self->{'connection'}->{'ctrl'},
					   $self->{'form'},
					   $f{$_});
		$connection->tryCatch();
		$t{$_} = $fv->{'dataType'};
		print "\tdatatype: $t{$_}\n" if $self->{'connection'}->{'.debug'};

		if ($fv->{'dataType'} eq "enum") {
			if (ref($fv->{'limit'}->{'enumLimits'}) eq "ARRAY") {
                                my $i = 0;
                                $enums{$_} = { map { $i++, $_ } @{$fv->{'limit'}->{'enumLimits'}} };
                        }
			elsif (exists $fv->{'limit'}->{'enumLimits'}->{'regularList'}) {
                                my $i = 0;
                                $enums{$_} = { map { $i++, $_ } @{$fv->{'limit'}->{'enumLimits'}->{'regularList'}} };
			} else {
                                $enums{$_} = { map { $_->{itemNumber}, $_->{itemName} } @{$fv->{'limit'}->{'enumLimits'}->{customList}} };
			}
		}
	}
	
	$self->{'fieldtypes'} = \%t;
	$self->{'fieldEnumValues'} = \%enums;
	return $b;
}

sub DESTROY {
  
}

# getEnumValues(-field => "fieldname")

sub getEnumValues {
	my ($this) = shift;
	my ($field) = ARS::rearrange([FIELD], @_);
	if(ref($this->{'fieldEnumValues'}->{$field}) eq "ARRAY") {
		return @{$this->{'fieldEnumValues'}->{$field}};
	}
        $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
                                           81006,
                                           "field $field is not an enumeration field.");
	$this->{'connection'}->tryCatch();
	return undef;
}

# query(-query => "qualifier", -maxhits => 100, -firstretrieve => 0)

sub query {
    my ($this) = shift;
    my ($query, $maxhits, $firstretr) = ARS::rearrange([QUERY,MAXHITS,FIRSTRETRIEVE], @_);
    $query = "(1 = 1)" unless defined($query);
    $maxhits = 0 unless defined($maxhits);
    $firstretr = 0 unless defined($firstretr);
    
    if($this->{'connection'}->{'.debug'}) {
	print "form->query(".$this->{'form'}.", $query, ".$this->{'vui'}.")\n";
    }
    
    $this->{'qualifier'} = 
      ARS::ars_LoadQualifier($this->{'connection'}->{'ctrl'},
			     $this->{'form'},
			     $query,
			     $this->{'vui'});
    $this->{'connection'}->tryCatch();
    
    my @sortOrder = ();
    if(defined($this->{'sortOrder'}) && 
       ref($this->{'sortOrder'}) eq "ARRAY") {

ARS/OOform.pm view on Meta::CPAN

					   "field '$name' not in view: ".$this->{'vui'}."\n"
					   );
    }
    
    return $this->{'fields'}->{$name} if(defined($name));
}

# getFieldName(-id => id)

sub getFieldName {
    my $this = shift;
    my ($id) = ARS::rearrange([ID], @_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->getFieldName(-id => id)\nid parameter required."
				       )
	unless defined($id);
    
    return $this->{'fields_rev'}->{$id} if defined($this->{'fields_rev'}->{$id});
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81002,
				       "field id '$id' not available on form: ".$this->{'form'}.""
				       );
}

# getFieldType(-field => name, -id => id)

sub getFieldType {
    my $this = shift;
    my ($name, $id) = ARS::rearrange([FIELD,ID], @_);
    
    if(!defined($name) && !defined($id)) {
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: form->getFieldType(-field => name, -id => id)\none of the parameters must be specified.");
    }
    
    if(defined($name) && !defined($this->{'fieldtypes'}->{$name})) {
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81001,
					   "field '$name' not in view: ".$this->{'vui'}."\n"
					   );
    }
    
    #print "getFieldType($name, $id)\n" if $this->{'connection'}->{'.debug'};
    
    return $this->{'fieldtypes'}->{$name} if defined($name);
    
    # they didnt give us a name, but instead gave us an id. look up the
    # name and return the type.
    
    if(defined($id)) {
	my $n = $this->getFieldName(-id => $id);
	return $this->{'fieldtypes'}->{$n};
    }
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81003,
				       "couldn't determine dataType for field.");
}

# delete(-entry => id)

sub delete {
    my $this = shift;
    my ($id) = ARS::rearrange([ENTRY],@_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->delete(-entry => id)\nentry parameter is required.")
	unless defined($id);
    
    my (@d);
    
    # allow the user to delete multiple entries in one shot
    
    if(ref($id) eq "ARRAY") {
	@d = @{$id};
    } else {
	push @d, $id;
    }
    
    foreach (@d) {
      ARS::ars_DeleteEntry($this->{'connection'}->{'ctrl'},
			   $this->{'form'},
			   $_);
	$this->{'connection'}->tryCatch();
    }
}

# merge(-type => mergeType, -values => { field1 => value1, ... })

sub merge {
	my ($this) = shift;
	my ($type, $vals) = 
	  ARS::rearrange([TYPE,[VALUE,VALUES]],@_);

	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: form->merge(-type => mergeType, -values => { field1 => value1, ... })\ntype and values parameters are required.")
	  unless(defined($type) && defined($vals));
	
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: form->merge(-type => mergeType, -values => { field1 => value1, ... })\nvalues parameter must be HASH ref.") 
	  unless ref($vals) eq "HASH";
	
	my (%realmap);
	
	# as we work thru each value, we need to perform translations for
	# enum fields.
	
	foreach (keys %{$vals}) {
		my ($rv) = $this->value2internal(-field => $_,
						 -value => $vals->{$_});
		#print "[form->merge] realval for $_ = $rv\n";
		$realmap{$this->getFieldID($_)} = $rv;
	}

ARS/OOform.pm view on Meta::CPAN


# create(-values => { field1 => value1, ... })

sub create {
    my ($this) = shift;
    my ($vals) = ARS::rearrange([[VALUES,VALUE]],@_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->create(-values => { field1 => value1, ... })\nvalues parameter is required.") 
	unless defined($vals);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->create(-values => { field1 => value1, ... })\nvalues parameter must be HASH ref.") 
	unless ref($vals) eq "HASH";
    
    my (%realmap);
    
    print "Mapping field information.\n" if $self->{'connection'}->{'.debug'};
    foreach (keys %{$vals}) {
	my ($rv) = $this->value2internal(-field => $_,
					 -value => $vals->{$_});
	#print "realval for $_ = $rv\n";
	$realmap{$this->getFieldID($_)} = $rv;
    }
    
    print "calling ars_CreateEntry..\n" if $self->{'connection'}->{'.debug'};
    my ($id) = ARS::ars_CreateEntry($this->{'connection'}->{'ctrl'},
				    $this->{'form'},
				    %realmap);
    
    print "calling tryCatch()..\n" if $self->{'connection'}->{'.debug'};
    $this->{'connection'}->tryCatch();
    
    return $id;
}

# get(-entry => entryid, -fields => [ field1, field2 ])

sub get {
    my $this = shift;
    my ($eid, $fields) = ARS::rearrange([ENTRY,[FIELD,FIELDS]],@_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->get(-entry => entryid, -fields => [ field1, field2, ... ])\nentry parameter is required.") 
	unless defined($eid);
    
    my (@fieldlist) = ();
    my ($allfields) = 1;
    
    if(defined($fields)) {
	$allfields = 0;
	foreach (@{$fields}) {
	    push @fieldlist, $this->getFieldID($_);
	}
    }
    
    # what we want to do is: retrieve all of the values, but for
    # certain datatypes (attachments) we want to insert
    # an object instead of the field value. for enum types, 
    # we want to decode the value.
    
    #print "(";  print $this->{'form'}; print ", $eid, @fieldlist)\n";
    
    my @v;
    if($allfields == 0) {
	@v = ARS::ars_GetEntry($this->{'connection'}->{'ctrl'},
			       $this->{'form'},
			       $eid, @fieldlist);
    } else {
	@v = ARS::ars_GetEntry($this->{'connection'}->{'ctrl'},
			       $this->{'form'},
			       $eid);
    }
    
    my @rv;
    
    for(my $i = 0 ; $i <= $#v ; $i += 2) {
	if($this->getFieldType(-id => $v[$i]) eq "attach") {
	    push @rv, $v[$i+1]; # "attach";
	} 
	elsif($this->getFieldType(-id => $v[$i]) eq "enum") {
	    push @rv, $this->internal2value(-id => $v[$i],
					    -value => $v[$i+1]);
	} 
	else {
	    push @rv, $v[$i+1];
	}
    }
    
    return @rv unless ($#rv == 0);
    return $rv[0];
}


# getAsHash(-entry => entryid, -fields => [field1, field2, ...])

sub getAsHash {
    my $this = shift;
    my ($eid, $fields) = ARS::rearrange([ENTRY,[FIELD,FIELDS]],@_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->getAsHash(-entry => entryid, -fields => [ field1, field2, ... ])\nentry parameter is required.") 
	unless defined($eid);
    
    my (@fieldlist) = ();
    my ($allfields) = 1;
    
    if(defined($fields)) {
	$allfields = 0;
	foreach (@{$fields}) {
	    push @fieldlist, $this->getFieldID($_);
	}
    }
    
    my @v;
    if($allfields == 0) {
	@v = ARS::ars_GetEntry($this->{'connection'}->{'ctrl'},

( run in 0.605 second using v1.01-cache-2.11-cpan-39bf76dae61 )