Cook results from the CPAN

Cook
Bot-Pastebot
view release on metacpan or search on metacpan
lib/Bot/Pastebot/Server/Http.pm view on Meta::CPAN
      }
      else {
        $paste_link = "http://$heap->{my_inam}:$heap->{my_port}/$id";
      }

      # show number of lines in paste in channel announce
      my $paste_lines = 0;
      $paste_lines++ for $paste =~ m/^.*$/mg;

      $paste = fix_paste($paste, 0, 0, 0, 0);

      my $response;

      if( $error ) {
        $response = static_response(
          $heap->{my_template},
          "$heap->{my_static}/paste-error.html",
          {
            error      => $error,
            footer     => PAGE_FOOTER,
          }
        );
      } else {
        $response = redirect(
          $heap->{my_template},
          "$heap->{my_static}/paste-answer.html",
          {
            paste_id   => $id,
            paste_link => $paste_link,
          },
        );
      }

      if ($channel and $channel =~ /^\#/) {
        $kernel->post(
          "irc_client_$heap->{my_isrv}" => announce =>
          $channel,
          "$nick pasted \"$summary\" ($paste_lines line" .
          ($paste_lines == 1 ? '' : 's') . ") at $paste_link"
        );
      }
      else {
        warn "channel $channel was strange";
      }

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

    # Error goes here.
  }

  ### 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});
      }

      my $tx = is_true($query->{tx});

      my $variants = [
        ['html', 1.000, 'text/html',  undef, 'us-ascii', 'en', undef],
        ['text', 0.950, 'text/plain', undef, 'us-ascii', 'en', undef],
      ];
      my $choice = choose($variants, $request);
      $tx = 1 if $choice && $choice eq 'text';

      $paste = fix_paste($paste, @flags{@flag_names}) unless $tx;

      # Spew the paste.

      my $response;
      if ($tx) {
        $response = HTTP::Response->new(200);
        $response->push_header( 'Content-type', 'text/plain' );
        $response->content($paste);
      }
      else {
        $response = static_response(
          $heap->{my_template},
          "$heap->{my_static}/paste-lookup.html",
          { bot_name => $heap->{my_name},
            paste_id => $num,
            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' );
    $response->content(
      "<html>" .
      "<head><title>Paste Not Found</title></head>" .
      "<body><p>Paste not found.</p></body>" .
      "</html>"
    );
    $heap->{wheel}->put( $response );
    return;
  }

  ### Root page.

  # 2003-12-22 - RC - Added _ and - as legal characters for channel
  # names.  What else?
  if ($url =~ m!^/([\#\-\w\.]+)?!) {

    # set default channel from request URL, if possible
    my $prefchan = $1;
    if (defined $prefchan) {
       $prefchan = "#$prefchan" unless $prefchan =~ m,^\#,;
    }
    else {
      $prefchan = '';
    }

    # Dynamically build the channel options from the configuration
    # file's list.
    my @channels = channels($heap->{my_isrv});
    unshift @channels, '';

    @channels = map {
         qq(<option value="$_")
       . ($_ eq $prefchan ? ' selected' : '')
       . '>'
       . ($_ eq '' ? '(none)' : $_)
       . '</option>'
    } sort @channels;

    # Build content.

    my $iname = $heap->{my_iname};
    $iname .= '/' unless $iname =~ m#/$#;
    my $response = static_response(
      $heap->{my_template},
      "$heap->{my_static}/paste-form.html",
      { bot_name => $heap->{my_name},
        channels => "@channels",
        footer   => PAGE_FOOTER,
        iname    => $iname,
      }
( run in 1.136 second using v1.01-cache-2.11-cpan-e1769b4cff6 )