Bot-Pastebot

 view release on metacpan or  search on metacpan

lib/Bot/Pastebot/Server/Http.pm  view on Meta::CPAN

  }

  ### Fetch paste.

  if ($url =~ m{^/(\d+)(?:\?(.*?)\s*)?$}) {
    my ($num, $params) = ($1, $2);
    my ($nick, $summary, $paste) = fetch_paste($num);

    if (defined $paste) {
      my @flag_names = qw(ln tidy hl wr);
      my $cookie = parse_cookie($request->headers->header('Cookie'));
      my $query  = parse_content($params);

      ### Make the paste pretty.

      my $store = is_true($query->{store});
      my %flags;
      for my $flag (@flag_names) {
        $flags{$flag} = $store || exists $query->{$flag}
                      ? is_true( $query->{$flag})
                      : is_true($cookie->{$flag});

lib/Bot/Pastebot/Server/Http.pm  view on Meta::CPAN

            nick     => $nick,
            summary  => $summary,
            paste    => $paste,
            footer   => PAGE_FOOTER,
            tx       => ( $tx ? "checked" : "" ),
            map { $_ => $flags{$_} ? "checked" : "" } @flag_names,
          }
        );
        if ($store) {
          for my $flag (@flag_names) {
            $response->push_header('Set-Cookie' => cookie($flag => $flags{$flag}, $request));
          }
        }
      }

      $heap->{wheel}->put( $response );
      return;
    }

    my $response = HTTP::Response->new(404);
    $response->push_header( 'Content-type', 'text/html; charset=utf-8' );

lib/Bot/Pastebot/WebUtil.pm  view on Meta::CPAN

# static pages, and do template things with them.
#
# TODO - We could probably replace them with an actual CPAN library or
# two.

package Bot::Pastebot::WebUtil;
$Bot::Pastebot::WebUtil::VERSION = '0.600';
use warnings;
use strict;

use CGI::Cookie;

use base qw(Exporter);
our @EXPORT_OK = qw(
  url_decode url_encode parse_content parse_cookie static_response
  dump_content dump_query_as_response base64_decode html_encode
  is_true cookie redirect
);

#------------------------------------------------------------------------------
# Build two URL-encoding maps.  Map non-printable characters to

lib/Bot/Pastebot/WebUtil.pm  view on Meta::CPAN

  my $hex = lc(unpack('H2', $character));

  # Map characters to their hex values, including the escape.
  $raw_to_url{ $character } = '%' . $hex;

  # Map hex codes (lower- and uppercase) to characters.
  $url_to_raw{    $hex } = $character;
  $url_to_raw{ uc $hex } = $character;
}

# Return a cookie string for a Set-Cookie header. The request argument is
# used to figure out domain.
sub cookie {
  my ($name, $value, $request) = @_;

  return CGI::Cookie->new(
    -name => $name,
    -value => $value,
    -expires => '+36M',
    -domain => (split /:/, $request->headers->header('Host'))[0],
    -path => '/',
  )->as_string;
}

# Decode url-encoded data.  This code was shamelessly stolen from
# Lincoln Stein's CGI.pm module.  Translate plusses to spaces, and

lib/Bot/Pastebot/WebUtil.pm  view on Meta::CPAN

      }
    }
    else {
      $content{$param} = $value;
    }
  }

  return \%content;
}

# Parse a cookie string (found usually in the Cookie: header), returning a 
# hashref containing cookies values, not CGI::Cookie objects.
sub parse_cookie {
  my ($cookie) = @_;

  return {} if not defined $cookie;
  return { map url_decode($_), map /([^=]+)=?(.*)/s, split /; ?/, $cookie };
}

sub _render_template {
  my ($template, $filename, $record) = @_;