File Coverage

script/mojopaste

Criterion	Covered	Total	%
statement	55	56	98.2
branch	10	14	71.4
condition	3	7	42.8
subroutine	12	12	100.0
pod			n/a
total	80	89	89.8

#!perl
package App::mojopaste::Backend::File;
use Mojo::Base 'Mojolicious::Plugin';

use Mojo::File 'path';
use Mojo::Util qw(encode decode);
use Text::CSV;

my $ID = 0;

sub register {
  my ($self, $app, $config) = @_;
  my $dir = $app->config('paste_dir');
  path($dir)->make_path unless -d $dir;
  $app->helper('paste.load_p' => sub { _load_p($dir, @_) });
  $app->helper('paste.save_p' => sub { _save_p($dir, @_) });
}

sub _load_p {
  my ($dir, $c, $id) = @_;
  my @res = ('', '');

  eval {
    die "Hacking attempt! paste_id=($id)" if !$id or $id =~ m!\W!;
    return Mojo::Promise->new->resolve(decode 'UTF-8', path($dir, $id)->slurp);
  } or do {
    return Mojo::Promise->new->reject($@ || 'Paste not found');
  };
}

sub _save_p {
  my ($dir, $c, $text) = @_;
  my $id  = substr Mojo::Util::md5_sum($$ . time . $ID++), 0, 12;
  my @res = ('', '');

  eval {
    path($dir, $id)->spurt(encode 'UTF-8', $text);
    return Mojo::Promise->new->resolve($id);
  } or do {
    return Mojo::Promise->new->reject($@ || 'Unknown error');
  };
}

package main;
use Mojolicious::Lite;

use Mojo::JSON 'true';

plugin 'config' if $ENV{MOJO_CONFIG};
app->config->{backend}   ||= $ENV{PASTE_BACKEND} || 'File';
app->config->{paste_dir} ||= $ENV{PASTE_DIR}     || 'paste';

app->defaults(
  brand_link    => app->config('brand_link') || $ENV{PASTE_BRAND_LINK} || 'index',
  brand_logo    => app->config('brand_logo') // $ENV{PASTE_BRAND_LOGO} // '/images/logo.png',
  brand_name    => app->config('brand_name') // $ENV{PASTE_BRAND_NAME} // 'Mojopaste',
  enable_charts => app->config('enable_charts') // $ENV{PASTE_ENABLE_CHARTS},
  embed         => 'description,graph,heading,nav',
  error         => '',
  paste         => '',
  placeholder   => 'Enter your text here and then press the "Save" button above.',
  title         => 'Mojopaste',
);

my $backend = app->config('backend');
plugin $backend =~ /::/ ? $backend : "App::mojopaste::Backend::$backend";

helper no_such_paste => sub {
  my ($c, $err) = @_;
  $c->app->log->debug("no_such_paste: $err");
  $c->stash($_ => 'Could not find paste') for qw(error heading title);
  $c->render(description => '', layout => 'mojopaste', status => 404);
};

helper set_title => sub {
  my ($c, $prefix, $suffix) = @_;
  my $brand_name = $c->stash('brand_name') || 'Mojopaste';
  $suffix = $suffix ? "$brand_name $suffix" : $brand_name;
  $prefix =~ s![\n\r]+! !g;
  $prefix =~ s!^\W+!!g;
  $prefix = substr $prefix, 0, 56 - length $suffix;
  return $c->stash(title => "$prefix - $suffix");
};

get(
  '/' => {layout => 'mojopaste'} => sub {
    my $c = shift;

    return $c->set_title("Create new paste") unless my $id = $c->param('edit');
    return $c->render_later->paste->load_p($id)->then(sub {
      return $c->no_such_paste('Could not find paste') unless my $paste = shift;
      $c->set_title(substr($paste, 0, 80), 'edit');
      $c->param(paste => $paste)->render;
    })->catch(sub { $c->no_such_paste(shift) });
  },
  'index'
);

post(
  '/' => {layout => 'mojopaste'},
  sub {
    my $c     = shift;
    my $paste = $c->param('paste') || '';

    return $c->render('index', placeholder => 'You neeed to enter some characters!', status => 400)
      unless $paste =~ /\w/;
    return $c->render_later->paste->save_p($paste)->then(sub {
      $c->redirect_to('show', paste_id => shift);
    })->catch(sub { $c->reply->exception(shift) });
  }
);

get(
  '/:paste_id',
  [format => ['html', 'txt']],
  {format => undef},
  sub {
    my $c      = shift;
    my $format = $c->stash('format') || '';

    $c->render_later->paste->load_p($c->stash('paste_id'))->then(sub {
      my $paste = shift;
      if (!$paste) {
        $c->no_such_paste('Could not find paste');
      }
      elsif ($c->param('raw') or $format eq 'txt') {
        $c->res->headers->content_type('text/plain; charset=utf-8');
        $c->render(text => $paste);
      }
      else {
        $c->set_title(substr($paste, 0, 80));
        $c->res->headers->header('X-Plain-Text-URL' => $c->url_for(format => 'txt')->userinfo(undef)->to_abs);
        $c->stash(embed => $c->param('embed')) if $c->param('embed');
        $c->render(layout => 'mojopaste', paste => $paste);
      }
    })->catch(sub { $c->no_such_paste(shift) });
  },
  'show'
);

app->defaults('enable_charts') and get(
  '/:paste_id/chart' => {layout => 'mojopaste'},
  sub {
    my $c     = shift;
    my $chart = {element => 'chart', data => [], hideHover => true, resize => true};
    my ($heading, $description, $error) = ('', '', '');

    $c->render_later->paste->load_p($c->stash('paste_id'))->then(sub {
      return $c->no_such_paste('Could not find paste') unless my $paste = shift;

      while ($paste =~ s!^\s*(?://|\#)(.*)!!m) {
        $description .= $1 if $heading;
        $heading ||= $1;
      }

      eval {
        _chart($chart, grep { $_ =~ /\S/ } split /\r?\n/, $paste);
      } or do {
        $error = $@ || 'Unknown error';
        $error =~ s!\s*at .*? line \d+.*!!s;
      };

      $c->set_title($heading || $description || substr($paste, 0, 80), 'graph');
      $c->stash(embed => $c->param('embed')) if $c->param('embed');
      $c->render(chart => $chart, description => $description // '', error => $error, heading => $heading);
    })->catch(sub { $c->no_such_paste(shift) });
  },
  'chart'
);

app->start;

sub _chart {
  my $chart = shift;
  my $csv   = Text::CSV->new;

  $csv->parse(shift @_);    # heading
  $chart->{ykeys}             = [$csv->fields];
  $chart->{xkey}              = shift @{$chart->{ykeys}};
  $chart->{labels}            = $chart->{ykeys};
  $chart->{pointStrokeColors} = '#222';

  while (@_) {
    die $csv->error_input unless $csv->parse(shift @_);
    my @row = $csv->fields or next;
    push @{$chart->{data}}, {$chart->{xkey} => shift(@row), map { ($_ => 0 + shift @row) } @{$chart->{ykeys}}};
  }

  die 'Could not parse CSV data.' unless @{$chart->{data}};
  return $chart;
}

=pod

=encoding utf8

=head1 NAME

mojopaste - Pastebin application

=head1 DESCRIPTION

See L.

=head1 AUTHOR

Jan Henning Thorsen - C

=cut

__DATA__