>>>>> "BR" == Bob Rogers <[EMAIL PROTECTED]> writes:
BR> use strict; use warnings should be here too. BR> use Getopt::Long; BR> use Pod::Usage qw(); BR> # use Data::Dumper; BR> # define instance accessors. BR> sub BEGIN { BR> no strict 'refs'; BR> for my $method (qw(option_definers additional_options BR> man_p help_p usage_p)) { BR> my $field = '_' . $method; i like "_$method" better. BR> *$method = sub { BR> my $self = shift; BR> @_ ? ($self->{$field} = shift, $self) : $self->{$field}; why are you returning $self when assigning in the accessor? in general doing side effects in ?: is frowned upon. here are two different ways to do that, with your semantics and a more common one which always returns the field value: return $self->{$field} unless @_ ; $self->{$field} = shift ; return $self ; $self->{$field} = shift if @_ ; return $self->{$field} ; BR> } BR> } BR> } BR> sub new { BR> my $class = shift; BR> $class = ref($class) BR> if ref($class); that idiom is not needed nor is it useful. it was meant to allow construction of an object from the class name OR an object. but those are really very different things and should have different methods. construction from an object is better called 'clone' as it may actually copy much (if not all) of the object into the new one. BR> my $self = bless {} => $class; i don't like using => like that. BR> sub command_line_options { BR> my $self = shift; BR> my $cl_options = $self->{_command_line_options}; BR> return $cl_options BR> if $cl_options; BR> $cl_options = { %{$self->additional_options} }; BR> $self->{_command_line_options} = $cl_options; BR> $cl_options->{options} = sub { $self->document_options; }; BR> my $option_definers = $self->option_definers; BR> if ($option_definers && @$option_definers) { BR> for my $definer (@$option_definers) { BR> my @options = $definer->command_line_options; BR> while (my ($key, $value) = splice(@options, 0, 2)) { BR> $cl_options->{$key} = $value BR> unless $cl_options->{$key}; $cl_options->{$key} ||= $value ; BR> } BR> } ever heard of vertical whitespace or comments? remember that code is what and comments are why. BR> } BR> $cl_options->{man} = sub { BR> $self->pod2usage(-exitstatus => 0, -verbose => 2); BR> } BR> if $self->man_p && ! $cl_options->{man}; BR> $cl_options->{help} = sub { $self->pod2usage(1); } BR> if $self->help_p && ! $cl_options->{help}; BR> $cl_options->{usage} = sub { $self->pod2usage(2); } BR> if $self->usage_p && ! $cl_options->{usage}; BR> $cl_options; use explicit returns. you may get burned with the return of last value thing. it is easier to see what is returned when you see 'return' BR> } for some reason my emacs/supercite is screwing up the indent. but your habit of putting statement modifiers on the next line is unusual. i would put them on the same line if possible (that is if the combined line isn't too long). it just reads odd to me to see all those if's on the next line. also using ||= will simplify many of those lines (as i did above). $cl_options->{usage} ||= sub { $self->pod2usage(2); } if $cl_options->$self->usage_p BR> sub _add_to_class_table { BR> my ($self, $table, $class_visited_p, $class) = @_; BR> if (! $class_visited_p->{$class}) { unless is nice there. event better since this if block is the whole sub, just return early and save an indent and a block return unless $class_visited_p->{$class} ; rest of code is here but no {} or indent. BR> sub class_precedence_table { BR> my $self = shift; BR> $self->{_class_precedence_table} = shift, return($self) BR> if @_; make that a regular if block. hidden side effects (return) with , expressions are hard to see. BR> or die; BR> my $index = $self->{_class_to_index}->{$class} = {}; BR> my $option_name; BR> while (defined(my $line = <IN>)) { BR> if ($line =~ /^=item B<--?([^\s<>=]+)/) { BR> # starting a new option description. if this is just a negated BR> # version of some other option, then we must lump it with its BR> # positive sense, since only the positive sense will appear in the BR> # GetOptions list. [bug: we should really check that the option is BR> # boolean, and doesn't actually appear in the list as 'no-foo'. -- BR> # rgr, 5-Sep-04.] BR> $option_name = $1; BR> $option_name =~ s/^no-?//; BR> $index->{$option_name} .= $line; BR> } BR> elsif ($line =~ /^=/) { BR> # ending an option description (if one was open). BR> $option_name = ''; BR> } BR> elsif ($option_name) { BR> # next line in the current option description. BR> $index->{$option_name} .= $line; BR> } BR> } BR> close(IN); no need for the close as the handle goes out of scope and gets closed. BR> $index; BR> } BR> sub _index_this_class { BR> my ($self, $class) = @_; BR> return BR> if $self->{_class_to_index}->{$class}; BR> my $pod_file; BR> if ($class eq 'main') { BR> # [bug: should search $PATH if not found.] BR> $pod_file = $0; BR> } BR> else { BR> my $file = "$class.pm"; BR> $file =~ s@::@/@g; BR> # die join("\n", %INC, ''); BR> my $source = $INC{$file}; BR> if ($source) { BR> my $pod = $source; BR> $pod =~ s/\.pm$/\.pod/; BR> $pod_file = (-r $pod ? $pod : $source); BR> } BR> } BR> if (! $pod_file || ! -r $pod_file) { de morgan to the rescue! unless ($pod_file && -r $pod_file) { BR> sub document_options { BR> my ($self, $fh) = @_; BR> $fh ||= *STDOUT; $fh ||= \*STDOUT; passing glob refs are better than passing globs i can't get into the actual design or debugging but i hope my comments are useful. uri -- Uri Guttman ------ [EMAIL PROTECTED] -------- http://www.stemsystems.com --Perl Consulting, Stem Development, Systems Architecture, Design and Coding- Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org _______________________________________________ Boston-pm mailing list [EMAIL PROTECTED] http://mail.pm.org/mailman/listinfo/boston-pm
