Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

A first attempt.. at OO perl

by why_bird (Pilgrim)
on Jul 02, 2008 at 10:49 UTC ( #695117=perlmeditation: print w/replies, xml ) Need Help??

Hi Monks,
I've finally got round to trying some OO stuff. I realise this is not groundbreaking stuff, but I thought I'd implement a 'getopt' module as an exercise.

It works (for me) reasonably so far, though it definitely needs some tweaking. I have a few questions though:

  1. I have very little experience coding for Windows, or even other *nixes. What things do you have to change/do to make code portable?
  2. How does one go about making a CPAN style module out of code like this? (Obviously I'd have to write something useful first, not the 101th 'getopt' variant :P) The modules on CPAN mostly seem to have loads of files in their tarballs, and you have to run make, make install etc. Is this to do with 1.?
  3. Have I got the right idea for OO code? What conventions have I missed? What dangerous/rubbish/useless things have I done?! I'm looking for both specific criticism on this code as well as general advice. The only real guideline I've followed is to not mess with the object directly and use methods whenever possible. Other than that I just followed my instinct..
  4. What would be your suggestion for a good next step for me into the OO world? Some kind of project, slightly more difficult than this would be good. I'm from a mathsy-sciencey background but don't have a whole lot of experience with programming or web stuff though I'm willing to learn.

I really am a bit clueless about all this, but I'd appreciate any help people could give..

Thanks,
why_bird
#! /usr/bin/perl #TODO: in parse, check whether str, num and int options have acutally +been given a value and warn if not. #TODO: check no. of args passed to each function #TODO: reimplement warnings and dies so that they're optionally fatal #TODO: mutually exclusive options? #TODO: - and -- not enforced in parse (or anywhere else). need a consi +stent policy package getopt_dev; use strict; use warnings; use Carp; use Data::Dumper; my $debug=0; if($debug==1){ $Carp::Verbose=1; } # constructor sub new { my $self = [{},""]; bless($self); return $self; } # create new valid options sub add_option { check_args(4,@_); my $class=shift; my $self=shift; my $name=shift; my $type=shift; my @types=qw(str bool int num); my @found=(); my %opt; $name=~s/^--?//; @found=grep(/^$type$/, @types); croak "$type not a valid type" if ($#found == -1); $opt{ "opt_name" }=$name; $opt{ "desc" }=""; $opt{ "opt_type" }=$type; $opt{ "long or short" }=(length($opt{ "opt_name" })==1)?("short"): +("long"); $opt{ "value" }={ "str" => "", "bool" => 0, "int" => "", "num" => "", }; $opt{ "valid" } = 1; print Dumper( $self->[0], ${$self->[0]}{ "d" }->{ "desc" }); ${$self->[0]}{ $name }=\%opt; print Dumper @$self if($debug==1); return keys (%{$self->[0]}); } sub make_options_available { check_args(4,@_); my $class=shift; my $self=shift; my $opt_available=shift; my $type_available=shift; my $num_opt; croak "available option and available type arrays need to match up +!" if ($#$opt_available != $#$type_available); for(my $i=0;defined $opt_available->[$i];$i++){ my $opt= $opt_available->[$i]; my $type= $type_available->[$i]; $num_opt=getopt_dev->add_option($self,$opt,$type); } } # print options sub print_usage { check_args(2,@_); my $class=shift; my $self=shift; my $i=0; my $prefix; print "\nUsage: ".$self->[1]."\n\n"; print "Options:\n"; for($i=0;$i<2;$i++){ foreach my $opt (sort(keys %{$self->[0]})){ next if(getopt_dev->is_option($self,$opt) == 0); $prefix=(${$self->[0]}{ $opt }->{ "long or short" } eq "sh +ort")?("-"):("--"); next if ($prefix eq "--" && $i==0); next if ($prefix eq "-" && $i==1); print $prefix.$opt."\t"; print ${$self->[0]}{ $opt }->{ "desc" }."\n"; } } } sub print_options { check_args(2,@_); my $class=shift; my $self=shift; my $value; my $i=0; print "\nOptions currently set:\n\n"; for($i=0;$i<2;$i++){ foreach my $opt (sort(keys %{$self->[0]})){ next if(getopt_dev->is_option($self,$opt) == 0); $value=getopt_dev->get_option($self,$opt); next if(! defined $value ); my $prefix=(${$self->[0]}{ $opt }->{ "long or short" } eq +"short")?("-"):("--"); next if ($prefix eq "--" && $i==0); next if ($prefix eq "-" && $i==1); print $prefix.$opt."\t"; print $value."\n"; } } } # parse and set options sub parse_options { my $class=shift; my $self=shift; my @temp=@_; my @args; my $found=0; my $last_found; my $last_arg=""; my @left_args; if(ref($temp[0]) eq "ARRAY"){ @args=@{$temp[0]}; } elsif(ref($temp[0]) eq ''){ @args=@temp; } else{ croak "@ARGV must be passed to function parse_options"; } #what about combining short options into 1?? foreach my $arg (@args){ $last_found=$found; $found=getopt_dev->is_option($self,$arg); $found=0 if $arg !~ /^--?/; if($last_found==0 && $found==0){ #previous value wasn't an opt +ion, and neither is this one push @left_args, $arg; } elsif($last_found== 1 && $found==0 && getopt_dev->get_type($se +lf,$last_arg) eq "bool"){ #previous value was and 'on or off' flag, a +nd this is not an option push @left_args, $arg; } elsif( $last_found==1 && $found==0 ){ #previous value was an o +ption, try to set the value of this option getopt_dev->set_option($self,$last_arg,$arg); } if($found==1 && getopt_dev->get_type($self,$arg) eq "bool"){ getopt_dev->set_option($self,$arg,1); } $last_arg=$arg; } return (\@left_args); } sub set_option { check_args(4,@_); my $class=shift; my $self=shift; my $opt_name=shift; my $value=shift; my $found=getopt_dev->is_option($self,$opt_name); croak "$opt_name is not a valid option" if($found==0); $opt_name=~s/^--?//; my $type=getopt_dev->get_type($self,$opt_name); if ($type eq "bool"){ ${$self->[0]}{ $opt_name }->{ "value" }->{ "bool" }=1; } elsif ($type eq "int"){ croak "Integer required for option $opt_name. Value $value is +not an integer.\n" if (getopt_dev->is_int($value)==0); ${$self->[0]}{ $opt_name }->{ "value" }->{ "int" }=$value; } elsif ($type eq "num"){ croak "Number required for option $opt_name. Value $value is n +ot a number.\n" if (getopt_dev->is_number($value)==0); ${$self->[0]}{ $opt_name }->{ "value" }->{ "num" }=$value; } elsif ($type eq "str"){ ${$self->[0]}{ $opt_name }->{ "value" }->{ "str" }=$value; } else{ carp "Type $type not recognised. Treating option as though it +were a string option"; ${$self->[0]}{ $opt_name }->{ "value" }->{ "str" }=$value; } } sub set_desc { check_args(4,@_); my $class=shift; my $self=shift; my $opt_name=shift; my $desc=shift; my $found=-1; my $i; $opt_name=~s/^--?//; $found=getopt_dev->is_option($self,$opt_name); my $prefix=length($opt_name)==1?("-"):("--"); if ($found == 0){ croak "$prefix$opt_name not a valid option"; } else{ ${$self->[0]}{ $opt_name }->{ "desc" }=$desc; if($debug==1){ print "Description of $prefix$opt_name set to:\n\t"; print $desc."\n"; } } } sub set_usage { check_args(3,@_); my $class=shift; my $self=shift; my $usage=shift; $self->[1]=$usage; } # get option values sub get_option { check_args(3,@_); my $class=shift; my $self=shift; my $opt_name=shift; my $value=0; my $type; $opt_name=~s/^--?//; $type=getopt_dev->get_type($self,$opt_name); if ($type eq "bool"){ $value=(${$self->[0]}{ $opt_name }->{ "value" }->{ "bool" }==1 +)?(1):(undef); } elsif ($type eq "int"){ $value=(${$self->[0]}{ $opt_name }->{ "value" }->{ "int" }eq"" +)?(undef):(${$self->[0]}{ $opt_name }->{ "value" }->{ "int" }); } elsif ($type eq "num"){ $value=(${$self->[0]}{ $opt_name }->{ "value" }->{ "num" }eq"" +)?(undef):(${$self->[0]}{ $opt_name }->{ "value" }->{ "num" }); } elsif ($type eq "str"){ $value=(${$self->[0]}{ $opt_name }->{ "value" }->{ "str" }eq"" +)?(undef):(${$self->[0]}{ $opt_name }->{ "value" }->{ "str" }); } else{ carp "Type $type not recognised. Treating option as though it +were a string option"; $value=(${$self->[0]}{ $opt_name }->{ "value" }->{ "str" }eq"" +)?(undef):(${$self->[0]}{ $opt_name }->{ "value" }->{ "str" }); } return $value; } sub get_type { check_args(3,@_); my $class=shift; my $self=shift; my $opt_name=shift; my $found=0; my $type=""; $opt_name=~s/^--?//; $found=getopt_dev->is_option($self, $opt_name); croak "$opt_name not a valid option\n" if($found==0); $type=${$self->[0]}{ $opt_name }->{ "opt_type" }; return $type; } #checking properties of options sub is_option { check_args(3,@_); my $class=shift; my $self=shift; my $opt_name=shift; my $found=-1; $opt_name=~s/^--?//; if(exists ${$self->[0]}{ $opt_name } && ${$self->[0]}{ $opt_name }->{ "valid" }==1){ return 1; } return 0; } sub is_number { check_args(2,@_); my $class=shift; my $value=shift; if ($value !~ /^\-?\d+(?:\.\d+)?(?:[Ee][+-]?\d{1,3})?$/){ return 0; } else { return 1; } } sub is_int { check_args(2,@_); my $class=shift; my $value=shift; if(getopt_dev->is_number($value)==0){ return 0; } elsif (int($value) == $value){ return 1; } else{ return 0; } return 0; } # debug sub check_args { my $number=shift; croak "Wrong number of arguments to method" if $#_ != ($number +-1); } 1;
........
Those are my principles. If you don't like them I have others.
-- Groucho Marx
.......

Replies are listed 'Best First'.
Re: A first attempt.. at OO perl
by moritz (Cardinal) on Jul 02, 2008 at 11:10 UTC
    What things do you have to change/do to make code portable?

    Perl already does most of the work for you. While glancing quickly over your code I noticed nothing platform specific, so chances are that you don't have to do anything at all.

    Have I got the right idea for OO code?

    Not entirely, I fear. You don't seem to use method calls at all. Consider $num_opt=getopt_dev->add_option($self,$opt,$type); - normally in OO you'd write $num_opt = $self->add_option($opt, $type); instead. That way one can actually subclass your module and override methods in the the derived module.

    Frankly I'm not too fond on going through all of your code to check for other OO paradigms. If you provide a Synopsis (ie a small usage summary, as found in the documentation of all good CPAN modules) it will be much easier to judge if your approach is a good one.

    A note on style: using an underscore in module names is generally frowned upon, use CamelCase instead, or separate the words with in the module name with :: instead.

      Not entirely, I fear. You don't seem to use method calls at all. Consider $num_opt=getopt_dev->add_option($self,$opt,$type); - normally in OO you'd write $num_opt = $self->add_option($opt, $type); instead.

      Ah. Ok, that explains why things look a little different in other people's code I've read. This is what I tried to begin with, but then, when you call your methods from outside the module, don't you have to call them like getopt_dev->add_option($self,$opt,$type); ? And if so, how do you deal with the class name being the first argument? I have the feeling I really do have the wrong end of the stick here!

      That way one can actually subclass your module and override methods in the the derived module.

      :| ok I'll, er look this up when I have the chance..! I sort of think I know what you mean, but don't know why this is the case..

      Frankly I'm not too fond on going through all of your code to check for other OO paradigms. If you provide a Synopsis (ie a small usage summary, as found in the documentation of all good CPAN modules) it will be much easier to judge if your approach is a good one.

      No, I don't blame you. I thought I'd just chuck all the code down since I didn't even really know what specific questions to ask and hoped someone enlightened like you would point me in the right direction. Thanks for all your comments. When I have some time (this is not something I should probably be doing much, if anything on during work hours) I will have a bash at a synopsis thingy and post it.

      A note on style: using an underscore in module names is generally frowned upon, use CamelCase instead, or separate the words with in the module name with :: instead.

      Noted.. when should you use :: ? I thought that was used as a file separator character?

      Update: Fixed typos
      ........
      Those are my principles. If you don't like them I have others.
      -- Groucho Marx
      .......
        As a user of an OO module, one typically uses the package name only to invoke the new method:
        my $obj = Your::Package->new(%options); $obj->do_something; $obj->do_something_other(@args);

        Consider reading perltoot, or if that doesn't help you, read a book on object orientation in general (doesn't really have to be perl related).

Re: A first attempt.. at OO perl
by tinita (Parson) on Jul 02, 2008 at 14:30 UTC
    sub new { my $self = [{},""]; bless($self); return $self; }
    please never use the one-argument-form of bless. always bless into the $class you got as an argument to new. otherwise it's impossible to inherit from your class.
    update: as rir /msgd me, of course you can inherit, but not from the constructor
Re: A first attempt.. at OO perl
by TGI (Parson) on Jul 02, 2008 at 17:43 UTC

    It looks like you've implemented everything as a class method.

    Here's a jot of example code.

    # ClassName->method( @args ); # class method # $object_ref->method( @args ); # instance method # calling your constructor. my $o = MyOptions->new( Usage => 'Do what I say, not what I do!', Options => [ { Name => 'Foo', Type => 'Bar', Etc => 'Blah' }, { Name => 'Bar', Type => 'Baz', Etc => 'Blah' }, ], ); $o->print_usage; MyOptions->debug(1); # having problems here. Enabling debug mode. my $chickens = $o->count_your_chickens($eggs); MyOptions->debug(0); my $parsed_ok = $o->parse_args( @ARGV ); package MyOptions; use const OPTIONS => 0, my $DEBUG; sub debug { my $old = $DEBUG; if ( @_ ) { my $old = $DEBUG; $DEBUG = shift; $Carp::Verbose = $DEBUG; } return $old; } sub new { my $class = shift; my %args = @_; my $self = []; bless $self, $class; $self->set_usage( $args{Usage} ); $self->add_options( @{ $args{Options} || [] } ); return $self; } sub set_usage { my $self = shift; check_args(@_,1); my $old_usage = $self->[USAGE]; $self->[USAGE] = shift; return $old_usage; } sub add_options { my $self = shift; foreach my $opt (@_) { my $opt_obj = $self->OptionFactory( $opt ); next unless $opt_obj; my $name = $opt_obj->get_name; $self->[OPTIONS]{ $name } = $opt_obj; } return keys %{$self->[OPTIONS]||{}}; } sub OptionFactory { my $self = shift; my $opt = shift; # make an option object from the specification passed in. # unless $opt is already an option object. Then return. # if opt is inavalid spec - return undef my $obj = UNIVERSAL::isa( 'MyOption', $opt ) ? $opt : MyOption->new(); return $obj; }

    I can't recommend thedamian's Object Oriented Perl enough. Very good for the OOP newbie. It covers concepts of OO and interesting Perl techniques, mostly along the lines of classical Perl OO.

    If you want to do really fancy OO stuff check out Moose. It's all the rage these days. I recommend learning to do the classical style first.


    TGI says moo

Re: A first attempt.. at OO perl
by roboticus (Chancellor) on Jul 02, 2008 at 13:28 UTC
    why_bird:

    Disclaimer: (1) I've never written any OO perl code, (2) I've not reviewed your code thoroughly. I hate the writing in this rambly node, but not quite enough to abandon it. Any comments on improving the writing / organization / code examples in this node would be greatly welcomed!

    I noticed two OO mistakes: First, if you have a bunch of if/else/... statements in a chunk of OO code, it's a place to look at and think about factoring. (Specifically, in both get_option and set_option, you have a sequence of conditionals based on the type of the argument, that *begs* for a factorization.) Second (related to the first), it's not extensible. What do you do if you want to add a "date" type? Perhaps a "filename" type might be nice (so it can automatically check for the presence of a file or some such?).

    So I'd first factor out a new base class to represent a typed option ... say "option_type". Initially, I'd give it two member functions: set_value and get_value. Then you can subclass it based on the types you want to handle. Thus, you'd get "option_bool", "option_int", "option_num" and "option_str". Factoring out the set_value and get_value code would give you something like[1]:

    package option_str; sub set_value { my ($class, $self, $value) = (shift, shift, shift); $self->{value} = $value; } sub get_value { my ($class, $self, $value) = (shift, shift, shift); return $self->{value}; }
    Then the code in your set_option and get_option subroutines would look more like[2]:

    sub set_option { check_args(4,@_); my $class=shift; my $self=shift; my $opt_name=shift; my $value=shift; my $found=getopt_dev->is_option($self,$opt_name); croak "$opt_name is not a valid option" if($found==0); $opt_name=~s/^--?//; $options->{$opt_name}->set_value($value); } sub get_option { check_args(3,@_); my $class=shift; my $self=shift; my $opt_name=shift; my $value=0; my $type; $opt_name=~s/^--?//; return $options->{$opt_name}->{value}; }

    After this factorization, you'll find that there are other things that belong in your "option_type" classes: Obviously, there would be a default value for each class type, which you could set in the object constructor (allowing you to rid yourself a bit of code in add_option):

    package option_bool; sub new { my $self = [{ value => 0 },""]; bless($self); return $self; }

    And, of course, you'd want the name, desc, valid etc. values you currently store for the options in there. You could add the is_valid method to each class, so your is_number and is_int methods would become member functions. Since you don't have is_XXX for bool and str, you could let the base class handle it (by assuming valid, for instance?). Then, you'd review your code (again) to find other things to factor out and make specific to the object type(s). You might have a value formatter for your print_options method, etc.

    Then, when you want to add a new type of option to the system, you could add it without having to touch so many bits of your getopt_dev package. If you guess correctly about what bits need to be factored into your option_type base class, you wouldn't have to touch the getopt_dev module at all. You could just add your new option type(s) in another module.

    Yark! I hate the way I ramble through this node. But I don't want to throw it away, and I know my code is screwed up. But I think the basic points I wanted to make come through, so here goes.

    Notes:

    [1] Here's where I first show my perl OO ignorance. I'm certain that my syntax here is screwed up, but I think this'll get the point across.

    [2] I'm just going to assume you have a hash of option_type variables called "options", as I don't know where you're storing them...

    ...roboticus
      Ok, that seems like a good idea. I haven't thought about subclasses yet, but the approach that you set out seems like a pretty good start for understanding that. I'll give it a go (when I get some time). Thank you.
      ........
      Those are my principles. If you don't like them I have others.
      -- Groucho Marx
      .......

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://695117]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (2)
As of 2021-10-23 06:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (87 votes). Check out past polls.

    Notices?