diff options
author | Arne Georg Gleditsch <argggh@lxr.linpro.no> | 2007-07-05 00:51:08 +0200 |
---|---|---|
committer | Arne Georg Gleditsch <argggh@lxr.linpro.no> | 2007-07-05 00:51:08 +0200 |
commit | e9fa4c98bb5f084739d3418ade3f0c51e34a0aa1 (patch) | |
tree | fec1d635625e031cde7cba1b0a1d95ee92ac760b /lib/LXRng/Markup |
Rebase tree.
Diffstat (limited to 'lib/LXRng/Markup')
-rw-r--r-- | lib/LXRng/Markup/Dir.pm | 64 | ||||
-rw-r--r-- | lib/LXRng/Markup/File.pm | 120 |
2 files changed, 184 insertions, 0 deletions
diff --git a/lib/LXRng/Markup/Dir.pm b/lib/LXRng/Markup/Dir.pm new file mode 100644 index 0000000..b7743ee --- /dev/null +++ b/lib/LXRng/Markup/Dir.pm @@ -0,0 +1,64 @@ +package LXRng::Markup::Dir; + +use strict; +use POSIX qw(strftime); +use LXRng::Cached; + +sub new { + my ($class, %args) = @_; + + return bless(\%args, $class); +} + +sub context { + my ($self) = @_; + return $$self{'context'}; +} + +sub _format_time { + my ($secs, $zone) = @_; + + my $offset = 0; + if ($zone and $zone =~ /^([-+])(\d\d)(\d\d)$/) { + $offset = ($2 * 60 + $3) * 60; + $offset = -$offset if $1 eq '-'; + $secs += $offset; + } + else { + $zone = ''; + } + return strftime("%F %T $zone", gmtime($secs)); +} + +sub listing { + my ($self) = @_; + + cached { + my @list; + foreach my $n ($$self{'node'}->contents) { + if ($n->isa('LXRng::Repo::Directory')) { + push(@list, {'name' => $n->name, + 'node' => $n->node, + 'size' => '', + 'time' => '', + 'desc' => ''}); + } + else { + my $rfile_id = $self->context->config->{'index'}->rfile_id($n); + my ($s, $tz) = + $self->context->config->{'index'}->get_rfile_timestamp($rfile_id); + ($s, $tz) = $n->time =~ /^(\d+)(?: ([-+]\d\d\d\d)|)$/ + unless $s; + + push(@list, {'name' => $n->name, + 'node' => $n->node, + 'size' => $n->size, + 'time' => _format_time($s, $tz), + 'desc' => ''}); + } + } + \@list; + } $$self{'node'}; +} + +1; 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="<num>" 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<a id="L$line" name="L$line"></a>}. + qq{<a href="$name#L$line" id="$line" class="line"></a>}; + } +} + +sub format_comment { + my ($self, $com) = @_; + + $com = safe_html($com); + return qq{<span class="comment">$com</span>}; +} + + +sub format_string { + my ($self, $str) = @_; + + $str = safe_html($str); + return qq{<span class="string">$str</span>} +} + +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<a href="+ambig=$alts" class="falt">$inc</a>$suf}; + } + elsif (@$paths > 0) { + $pre = safe_html($pre); + $inc = safe_html($inc); + $suf = safe_html($suf); + return qq{$pre<a href="$$paths[0]" class="fref">$inc</a>$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{<a href="+code=$sym" class="sref">$sym</a>} + } + 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; |