Toby Inkster avatar Toby Inkster committed 15218da Draft

initial version

Comments (0)

Files changed (15)

+use inc::Module::Package 'RDF:tobyink 0.009';
+

bin/web-paste-simple.psgi

+#!/usr/bin/env plackup
+
+use lib 'lib';
+use Web::Paste::Simple;
+Web::Paste::Simple->new->app;

lib/Web/Paste/Simple.pm

+package Web::Paste::Simple;
+
+use 5.010;
+use MooX 'late';
+use JSON qw( from_json to_json );
+use Path::Class qw( file dir );
+use HTML::HTML5::Entities qw( encode_entities_numeric );
+use Text::Template;
+use aliased 'Data::UUID';
+use aliased 'Plack::Request';
+use aliased 'Plack::Response';
+
+BEGIN {
+	$Web::Paste::Simple::AUTHORITY = 'cpan:TOBYINK';
+	$Web::Paste::Simple::VERSION   = '0.001';
+}
+
+has uuid_gen => (
+	is      => 'ro',
+	default => sub { UUID->new },
+);
+
+has template => (
+	is      => 'ro',
+	isa     => 'Text::Template',
+	lazy    => 1,
+	default => sub {
+		return Text::Template->new(
+			TYPE   => 'FILEHANDLE',
+			SOURCE => \*DATA,
+		);
+	},
+);
+
+has storage => (
+	is      => 'ro',
+	isa     => 'Path::Class::Dir',
+	default => sub { dir('/tmp/perl-web-paste-simple/') },
+);
+
+has codemirror => (
+	is      => 'ro',
+	isa     => 'Str',
+	default => 'http://buzzword.org.uk/2012/codemirror-2.36',
+);
+
+has app => (
+	is      => 'ro',
+	isa     => 'CodeRef',
+	lazy_build => 1,
+);
+
+has modes => (
+	is      => 'ro',
+	isa     => 'ArrayRef[Str]',
+	default => sub {
+		[qw(
+			htmlmixed xml css javascript
+			clike perl php ruby python lua haskell
+			diff sparql ntriples plsql
+		)]
+	},
+);
+
+has default_mode => (
+	is      => 'ro',
+	isa     => 'Str',
+	default => 'perl',
+);
+
+sub _build_app
+{
+	my $self = shift;
+	
+	$self->storage->mkpath unless -d $self->storage;
+	confess "@{[$self->storage]} is not writeable" unless -w $self->storage;
+		
+	return sub {
+		my $req = Request->new(shift);
+		
+		if ($req->method eq 'POST') {
+			$self->_save_paste($req)->finalize;
+		}
+		elsif ($req->path =~ m{^/([^.]+)}) {
+			return $self->_serve_paste($req, $1)->finalize;
+		}
+		elsif ($req->path eq '/') {
+			return $self->_serve_template($req)->finalize;
+		}
+		else {
+			return $self->_serve_error("Bad URI", 404);
+		}
+	};
+}
+
+sub _mk_id
+{
+	my $id = shift->uuid_gen->create_b64;
+	$id =~ tr{+/}{-_};
+	$id =~ s{=+$}{};
+	return $id;
+}
+
+sub _save_paste
+{
+	my ($self, $req) = @_;
+	my $id = $self->_mk_id;
+	$self->storage->file("$id.paste")->spew(
+		to_json( +{ %{$req->parameters} } ),
+	);
+	return Response->new(
+		302,
+		[
+			'Content-Type' => 'text/plain',
+			'Location'     => $req->base . $id,
+		],
+		"Yay!",
+	);
+}
+
+sub _serve_error
+{
+	my ($self, $err, $code) = @_;
+	$code //= 500;
+	return Response->new(
+		$code,
+		[ 'Content-Type' => 'text/plain' ],
+		"$err\n",
+	);
+}
+
+sub _serve_paste
+{
+	my ($self, $req, $id) = @_;
+	my $file = $self->storage->file("$id.paste");
+	-r $file or return $self->_serve_error("Bad file", 404);
+	my $data = from_json($file->slurp);
+	
+	if ($req->parameters->{raw}) {
+		return Response->new(
+			200,
+			[ 'Content-Type' => 'text/plain' ],
+			$data->{paste},
+		);
+	}
+	
+	return $self->_serve_template($req, $data);
+}
+
+sub _serve_template
+{
+	my ($self, $req, $data) = @_;
+	
+	$data //= {
+		paste => '',
+		mode  => $self->default_mode,
+	};
+	my %replace = (
+		DATA       => encode_entities_numeric($data->{paste}),
+		MODE       => encode_entities_numeric($data->{mode}),
+		MODES      => $self->modes,
+		PACKAGE    => ref($self),
+		VERSION    => $self->VERSION,
+		CODEMIRROR => $self->codemirror,
+	);	
+	
+	return Response->new(
+		200,
+		[ 'Content-Type' => 'text/html' ],
+		$self->template->fill_in(HASH => \%replace),
+	);
+}
+
+1;
+
+=head1 NAME
+
+Web::Paste::Simple - simple PSGI-based pastebin-like website
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Web-Paste-Simple>.
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+=cut
+
+__DATA__
+<!doctype html>
+<title>{$PACKAGE} {$VERSION}</title>
+<link rel="stylesheet" href="{$CODEMIRROR}/lib/codemirror.css">
+<script src="{$CODEMIRROR}/lib/codemirror.js"></script>
+{
+	for my $m (@MODES) {
+		$OUT .= qq[<script src="$CODEMIRROR/mode/$m/$m.js"></script>\n]
+	}
+}
+<form action="/" method="post">
+	<div>
+		<textarea name="paste">{$DATA}</textarea>
+		<br>
+		<select name="mode" onchange="change_mode();">
+			{
+				for my $m (@MODES) {
+					$OUT .= qq[<option @{[$m eq $MODE ? 'selected':'']}>$m</option>\n]
+				}
+			}
+		</select>
+		<input type="submit" value=" Paste ">
+	</div>
+</form>
+<script>
+var ta = document.getElementsByTagName("textarea");
+var editor = CodeMirror.fromTextArea(ta[0], \{
+	lineNumbers: true,
+	matchBrackets: true,
+	indentUnit: 4,
+	mode: "{$MODE}",
+\});
+function change_mode () \{
+	var s = document.getElementsByTagName("select");
+	editor.setOption("mode", s[0].options[s[0].selectedIndex].value);
+\}
+</script>

meta/changes.pret

+# This file acts as the project's changelog.
+
+`Web-Paste-Simple 0.001 cpan:TOBYINK`
+	issued  2012-12-07;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`Web-Paste-Simple`
+	:programming-language "Perl" ;
+	:shortdesc            "simple PSGI-based pastebin-like website";
+	:homepage             <https://metacpan.org/release/Web-Paste-Simple>;
+	:download-page        <https://metacpan.org/release/Web-Paste-Simple>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=Web-Paste-Simple>;
+	:created              2012-12-07;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`Web-Paste-Simple`
+	perl_version_from m`Web::Paste::Simple`;
+	version_from      m`Web::Paste::Simple`;
+	readme_from       m`Web::Paste::Simple`;
+	test_requires     p`Test::More 0.61` ;
+	.
+
+# This file contains data about the project developers.
+
+@prefix : <http://xmlns.com/foaf/0.1/>.
+
+cpan:TOBYINK
+	:name  "Toby Inkster";
+	:mbox  <mailto:tobyink@cpan.org>.
+
+use Test::More tests => 1;
+BEGIN { use_ok('Web::Paste::Simple') };
+
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use XT::Util;
+use Test::More;
+use Test::Pod::Coverage;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pod_coverage_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pod_coverage_ok();
+}
+

xt/03meta_uptodate.config

+{"package":"Web-Paste-Simple"}
+

xt/03meta_uptodate.t

+use XT::Util;
+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok(__CONFIG__->{package}, __CONFIG__->{version_from});
+
+use Test::EOL;
+all_perl_files_ok();
+use Test::Tabs;
+all_perl_files_ok();
+use XT::Util;
+use Test::More;
+use Test::HasVersion;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pm_version_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pm_version_ok();
+}
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.