###################################################################### # # EPrints::Apache::VLit # ###################################################################### # # ###################################################################### =pod =for Pod2Wiki =head1 NAME B - VLit Transclusion Module =head1 DESCRIPTION This module is consulted when any document file is served. It allows subsets of the whole to be served. This is an experimental feature. It may be turned off in the configuration if you object to it for some reason. =cut package EPrints::Apache::VLit; use Digest::MD5; use FileHandle; use EPrints::Apache::AnApache; # exports apache constants use strict; my $TMPDIR = "/tmp/partial"; ###################################################################### =pod =over 4 =item $rc = EPrints::Apache::VLit::handler( $r ) Handler for managing EPrints VLit requests. =cut ###################################################################### sub handler { my( $r ) = @_; my $filename = $r->filename; if ( ! -r $filename ) { return NOT_FOUND; } my %args = (); my @a = split( "&", $r->args ); foreach my $arg ( @a ) { my( $k, $v ) = split( '=', $arg, 2 ); $args{$k}=$v; } my $version = $args{xuversion}; my $locspec = $args{locspec}; if( !defined $version && !defined $args{mode} ) { # We don't need to handle it, just do this # the normal way. return DECLINED; } if( !defined $locspec ) { $locspec = "charrange:"; } # undo eprints rewrite! my $uri = $r->uri; $uri =~ s#/([0-9]+)/([0-9][0-9])/([0-9][0-9])/([0-9][0-9])/#/$1$2$3$4/#; my $repository = EPrints->new->current_repository; my $baseurl = $repository->get_conf( "base_url" ).$uri; my $LSMAP = { "area" => \&ls_area, "charrange" => \&ls_charrange }; unless( $locspec =~ m/^([a-z]+):(.*)$/ ) { send_http_error( 400, "Bad locspec \"$locspec\"" ); return; } my( $lstype, $lsparam ) = ( $1, $2 ); my $fn = $LSMAP->{$lstype}; if( !defined $fn ) { send_http_error( 501, "Unsupported locspec" ); return; } &$fn( $filename, $lsparam, $locspec, $r, $baseurl, \%args ); return OK; } ###################################################################### =pod =item EPrints::Apache::VLit::send_http_error( $code, $message ) Generates and prints VLit error message page with HTTP error $code and $message provided. =cut ###################################################################### sub send_http_error { my( $code, $message ) = @_; my $r = EPrints::Apache::AnApache::get_request(); $r->content_type( 'text/html' ); EPrints::Apache::AnApache::send_status_line( $r, $code, $message ); $r->send_http_header; my $title = "Error $code in Apache::VLit request"; $r->print( < $title

$title

$message

END } ###################################################################### =pod =item EPrints::Apache::VLit::send_http_header( $type ) Generates HTTP header part of VLit response with content type $type. =cut ###################################################################### sub send_http_header { my( $type ) = @_; my $r = EPrints::Apache::AnApache::get_request(); if( defined $type ) { $r->content_type( $type ); } EPrints::Apache::AnApache::send_status_line( $r, 200, "YAY"); EPrints::Apache::AnApache::send_http_header( $r ); } ###################################################################### =pod =item EPrints::Apache::VLit::ls_charrange( $filename, $param, $locspec, $r, $baseurl, $args ) Generate VLit response for a specific character range in a particular file. =cut ###################################################################### sub ls_charrange { my( $filename, $param, $locspec, $r, $baseurl, $args ) = @_; my $repository = EPrints->new->current_repository( $r ); # if( $r->content_type !~ m#^text/# ) # { # send_http_error( 400, "Can't return a charrange of mimetype: ".$r->content_type ); # return; # } my( $offset, $length ); if( $param eq "" ) { $offset = 0; $length = -s $filename; } else { unless( $param=~m/^(\d+)\/(\d+)$/ ) { send_http_error( 400, "Malformed charrange param: $param" ); return; } ( $offset, $length ) = ( $1, $2 ); } my $mode = $args->{mode}; my $readoffset = $offset; my $readlength = $length; my $constart = -1; my $conend = -1; if( $mode eq "context" ) { my $contextsize = 512; $readoffset-=$contextsize; $readlength+=$contextsize+$contextsize; $constart = $contextsize; if( $readoffset<0 ) { $constart += $readoffset; $readlength += $readoffset; $readoffset=0; } $conend = $readlength-$contextsize; } if( $mode eq "context2" ) { # has a char range but loads whole document $readoffset = 0; $readlength = -s $filename; $constart = $offset; $conend = $offset+$length; } my $fh = new FileHandle( $filename, "r" ); binmode( $fh ); my $data = ""; $fh->seek( $readoffset, 0 ); $fh->read( $data, $readlength ); $fh->close(); if( $mode eq "human" || $mode eq "context" || $mode eq "context2" || $mode eq 'spanSelect' || $mode eq 'endSelect' || $mode eq 'link' || $mode eq 'spanSelect2' || $mode eq 'endSelect2' ) { my $html = ""; my $BIGINC = 100; my $inc = $BIGINC; if( $mode eq 'spanSelect2' || $mode eq 'endSelect2' || $mode eq 'context' || $mode eq "context2" ) { $inc = 1; } $html.=''; my $toggle = 0; for( my $o=0; $o<$readlength; $o+=$inc ) { my $class = "vlit-spanlink".($toggle+1); $toggle = !$toggle; if( $o == $constart) { $html.=''; } if( $o == $constart-512) { $html.=''; } my $c=substr($data,$o,$inc); # $c is either a string or a single char $c =~ s/&/&/g; $c =~ s//>/g; $c =~ s/\n/
/g; if( $mode eq 'spanSelect' ) { my $url = $baseurl.'?locspec=charrange:'.($offset+$o)."/".($length-$o).'&mode=spanSelect2'; $c =''.$c.''; } if( $mode eq 'spanSelect2' && $o < $BIGINC ) { my $url = $baseurl.'?locspec=charrange:'.($offset+$o)."/".($length-$o).'&mode=endSelect'; $c =''.$c.''; } if( $mode eq 'endSelect' ) { my $url = $baseurl.'?locspec=charrange:'.($offset)."/".($o+$inc).'&mode=endSelect2#end'; $c =''.$c.''; } if( $mode eq 'endSelect2' && $o > $readlength-$BIGINC-1) { my $url = $baseurl.'?locspec=charrange:'.($offset)."/".($o+1).'&mode=link'; $c =''.$c.''; } #if( $o > 0 && $mode eq "spanSelect" ) { $html.="|"; } $html.=$c; if( $o == $conend-1 ) { $html.=''; } } $html.=''; my $copyurl = $repository->get_conf( "vlit" )->{copyright_url}; my $front = 'trans ©'; if( $param eq "" ) { if( $mode eq "human" ) { $front.= ' [quote document]'; } } else { my $url = $baseurl; if( $mode eq "human" ) { $front.= ' [view context]'; } if( $mode eq "context" ) { $front.= ' [context in full document]'; } if( $mode eq "context2" ) { $front.= ' [full document]'; $front.= ' [quote document]'; } } $front.= ' [raw data]'; my $msg=''; my $msg2=''; if( $mode eq "endSelect2" ) { $msg='

select exact end point

'; } if( $mode eq "spanSelect2" ) { $msg='

select exact start point

'; } if( $mode eq "endSelect" ) { $msg='

select approximate end point

'; } if( $mode eq "spanSelect" ) { $msg='

select approximate start point

'; } $msg2=$msg; # only for span msgs send_http_header( "text/html" ); my $title = "Transquotation from char $offset, length $length"; if( $mode eq 'link' ) { my $url = $baseurl.'?xuversion=1.0&locspec=charrange:'.($offset)."/".($length); my $urlh = $url.'&mode=human'; my $urlx = $url.'&mode=xml-entity'; $msg=<

$title

Raw char quote: $url

Human readable (HTML): $urlh

XML: $urlx

END my $urlh2 = $urlh; $urlh2=~s/'/&squot;/g; $msg.=<Cut and paste HTML for pop-up window:


<a href="#" onclick="javascript:window.open( '$urlh2', 'transclude_window', 'width=666, height=444, scrollbars');">$title</a>

END } my $cssurl = $repository->get_conf( "base_url" )."/style/vlit.css"; $r->print( < $title $msg

$front

$html

$msg2 END } elsif( $mode eq "xml-entity" ) { my $page = EPrints::XML::make_document(); my $transclusion = $page->createElement( "transclusion" ); $transclusion->setAttribute( "xlmns", "http://xanadu.net/transclusion/xu/1.0" ); $transclusion->setAttribute( "href", $baseurl ); $transclusion->setAttribute( "offset", $offset ); $transclusion->setAttribute( "length", $length ); $transclusion->appendChild( $page->createTextNode( $data ) ); $page->appendChild( $transclusion ); send_http_header( "text/xml" ); $r->print( EPrints::XML::to_string( $page ) ); } else { send_http_header(); $r->print( $data ); } } ###################################################################### =pod =item EPrints::Apache::VLit::ls_area( $file, $param, $resspec, $r, $baseurl, $args ) Generate VLit response for a specific page area in a particular file. =cut ###################################################################### sub ls_area { my( $file, $param, $resspec, $r, $baseurl , $args) = @_; my $page = 1; my $opts = { page => 1, hrange => { start=>0 }, vrange => { start=>0 } }; my $repository = EPrints->new->current_repository( $r ); my $mode = $args->{mode}; if( $mode eq "human" ) { send_http_header( "text/html" ); my $cssurl = $repository->get_conf( "base_url" )."/vlit.css"; my $title = "title"; my $html = "html"; my $copyurl = $repository->get_conf( "vlit" )->{copyright_url}; my $front = 'trans ©'; my $fullurl = $baseurl.'?xuversion=1.0&locspec=area:&mode=human'; my $imgurl = $baseurl.'?xuversion=1.0&locspec=area:'.$param; my $linkurl = $imgurl; if( $param ne '' ) { $linkurl = $fullurl; $front.= ' [full document]'; } $front.= ' [raw data]'; $r->print( < $title

$front