view release on metacpan or  search on metacpan

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

    "</table>" .

    dump_content($request->content()) .

    "<p>Request as string=" . $request->as_string() . "</p>" .

    "</body></html>"
  );

  # A little debugging here.
  if (DUMP_REQUEST) {
    my $request_as_string = $request->as_string();
    warn unpack('H*', $request_as_string), "\n";
    warn "Request has CR.\n" if $request_as_string =~ /\x0D/;
    warn "Request has LF.\n" if $request_as_string =~ /\x0A/;
  }

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

# Start the HTTPD server.

sub initialize {
  foreach my $server (get_names_by_type(WEB_SERVER_TYPE)) {
    my %conf = get_items_by_name($server);
    my %ircconf = get_items_by_name($conf{irc});

    my $static = $conf{static};
    unless (defined $static) {
      $static = dist_dir("Bot-Pastebot");
    }


    my $template;
    if (defined $conf{template}) {
      my $template_class = $conf{template};
      my $filename       = $template_class;
      $filename =~ s[::][/]g;

      eval { require "$filename.pm" };
      die("Unable to load template class '$template_class': $@") if $@;

      $template = $template_class->new();
      die("Unable to instantiate template object.\n") unless $template;

    } else {
      require Bot::Pastebot::TextTemplate;
      $template = Bot::Pastebot::TextTemplate->new()
        or die("Unable to instantiate default template object.\n");
    }


    POE::Component::Server::TCP->new(
      Port     => $conf{port},
      (
        (defined $conf{iface})
        ? ( Address => $conf{iface} )
        : ()
      ),
      # TODO - Can we use the discrete callbacks?
      Acceptor => sub {
        POE::Session->create(
          inline_states => {
            _start    => \&httpd_session_started,
            got_flush => \&httpd_session_flushed,
            got_query => \&httpd_session_got_query,
            got_error => \&httpd_session_got_error,
          },

          # Note the use of ifname here in ARG6.  This gives the
          # responding session knowledge of its host name for
          # building HTML responses.  Most of the time it will be
          # identical to iface, but sometimes there may be a reverse
          # proxy, firewall, or NATD between the address we bind to
          # and the one people connect to.  In that case, ifname is
          # the address the outside world sees, and iface is the one
          # we've bound to.

          args => [
            @_[ARG0..ARG2], $server,
            $conf{iface}, $conf{port}, $conf{ifname}, $conf{irc},
            $conf{proxy}, $conf{iname}, $template, $static
          ],
        );
      },
    );
  }
}

### Fix paste for presentability.

sub fix_paste {
  my ($paste, $line_nums, $tidied, $highlighted, $wrapped) = @_;

  ### If the code is tidied, then tidy it.

  if ($tidied) {
    my $tidy_version = "";
    eval {
      Perl::Tidy::perltidy(
        source      => \$paste,
        destination => \$tidy_version,
        argv        => [ '-q', '-nanl', '-fnl' ],
      );
    };
    if ($@) {
      $paste = "Could not tidy this paste (try turning tidying off): $@";
    }
    else {
      $paste = $tidy_version;
    }
  }

  ### If the code is to be highlighted, then highlight it.

  if ($highlighted) {
    my @html_args = qw( -q -html -pre );
    push @html_args, "-nnn" if $line_nums;

    my $highlighted = "";