Apache-AxKit-Provider-File-Syntax
view release on metacpan or search on metacpan
# $Id: Syntax.pm,v 1.7 2004/07/16 04:40:56 nachbaur Exp $
package Apache::AxKit::Provider::File::Syntax;
use strict;
use vars qw/@ISA/;
use Apache::AxKit::Provider::File;
@ISA = ('Apache::AxKit::Provider::File');
our $VERSION = 0.06;
our $noMimeInfo = 0; # unless told otherwise, we use File::MimeInfo::Magic
use Apache;
use Apache::Log;
use Apache::Constants qw(HTTP_OK);
use Apache::AxKit::Exception;
use Apache::AxKit::Provider;
use Text::VimColor;
use AxKit;
use File::Spec;
use Fcntl qw(O_RDONLY LOCK_SH);
# see if we can use File::MimeInfo::Magic
eval "use File::MimeInfo::Magic qw( mimetype )";
$noMimeInfo = 1 if $@;
#
# We can't output a filehandle, so throw the necessary exception
sub get_fh {
throw Apache::AxKit::Exception::IO( -text => "Can't get fh for Syntax" );
}
#
# perform the necessary mime-type processing magic
sub get_strref {
my $self = shift;
# Return the XML data if we've already computed it
return \$$self{xml} if ($self->{xml});
# Let the superclass A:A:P:File handle the request if
# this is a directory
if ($self->_is_dir()) {
return $self->SUPER::get_strref();
}
# Process the file with Text::VimColor
my $filetype = '';
$filetype = $self->_resolve_type unless $noMimeInfo;
my $syntax = undef;
if ($filetype) {
$syntax = new Text::VimColor(
file => $self->{file},
filetype => $filetype,
xml_root_element => 0, # We'll add the root ourselves
);
} else {
# either the filetype is empty or set to 'plain'
# in both cases, we let VimColor take care of
# figuring out what kind of file this is
$syntax = new Text::VimColor(
file => $self->{file},
xml_root_element => 0, # We'll add the root ourselves
);
}
# Fetch the XML and return it
my $data = $syntax->xml;
# Trim off the > that Text::VimColor always seems to add
$data =~ s/>>/>/;
# Add <syn:line> tags, since it would be nice to have
my $filename = $self->{file};
$self->{data} = qq{<?xml version="1.0"?>\n<syn:syntax xmlns:syn="http://ns.laxan.com/text-vimcolor/1"};
$self->{data} .= qq{ type="$filetype"} if ($filetype);
$self->{data} .= qq{ filename="$filename">};
my $line_number = 0;
foreach my $line (split(/\n/, $data)) {
$line_number++;
$self->{data} .= qq{<syn:Line number="$line_number">$line$1</syn:Line>};
}
$self->{data} .= qq{</syn:syntax>};
return \$$self{data};
}
sub _resolve_type {
my ($self) = shift;
# Figure out the mime-type, and rip it apart to determine
( run in 1.691 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )