Mailing List Archive

Author: creamyg
Date: 2008-07-29 17:57:24 -0700 (Tue, 29 Jul 2008)
New Revision: 3667

Modified:
trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm
Log:
Make it possible to inherit a method's documentation.


Modified: trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm
===================================================================
--- trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm 2008-07-29 22:41:50 UTC (rev 3666)
+++ trunk/boilerplater/lib/Boilerplater/Binding/Perl.pm 2008-07-30 00:57:24 UTC (rev 3667)
@@ -369,17 +369,29 @@
}

sub _gen_subroutine_pod {
- my ( $func, $sub_name, $code_sample, $class_name ) = @_;
- my $docucom = $func->get_docu_comment;
- confess("No DocuComment for '$sub_name' in '$class_name'")
- unless $docucom;
+ my ( $self, %args ) = @_;
+ my ( $func, $sub_name, $class, $code_sample, $class_name )
+ = @args{qw( func name class sample class_name )};
my $param_list = $func->get_param_list;
my $args = "";
my $num_vars = $param_list->num_vars;

- # FIXME replace kludgy heuristic for detecting constructor. (Not all
- # constructors are named "new".)
- if ( $num_vars > 2 or ( $num_vars > 1 and $sub_name eq 'new' ) ) {
+ # Get documentation, which may be inherited.
+ my $docucom = $func->get_docu_comment;
+ if (!$docucom) {
+ my $micro_name = $func->get_micro_name;
+ my $parent = $class;
+ while ( $parent = $parent->get_parent ) {
+ my $parent_func = $parent->method($micro_name);
+ last unless $parent_func;
+ $docucom = $parent_func->get_docu_comment;
+ last if $docucom;
+ }
+ }
+ confess("No DocuComment for '$sub_name' in '$class_name'")
+ unless $docucom;
+
+ if ( $num_vars > 2 or $args{is_constructor} ) {
$args = " I<[labeled params]> ";
}
elsif ( $param_list->num_vars ) {
@@ -435,8 +447,13 @@
my $ctor_name = $pod_args->{constructor}{name} || 'new';
my $code_sample = $pod_args->{constructor}{sample};
$constructor_pod .= _perlify_doc_text(
- _gen_subroutine_pod(
- $init_func, $ctor_name, $code_sample, $class_name
+ $self->_gen_subroutine_pod(
+ func => $init_func,
+ name => $ctor_name,
+ sample => $code_sample,
+ class => $class,
+ class_name => $class_name,
+ is_constructor => 1,
)
);
}
@@ -448,10 +465,19 @@
my $method = $class->method($meth_name);
confess("Can't find method '$meth_name' in class '$class_name'")
unless $method;
- my $method_pod
- = ref($spec)
- ? $spec->{pod}
- : _gen_subroutine_pod( $method, $meth_name, '', $class_name );
+ my $method_pod;
+ if ( ref($spec) ) {
+ $method_pod = $spec->{pod};
+ }
+ else {
+ $method_pod = $self->_gen_subroutine_pod(
+ func => $method,
+ name => $meth_name,
+ sample => '',
+ class => $class,
+ class_name => $class_name
+ );
+ }
push @method_docs, _perlify_doc_text($method_pod);
}
if (@method_docs) {


_______________________________________________
kinosearch-commits mailing list
kinosearch-commits@rectangular.com
http://www.rectangular.com/mailman/listinfo/kinosearch-commits