view release on metacpan or  search on metacpan

lib/HTTP/WebTest/SelfTest.pm  view on Meta::CPAN

# $Id: SelfTest.pm,v 1.8 2003/07/03 11:22:01 m_ilya Exp $

package HTTP::WebTest::SelfTest;

=head1 NAME

HTTP::WebTest::SelfTest - Helper package for HTTP::WebTest test suite

=head1 SYNOPSIS

    use HTTP::WebTest::SelfTest;

=head1 DESCRIPTION

This module provides helper routines used by L<HTTP::WebTest> self
test suite. Plugin writers may find this module useful for
implementation of test suites for their plugins.

=cut

use strict;

use base qw(Exporter);

=head1 GLOBAL VARIABLES

This module imports in namespace of test script following global
variables.

=cut

use vars qw(@EXPORT $HOSTNAME $PORT $URL);

@EXPORT = qw($HOSTNAME $PORT $URL
             abs_url
             check_webtest
             read_file write_file
             generate_testfile canonical_output compare_output
             parse_basic_credentials
             start_webserver stop_webserver);

use Algorithm::Diff qw(diff);
use MIME::Base64;
use URI;

use HTTP::WebTest::Utils qw(find_port start_webserver stop_webserver);

=head2 $HOSTNAME

The hostname of the test webserver.

=cut

$HOSTNAME = $ENV{TEST_HOSTNAME} || '127.0.0.1';

=head2 $PORT

The port of the test webserver.

=cut

$PORT = find_port();
die "Can't find free port" unless defined $PORT;

=head2 $URL

The URL of the test webserer.

=cut

$URL = "http://$HOSTNAME:$PORT/";

=head1 SUBROUTINES

This module imports in namespace of test script following helper
subroutines.

=head2 abs_url($base, $rel)

=head3 Return

Returns absolute URL based on pair of base and relative URLs.

=cut

sub abs_url {
    my $abs = shift;
    my $rel = shift;

    return URI->new_abs($rel, $abs);
}

=head2 read_file($filename, $ignore_errors)

Reads a file.

=head3 Parameters

=over 4

lib/HTTP/WebTest/SelfTest.pm  view on Meta::CPAN

=head3 Parameters

=over 4

=item output_ref => $output_ref

A reference on scalar which contains test output as whole string.

=item check_file => $check_file

Filename of the reference file.

=back

=cut

sub compare_output {
    my %param = @_;

    my $check_file = $param{check_file};
    my $output2 = ${$param{output_ref}};

    my $output1 = read_file($check_file, 1);
    _print_diff($output1, $output2);
    _ok(($output1 eq $output2) or defined $ENV{TEST_FIX});

    if(defined $ENV{TEST_FIX} and $output1 ne $output2) {
	# special mode for writting test report output files

	write_file($check_file, $output2);
    }
}

# ok compatible with Test and Test::Builder
sub _ok {
    # if Test is already loaded use its ok
    if(Test->can('ok')) {
        @_ = $_[0];
        goto \&Test::ok;
    } else {
        require Test::Builder;
        local $Test::Builder::Level = $Test::Builder::Level + 1;
        Test::Builder->new->ok(@_);
    }
}

# print diff of outputs
sub _print_diff {
    my $output1 = shift;
    my $output2 = shift;

    my @diff = diff([split /\n/, $output1], [split /\n/, $output2]);

    for my $hunk (@diff) {
	for my $diff_str (@$hunk) {
	    printf "%s %03d %s\n", @$diff_str;
	}
    }
}

=head2 parse_basic_credentials($credentials)

Decodes credentials for Basic authorization scheme according RFC2617.

=head3 Returns

Returns user/password pair.

=cut

sub parse_basic_credentials {
    my $credentials = shift;

    return () unless defined $credentials;
    $credentials =~ m|^ \s* Basic \s+ ([A-Za-z0-9+/=]+) \s* $|x;
    my $basic_credentials = $1;
    return () unless defined $basic_credentials;
    my $user_pass = decode_base64($basic_credentials);
    my($user, $password) = $user_pass =~ /^ (.*) : (.*) $/x;
    return () unless defined $password;

    return ($user, $password);
}

=head1 DEPRECATED SUBROUTINES

This module imports in namespace of test script following helper
subroutines but they are deprecated and may be removed in the future
from this module.

=head2 start_webserver

This subroutine was moved into
L<HTTP::WebTest::Utils|HTTP::WebTest::Utils> but for backward
compatibility purposes can be exported from this module.

=head2 stop_webserver

This subroutine was moved into
L<HTTP::WebTest::Utils|HTTP::WebTest::Utils> but for backward
compatibility purposes can be exported from this module.

=head1 COPYRIGHT

Copyright (c) 2001-2003 Ilya Martynov.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<HTTP::WebTest|HTTP::WebTest>

L<HTTP::WebTest::API|HTTP::WebTest::API>

L<HTTP::WebTest::Plugins|HTTP::WebTest::Plugins>

=cut

1;