in reply to Re: Constructor fails with Undefined subroutine when called as new Foo()
in thread Constructor fails with Undefined subroutine when called as new Foo()
Basically, the error gets triggered when I'm trying to cwd into includes/ directory (which is InMem::DirHandle). The rest works perfectly.#!/usr/bin/perl { package Net::FTPServer::Atrex::DirHandle; use strict; use warnings; use Net::FTPServer::Full::DirHandle; use Net::FTPServer::Full::FileHandle; use Net::FTPServer::InMem::DirHandle; use Net::FTPServer::InMem::FileHandle; use Data::Dumper; our @ISA = qw(Net::FTPServer::Full::DirHandle); sub open { my $self = shift; my $filename = shift; my $mode = shift; if ($filename =~ /^atx.*\.txt$/ || $mode eq 'r') { return $self->SUPER::open($filename, $mode); } my $content = ""; return new IO::Scalar (\$content); } } { package Net::FTPServer::Virtual::DirHandle; use strict; use warnings; use Net::FTPServer::Full::DirHandle; use Net::FTPServer::Full::FileHandle; use Net::FTPServer::InMem::DirHandle; use Net::FTPServer::InMem::FileHandle; use Data::Dumper; use vars qw(%dirs %files); our @ISA = qw(Net::FTPServer::InMem::DirHandle); sub get { my $self = shift; my $filename = shift; warn $filename; if ($filename eq 'images') { return new Net::FTPServer::Full::DirHandle($self->{ftps}, +$self->{ftps}->config("image directory")); } elsif ($filename eq 'atrex') { return new Net::FTPServer::Atrex::DirHandle($self->{ftps}, + $self->{ftps}->config("import directory")); } return $self->SUPER::get($filename); } } { package Net::FTPServer::Opencart; use strict; use warnings; use Cwd; use File::Slurp; use Digest::MD5 qw(md5_hex); use Net::FTPServer::InMem::Server; use Net::FTPServer::InMem::DirHandle; use Net::FTPServer::InMem::FileHandle; use Data::Dumper; our @ISA = qw(Net::FTPServer::InMem::Server); sub post_configuration_hook { my $self = shift; if (my $external_ip = $self->config("external ip")) { my $subname = "_PASV_command"; $self->{command_table}{PASV} = \&$subname; $external_ip =~ s/\./\,/g; $self->{external_ip} = $external_ip; } } sub authentication_hook { my $self = shift; my $username = shift; my $password = shift; my $user_is_anon = shift; # Deny anonymous access. return -1 if $user_is_anon; # Verify access against our config username/password combinati +ons. return 0 if $username eq $self->config("username") && md5_hex( +$password) eq $self->config("password"); # Unsuccessful login. return -1; } sub user_login_hook { } sub root_directory_hook { my $self = shift; if (!$self->{__root_directory}) { my $root = $self->{__root_directory} = Net::FTPServer::Vir +tual::DirHandle->new($self); $root->mkdir('atrex'); $root->mkdir('images'); $root->mkdir('includes'); my $includes = $root->get('includes'); if (my $handle = $includes->open("version.php", "w")) { my $content = <<'CONTENT'; ... CONTENT $handle->print($content); close($handle); } if (my $handle = $includes->open("configure.php", "w")) { my $content = <<'CONTENT'; ... CONTENT $content =~ s/_HTTP_SERVER_/$self->config("catalog url +")/e; $handle->print($content); close($handle); } } return $self->{__root_directory}; } sub _PASV_command { no warnings qw(redefine); my $self = shift; my $cmd = shift; my $rest = shift; my $reply = \&Net::FTPServer::reply; local *Net::FTPServer::reply = sub { my $self = shift; my $code = shift; my $message = shift; $message =~ s/\d+,\d+,\d+,\d+(,\d+,\d+)/$self->{external_i +p}$1/; $reply->($self, $code, $message); }; $self->SUPER::_PASV_command($cmd, $rest); } } { package main; use strict; use warnings; my $ftpd = Net::FTPServer::Opencart->run(); }
|
|---|