view release on metacpan or  search on metacpan

lib/Apache/TopicMaps.pm  view on Meta::CPAN

		return { query => 'String' };
	} else {
		return {};
	}
}
	

sub trim_path_info
{
	my $r = shift;

	my $p = $r->path_info;
	$p =~ s/\/$//g;
	$p =~ s/^\///g;
	if( $p eq '') { $p = 'WELCOME'; }
	$r->path_info($p);
}
sub choose_mime
{
	my $r = shift;

	my $accept = 'text/plain';
	my $accept_header = $r->header_in('Accept');

	if($accept_header =~ /\*\/\*/) {
		return 'text::html';
	} elsif($accept_header =~ /text\/html/) {
		return 'text::html';
	} elsif($accept_header =~ /application\/xtm\+xml/) {
		return 'application::xtmPLUSxml';
	} elsif($accept_header =~ /application\/rdf\+xml/) {
		return 'application::rdfPLUSxml';
	}
	return 'text::plain';
}

sub load_maps
{
	my($r,$tm) = @_;

	my $load_maps = $r->dir_config('LoadMaps');
	my @maps = split(/\s+/,$load_maps);

	foreach (@maps)
	{
		my ($path,$pm,$parse,$param) = split /,/ ;
		if( ($path =~ /^\//) or ( $path =~ /^file:\/\// ))
		{
			if(defined $param)
			{
				$tm->load_file( $path,$pm,$parse,$param ) || die("unable to load $path, " . $tm->get_error() );
			}
			else
			{
				$tm->load_file( $path,$pm,$parse ) || die("unable to load $path, " . $tm->get_error() );
			}
		}
		elsif( $path =~ /^http/ )
		{

			my $request = HTTP::Request->new('GET', '$path');
			#$request->authorization_basic("user","pass");
			my $tm_id = time() .'-'.$$;
			my $response = $ua->request($request, '/tmp/topicmap'.$tm_id);
			$tm->load_file( '/tmp/topicmap'.$tm_id,$pm,$parse );
			# FIXME: check loaded!
		}
		else
		{
			# FIXME
			die("$path has unsopported protocol");
		}
	}
}
sub getTM
{
	my ($tm,$uri) = @_;
	my $request = HTTP::Request->new('GET', $uri);
	$request->header( 'Accept' => 'application/xtm+xml' );

	my $tm_id = $$ .'-'.$tmc ;
	$tmc++;
	my $response = $ua->request($request, '/tmp/topicmap_' . $tm_id);
	print STDERR $response->status_line," ZZZZZ\n";
	return unless(  $response->is_success );
	my $rval = $tm->load_file( '/tmp/topicmap_' . $tm_id, 'xtm_simple' , 'xml' , "" , $uri);
	if(!defined $rval)
	{
		print STDERR "ERROR(2): ", $tm->get_error() , "\n";
        }
}


sub static_tm_handler {
	my $r = shift;
	if(! defined $topicmap)
	{
		$topicmap = TM::TopicMap->new();
		load_maps($r,$topicmap);
	}
	trim_path_info($r);
	my $accept = choose_mime($r);

	#eval( 'require("' . "/home/jan/projects/FOO/TMS/$accept/" . $r->path_info .'")' );
	eval( 'require ' . "Apache::TopicMaps::" .$accept . "::" . $r->path_info .' ' );
	print STDERR 'require ' . "Apache::TopicMaps::" .$accept . "::" . $r->path_info .' ' ;
	if ($@)
	{
		$r->log_error( $@ );	
		return HTTP_NOT_FOUND if($@ =~ qr{^Can't locate});
		$r->log_error( $@ );	
		return SERVER_ERROR;
	}

	my $rv;
	# FIXME: this seems to prevent $topicmap from 'becoming' undef somehow...???
	return SERVER_ERROR unless (defined $topicmap);

	# note that calling do() with only two params will prevent view code from
	# doing additional remote access
	eval( "\$rv = Apache::TopicMaps::".$accept."::".$r->path_info."::do" . '($r,$topicmap)' );
	if ($@)
	{
		$r->log_error( $@ );	
		return SERVER_ERROR;
	}
	return $rv;
}

my $conf = {
	'search' => [
		'http://www.topicmapping.com/topicmap/search'
		],
	'index' => [
		'http://www.topicmapping.com/topicmap/index'
		],
	'topic' => [
		'http://www.topicmapping.com/topicmap/topic',