Smallest mod_perl application (almost)

package PasteBot;

use strict;
use warnings;
no warnings qw(redefine);

=head1 Apache Configuration

<VirtualHost *:80>
    ServerName paste.dollyfish.net.nz

    <Location />
        SetHandler perl-script
        <Perl>
            use lib '/path/to/libdir';
        </Perl>
        PerlInitHandler Apache::Reload
        PerlHandler PasteBot
    </Location>
</VirtualHost>

=cut

use Apache::Reload;
use Digest::MD5 qw();
use File::Type;
use File::Slurp;
use Text::VimColor;
use FindBin;
use Apache;
Apache->import();

my $storage_path = '/var/lib/apache/paste/';
my $filetype_for = {
    'text/html' => 'html',
};

sub handler {
    # get Apache::Request object
    my $r = shift;

    # query parameters 
    my %get = $r->args();

    # post parameters
    my %args = $r->content;

    # content posted to be pastebotted
    if ( $r->method eq 'POST' and exists $args{text} ) {
        my $digest = substr Digest::MD5::md5_hex($args{text}), 26;
        write_file($storage_path . $digest, $args{text});
        if (defined $args{filetype} and $args{filetype} =~ /\S/) {
            write_file($storage_path . $digest . '.filetype', $args{filetype});
        }

        $r->header_out('Location', 'http://' . $r->hostname . '/' . $digest);
        $r->status(303);
        $r->send_http_header;
    }
    # request for the homepage
    elsif ( $r->uri eq '/' ) {
        $r->content_type('text/html');
        $r->send_http_header;
        home_page($r);
    }
    # request for existing pastebot content
    elsif ( $r->uri =~ m{/([a-z0-9]{6})} and -f $storage_path . $1 ) {
        my $contents = read_file($storage_path . $1);
        my $mimetype = File::Type->new->checktype_contents($contents);
        my $filetype = $get{filetype};

        $filetype ||= read_file($storage_path . $1 . '.filetype') if -f $storage_path . $1 . '.filetype';
        $filetype ||= $filetype_for->{$mimetype};

        my $syntax = Text::VimColor->new(
            string => $contents,
            html_full_page => 1,
            filetype => $filetype,
        );

        $r->content_type('text/html');
        $r->send_http_header;
        $r->print($syntax->html);
    }
    # request for source listing
    elsif ( $r->uri eq '/source' ) {
        my $syntax = Text::VimColor->new(
            file => $INC{__PACKAGE__ . '.pm'},
            html_full_page => 1,
            filetype => 'perl',
        );

        $r->content_type('text/html');
        $r->send_http_header;
        $r->print($syntax->html);
    }
    # don't know what it is, 404
    else {
        $r->status(404);
        $r->send_http_header;
    }

    return Apache::OK;
}

# Function to render the homepage
sub home_page {
    my $r = shift;

    $r->print(q|<html>
    <head>
        <style type="text/css">
            textarea {
                width: 100%;
                height: 50%;
            }
        </style>
        <title>paste.dollyfish.net.nz</title>
    </head>
    <body>
        <form method="post">
            <input type="submit" value="Paste">
            <textarea name="text"></textarea>
            <input type="submit" value="Paste">
|);
    if ( -f '/usr/share/vim/vimcurrent/synmenu.vim' ) {
        print q{<select name="filetype">};
        print q{<option value="">Automatic Detection</option>};
        foreach my $line ( read_file('/usr/share/vim/vimcurrent/synmenu.vim') ) {
            next unless ( my ( $syntax, $filetype ) = $line =~ /Syntax.[\w-]+\.(.*) :cal SetSyn\("(.*?)"/ );
            $syntax =~ s/\\ / /g;
            print '<option value="' . $filetype . '">' . $syntax . '</option>';
        }
        print q{</select>};
    }
    $r->print(q|
        </form>
    </body>
</html>
|);

    return Apache::OK;
}

1;