view release on metacpan or  search on metacpan

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

    my $package = $self->{_classname};
    my $method = $self->{_methodname};
    
    my $calledMethod = $method;
    
    if(exists $self->{services}->{$package})
    {    
        return $self->doMethodCall_registered($package, $method, $a);
    }
    
    #Otherwise, browse in the directory specified by the user.

    push @INC, $self->{_basecp};

    # build the class object
    
    $package =~ s#\.#::#g;
    
    unless (eval ("require " . $package))
    {
        # report back to flash that the class wasn't properly formatted
        print STDERR  "Class $package does not exist or could not be loaded.\n";
	print STDERR $@;
        return;
    }

    # build the construct from the extended class
    my $object = $package->new;
    
    # Check to see if the DescribeService header has been turned on
    if ($self->{_headerFilter} && $self->{_headerFilter} eq "DescribeService")
    {
        my $wrapper = new AMF::Perl::Util::RemotingService($package, $object);

        $self->{_classConstruct} = $wrapper;

        $method =  "__describeService";

# override the method name to the __describeService method
        $self->{_methodname} = $method;

# add the instance to the methodrecord to control registered discover
        my $methodTable = $self->{_classConstruct}->methodTable;
        $methodTable->{$method}{'instance'} = $self->{_instanceName};

    }
    else
    {
        $self->{_classConstruct} = $object;
    }

# was this defined in the methodTable -- required to enable AMF::Perl service approach
    if (exists ($self->{_classConstruct}->methodTable->{$method}))
    {
# create a shortcut to the methodTable
        my %methodrecord = %{$self->{_classConstruct}->methodTable->{$method}};

# check to see if this method name is aliased
        if (exists ($methodrecord{'alias'}))
        {
# map the _methodname to the alias
            $method = $methodrecord{'alias'};
        }

        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};