On Sun, Apr 28, 2002 at 01:06:18AM -0700, chromatic wrote:
> I've written a module to make it easier to do very strict unit testing.  It
> lets you fake an existing interface somewhat more easily.  For example, if
> you're testing a web app, you can mock up CGI.pm instead of having to specify
> query information manually.

We've been doing a lot of this at Mitel lately.  Below is an example of an
embedded test for method which downloads an RPM over rsync after first
requesting how to download it over an RPC session.

The obvious problem is how do you test this without having a machine for it
to actually connect to and download from.  In this case we've created a mock
RPC session object with a single method, sendRequest(), which simply traps
the user's RPC request and returns a canned response.  I also made a small
modification to the code WRT the rsync call.  Previously it was calling
rsync directly via system().  I moved that off into a function which I can
then override in the test so I can trap and examine the arguments.  Finally,
I override the identity_file() method so I can change where it's putting
it's ssh key.

So on the whole, a lot of fun glassbox testing going on here.

chromatic, it might be a nice exercise for you to work through if/how this
would be done with MockObject?



=item I<download>

  $pkg->download($session);

Downloads a copy of the RPM this $pkg represents from the $session and
places it into $pkg->abspath.

Throws E_DOWNLOAD if there is a problem.

=begin testing

{
    package Fake::Session::DL;

    sub sendRequest {
        my($self) = shift;
        $self->{_request} = shift;
        return {
                response_data => {
                                  user  => 'someuser',
                                  host  => 'somehost',
                                  session_key => 'CkR3t k33',
                                 }
               };
    }
}

my $session = bless {}, 'Fake::Session::DL';

no warnings 'once';
local $esmith::Blades::Package::LICENSEDIR = '30e-smith-blades';
local $esmith::Blades::Package::PKGDIR     = '30e-smith-blades';

no warnings 'redefine';
local *esmith::Blades::Package::identity_file = sub {
    my $self = shift;
    return "30e-smith-blades/ident_".$self->pkgString
};

my @rsync_args;
local *esmith::Blades::Package::rsync_ssh = sub {
    @rsync_args = @_;
    return 1;
};

my $pkg = $CLASS->new('foo-bar-1.2.3-01.i386');
ok( $pkg->download($session) );
is( $session->{_request}{request_type}, 'DownloadPackageKey' );
is( $session->{_request}{request_data}{package}, $pkg->pkgString );

is( $rsync_args[0], 'somehost:' );
is( $rsync_args[1], $pkg->abspath );
is( $rsync_args[2], 'someuser' );
is( $rsync_args[3], $pkg->identity_file );
isa_ok( $rsync_args[4], 'ARRAY' );

ok( open(IDENT, $pkg->identity_file) );
is( join('', <IDENT>), 'CkR3t k33' );
close IDENT;

unlink $pkg->identity_file;


=end testing

=cut

use esmith::util::system qw(rsync_ssh);
sub download
{
    my $self = shift;
    my $sessionObj = shift;

    my $request = {
          request_type => 'DownloadPackageKey',
          request_data => { package => $self->pkgString },
    };

    # XXX: catch exceptions
    my $response = $sessionObj->sendRequest($request);

    my $dataRef = $response->{response_data};
    my $remoteUser = $dataRef->{user};
    my $remoteHost = $dataRef->{host};
    my $sshKey     = $dataRef->{session_key};
    my $identity = $self->identity_file;

    # save download key
    open (KEY, ">$identity")
        or die "Could not open $identity: $!\n";
    print KEY $sshKey;
    close KEY;
    chmod 0600, $identity;

    # ok, now we should be able to start the rsync download
    my @rsync_options = (
                         '-p',
                         '--partial',
                         '--size-only',
                        );

    my $source = $remoteHost.':';
    my $dest = $self->abspath;

    rsync_ssh($source, $dest, $remoteUser, $identity, \@rsync_options)
      or throw esmith::Blades::Package::Error('E_DOWNLOAD');
}


-- 

Michael G. Schwern   <[EMAIL PROTECTED]>    http://www.pobox.com/~schwern/
Perl Quality Assurance      <[EMAIL PROTECTED]>         Kwalitee Is Job One
Let's leave my ass out of this, shall we?

Reply via email to