view release on metacpan or  search on metacpan

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

	'http://www.topicmapping.com/cgi-bin/test.cgi' =>
		{
			$SAM.'::SubjectAddress' => 1,
			$SAM.'::SubjectIndicators' => 1,
			$SAM.'::BaseNames' => 1
		 },
	'http://www.topicmapping.com/topicmap/topic' =>
		{
			$SAM.'::SubjectAddress' => 1,
			$SAM.'::SubjectIndicators' => 1,
			$SAM.'::BaseNames' => 1
		 },
	'http://www.topicmapping.com/cgi-bin/test2.cgi' =>
		{
			$SAM.'::SubjectAddress' => 1,
			$SAM.'::SubjectIndicators' => 1,
			$SAM.'::BaseNames' => 1
		 },
	'http://www.topicmapping.com/cgi-bin/google_about' =>
		{ $SAM.'::SubjectAddress' => 1 } 
};




sub handler {
	my $r = shift;
	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 ($@)
	{
		return HTTP_NOT_FOUND if($@ =~ qr{^Can't locate});
		$r->log_error( $@ );	
		return SERVER_ERROR;
	}

	my $result_tm = TM::TopicMap->new();

	print STDERR "dynamic handler asking all TMS for this VIEW, VIEW is " .
								$r->path_info . "\n"; 
	foreach my $view_uri ( @{$conf->{$r->path_info}} )
	{
		print STDERR "  --> $view_uri\n";
		my $u = $view_uri; 
		if( (defined $r->args)  && $r->args )
		{
			my %params = $r->args;
			my $param_types = get_param_types( $r->path_info );
			foreach my $p (keys %params)
			{
				print STDERR $p , "\n";
				next unless ($param_types->{$p} eq 'Topic');
				
				# maybe alter sidp string
			}

			$u  .= '?'. join( '&' , map { uri_escape($_) .'='. uri_escape($params{$_} )} keys %params );
		}
		print STDERR $u , "\n";
		getTM($result_tm, $u);		
	}

	my $rv;
	print STDERR "\$rv = Apache::TopicMaps::".$accept."::".$r->path_info."::do" . '($r,$result_tm,1)';

	eval( "\$rv = Apache::TopicMaps::".$accept."::".$r->path_info."::do" . '($r,$result_tm,1)' );
	if ($@)
	{
		$r->log_error( $@ );	
		return SERVER_ERROR;
	}
	$result_tm->dump();
	undef $result_tm;
	return $rv;
}


sub moo {
	my ($tm,$view,$params) = @_;

	foreach my $view_uri ( @{$conf->{$view}} )
	{
		print STDERR "  --> $view_uri\n";
		my $u = $view_uri; 
		if( defined $params )
		{
			my $param_types = get_param_types( $view );
			foreach my $p (keys %$params)
			{
				print STDERR $p , "\n";
				next unless ($param_types->{$p} eq 'Topic');
				
				# maybe alter sidp string
			}

			$u  .= '?'. join( '&' , map { uri_escape($_) .'='. uri_escape($params->{$_} )} keys %$params );
		}
		print STDERR $u , "\n";
		getTM($tm, $u);		
	}

}

sub get_topic_from_full_sidp_string
{
	my($tm,$sidp_string) = @_;
 
        my @pairs = split /\|\|\|/ , $sidp_string;
	my $topic;
 
        foreach my $pair (@pairs)
        {
                my ($p,$v) = split /===/ , $pair;
                $topic = $tm->get_topic_from_string($p , $v);
                last if ( defined $topic );
        }
	return $topic;
}

1;

1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Apache::TopicMaps - Perl extension for serving topic maps.

=head1 SYNOPSIS

  use Apache::TopicMaps;
  FIXME

=head1 ABSTRACT

  A server for topic maps.

=head1 DESCRIPTION

  This is a pre-alpha version. Contact the author if you plan to use it.

=head2 EXPORT

None by default.

=head1 SEE ALSO

See the topic map mail mailing list: http://www.infoloom.com/mailman/listinfo/topicmapmail

If you have a mailing list set up for your module, mention it here.

If you have a web site set up for your module, mention it here.

=head1 AUTHOR