From e9fa4c98bb5f084739d3418ade3f0c51e34a0aa1 Mon Sep 17 00:00:00 2001 From: Arne Georg Gleditsch Date: Thu, 5 Jul 2007 00:51:08 +0200 Subject: Rebase tree. --- lib/LXRng/Markup/File.pm | 120 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 120 insertions(+) create mode 100644 lib/LXRng/Markup/File.pm (limited to 'lib/LXRng/Markup/File.pm') diff --git a/lib/LXRng/Markup/File.pm b/lib/LXRng/Markup/File.pm new file mode 100644 index 0000000..406737c --- /dev/null +++ b/lib/LXRng/Markup/File.pm @@ -0,0 +1,120 @@ +package LXRng::Markup::File; + +use strict; +use HTML::Entities; + +sub new { + my ($class, %args) = @_; + + return bless(\%args, $class); +} + +sub context { + my ($self) = @_; + return $$self{'context'}; +} + +sub safe_html { + my ($str) = @_; + return encode_entities($str, '^\n\r\t !\#\$\(-;=?-~'); +} + +sub make_format_newline { + my ($self, $node) = @_; + my $line = 0; + my $tree = $self->context->vtree(); + my $name = $node->name; + + sub { + my ($nl) = @_; + $line++; + $nl = safe_html($nl); + + # id="" is not valid XHTML 1.0, but it is an extremely + # handy shorthand for generating line numbers that don't + # affect cut-n-paste. + return qq{$nl}. + qq{}; + } +} + +sub format_comment { + my ($self, $com) = @_; + + $com = safe_html($com); + return qq{$com}; +} + + +sub format_string { + my ($self, $str) = @_; + + $str = safe_html($str); + return qq{$str} +} + +sub format_include { + my ($self, $paths, $all, $pre, $inc, $suf) = @_; + + my $tree = $self->context->vtree(); + if (@$paths > 1) { + $pre = safe_html($pre); + $inc = safe_html($inc); + $suf = safe_html($suf); + my $alts = join("|", map { $_ } @$paths); + return qq{$pre$inc$suf}; + } + elsif (@$paths > 0) { + $pre = safe_html($pre); + $inc = safe_html($inc); + $suf = safe_html($suf); + return qq{$pre$inc$suf}; + } + else { + return safe_html($all); + } +} + +sub format_code { + my ($self, $idre, $syms, $frag) = @_; + + my $tree = $self->context->vtree(); + my $path = $self->context->path(); + Subst::Complex::s($frag, + $idre => sub { + my $sym = $_[1]; + if (exists($$syms{$sym})) { + $sym = safe_html($sym); + return qq{$sym} + } + else { + return safe_html($sym); + } + }, + qr/(.*?)/ => sub { return safe_html($_[0]) }, + ); +} + +sub format_raw { + my ($self, $str) = @_; + + return safe_html($str); +} + +sub markupfile { + my ($self, $subst, $parse) = @_; + + my ($btype, $frag) = $parse->nextfrag; + + return () unless defined $frag; + + $btype ||= 'code'; + if ($btype and exists $$subst{$btype}) { + return $$subst{$btype}->s($frag); + } + else { + return $frag; + } +} + +1; -- cgit v1.2.3