File Coverage

script/mojopaste
Criterion Covered Total %
statement 54 55 98.1
branch 10 14 71.4
condition 3 7 42.8
subroutine 12 12 100.0
pod n/a
total 79 88 89.7


line stmt bran cond sub pod time code
1             #!/usr/bin/env perl
2             package App::mojopaste::Backend::File;
3 6     6   3143 use Mojo::Base 'Mojolicious::Plugin';
  6         13  
  6         49  
4              
5 6     6   5215 use Mojo::File 'path';
  6         10  
  6         283  
6 6     6   31 use Mojo::Util qw(encode decode);
  6         11  
  6         254  
7 6     6   3930 use Text::CSV;
  6         74769  
  6         2561  
8              
9             my $ID = 0;
10              
11             sub register {
12 6     6   2185 my ($self, $app, $config) = @_;
13 6         30 my $dir = $app->config('paste_dir');
14 6 100       210 path($dir)->make_path unless -d $dir;
15 6     12   308 $app->helper('paste.load_p' => sub { _load_p($dir, @_) });
  12         865  
16 6     3   153 $app->helper('paste.save_p' => sub { _save_p($dir, @_) });
  3         250  
17             }
18              
19             sub _load_p {
20 12     12   44 my ($dir, $c, $id) = @_;
21 12         39 my @res = ('', '');
22              
23             eval {
24 12 100 66     100 die "Hacking attempt! paste_id=($id)" if !$id or $id =~ m!\W!;
25 11         62 return Mojo::Promise->new->resolve(decode 'UTF-8', path($dir, $id)->slurp);
26 12 100       21 } or do {
27 4   50     5794 return Mojo::Promise->new->reject($@ || 'Paste not found');
28             };
29             }
30              
31             sub _save_p {
32 3     3   13 my ($dir, $c, $text) = @_;
33 3         30 my $id = substr Mojo::Util::md5_sum($$ . time . $ID++), 0, 12;
34 3         13 my @res = ('', '');
35              
36             eval {
37 3         16 path($dir, $id)->spurt(encode 'UTF-8', $text);
38 3         747 return Mojo::Promise->new->resolve($id);
39 3 50       5 } or do {
40 0   0     0 return Mojo::Promise->new->reject($@ || 'Unknown error');
41             };
42             }
43              
44             package main;
45 6     6   2593 use Mojolicious::Lite;
  6         295827  
  6         46  
46              
47 6     6   76644 use Mojo::JSON 'true';
  6         13  
  6         9926  
48              
49             plugin 'config' if $ENV{MOJO_CONFIG};
50             app->config->{backend} ||= $ENV{PASTE_BACKEND} || 'File';
51             app->config->{paste_dir} ||= $ENV{PASTE_DIR} || 'paste';
52              
53             app->defaults(
54             enable_charts => app->config('enable_charts') // $ENV{PASTE_ENABLE_CHARTS},
55             embed => 'description,graph,heading,nav',
56             error => '',
57             paste => '',
58             placeholder => 'Enter your text here and then press the "Save" button above.',
59             site_name => $ENV{MOJOPASTE_SITE_NAME} || 'Mojopaste',
60             title => 'Mojopaste',
61             );
62              
63             my $backend = app->config('backend');
64             plugin $backend =~ /::/ ? $backend : "App::mojopaste::Backend::$backend";
65              
66             helper no_such_paste => sub {
67             my ($c, $err) = @_;
68             $c->app->log->debug("no_such_paste: $err");
69             $c->stash($_ => 'Could not find paste') for qw(error heading title);
70             $c->render(description => '', layout => 'mojopaste', status => 404);
71             };
72              
73             helper set_title => sub {
74             my ($c, $prefix, $suffix) = @_;
75             my $site_name = $c->stash('site_name');
76             $suffix = $suffix ? "$site_name $suffix" : $site_name;
77             $prefix =~ s![\n\r]+! !g;
78             $prefix =~ s!^\W+!!g;
79             $prefix = substr $prefix, 0, 56 - length $suffix;
80             return $c->stash(title => "$prefix - $suffix");
81             };
82              
83             get(
84             '/' => {layout => 'mojopaste'} => sub {
85             my $c = shift;
86              
87             return $c->set_title("Create new paste") unless my $id = $c->param('edit');
88             return $c->render_later->paste->load_p($id)->then(sub {
89             return $c->no_such_paste('Could not find paste') unless my $paste = shift;
90             $c->set_title(substr($paste, 0, 80), 'edit');
91             $c->param(paste => $paste)->render;
92             })->catch(sub { $c->no_such_paste(shift) });
93             },
94             'index'
95             );
96              
97             post(
98             '/' => {layout => 'mojopaste'},
99             sub {
100             my $c = shift;
101             my $paste = $c->param('paste') || '';
102              
103             return $c->render('index', placeholder => 'You neeed to enter some characters!', status => 400)
104             unless $paste =~ /\w/;
105             return $c->render_later->paste->save_p($paste)->then(sub {
106             $c->redirect_to('show', paste_id => shift);
107             })->catch(sub { $c->reply->exception(shift) });
108             }
109             );
110              
111             get(
112             '/:paste_id',
113             sub {
114             my $c = shift;
115             my $format = $c->stash('format') || '';
116              
117             $c->render_later->paste->load_p($c->stash('paste_id'))->then(sub {
118             my $paste = shift;
119             if (!$paste) {
120             $c->no_such_paste('Could not find paste');
121             }
122             elsif ($c->param('raw') or $format eq 'txt') {
123             $c->res->headers->content_type('text/plain; charset=utf-8');
124             $c->render(text => $paste);
125             }
126             else {
127             $c->set_title(substr($paste, 0, 80));
128             $c->res->headers->header('X-Plain-Text-URL' => $c->url_for(format => 'txt')->userinfo(undef)->to_abs);
129             $c->stash(embed => $c->param('embed')) if $c->param('embed');
130             $c->render(layout => 'mojopaste', paste => $paste);
131             }
132             })->catch(sub { $c->no_such_paste(shift) });
133             },
134             'show'
135             );
136              
137             app->defaults('enable_charts') and get(
138             '/:paste_id/chart' => {layout => 'mojopaste'},
139             sub {
140             my $c = shift;
141             my $chart = {element => 'chart', data => [], hideHover => true, resize => true};
142             my ($heading, $description, $error) = ('', '', '');
143              
144             $c->render_later->paste->load_p($c->stash('paste_id'))->then(sub {
145             return $c->no_such_paste('Could not find paste') unless my $paste = shift;
146              
147             while ($paste =~ s!^\s*(?://|\#)(.*)!!m) {
148             $description .= $1 if $heading;
149             $heading ||= $1;
150             }
151              
152             eval {
153             _chart($chart, grep { $_ =~ /\S/ } split /\r?\n/, $paste);
154             } or do {
155             $error = $@ || 'Unknown error';
156             $error =~ s!\s*at .*? line \d+.*!!s;
157             };
158              
159             $c->set_title($heading || $description || substr($paste, 0, 80), 'graph');
160             $c->stash(embed => $c->param('embed')) if $c->param('embed');
161             $c->render(chart => $chart, description => $description // '', error => $error, heading => $heading);
162             })->catch(sub { $c->no_such_paste(shift) });
163             },
164             'chart'
165             );
166              
167             app->start;
168              
169             sub _chart {
170 1     1   2 my $chart = shift;
171 1         12 my $csv = Text::CSV->new;
172              
173 1         204 $csv->parse(shift @_); # heading
174 1         54 $chart->{ykeys} = [$csv->fields];
175 1         11 $chart->{xkey} = shift @{$chart->{ykeys}};
  1         4  
176 1         3 $chart->{labels} = $chart->{ykeys};
177              
178 1         4 while (@_) {
179 3 50       9 die $csv->error_input unless $csv->parse(shift @_);
180 3 50       70 my @row = $csv->fields or next;
181 3         25 push @{$chart->{data}}, {$chart->{xkey} => shift(@row), map { ($_ => 0 + shift @row) } @{$chart->{ykeys}}};
  3         6  
  6         34  
  3         6  
182             }
183              
184 1 50       2 die 'Could not parse CSV data.' unless @{$chart->{data}};
  1         8  
185 1         14 return $chart;
186             }
187              
188             __DATA__