view release on metacpan or  search on metacpan

scripts/object.pl  view on Meta::CPAN

						if ($m =~ /#(\s*)(.*)$/) {
							$members{$name}->{access_level($n)}->{$n}->{desc} = $2;
						}
					}
					last if (/\};/);
			    }
			} else {
				$methods{$name}->{access_level($1)}->{$1}->{doc} = $doc;
			}
			$doc = { desc => ""};
		} elsif (/^##(\s*)(.*)$/) {
			my $t = $2;
			if ($t =~ /^in>\s+(.*)/) {
				$doc->{in} .= $1;
			} elsif ($t =~ /^out>\s+(.*)/) {
				$doc->{out} .= $1."\n";
			} elsif ($t =~ /^eg>\s+(.*)/) {
				$doc->{eg} .= $1."\n";
			} else {
				$doc->{desc} .= $t."\n";
			}
		}
	}
	close(FH);
}

die "Given class not found, cannot build object structure. ($base)" if (!$members{$base} && !$methods{$base});

podout("head1","Class VARIABLES");
my %ready;
showclass_members($base,0,0,"public");
showclass_members($base,0,0,"protected");
showclass_members($base,0,0,"private");

%ready = ();
podout("head1","Class METHODS");
showclass_methods($base,0,0,"public");
showclass_methods($base,0,0,"protected");
showclass_methods($base,0,0,"private");

print "\n";

sub access_level
{
	$_ = $_[0];
	if (/^__/) {
		return "private";
	} elsif (/^_/) {
		return "protected";
	} else {
		return "public";
	}
}

sub issuperior
{
	my ($type,$cname,$item,$acl) = @_;

	my $text = "";
	while ($cname = $iter{$cname}) {
		if (eval '$'.$type.'{$cname}->{$acl}->{$item}') {
			$ready{$item} = 1;
			$text = "reimplemented from $cname";
			last;
		}
	}
	return $text;
}

sub showmembers 
{
	my $inh = shift;
	my $cname = shift;
	my $aclevel = shift;
	my %ac = @_;
	%ac = %{$ac{$aclevel}};
	
	foreach (sort { uc($a) cmp uc($b) } keys %ac) {
# superior classes maybe have this method, we want to know which one
		next if $ready{$_};
		my $inherited = issuperior("members",$cname,$_,$aclevel); 
		$inherited |= $inh;
		if ($inherited ne "") {
			$inherited = "I<".$inherited.">"; 
		} else {
			$inherited = "";
		}
		
		podout("item",$_," ",$inherited);

		if ($ac{$_}->{desc}) {
			textout("B<Description>: ",$ac{$_}->{desc});
		}
		if ($ac{$_}->{value}) {
			textout("B<Default value>: ",$ac{$_}->{value});
		}
	}
}

sub showmethods
{
	my $inh = shift;
	my $cname = shift;
	my $aclevel = shift;
	my %ac = @_;
	%ac = %{$ac{$aclevel}};
	foreach (sort { uc($a) cmp uc($b) } keys %ac) {
# superior classes maybe have this method, we want to know which one
		next if $ready{$_};
		my $inherited = issuperior("methods",$cname,$_,$aclevel); 
		$inherited |= $inh;
		if ($inherited ne "") {
			$inherited = "I<".$inherited.">"; 
		} else {
			$inherited = "";
		}
		podout("item","$_ ( ",$ac{$_}->{doc}->{in} ? $ac{$_}->{doc}->{in} : "" ," ) ",$inherited);
		
		if ($ac{$_}->{doc}->{desc}) {
			textout("B<Description>: ",$ac{$_}->{doc}->{desc});
		}