ARSperl

 view release on metacpan or  search on metacpan

ARS/OOform.pm  view on Meta::CPAN

	$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") {
    		@sortOrder = @{$this->{'sortOrder'}};
    }
    
    my @matches = ARS::ars_GetListEntry($this->{'connection'}->{'ctrl'},
					$this->{'form'},
					$this->{'qualifier'},
					$maxhits, $firstretr,
					@sortOrder);
    
    my(@mids, @mdescs);
    for(my $i = 0; $i <= $#matches ; $i += 2) {
	push @mids, $matches[$i];
	push @mdescs, $matches[$i+1];
    }
    
    $this->{'matches'} = \@mids;
    $this->{'querylist'} = \@mdescs;
    
    return @mids;
}

# getFieldID(-field => name)

sub getFieldID {
    my $this = shift;
    my ($name) = ARS::rearrange([FIELD], @_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->getFieldID(-field => name)\nname parameter is required.")
	unless defined($name);
    
    if(!defined($this->{'fields'}->{$name})) {
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81001,

ARS/OOform.pm  view on Meta::CPAN

    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->value2internal(-field => name, -value => value)\nfield parameter is required.") 
	unless (defined($f));
    
    return $v unless defined $v;
    my ($t) = $this->getFieldType($f);
    
    print "value2internal($f, $v) type=$t\n" 
	if $this->{'connection'}->{'.debug'};
    
    # translate an text value into an enumeration number if this
    # field is an enumeration field and we havent been passed a number
    # to begin with.
    
    if(($t eq "enum") && ($v !~ /^\d+$/)) {
	if(!defined($this->{'fieldEnumValues'}->{$f})) {
	    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					       81004,
					       "[1] unable to translate enumeration value for field '$f'");
	}
	foreach (keys %{$this->{'fieldEnumValues'}->{$f}}) {
	    return $_ if $this->{'fieldEnumValues'}->{$f}->{$_} eq $v;
	}
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81004,
					   "[2] unable to translate enumeration value for field '$f'");
    }
    
    # we don't need translation..
    
    return $v;
}

# internal2value(-field => name, -id => id, -value => value)

sub internal2value {
    my ($this) = shift;
    my ($f, $id, $v) = ARS::rearrange([FIELD,ID,VALUE], @_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->internal2value(-field => name, -id => id, -value => value)\nid or field parameter are required.")
	unless (defined($f) || defined($id));
    
    $f = $this->getFieldName(-id => $id) unless defined($f);
    
    my ($t) = $this->getFieldType($f);
    
    print "internal2value($f, $v) type=$t\n" 
	if $this->{'connection'}->{'.debug'};
    
    # translate an enumeration value into a text value
    
    if($t eq "enum") {
	# if the field doesnt exist in our cache, or if the
	# enumeration value exceeds the known list of enumerations,
	# barf.
	
	return undef unless defined $v;
	if(!defined($this->{'fieldEnumValues'}->{$f}) || 
	   (!exists($this->{'fieldEnumValues'}->{$f}->{$v})) ) {
	    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					       81004,
					       "[1] unable to translate enumeration value for field '$f'"
					       );
	}
	
	return $this->{'fieldEnumValues'}->{$f}->{$v}
	}
    
    # we don't need translation..
    
    return $v;
}

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



( run in 1.401 second using v1.01-cache-2.11-cpan-d80b1682f3f )