Login
basic module
authorGraham Knop <haarg@haarg.org>
Sun, 10 Feb 2013 23:32:34 +0000 (18:32 -0500)
committerGraham Knop <haarg@haarg.org>
Sun, 10 Feb 2013 23:32:34 +0000 (18:32 -0500)
lib/Web/Paste/Viewer.pm [new file with mode: 0644]

diff --git a/lib/Web/Paste/Viewer.pm b/lib/Web/Paste/Viewer.pm
new file mode 100644 (file)
index 0000000..1fe9d7c
--- /dev/null
@@ -0,0 +1,116 @@
+package Web::Paste::Viewer;
+use strict;
+use warnings;
+
+use parent qw(Plack::Component);
+
+use HTML::Entities;
+use Plack::Request;
+use Plack::Util;
+use namespace::clean;
+
+use Plack::Util::Accessor qw(dir);
+
+sub call {
+    my $self = shift;
+    my $env = shift;
+    my $req = Plack::Request->new($env);
+    my $dir = $self->dir;
+    my $file = $req->path_info;
+    $file =~ s{^/}{};
+    ($file, my $path) = split m{[/\\]}, $file;
+    my $full_file = File::Spec->catfile($dir, $file);
+    open my $fh, '<', $full_file
+        or return $self->_not_found;
+    -f $fh or return $self->_not_found;
+    if ($path && $path eq 'raw') {
+        Plack::Util::set_io_path($fh, $full_file);
+        return [200, ['Content-Type' => 'text/plain'], $fh];
+    }
+
+    return sub {
+        my $responder = shift;
+        my $writer = $responder->([ 200, [ 'Content-Type', 'text/html' ] ]);
+
+        $self->send_content(
+            send => sub { $writer->write(@_) },
+            req => $req,
+            file => $file,
+            handle => $fh,
+        );
+        $writer->close;
+    };
+}
+
+sub _not_found {
+    [404, ['Content-Type' => 'text/plain'], ['not found']];
+}
+
+sub send_content {
+    my $self = shift;
+    my %opts = @_;
+    my $send = $opts{send};
+    my $fh = $opts{handle};
+    my $file = $opts{file};
+    my $req = $opts{req};
+    my $raw_link = $req->base;
+    $raw_link->path($raw_link->path . "$file/raw");
+    $send->(sprintf <<'END_HEADER', $file, $raw_link);
+<!DOCTYPE html>
+<html>
+<head>
+    <title>paste viewer: %s</title>
+    <style type="text/css">
+body {
+    font-family: sans-serif;
+}
+ol.file-content {
+    font-family: monospace;
+    list-style-type: none;
+    counter-reset: level1;
+    padding-left: 0px;
+}
+ol.file-content li {
+    white-space: pre;
+}
+ol.file-content li:before {
+    content: counter(level1) " ";
+    counter-increment: level1;
+    display: inline-block;
+    text-align: right;
+    width: 5em;
+    border-right: 1px solid #222;
+    margin-right: 5px;
+}
+ol.file-content li:nth-child(odd):before {
+    background-color: #eeeeee;
+}
+ol.file-content li:nth-child(odd) {
+    background-color: #f4f4f4;
+}
+ol.file-content li:nth-child(even):before {
+    background-color: #e0e0ff;
+}
+ol.file-content li:nth-child(even) {
+    background-color: #f4f4ff;
+}
+    </style>
+</head>
+<body>
+    <div>
+        <p><a href="%s">View Raw</a></p>
+        <ol class="file-content">
+END_HEADER
+    while (my $line = readline $fh) {
+        $line =~ s/[\r\n]+$//;
+        $send->('<li>' . $line . '</li>');
+    }
+    $send->(<<'END_FOOTER');
+        </ol>
+    </div>
+</body>
+</html>
+END_FOOTER
+}
+
+1;