aboutsummaryrefslogtreecommitdiffstats
path: root/lib/LXRng/Markup
diff options
context:
space:
mode:
authorArne Georg Gleditsch <argggh@lxr.linpro.no>2007-07-05 00:51:08 +0200
committerArne Georg Gleditsch <argggh@lxr.linpro.no>2007-07-05 00:51:08 +0200
commite9fa4c98bb5f084739d3418ade3f0c51e34a0aa1 (patch)
treefec1d635625e031cde7cba1b0a1d95ee92ac760b /lib/LXRng/Markup
Rebase tree.
Diffstat (limited to 'lib/LXRng/Markup')
-rw-r--r--lib/LXRng/Markup/Dir.pm64
-rw-r--r--lib/LXRng/Markup/File.pm120
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;