ARSOOform.pm - metacpan.org

# 
# 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") {
                                $enums{$_} = [@{$fv->{'limit'}->{'enumLimits'}}];
                        }
			elsif (exists $fv->{'limit'}->{'enumLimits'}->{'regularList'}) {
				$enums{$_} = [@{$fv->{'limit'}->{'enumLimits'}->{'regularList'}}];
			} else {
				print "Sorry. I'm not sure what to do with non-regularLists of enums.\n";
				print "(this enum is type \"", keys %{$fv->{'limit'}->{'enumLimits'}}, "\")\n";
				print "listStyle = ", $fv->{'limit'}->{'enumLimits'}->{'listStyle'}, "\n";
				die;
			}
		}
	}
	
	$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,
					   "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;
	}

	print "merge/type=$type\n" if $this->{'connection'}->{'.debug'};

	my ($rv) = ARS::ars_MergeEntry($this->{'connection'}->{'ctrl'},
				       $this->{'form'},
				       $type,
				       %realmap);
	

	$this->{'connection'}->tryCatch();

	# if ($rv is "") and there are no FATAL or ERRORs and
	# an entry id was in our vals realmap hash, then this was
	# a successful "OVERWRITE" or "MERGE" operation. lets return
	# the entry-id. if $rv is no "", then whatever operation this
	# was - it was successful. if it's "" and we had no entry-id
	# specified - or we did have one specified and there are FATALs
	# or ERRORs then something is wrong. complicated, but that's how
	# the C API works. we try to make the OO layer a little nicer for
	# the end user.

	if(($rv eq "") && defined($realmap{1})) {
		if(!$this->{'connection'}->hasFatals() &&
		   !$this->{'connection'}->hasErrors()) {
			$rv = $realmap{1};
		}
	}
		   
	return $rv;
}

# set(-entry => id, -gettime => tstamp, -values => { field1 => value1, ... })

sub set {
    my ($this) = shift;
    my ($entry,$gettime,$vals) = 
      ARS::rearrange([ENTRY,GETTIME,[VALUE,VALUES]],@_);
    
    $gettime = 0 unless defined($gettime);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->set(-entry => id, -gettime => tstamp, -values => { field1 => value1, ... })\nentry and values parameters are required."
				       )
	unless (defined($vals) && defined($entry));
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->set(-entry => id, -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 "realval for $_ = $rv\n";
	$realmap{$this->getFieldID($_)} = $rv;
    }
    
    my ($rv) = ARS::ars_SetEntry($this->{'connection'}->{'ctrl'},
				 $this->{'form'},
				 $entry,
				 $gettime,
				 %realmap);
    
    $this->{'connection'}->tryCatch();
    
    return $rv;
}

# value2internal(-field => name, -value => value)

sub value2internal {
    my ($this) = shift;
    my ($f, $v) = ARS::rearrange([FIELD,VALUE], @_);
    
    $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'");
	}
	for($i = 0 ; $i <= $#{$this->{'fieldEnumValues'}->{$f}} ; $i++) {
	    return $i if $this->{'fieldEnumValues'}->{$f}->[$i] 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}) || 
	   ($#{$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,
				       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'},
			       $this->{'form'},
			       $eid, @fieldlist);
    } else {
	@v = ARS::ars_GetEntry($this->{'connection'}->{'ctrl'},
			       $this->{'form'},
			       $eid);
    }
    
    for(my $i = 0 ; $i <= $#v ; $i += 2) {
	if($this->getFieldType(-id => $v[$i]) eq "attach") {
	    #$v[$i+1] = "attach";
	} 
	elsif($this->getFieldType(-id => $v[$i]) eq "enum") {
	    $v[$i+1] = $this->internal2value(-id => $v[$i], 
					     -value => $v[$i+1]);
	}
	$v[$i] = $this->getFieldName(-id => $v[$i]);
    }
    
    return @v;
}

# getAttachment(-entry => eid, -field => fieldname, -file => filename)
# if file isnt specified, the attachment is returned "in core"

sub getAttachment {
    my $this = shift;
    my ($eid, $field, $file) = ARS::rearrange([ENTRY,FIELD,FILE],@_);
    
    if(!defined($eid) && !defined($field)) {
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: getAttachment(-entry => eid, -field => fieldname, -file => filename)\nentry and field parameters are required.");
    }
    
    if(defined($file)) {
	my $rv = ARS::ars_GetEntryBLOB($this->{'connection'}->{'ctrl'},
				       $this->{'form'},
				       $eid,
				       $this->getFieldID($field),
				     ARS::AR_LOC_FILENAME,
				       $file);
	$this->{'connection'}->tryCatch();
	return $rv;
    } 
    
    return  ARS::ars_GetEntryBLOB($this->{'connection'}->{'ctrl'},
				  $this->{'form'},
				  $eid,
				  $this->getFieldID($field),
				ARS::AR_LOC_BUFFER);
}

#setSort(... )

sub setSort {
    my $this = shift;
    
    if(($#_+1) % 2 == 1){
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: setSort(...)\nMust have an even number of parameters. (nparm = $#_)");
    }
    
    my (@t) = @_;
    
    for(my $i = 0 ; $i <= $#t ; $i+=2) {
	$t[$i] = $this->getFieldID($t[$i]);
    }
    
    $this->{'sortOrder'} = \@t;
}

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)