Gopher-Server

 view release on metacpan or  search on metacpan

lib/Gopher/Server/RequestHandler/File.pm  view on Meta::CPAN

	my $selector = $request->selector;
	opendir( my $dir, $path ) or die "Can't open directory $path: $!\n";

	my @menu_items;
	foreach my $dir_item (readdir($dir)) {
		use Gopher::Server::TypeMapper;
		my $item_type = Gopher::Server::TypeMapper->get_type({
			filename => "$path/$dir_item", 
		});

		use Net::Gopher::Response::MenuItem;
		my $item_selector = $selector . "/$dir_item";
		push @menu_items, Net::Gopher::Response::MenuItem->new({
			#request      => $request, 
			ItemType     => $item_type->gopher_type, 
			Display      => $dir_item,
			Selector     => $item_selector,
			Host         => $self->{host}, 
			Port         => $self->{port},
		});
	}

	return Gopher::Server::Response->new({

t/025_make_response.t  view on Meta::CPAN

use 5.005;
use Test::More tests => 6;
use Test::Exception;
use strict;
use warnings;

use Gopher::Server::ParseRequest;
use Gopher::Server::Response;
use Net::Gopher::Response::MenuItem;
use IO::Scalar;
my $request = Gopher::Server::ParseRequest->parse( '' );
my $data = "content\n";
my $content = $data;
my $fh = IO::Scalar->new(\$content);


dies_ok { Gopher::Server::Response->new() } "Empty constructor dies";
dies_ok { Gopher::Server::Response->new({ }) } "Unfilled args dies";

t/025_make_response.t  view on Meta::CPAN

	"Request check" );

my $got;
my $out = IO::Scalar->new(\$got);
$response->print_to( $out );
close($out);
ok( $got eq $data, "Response returned" );
close($fh);

my @items;
push @items, Net::Gopher::Response::MenuItem->new({
	ItemType     => '0', 
	Display      => 'test1', 
	Selector     => '/test1', 
	Host         => 'localhost', 
	Port         => 70, 
});
push @items, Net::Gopher::Response::MenuItem->new({
	ItemType     => '1', 
	Display      => 'test2', 
	Selector     => '/test2', 
	Host         => 'localhost', 
	Port         => 70, 
});
$response = Gopher::Server::Response->new({
	request     => $request, 
	menu_items  => \@items, 
});
$data = "0test1\t/test1\tlocalhost\t70\r\n" . 
        "1test2\t/test2\tlocalhost\t70\r\n" . 
        ".\r\n";

$got = '';
$out = IO::Scalar->new(\$got);
$response->print_to( $out );
close($out);
ok( $got eq $data, "Menu Items returned" );

t/030_map_type.t  view on Meta::CPAN

ok( $type->gopher_type eq '0', "Plaintext Gopher type" );
ok( $type->mime_type eq 'text/plain', "Plaintext MIME type" );


# Directories
$type = Gopher::Server::TypeMapper->get_type({
	filename => getcwd(), 
});
ok( defined $type, "returns a defined value" );
ok( UNIVERSAL::isa( $type, 'Gopher::Server::TypeMapper' ), "isa correct" );
ok( $type->gopher_type eq '1', "Menu Entity Gopher type" );
ok( $type->mime_type eq '',    "No MIME equivilent to menu entities" );


# Anything else should be binary type, for now
$type = Gopher::Server::TypeMapper->get_type({
	filename => 'blah.foo', 
});
ok( defined $type, "return a defined value" );
ok( UNIVERSAL::isa( $type, 'Gopher::Server::TypeMapper' ), "isa correct" );
ok( $type->gopher_type eq '9', "Binary Gopher type" );

t/041_handle_request_file.t  view on Meta::CPAN

open(IN, '<', $path) or die "Can't open $good_path: $!\n";
my $data;
while(<IN>) { $data .= $_ }
close(IN);

my $got;
my $out = IO::Scalar->new(\$got);
$response->print_to( $out );
close($out);
ok( $got eq $data, "Menu Items returned" );


$request = Net::Gopher::Request->new( 'Gopher', 
	Host      => "localhost", 
	Port      => 70, 
	Selector  => '', 
);
$response = $handler->process( $request );
ok( $response, "processes request" );
ok( UNIVERSAL::isa($response, 'Gopher::Server::Response'), "isa check on returned request" );