view release on metacpan or  search on metacpan

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

    my @hrefs = map { 
	join("/",@breadcrumbs[1..$i++]);
    } @breadcrumbs;

    $xsl_parser->register_function("urn:aaronstraupcope:apache:xbel",
				   "breadcrumbs",
				   sub { return shift @breadcrumbs; });   

    $xsl_parser->register_function("urn:aaronstraupcope:apache:xbel",
				   "href_for_crumb",
				   sub { return join("/",
						     "$uri_scheme://$uri_host$loc",
						     shift @hrefs); });

    # Munge munge munge

    my $xmldoc = $xml_parser->parse_file($cache_file);
    my $html   = $xsl_transformer->transform($xmldoc,%params);
    
    $xsl_transformer->output_file($html,$cache_file);

    # Send the stupid file, already

    $apache->content_type("text/html");
    $apache->send_http_header();

    $apache->send_fd(Apache::File->new($cache_file));
    return OK;
}

sub cleanup {
    my $apache = shift;
    return 1;
}

sub cache_file {
    my $apache = shift;
    my $file = shift;
    my $path = shift;

    my $hex = &md5_hex(join("#",$file,$path));
    return File::Spec->catfile($apache->dir_config("CacheDir"),$hex);
}

sub fetch_cache {
    my $apache = shift;
    my $file   = shift;
    my $path   = shift;

    my $cache = &cache_file($apache,$file,$path);

    # Check for existence

    if (! -e $cache) {
	$apache->log->debug("Cachefile '$cache' does not exist.");
	return ($cache,0);
    }

    #

    my $cache_mtime = (stat($cache))[9];

    if ((stat(__FILE__))[9] > $cache_mtime ) {
	$apache->log->debug("Cache is out of sync with handler.");
	return ($cache,0);
    }

    if ((stat($file))[9] > $cache_mtime ) {
	$apache->log->debug("Cache is out of sync with XBEL file.");
	return ($cache,0);
    }

    my $xsl_file = $apache->dir_config("XslPath");

    if ((stat($xsl_file))[9] > $cache_mtime) {
	$apache->log->debug("Cache is out of sync with stylesheet.");

	$xsl_stylesheet  = $xml_parser->parse_file($xsl_file);
	$xsl_transformer = $xsl_parser->parse_stylesheet($xsl_stylesheet);
	
	return ($cache,0);
    }

    return ($cache,1);
}

sub path2node {
    my @path = map { "folder[\@id=\"$_\"]"; } @_;
    return join("/","","xbel",@path);
}

sub render_slice {
    my $apache = shift;
    my $file   = shift;
    my $doc    = shift;
    my $node   = shift;

    #

    my $owner = $doc->find(qq(/xbel/info/metadata[\@owner]));
    my $ver   = $doc->version();
    my $enc   = $doc->encoding();

    my $dom  = XML::LibXML::Document->createDocument($ver,$enc);
    my $xbel = XML::LibXML::Element->new(qq(xbel));

    my $info = XML::LibXML::Element->new(qq(info));
    my $meta = XML::LibXML::Element->new(qq(metadata));
    $meta->setAttribute("owner",$owner);

    my $title = XML::LibXML::Element->new(qq(title));
    $title->appendText($doc->find(qq(/xbel/title)));

    my $desc = XML::LibXML::Element->new(qq(desc));
    $desc->appendText($doc->find(qq(/xbel/desc)));
    
    $info->appendChild($meta);
    $xbel->appendChild($title);
    $xbel->appendChild($info);
    $xbel->appendChild($desc);

    # Add support to expand <alias>
    # elements here. This is slated
    # for version 1.5

    $xbel->appendChild($node);
    $dom->setDocumentElement($xbel);

    #

    if (my $fh = &get_fh($apache,$file)) {

	# WTF doesn't Apache::File
	# have a print method?