view release on metacpan or  search on metacpan

lib/Bio/BioVeL/Service.pm  view on Meta::CPAN

			for my $p ( @{ $params } ) {
				$getopt{"${p}=s"} = sub {
					my $value = pop;
					$self->{'_params'}->{$p} = $value;
				};
			}
			GetOptions(%getopt);			
		}
		elsif ( my $req = delete $args{'request'} ) {
			for my $p ( @{ $params } ) {
				$self->{'_params'}->{$p} = $req->param($p);
			}		
		}
		else {
			my $cgi = CGI->new;
			for my $p ( @{ $params } ) {
				$self->{'_params'}->{$p} = $cgi->param($p);
			}
		}
	}
	for my $key ( keys %args ) {
		$self->$key( $args{$key} );
	}	
	return $self;
}

# the AUTOLOAD method traps all undefined method calls that child classes might
# make on themselves. the method names are turned into keys inside the object's
# '_params' hash, whose values are returned (and optionally updated, if an argument
# was provided.

sub AUTOLOAD {
	my $self = shift;
	my $method = $AUTOLOAD;
	$method =~ s/.+://;
	if ( $method !~ /^[A-Z]+$/ ) {
	
		# an argument was provided, update the parameter
		if ( @_ ) {
			$self->{'_params'}->{$method} = shift;
		}
		return $self->{'_params'}->{$method};
	}	
}

=item get_handle

Given a string parameter name, such as 'tree', returns a readable handle that corresponds
with the specified data.

=cut

sub get_handle {
	my ( $self, $location ) = @_;
	
	# location is a URL
	if ( $location =~ m#^(?:http|ftp|https)://# ) {
		my $ua = LWP::UserAgent->new;
		my $response = $ua->get($location);
		if ( $response->is_success ) {
			my $content = $response->decoded_content;
			open my $fh, '<', \$content;
			return $fh;
		}
	}
	else {
		open my $fh, '<', $location or die $!;
		return $fh;
	}
}

=item handler

This method is triggered by mod_perl when a URL path fragment is encountered that matches
the mapping specified in httpd.conf. Example:

 <Location /foo>
         SetHandler perl-script
         PerlResponseHandler Bio::BioVeL::Service::Foo
 </Location>

In this case, requests to http://example.com/foo will be dispatched to 
C<Bio::BioVeL::Service::Foo::handler>.

The method instantiates a concrete service class based on the request parameter 
C<service>, passes in the L<Apache2::Request> object and expects the concrete service
to produce a response body, which the handler prints out. The return value, 
C<Apache2::Const::OK>, indicates to mod_perl that everything went well.

=cut

sub handler {
	my $request = Apache2::Request->new(shift);
	my $subclass = __PACKAGE__ . '::' . $request->param('service');
	eval "require $subclass";
	my $self = $subclass->new( 'request' => $request );
	print $self->response_body;
	return Apache2::Const::OK;
}

=item response_header

Returns the HTTP response header. This might include the content-type.

=cut

sub response_header {
	die "Implement me!";
}

=item response_body

Returns the response body as a big string.

=cut

sub response_body {
	die "Implement me!";
}

=item logger