view release on metacpan or  search on metacpan

lib/Pod/Webserver.pm  view on Meta::CPAN

  my $m2p;

  if( $self->skip_indexing ) {
    $self->muse("Skipping \@INC indexing.");
  } else {

    if($self->progress) {
      DEBUG and print "Using existing progress object\n";
    } elsif( DEBUG or ($self->verbose() >= 1 and $self->verbose() <= 5) ) {
      require Pod::Simple::Progress;
      $self->progress( Pod::Simple::Progress->new(4) );
    }

    my $search = $Pod::Simple::HTMLBatch::SEARCH_CLASS->new;
	my $dir_include = $self->dir_include;
    if(DEBUG > -1) {
		if ($#{$self->dir_include} >= 0) {
			print " Indexing all of @$dir_include -- this might take a minute.\n";
		}
		else {
			print " Indexing all of \@INC -- this might take a minute.\n";
			DEBUG > 1 and print "\@INC = [ @INC ]\n";
		}
      $self->{'httpd_has_noted_inc_already'} ++;
    }
	$m2p = $self->modnames2paths($dir_include ? $dir_include : undef);
    $self->progress(0);

	# Filter out excluded folders
	while ( my ($key, $value) = each %$m2p ) {
		DEBUG > 1 and print "-e $value, ",  (grep $value =~ /^\Q$_\E/, @{ $self->dir_exclude }), "\n";
		delete $m2p->{$key} if grep $value =~ /^\Q$_\E/, @{ $self->dir_exclude };
	}

    die "Missing path\n" unless $m2p and keys %$m2p;

	DEBUG > -1 and print " Done scanning \n";

    foreach my $modname (sort keys %$m2p) {
      my @namelets = split '::', $modname;
      $self->note_for_contents_file( \@namelets, 'crunkIn', 'crunkOut' );
    }
    $self->write_contents_file('crunkBase');
  }
  $self->{'__modname2path'} = $m2p || {};

  return;

} # End of prep_lookup_table.

# ------------------------------------------------

sub run_daemon {
  my($self, $daemon) = @_;

  while( my $conn = $daemon->accept ) {
    if( my $req = $conn->get_request ) {
      #^^ That used to be a while(... instead of an if( ..., but the
      # keepalive wasn't working so great, so let's just leave it for now.
      # It's not like our server here is streaming GIFs or anything.

      DEBUG and print "Answering connection at ", localtime()."\n";
      $self->_serve_thing($conn, $req);
    }
    $conn->close;
    undef($conn);
  }
  $self->muse("HTTP Server terminated");
  return;

} # End of run_daemon.

# ------------------------------------------------

sub _serve_pod {
  my($self, $modname, $filename, $resp) = @_;
  unless( -e $filename and -r _ and -s _ ) { # sanity
    $self->muse( "But filename $filename is no good!" );
    return;
  }

  my $modtime = (stat(_))[9];  # use my own modtime whynot!
  $resp->content('');
  my $contr = $resp->content_ref;

  $Pod::Simple::HTMLBatch::HTML_EXTENSION
     = $Pod::Simple::HTML::HTML_EXTENSION = '';

  $resp->header('Last-Modified' => time2str($modtime) );

  my $retval;
  if(
    # This is totally gross and hacky.  So unless your name rhymes
    #  with "Pawn Lurk", you have to cover your eyes right now.
    $retval =
    $self->_do_one_batch_conversion(
      $modname,
      { $modname => $filename },
      '/',
      Pod::Simple::TiedOutFH->handle_on($contr),
    )
  ) {
    $self->muse( "$modname < $filename" );
  } else {
    $self->muse( "Ugh, couldn't convert $modname"  );
  }

  return $retval;

} # End of _serve_pod.

# ------------------------------------------------

sub _serve_thing {
  my($self, $conn, $req) = @_;
  return $conn->send_error(405) unless $req->method eq 'GET';  # sanity

  my $path = $req->url;
  $path .= substr( ($ENV{PATH} ||''), 0, 0);  # to force-taint it.