# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

use strict;
use vars qw($loaded);

BEGIN { $| = 1; print "1..187\n"; }
END   { print "not ok 1\n" unless $loaded; }

my $ok_count = 1;
sub ok {
  my $ok = shift;
  $ok or print "not ";
  print "ok $ok_count\n";
  ++$ok_count;
  $ok;
}

use URI;
use WebFS::FileCopy;
use Data::Dumper;
use Cwd;
use LWP::StdSched;

if (0) {
  $LWP::UA::DEBUG = 10;
  $LWP::EventLoop::DEBUG = 10;
  $LWP::Server::DEBUG = 10;
  $LWP::Conn::FTP::DEBUG = 10;
  $LWP::Conn::HTTP::DEBUG = 10;
  $LWP::Conn::_Connect::DEBUG = 10;
  $LWP::StdSched::DEBUG = 10;
}

# If we got here, then the package being tested was loaded.
$loaded = 1;
ok(1);									#  1

# Cd to the test directory.
chdir 't' if -d 't';

# Check the _is_directory subroutine.
ok(  WebFS::FileCopy::_is_directory('http://www.gps.caltech.edu') );	#  2
ok( !WebFS::FileCopy::_is_directory('http://www/fff') );		#  3
ok(  WebFS::FileCopy::_is_directory('http://www.gps.caltech.edu/~blair/') );# 4
ok( !WebFS::FileCopy::_is_directory(URI::file->new_abs('file1')) );	#  5

# Check illegal argument passing to copy_urls.

# Cannot copy more than one file to a single destination file.
ok( !defined copy_urls(['file:/a', 'file:/b'], 'file:/c') );		#  6
ok( $@ eq 'Cannot copy many files to one file' );			#  7

# Cannot copy a directory.
ok( !defined copy_urls('file:/tmp/', 'file:/tmp/') );			#  8
ok( $@ eq 'Cannot copy directories: file:/tmp/' );			#  9

# Cannot copy to non ftp: or file:
ok( !copy_url('http://www.gps.caltech.edu/', 'http://ftp/') );		# 10
ok( $@ eq 'Can only copy to file or FTP URLs: http://ftp/' );		# 11

# Put together file URIs for the test files.  Files 1, 2, and 3, 5 exists and
# file 4 doesn't.
my $cwd = cwd;
my @from_files = qw(file1 file2 file3 file4 file5);
my @from_uris  = map { URI::file->new_abs($_) } @from_files;
my @to_uris    = map { WebFS::FileCopy::_create_uri("$_.new") } @from_uris;

# Clean up any output files from previous testing runs.
unlink(map { $_->file } @to_uris);

# Test the get_urls.
my @a = get_urls(@from_uris);

ok( @a == @from_uris );							# 12
ok( $a[0] );								# 13
ok( $a[1] );								# 14
ok( $a[2] );								# 15
ok( $a[3] );								# 16
ok( $a[4] );								# 17

ok(  $a[0]->is_success and length($a[0]->content) ==  90 );		# 18
ok(  $a[1]->is_success and length($a[1]->content) == 501 );		# 19
ok(  $a[2]->is_success and length($a[2]->content) == 365 );		# 20
ok( !$a[3]->is_success );						# 21
ok(  $a[4]->is_success and length($a[4]->content) == 11683 );		# 22

# Try to put the files.
my $content = $a[4]->content;
my @b = put_urls($content, @to_uris, 'file:/this/path/should/not/exist');
ok(  @b == @from_files+1 );						# 23
ok(  $b[0] );								# 24
ok(  $b[1] );								# 25
ok(  $b[2] );								# 26
ok(  $b[3] );								# 27
ok(  $b[4] );								# 28
ok(  $b[5] );								# 29
ok(  $b[0]->is_success );						# 30
ok(  $b[1]->is_success );						# 31
ok(  $b[2]->is_success );						# 32
ok(  $b[3]->is_success );						# 33
ok(  $b[4]->is_success );						# 34
ok( !$b[5]->is_success );						# 35
ok(  $b[5]->message eq "No such file or directory" );			# 36

# Try to get the same files we just put.
my @c = get_urls(@to_uris);
ok( @c == @from_files );						# 37
ok( $a[4] );								# 38
ok( $a[4]->content eq $c[0]->content );					# 39
ok( $a[4]->content eq $c[1]->content );					# 40
ok( $a[4]->content eq $c[2]->content );					# 41
ok( $a[4]->content eq $c[3]->content );					# 42
ok( $a[4]->content eq $c[4]->content );					# 43

# Test the subroutine form of put_urls.
my $i = 0;
my $put_string = $a[2]->content;
sub put_test {
  return undef if $i == length($put_string);
  substr($put_string, $i++, 1);
}

@b = put_urls(\&put_test, 'file:/this/path/should/not/exist', @to_uris);
ok( @b == @from_files+1 );						# 44
ok(  $b[0] );								# 45
ok(  $b[1] );								# 46
ok(  $b[2] );								# 47
ok(  $b[3] );								# 48
ok(  $b[4] );								# 49
ok(  $b[5] );								# 50
ok( !$b[0]->is_success );						# 51
ok(  $b[0]->message eq "No such file or directory" );			# 52
ok(  $b[1]->is_success );						# 53
ok(  $b[2]->is_success );						# 54
ok(  $b[3]->is_success );						# 55
ok(  $b[4]->is_success );						# 56
ok(  $b[5]->is_success );						# 57

# Try to get the same files we just put.
@b = get_urls(@to_uris);
ok( @b == @from_files );						# 58
ok( $a[2] );								# 59
ok( $b[0] );								# 60
ok( $b[1] );								# 61
ok( $b[2] );								# 62
ok( $b[3] );								# 63
ok( $b[4] );								# 64
ok( $a[2]->content eq $b[0]->content );					# 65
ok( $a[2]->content eq $b[1]->content );					# 66
ok( $a[2]->content eq $b[2]->content );					# 67
ok( $a[2]->content eq $b[3]->content );					# 68
ok( $a[2]->content eq $b[4]->content );					# 69

# Try to get many different failures from put_urls.
@b = put_urls('text',
	'http://www.perl.com/test.html',
	'file://some.other.host/test',
	'ftp://ftp.gps.caltech.edu/test',
        '');
ok(  $b[0] );								# 70
ok(  $b[1] );								# 71
ok(  $b[2] );								# 72
ok(  $b[3] );								# 73
ok( !$b[0]->is_success );						# 74
ok(  $b[0]->message eq 'Invalid scheme http' );				# 75
ok( !$b[1]->is_success );						# 76
ok(  $b[1]->message eq "Only file://localhost/ allowed" );		# 77
ok( !$b[2]->is_success );						# 78
ok(  $b[2]->message eq "FTP return code 553" );				# 79
ok( !$b[3]->is_success );						# 80
ok(  $b[3]->message eq "Missing URL in request" );			# 81

# Try to delete some nonexistent files.
@b = delete_urls(
	'http://www.perl.com/test.html',
	'file://some.other.host/test',
	'ftp://ftp.gps.caltech.edu/test',
        '');
ok( $b[0] );								# 82
ok( $b[1] );								# 83
ok( $b[2] );								# 84
ok( !$b[0]->is_success );						# 85
ok(  $b[0]->message eq "Method Not Allowed" );				# 86
ok( !$b[1]->is_success );						# 87
ok(  $b[1]->message eq "Use ftp instead" );				# 88
ok( !$b[2]->is_success );						# 89
ok(  $b[2]->message eq "/test: Permission denied on server. (Delete)" );# 90
ok( !$b[3]->is_success );						# 91
ok(  $b[3]->message eq "Missing URL in request" );			# 92

# Try to delete the files we created.
@b = delete_urls(@to_uris);
ok( @b == @to_uris );							# 93
ok( $b[0] );								# 94
ok( $b[1] );								# 95
ok( $b[2] );								# 96
ok( $b[3] );								# 97
ok( $b[4] );								# 98
ok( $b[0]->is_success );						# 99
ok( $b[1]->is_success );						# 100
ok( $b[2]->is_success );						# 101
ok( $b[3]->is_success );						# 102
ok( $b[4]->is_success );						# 103

# Try to delete the files again.  This time it should fail.
@b = delete_urls(@to_uris);
ok(  @b == @to_uris );							# 104
ok(  $b[0] );								# 105
ok(  $b[1] );								# 106
ok(  $b[2] );								# 107
ok(  $b[3] );								# 108
ok(  $b[4] );								# 109
ok( !$b[0]->is_success );						# 110
ok( !$b[1]->is_success );						# 111
ok( !$b[2]->is_success );						# 112
ok( !$b[3]->is_success );						# 113
ok( !$b[4]->is_success );						# 114

# Create one file and try to move it.
ok( copy_url($from_uris[4], $to_uris[4]) );				# 115
ok( move_url($to_uris[4], $to_uris[0]) );				# 116

# Now try failures of move_url.
ok( !move_url($to_uris[4], $to_uris[0]) );				# 117
ok( $@ =~ m?/t/file5.new: No such file or directory? );			# 118
ok( !move_url($to_uris[0], 'file://some.other.host/test') );		# 119
ok( $@ eq 'PUT file://some.other.host/test: Only file://localhost/ allowed' ); # 120

# Make sure that if empty URIs are passed, we get the proper return message.
ok( !copy_url(' ', ' ') );						# 121
ok( $@ eq 'Missing GET URL' );						# 122
ok( !copy_url('http://www.perl.com/', ' ') );				# 123
ok( $@ eq 'Missing PUT URL' );						# 124

ok( !copy_urls([], []) );						# 125
ok( $@ eq 'No non-empty GET URLs' );					# 126
ok( !copy_urls('http://www.perl.com/', []) );				# 127
ok( $@ eq 'No non-empty PUT URLs' );					# 128

@b = delete_urls(' ');
ok(  $b[0] );								# 129
ok( !$b[0]->is_success );						# 130
ok(  $b[0]->message eq 'Missing URL in request' );			# 131

@b = get_urls(' ');
ok(  $b[0] );								# 132
ok( !$b[0]->is_success );						# 133
ok(  $b[0]->message eq 'Missing URL in request' );			# 134

@b = move_url(' ', 'file:/tmp/ ');
ok( !$b[0] );								# 135
ok(  $@ eq 'Missing GET URL');						# 136

@b = move_url('/etc/passwd', ' ');
ok( !$b[0] );								# 137
ok(  $@ eq 'Missing PUT URL' );						# 138

@b = put_urls('test', ' ');
ok( !$b[0]->is_success );						# 139
ok(  $b[0]->message eq 'Missing URL in request' );			# 140

# Test copy_urls.
@b = copy_urls(['', $from_uris[0]], [@to_uris, '', 'file:/no/such/path/ZZZ/']);
ok( @b );								# 141
ok(  $b[0] );								# 142
ok(  $b[1] );								# 143
ok( !$b[0]->is_success );						# 144
ok(  $b[0]->message eq 'Missing URL in request' );			# 145
ok(  $b[1]->is_success );						# 146
ok(  $b[1]->{put_requests}[0]->is_success );				# 147
ok(  $b[1]->{put_requests}[1]->is_success );				# 148
ok(  $b[1]->{put_requests}[2]->is_success );				# 149
ok(  $b[1]->{put_requests}[3]->is_success );				# 150
ok(  $b[1]->{put_requests}[4]->is_success );				# 151
ok( !$b[1]->{put_requests}[5]->is_success );				# 152
ok(  $b[1]->{put_requests}[5]->message eq 'Missing URL in request' );	# 153
ok( !$b[1]->{put_requests}[6]->is_success );				# 154
ok(  $b[1]->{put_requests}[6]->message eq 'No such file or directory' ); # 155

# Try to read all of the files we put and compare with what we've read.
@b = get_urls(@to_uris);
ok( @b == @from_files );						# 156
ok( $b[0] );								# 157
ok( $b[1] );								# 158
ok( $b[2] );								# 159
ok( $b[3] );								# 160
ok( $b[4] );								# 161
ok( $b[0]->is_success and $b[0]->content eq $a[0]->content );		# 162
ok( $b[1]->is_success and $b[1]->content eq $a[0]->content );		# 163
ok( $b[2]->is_success and $b[2]->content eq $a[0]->content );		# 164
ok( $b[3]->is_success and $b[3]->content eq $a[0]->content );		# 165
ok( $b[4]->is_success and $b[4]->content eq $a[0]->content );		# 166

# Check the directory listing code.
ok( !list_url );							# 167
ok( !list_url('http://www.perl.com/') );				# 168
ok( $@ eq 'Unsupported scheme http in URL http://www.perl.com/' );	# 169
@b = list_url("file://localhost/$cwd");
ok( @b == 13 );								# 170
ok( !list_url('file://localhost/this/path/should/not/exist') );		# 171
# This case insensitive match is done to match on both Unix and Windows.
#           File or directory `/this/path/should/not/exist' does not exist
ok( $@ =~ m:File or directory `.this.path.should.not.exist' does not exist:i ); # 172
ok( !list_url($from_uris[0]) );						# 173
ok( $@ =~ m:t.file1' is not a directory:i );				# 174
ok( !list_url('ftp://ftp.gps.caltech.edu/ZZZZ') );			# 175
ok( $@ = "Cannot chdir to `ZZZ'" );					# 176
@b = list_url("ftp://ftp.gps.caltech.edu/etc");
ok( @b == 5 );								# 177

# Try one function with a HTTP::Request object.  Because we are doing
# a GET on a object but passing in a request with a DELETE method,
# get_urls should make a clone, change the method and leave the initial
# request alone.
my $http_req = HTTP::Request->new('DELETE', $from_uris[0]);
ok( $http_req and $http_req->method eq 'DELETE' );			# 178
@b = get_urls($http_req);
ok( @b == 1);								# 179
ok( $b[0] and $b[0]->is_success and length($b[0]->content) == 90 );	# 180
ok( $http_req and $http_req->method eq 'DELETE' );			# 181

# Try copying a file from a subdirectory into the current directory.
# This also tests the name appending code for copying a file into a
# directory.
ok( copy_url('file:dir/file6', "file://localhost/$cwd/") );		# 182
ok( -e 'file6' );							# 183
ok( -s _ == 90 );							# 184
ok( unlink('file6') );							# 185

# Clean up the output files.
ok( unlink(map { $_->file } @to_uris) == @from_files );			# 186
@b = list_url("file://localhost/$cwd");
ok( @b == 8 );								# 187