Permalink
Browse files

initial commit

  • Loading branch information...
0 parents commit d286de1c551d03719715dd40d1e87f021919a4e5 @wchristian committed Oct 31, 2010
Showing with 307 additions and 0 deletions.
  1. +2 −0 .gitignore
  2. +4 −0 Changes
  3. +44 −0 dist.ini
  4. +245 −0 lib/Net/FTP/Mock.pm
  5. +12 −0 t/00_load.t
@@ -0,0 +1,2 @@
+/Net-FTP-Mock-*
+/.build
@@ -0,0 +1,4 @@
+Revision history for Perl module {{$dist->name}}
+
+{{$NEXT}}
+ - initial release
@@ -0,0 +1,44 @@
+name = Net-FTP-Mock
+author = Christian Walde <mithaldu@yahoo.de>
+license = WTFPL_2
+copyright_holder = Christian Walde
+copyright_year = 2010
+
+[AutoVersion]
+major = 0
+
+[PkgVersion]
+[GatherDir]
+[PruneCruft]
+[ManifestSkip]
+[AutoPrereqs]
+[MetaYAML]
+[License]
+[Readme]
+[PodWeaver]
+[ExtraTests]
+[PodCoverageTests]
+[PodSyntaxTests]
+[KwaliteeTests]
+[MetaConfig]
+[MetaJSON]
+[CheckChangeLog]
+[NextRelease]
+[MakeMaker]
+[Manifest]
+[TestRelease]
+[ConfirmRelease]
+[UploadToCPAN]
+
+[@Git]
+
+[MetaNoIndex]
+dir = t
+
+[Prereqs / TestRequires]
+Test::Simple = 0.96
+
+[MetaResources]
+repository.web = http://github.com/wchristian/Net-FTP-Mock
+repository.url = http://github.com/wchristian/Net-FTP-Mock.git
+repository.type = git
@@ -0,0 +1,245 @@
+use strict;
+use warnings;
+
+package Net::FTP::Mock;
+
+# ABSTRACT: test code using Net::FTP without having an FTP server
+
+=head1 NAME
+
+test code using Net::FTP without having an FTP server
+
+=head1 SYNOPSIS
+
+ use Net::FTP::Mock (
+ localhost => {
+ username => { password => {
+ active => 1,
+ root => "t/remote_ftp/"
+ }},
+ },
+ ftp.work.com => {
+ harry => { god => {
+ active => 1,
+ root => "t/other_remote_ftp/"
+ }},
+ },
+ );
+
+ use Net::FTP; # will do nothing, since Mock already blocked it
+
+ # $ftp here actually is a Net::FTP::Mock object,
+ # but when inspected with isa() it happily claims to be Net::FTP
+ my $ftp = Net::FTP->new("ftp.work.com", Debug => 0) or die "Cannot connect to some.host.name: $@";
+
+ # all of these do what you'd think they do, only instead of acting
+ # on a real ftp server, they act no the data provided via import
+ # and the local harddisk
+ $ftp->login( "harry",'god' ) or die "Cannot login ", $ftp->message;
+ $ftp->get("that.file") or die "get failed ", $ftp->message;
+ $ftp->quit;
+
+=head1 DESCRIPTION
+
+Net::FTP::Mock is designed to make code using Net::FTP testable without having to set up actual FTP servers. When
+calling its import(), usually by way of use, you can pass it a hash detailing virtual servers, their accounts, as well
+as directories that those accounts map to on the local machine.
+
+You can then interact with the Net::FTP::Mock object exactly as you would with a real one.
+
+NOTE: This is a work in progress and much of Net::FTP's functionality is not yet emulated. If it behaves odd, look at
+the code or yell at me. Contributions on github are very welcome.
+
+=cut
+
+use Moose;
+use MooseX::HasDefaults::RW;
+use MooseX::ClassAttribute;
+
+use File::Copy 'copy';
+
+class_has servers => ( isa => 'HashRef', is => 'rw', default => sub { {} } );
+
+has host => ( isa => 'Str', is => 'ro', required => 1, initializer => '_check_host' );
+has user => ( isa => 'Str' );
+has pass => ( isa => 'Str' );
+has message => ( isa => 'Str' );
+has account => ( isa => 'HashRef', lazy => 1, builder => '_get_account' );
+has root => ( isa => 'Str', lazy => 1, default => sub { $_[0]->_account->{root} } );
+has code => ( isa => 'Int' );
+
+=head1 METHODS
+
+=head2 Net::FTP::new
+
+Factory method that is implanted into Net::FTP's namespace and returns a Net::FTP::Mock object. Should behave exactly
+like Net::FTP's new() behaves.
+
+=cut
+
+sub Net::FTP::new {
+ my ( undef, @args ) = @_;
+
+ my $ftp = Net::FTP::Mock->new( @args );
+ return $ftp if !$ftp->message;
+
+ $@ = $ftp->message;
+ return;
+}
+
+=head2 Net::FTP::Mock->import( %server_details );
+
+Blocks Net::FTP's namespace in %INC and prepares the servers to be emulated.
+
+=cut
+
+sub import {
+ my ( $self , %args ) = @_;
+
+ $INC{'Net/FTP.pm'} = $INC{'Net/FTP/Mock.pm'};
+ $self->servers( \%args );
+
+ return;
+}
+
+=head2 isa
+
+Overrides isa to ensure that Moose's type checks recognize this as a Net::FTP object.
+
+=cut
+
+sub isa {
+ return 1 if $_[1] eq 'Net::FTP';
+ return $_[0]->UNIVERSAL::isa($_[1]);
+}
+
+sub BUILDARGS {
+ my ( $class, $host, @args ) = @_;
+ return { host => $host, @args };
+};
+
+sub _check_host {
+ my ( $self, $host, $set_function ) = @_;
+
+ $self->message( "Net::FTP: Bad hostname '$host'" ) if !$self->servers->{$host};
+
+ return $set_function->( $host );
+}
+
+sub _server {
+ my ( $self ) = @_;
+ return if !$self->servers;
+ return $self->servers->{$self->host};
+}
+
+sub _get_account {
+ my ( $self ) = @_;
+ return $self->_bad_host if !$self->_server;
+ my $acc = $self->_server->{$self->user}{$self->pass} || $self->_bad_account;
+ return $acc;
+}
+
+sub _bad_host {
+ my ( $self ) = @_;
+ $self->message( "Cannot connect to ".$self->host.": Net::FTP: Bad hostname '".$self->host."'" );
+ return {};
+}
+
+sub _bad_account {
+ my ( $self ) = @_;
+ $self->message( "Login or password incorrect!\n" );
+ return {};
+}
+
+sub _file_missing {
+ my ( $self, $file, $target ) = @_;
+ $self->code( 550 );
+ return;
+}
+
+sub _full_filename {
+ my ( $self, $file ) = @_;
+
+ $file = $self->root.$file;
+
+ return $file;
+}
+
+=head1 SUPPORTED NET::FTP METHODS
+
+=head2 code
+
+=head2 message
+
+=head2 binary
+
+=head2 get
+
+=head2 quit
+
+=head2 mdtm
+
+=head2 size
+
+=head2 login
+
+=cut
+
+
+sub login {
+ my ( $self, $user, $pass ) = @_;
+
+ $self->user( $user );
+ $self->pass( $pass );
+
+ return 1 if $self->_account->{active};
+ return;
+}
+
+sub binary {}
+
+sub get {
+ my ( $self, $file, $target ) = @_;
+
+ $file = $self->_full_filename( $file );
+ return $self->_file_missing if !-e $file;
+
+ copy $file, $target or return;
+
+ $self->code( 226 );
+ return $file;
+}
+
+sub quit {}
+
+sub mdtm {
+ my ( $self, $file ) = @_;
+
+ $file = $self->_full_filename( $file );
+ return if !-e $file;
+
+ return (stat $file)[9];
+}
+
+sub size {
+ my ( $self, $file ) = @_;
+
+ $file = $self->_full_filename( $file );
+ return if !-e $file;
+
+ return -s $file;
+}
+
+=head1 ACKNOWLEDGEMENTS
+
+Many thanks to mst and rjbs who fielded my newbie questions in #moose and helped me figure out how to actually create
+the Mock object from Net::FTP's mainspace, as well as how to get the Mock object to masquerade as Net::FTP.
+
+=head1 CONTRIBUTIONS
+
+Since I'm not sure how much time i can devote to this, I'm happy about any help. The code is up on github and i'll
+accept any helping pull requests.
+
+=cut
+
+1;
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+package load_test;
+
+use Test::Most;
+
+use_ok("Net::FTP::Mock");
+
+done_testing;

0 comments on commit d286de1

Please sign in to comment.