kodo has asked for the wisdom of the Perl Monks concerning the following question:

Hello monks!

I've finally read some perldocs about OO-Perl Coding and thought I should give it a try to rewrite a module I used in scripts like ftp remote editing script before.
So I want you to have a look at my code please, and give me any idea you have about what to improve, make more simple/readable, optimize on speed or just coding-style suggestions.
I didn't want to comment the code yet, because I'd like to see if it's easy/hard for you to understand what's happening, not that the code is complex but if it's written clear/logical from your point of view.

Thank you,

giant
package myftp; # myFTP is simply a frontend to the Net::FTP modules # I've written this to simplify all those FTP-Transfers here, so th +at I have a nice overview what happened (stats()) and easy error-catc +hing # The idea is to have all warnings etc saved, and not print while t +hings are called, but have a nice formatted statistic when it quits. # Some functions still need to be done like rename() etc, they curr +ently aren't in because I don't need them but I plan to put in even m +ore stuff # But primary this was just something for me to learn a bit about h +ow OO-Perl works...but maybe some other people find it usefull, too.. +. # Errormessages can be accessed via $ftp->{'errormsg'}. # # myFTP usage: # ~~~~~~~~~~~ # use myftp; # my $ftp = new myftp ( host => 'myhost', # Host to +connect to # port => '21', # Port to con +nect to # user => 'myuser', # username fo +r login # pw => 'mypassword', # password +for login # timeout => '20', # default +is 30 # retries => '3', # How o +ften should an action be retried if it fails? # verbose => '0', # Verbo +se-Level: 0 = no warnings, no failures # + 1 = no warnings, failures printed # + 2 = warnings and failures printed # + 3 = same as 2 + more details # debug => '0', # Use Net +::FTP-Debug mode? (default 0) # stats => '1', # Print s +tats when object is DESTROYed? # # $ftp->get('remotefile', 'localfile') || die "couldn't get remotef +ile: $self->{'errormsg'}; # $ftp->put('localfile', 'remotefile'); # $ftp->ls('remotefile'); # $ftp->dir('remotefile'); # $ftp->delete('remotefile'); # $ftp->stats(); # # use strict; use Net::FTP; use Carp; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; my %arg = @_; $self->{'host'} = defined($arg{'host'}) ? $arg{'host'} + : do { carp "No host specified!"; return undef; }; $self->{'port'} = defined($arg{'port'}) ? $arg{' +port'} : 21; $self->{'user'} = defined($arg{'user'}) ? $arg{'us +er'} : do { carp "No user specified!"; return undef; }; $self->{'pw'} = defined($arg{'pw'}) ? $arg{'pw'} + : do { carp "No password(pw) specified!"; return undef; }; $self->{'timeout'} = defined($arg{'timeout'}) ? $arg{'t +imeout'} : 30; $self->{'retries'} = defined($arg{'retries'}) ? $arg{'re +tries'} : 0; $self->{'verbose'} = defined($arg{'verbose'}) ? $arg{'ve +rbose'} : 1; $self->{'debug'} = defined($arg{'debug'}) ? $arg{'debug' +} : 0; $self->{'stats'} = defined($arg{'stats'}) ? $arg{'stats' +} : 1; $self->{'files_ok'} = {}; $self->{'files_failed'} = {}; $self->{'sub_warnings'} = []; $self->{'failures'} = 0; $self->{'warnings'} = 0; $self->{'errormsg'} = ''; $self->{'connected'} = ''; $self->{'start_time'} = scalar(localtime); $self->{'ftp'} = ''; $SIG{__WARN__} = sub { push(@{ $self->{'sub_warnings'} }, shift); +} if $self->{'verbose'} == 0; bless ($self, $class); { my $ok = 0; my $counter = -1; my $start_time = time; do { unless ($self->{'ftp'} = Net::FTP->new($self->{'host'}, Po +rt => $self->{'port'}, Timeout => $self->{'timeout'}, Debug => $self- +>{'debug'})) { carp "Couldn't connect to $self->{'host'}" if $self->{ +'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'time'}{'connect'} = (time - $start_time); print "Connection to $self->{'host'} established.\n" i +f $self->{'verbose'} > 2; $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { carp "Couldn't connect to $self->{'host'}"; return undef; + } if $ok == 0; } { my $ok = 0; my $counter = -1; my $start_time = time; do { unless ($self->{'ftp'}->login($self->{'user'}, $self->{'pw +'})) { carp "Couldn't login to $self->{'host'}: FTP-Error ".$ +self->{'ftp'}->code()." : ".$self->{'ftp'}->message() if $self->{'ver +bose'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'time'}{'login'} = (time - $start_time); print "Login accepted to $self->{'host'}.\n" if $self- +>{'verbose'} > 2; $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { carp "FTP Failed: Couldn't login to $self->{'host'}"; ret +urn undef; } if $ok == 0; } return $self; } sub DESTROY { my $self = shift; $self->{'ftp'}->quit() if defined($self->{'ftp'}); print $self->status() if $self->{'stats'} > 0; } sub status { my $self = shift; my @data = ("##################".("#" x length(scalar(localtime))) +."\n", "# myFTP Stats \@ ".scalar(localtime)." #\n", "##################".("#" x length(scalar(localtime))) +."\n\n", sprintf("%-23s %s %s", 'Started:', $se +lf->{'start_time'}, "\n"), sprintf("%-23s %s %s", 'Remote host:', $sel +f->{'host'}.":".$self->{'port'},"\n"), sprintf("%-23s %s %s", 'User:', $se +lf->{'user'}, "\n\n"), sprintf("%-23s %s %s", 'Warnings:', $self- +>{'warnings'}, "\n"), sprintf("%-23s %s %s", 'Failures:', $self- +>{'failures'}, "\n\n"), sprintf("%-23s %s %s", 'Connect-Time (secs):', $se +lf->{'time'}{'connect'}, "\n"), sprintf("%-23s %s %s", 'Login-Time (secs):', $self +->{'time'}{'login'}, "\n\n") ); push(@data, (scalar(keys %{ $self->{'files_ok'} })." files transfe +red\n", "=================".("=" x length(scalar(keys %{ $self->{'fil +es_ok'} })))."\n")); foreach (keys %{ $self->{'files_ok'} }) { $self->{'files_ok'}{$_} > 59 ? push(@data, "$_ in ".($self->{' +files_ok'}{$_} / 60)." minute(s)\n") : push(@data, "$_ in $self->{'fi +les_ok'}{$_} second(s)\n"); } push(@data, ("\n".scalar(keys %{ $self->{'files_failed'} })." file +s not transfered\n", "=====================".("=" x length(scalar(key +s %{ $self->{'files_failed'} })))."\n")); push(@data, "$_ : $self->{'files_failed'}{$_}") foreach (keys %{ $ +self->{'files_failed'} }); push(@data, ("\n".scalar(keys %{ $self->{'time'}{'commands'} })." +other commands done\n", "====================".("=" x length(scalar(k +eys %{ $self->{'time'}{'commands'} })))."\n")); push(@data, "Time(secs) for: $_: $self->{'time'}{'commands'}{$_}\n +") foreach keys %{ $self->{'time'}{'commands'} }; push(@data, ("\n".scalar(@{ $self->{'sub_warnings'} })." unexpecte +d warnings\n", "====================".("=" x length(scalar(@{ $self-> +{'sub_warnings'} })))."\n")); push(@data, $_) foreach(@{ $self->{'sub_warnings'} }); return @data; } sub error { my $self = shift; my $msg = shift; my $file = shift; $self->{'errormsg'} = $msg; $self->{'failures'}++; $self->{'files_failed'}{$file} = $msg if $file; warn $msg if $self->{'verbose'} > 0; return; } sub dir { my $self = shift; my $dir = shift || do { $self->error("dir() needs dir/file as +parameter!"); return undef; }; my @dir = (); { my $ok = 0; my $counter = -1; my $start_time = time; do { unless (@dir = $self->{'ftp'}->dir($dir)) { carp "Couldn't list(dir) $dir: ".$self->{'ftp'}->code( +).": ".$self->{'ftp'}->message() if $self->{'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'time'}{'commands'}{"dir($dir)"} = (time - $st +art_time); $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't list(dir) $dir: ".$self->{'ftp'}-> +code().": ".$self->{'ftp'}->message()); return undef; } if $ok == 0; } return @dir; } sub ls { my $self = shift; my $dir = shift || do { $self->{'errormsg'} = "ls() needs dir/ +file as parameter!"; return undef; }; my @dir = (); { my $ok = 0; my $counter = -1; my $start_time = time; do { unless (@dir = $self->{'ftp'}->ls($dir)) { carp "Couldn't list(ls) $dir: ".$self->{'ftp'}->code() +.": ".$self->{'ftp'}->message() if $self->{'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'time'}{'commands'}{"ls($dir)"} = (time - $sta +rt_time); $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't list(ls) $dir: ".$self->{'ftp'}->c +ode().": ".$self->{'ftp'}->message()); return undef; } if $ok == 0; } return @dir; } sub size { my $self = shift; my $file = shift || do { $self->{'errormsg'} = "size() needs file +as parameter!"; return undef; }; my $size = ''; { my $ok = 0; my $counter = -1; my $start_time = time; do { unless($size = grep_size($self->{'ftp'}->dir($file))) { carp "Couldn't get size of $file:".$self->{'ftp'}->cod +e().": ".$self->{'ftp'}->message() if $self->{'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'time'}{'commands'}{"size($file)"} = (time - $ +start_time); $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't get size of $file: ".$self->{'ftp' +}->code().": ".$self->{'ftp'}->message()); return undef; } if $ok == +0; } sub grep_size { my $size; foreach(@_) { ($size) = $_ =~ /^.*?\s+.*?\s+.*?\s+.*?\s+(.*?)\s.*?/; } return $size if $size =~ /^\d*$/; return undef; } return $size; } sub delete { my $self = shift; my $file = shift || do { $self->{'errormsg'} = "delete() needs fil +e as parameter!"; return undef; }; { my $ok = 0; my $counter = -1; my $start_time = time; do { unless ($self->{'ftp'}->delete($file)) { carp "Couldn't delete $file: ".$self->{'ftp'}->code(). +": ".$self->{'ftp'}->message() if $self->{'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'time'}{'commands'}{"delete($file)"} = (time - + $start_time); $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't delete $file: ".$self->{'ftp'}->co +de().": ".$self->{'ftp'}->message()); return undef; } if $ok == 0; } return 1; } sub put { my $self = shift; my %arg = @_; my $localfile = $arg{'localfile'} || do { $self->{'errorms +g'} = "put() needs (localfile,remotefile) as parameters!"; return und +ef; };; my $remotefile = $arg{'remotefile'} || do { $self->{'error +msg'} = "put() needs (localfile,remotefile) as parameters!"; return u +ndef; };; my $mode = $arg{'mode'} || 'binary'; { my $ok = 0; my $counter = -1; my $start_time = time; do { unless ($self->{'ftp'}->$mode()) { carp "Couldn't set mode to $mode!: ".$self->{'ftp'}->c +ode().": ".$self->{'ftp'}->message() if $self->{'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't upload $localfile as $remotefile: +Couldn't change mode to $mode: ".$self->{'ftp'}->code().": ".$self->{ +'ftp'}->message(), "$localfile => $remotefile"); return undef; } if $ +ok == 0; } { my $ok = 0; my $counter = -1; my $start_time = time; do { unless ($self->{'ftp'}->put($localfile, $remotefile)) { carp "Couldn't upload $localfile as $remotefile: ".$se +lf->{'ftp'}->code().": ".$self->{'ftp'}->message() if $self->{'verbos +e'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'files_ok'}{"$localfile => $remotefile"} = (ti +me - $start_time); $self->{'files'}++; $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't upload $localfile as $remotefile: +".$self->{'ftp'}->code().": ".$self->{'ftp'}->message(), "$localfile +=> $remotefile"); return undef; } if $ok == 0; } return 1; } sub get { my $self = shift; my %arg = @_; my $remotefile = $arg{'remotefile'} || do { $self->{'error +msg'} = "put() needs (localfile,remotefile) as parameters!"; $self->{ +'failures'}++; return undef; };; my $localfile = $arg{'localfile'} || do { $self->{'errorms +g'} = "put() needs (localfile,remotefile) as parameters!"; $self->{'f +ailures'}++; return undef; };; my $mode = $arg{'mode'} || 'binary'; { my $ok = 0; my $counter = -1; my $start_time = time; do { unless ($self->{'ftp'}->$mode()) { carp "Couldn't set mode to $mode!: ".$self->{'ftp'}->c +ode().": ".$self->{'ftp'}->message() if $self->{'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't download $remotefile as $localfile +: Couldn't change mode to $mode: ".$self->{'ftp'}->code().": ".$self- +>{'ftp'}->message(), "$remotefile => $localfile"); return undef; } if + $ok == 0; } { my $ok = 0; my $counter = -1; my $start_time = time; do { unless ($self->{'ftp'}->get($remotefile, $localfile)) { carp "Couldn't download $remotefile as $localfile!" if + $self->{'verbose'} > 1; $self->{'warnings'}++; $counter++; } else { $self->{'files_ok'}{"$localfile => $remotefile"} = (ti +me - $start_time); $self->{'files'}++; $ok++; } } while ($counter < $self->{'retries'} && $ok == 0); do { $self->error("Couldn't download $remotefile as $localfile +: ".$self->{'ftp'}->code().": ".$self->{'ftp'}->message(), "$remotefi +le => $localfile"); return undef; } if $ok == 0; } return 1; } 1;

Replies are listed 'Best First'.
Re: First steps in OO-Perl , suggestions please!
by broquaint (Abbot) on Jul 25, 2002 at 12:14 UTC
    Here's a bunch of points that sprung to mind from looking over the code

    • Lower-case package names indicate pragmata, so your package might be better named MyFTP
    • You've got the cargo-cult ref($proto) || $proto which, like all code, you shouldn't use unless you know what it it's doing (see. this node for some heavy discussion on the matter)
    • There's an awful lot going on in your constructor which should probably be fielded off to an initialisation metehod
    • While I realise you've left out comments for a reason it would be very much more perlish to change the comments at the top of the source into POD :)
    • In your put(), get() and delete() methods you should be returning the status of the equivalent Net::FTP call
    • You could cut down on duplicate code by getting rid of the double bare blocks in some of the methods as they currently don't serve a great deal of purpose
    • The method grep_size() is a package level sub, so it's a good idea to move it into the same code space (unless you want to use Sub::Lexical ;)
    • And one more minor point - your lines are positively mahoosive. It'd be nice if they were nearer the 80-char 'standard', but different keystrokes for different folks I guess

    Of course perl is all about TIMTOWTDI and if it ain't broke don't fix it. But if you're serious about getting OO in perl down then I'd recommend checking out other OO languages, not only will you get a feeling for how OO works you'll also appreciate the freedom you get from perl's OO system.
    HTH

    _________
    broquaint

    • Well to be honest I didn't think much about using ref($proto) || $proto, I did because I've read Planning for the Future - Better constructors in perltoot.
    • Yes I'll do a POD once it's really finished
    • About the 80-char-standard: Should I just break the lines?
    • All other points: Agreed. :)
    • thanks!

      giant
        About the 80-char-standard: Should I just break the lines?
        Break the lines where it's logical. For example when you assign the new Net::FTP object to $self->{ftp} you could restructure it like so
        $self->{ftp} = Net::FTP->new( $self->{'host'}, Port => $self->{'port'}, Timeout => $self->{'timeout'}, Debug => $self->{'debug'} ); unless($self->{ftp}) { ... }
        Play around with it and see what looks best to you. You might even notice some improvements that could be made to your code along the way.
        HTH

        _________
        broquaint

Re: First steps in OO-Perl , suggestions please!
by davis (Vicar) on Jul 25, 2002 at 11:40 UTC
    2 thoughts spring to mind from skimming over your code:

    Please, please use POD. I initially stayed away from it, but the effort required to learn really is minimal. Even if it's only you using the module, there's something satisfying about being able to do perldoc My::Module

    In your constructor, you've hardcoded the required arguments - you may wish to try something like this:

    my $args = { @_ }; #Check for required values foreach my $required qw(arg1 arg2 arg3) { if(!defined($args->{$required})) { carp("Required value $required missing\n"); return undef; } }
    This tends to make the code a lot easier to update.
    davis
    Is this going out live?
    No, Homer, very few cartoons are broadcast live - it's a terrible strain on the animator's wrist
      Uhm yea I planned to write a POD once it's really done. I've already had a look at it and it's pretty easy to write so I'll definitly use it.
      Good idea about the constructor!

      giant
Re: First steps in OO-Perl , suggestions please!
by dreadpiratepeter (Priest) on Jul 25, 2002 at 12:56 UTC
    And the requisite plug, read Damian Conway's "Object Oriented Perl" book. It's a great introduction (and advanced course) in OOP in Perl.

    -pete
    "Pain heals. Chicks dig scars. Glory lasts forever."
      Yep, I already ordered it, but may take a while untill I've got it here because it always takes a while here when ordering books :(

      giant
Re: First steps in OO-Perl , suggestions please!
by joealba (Hermit) on Jul 25, 2002 at 13:16 UTC
    If you're interested in looking at some good code examples on the subject, check out suaveant's WebFTP project. It may help you out quite a bit.
Re: First steps in OO-Perl , suggestions please!
by cephas (Pilgrim) on Jul 25, 2002 at 13:57 UTC
    You've got:

    $SIG{__WARN__} = sub { push(@{ $self->{'sub_warnings'} }, shift); +} if $self->{'verbose'} == 0

    in your new() method. I wouldn't recommend doing that, or you'll be left wondering why you're warn statements in the calling script aren't acting as expected. You should be very careful when setting the special globals in order to avoid unwanted action at a distance.

    cephas
      Um well I wanted it that way, get all warnings in that array and print it with stats() then at the end.

      giant
        You asked for advice on OO. If you're going to encapsulate functionality, you should not affect things outside the scope of your module. By setting a handler for all warn calls the way you have done, all of the warning messages that might be generated by the script using your module would also be trapped. It may be what you want in your scenario, but if I personally were to use a module and suddenly have all of my calls to warn() stop working as expected, I would at first be confused, then annoyed once I found out what the problem was and had to rewrite my code to account for this. The only time I could see that you would want to rewrite the warn handler on a global scale would be if you were writing a message specificly for the purpose of trapping warn messages.

        Just my 2 cents.

        cephas