Apache-AxKit-Provider-File-Syntax

 view release on metacpan or  search on metacpan

Syntax.pm  view on Meta::CPAN

# $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 )