view release on metacpan or  search on metacpan

lib/AMF/Perl/App/Executive.pm  view on Meta::CPAN

        }

        if (exists($methodrecord{'instance'}))
        {
# check the instance names to see if they match.  If so, then let this happen
            if (!exists($methodrecord{'instance'}) || $self->{_instanceName} != $methodrecord{'instance'})
            {	
# if they don't match then print STDERR  with this error
            print STDERR  "Access error for " . $self->{_headerFilter} . ".\n";
            return;
            }
        }
        
        # check to see if an explicit return type was defined
        if (exists($methodrecord{'returns'}))
        {
            $self->{_returnType} = $methodrecord{'returns'};
        }
        # set the default return type of "unknown"
        else
        {
            $self->{_returnType} = "unknown";
        }
        # set to see if the access was set and the method as remote permissions.
        if ( (exists($methodrecord{'access'})) && (lc ($methodrecord{'access'}) eq "remote"))
        {
            # finally check to see if the method existed
            if ($self->{_classConstruct}->can($method))
            {
                # execute the method and return it's results to the gateway
                return $self->{_classConstruct}->$method(@$a);
            }
            else
            {
                # print STDERR  with error
                print STDERR  "Method " . $calledMethod . " does not exist in class ".$self->{_classConstruct}.".\n";
            }
        }
        else
        {
            # print STDERR  with error
            print STDERR  "Access Denied to " . $calledMethod . "\n";
        }
            
        
    }
    else
    {
        # print STDERR  with error
        print STDERR  "Function " . $calledMethod . " does not exist in class ".$self->{_classConstruct}.".\n";
    }

}

sub doMethodCall_registered
{
    my ($self, $package, $method, $a) = @_;
    
    my $serviceobject = $self->{services}->{$package};

    if(length($package) == 0)
    {
    # TODO: handle non packaged functions
    #trigger_error("ERROR: no package in call",E_USER_ERROR);
        return;
    } 
    elsif(!$serviceobject)
    {
        print STDERR "Package ".$package." not registerd on server\n";
        return;
    } 
    elsif(!$serviceobject->can($method))
    {
        print STDERR "Function ".$method." does not exist in package ".$package."\n";
        return;
    }
    else
    {
        $self->{_returnType} = "unknown";

    	if ($serviceobject->can("methodTable") && exists ($serviceobject->methodTable->{$method}))
    	{
			# create a shortcut to the methodTable
        	my %methodrecord = %{$serviceobject->methodTable->{$method}};
        	# check to see if an explicit return type was defined
        	if (exists($methodrecord{'returns'}))
        	{
            	$self->{_returnType} = $methodrecord{'returns'};
        	}
        	# set the default return type of "unknown"
        	else
        	{
            	$self->{_returnType} = "unknown";
        	}
		}
        return $serviceobject->$method(@$a);
    }    
}

sub strrpos
{
    my ($string)=@_;
    my $reversed = reverse $string;
    my $firstDotIndex = index($reversed, ".");
    return length($string)-$firstDotIndex-1;
}

1;