The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package WWW::Hashbang::Pastebin;
use strict;
use warnings;
use 5.014000;
use Dancer ':syntax';
use Dancer::Plugin::DBIC qw(schema);
use Dancer::Plugin::EscapeHTML qw(escape_html);
use Integer::Tiny;
use Try::Tiny;
use DateTime;

# ABSTRACT: command line pastebin
our $VERSION = '0.004'; # VERSION


my $mapper = do {
    my $key = config->{key} || join '', ('a'..'z', 0..9);
    $key =~ tr/+//d;
    Integer::Tiny->new($key);
};


get '/' => sub {
    return template 'index';
};

post '/' => sub {
    my $paste_content = param('p') || param('sprunge');
    my $lang = param('lang');

    unless ($paste_content) {
        status 'bad_request';
        return 'No paste content received';
    }

    my $now = DateTime->now( time_zone => 'UTC' );
    my $row = schema->resultset('Paste')->create({
        paste_content => $paste_content,
        paste_date    => $now,
    });

    my $ext_id  = $mapper->encrypt($row->id);
    my $ext_url = uri_for("/$ext_id");
    $ext_url = "$ext_url?$lang" if $lang;
    debug "Created paste $ext_id: $ext_url";
    headers
        'X-Pastebin-ID'     => $ext_id,
        'X-Pastebin-URL'    => $ext_url;
    return "$ext_url\n";
};

get '/:id' => sub {
    my $ext_id = param('id');
    my $line_nos = ($ext_id =~ s{\+$}{});

    my $int_id = try { $mapper->decrypt( $ext_id ) } || do {
        status 'bad_request';
        return "'$ext_id' is not a valid paste ID";
    };
    debug "paste ID requested: $int_id";

    my $paste = schema->resultset('Paste')->find( $int_id );

    unless ($paste) {
        my $msg = "No such paste as '$ext_id'";
        warning $msg;
        content_type('text/plain');
        status 'not_found';
        return $msg;
    }
    elsif ($paste->deleted) {
        warning "Request was for deleted paste '$ext_id'->'$int_id'";
        status 'gone';
        return "No such paste as '$ext_id'";
    }

    headers 'X-Pastebin-ID' => $ext_id;
    if ($line_nos) {
        open my $in, '<', \$paste->content;
        1 while (<$in>);
        my $lines = $.;
        close $in;
        return template paste => { content => $paste->content, lines => [1..$lines] };
    }
    else {
        content_type('text/plain');
        return $paste->content;
    }
};


true;

__END__
=pod

=encoding utf-8

=head1 NAME

WWW::Hashbang::Pastebin - command line pastebin

=head1 VERSION

version 0.004

=head1 SYNOPSIS

    $ (hostname ; uptime) | curl -F 'p=<-' http://p.hashbang.ca
    http://p.hashbang.ca/f4s2
    $ chromium-browser http://p.hashbang.ca/f4s2+#l2

=head1 DESCRIPTION

This pastebin has no user interface - use C<curl> or L<WWW::Hashbang::Pastebin::Client>'s
C<p> command to POST paste content. Your paste's ID is returned in the
C<X-Pastebin-ID> header; the URL in the C<X-Pastebin-URL>, as well as the response
content.

Append a plus sign to the URL to get line numbers. Add an anchor like C<#l1> to
jump to the given line number, or click the line number you want. The line number
for the selected line will be highlighted.

=for test_synopsis 1;
__END__

=head1 SEE ALSO

=over 4

=item * L<http://sprunge.us>

=item * L<http://p.defau.lt>

=back

=head1 AVAILABILITY

The project homepage is L<http://metacpan.org/release/WWW-Hashbang-Pastebin/>.

The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN
site near you, or see L<https://metacpan.org/module/WWW::Hashbang::Pastebin/>.

=head1 SOURCE

The development version is on github at L<http://github.com/doherty/WWW-Hashbang-Pastebin>
and may be cloned from L<git://github.com/doherty/WWW-Hashbang-Pastebin.git>

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L<https://github.com/doherty/WWW-Hashbang-Pastebin/issues>.

=head1 AUTHOR

Mike Doherty <doherty@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Mike Doherty.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut