view release on metacpan or  search on metacpan

Example.pm  view on Meta::CPAN

# Get content for file or module.
sub get {
	my ($file_or_module, $section, $number_of_example) = @_;

	# Get Pod::Abstract object.
	my $pod_abstract = _pod_abstract($file_or_module);

	# Get section pod.
	my ($code, $example_filename) = _get_content($pod_abstract, $section, $number_of_example);

	return wantarray ? ($code, $example_filename) : $code;
}

# Get example sections.
sub sections {
	my ($file_or_module, $section) = @_;

	# Get Pod::Abstract object.
	my $pod_abstract = _pod_abstract($file_or_module);

	# Get first section.
	my @pod_sections = _get_sections($pod_abstract, $section);

	# Get section names.
	my @sections = map { _get_section_name($_) } @pod_sections;

	return @sections;
}

# Get content in Pod::Abstract object.
sub _get_content {
	my ($pod_abstract, $section, $number_of_example) = @_;

	# Get first section.
	my ($pod_section) = _get_sections($pod_abstract, $section,
		$number_of_example);

	# No section.
	if (! defined $pod_section) {
		return;
	}

	# Remove #cut.
	my @cut = $pod_section->select("//#cut");
	foreach my $cut (@cut) {
		$cut->detach;
	}

	# Get pod.
	my $child_pod = $EMPTY_STR;
	my $example_filename;
	my $first_node = 1;
	foreach my $child ($pod_section->children) {
		if ($child->type eq 'begin') {

			# =begin text as commented text.
			if ($child->body =~ m/^text/ms) {
				$child_pod .= join "\n",
					map { ' #'.$_ }
					split m/\n/ms,
					($child->children)[0]->pod;
				$child_pod .= "\n\n";
				$first_node = 0;

			# Skip =begin html and other unsupported sections.
			} else {
				$first_node = 0;
				next;
			}
		} elsif ($child->type eq 'for') {
			# =for paragraphs are formatter-specific data. Only a first
			# =for comment filename=... paragraph is metadata for this module.
			if ($first_node && $child->body eq 'comment') {
				my ($node) = $child->tree->children;
				my $body = $node->body;
				if ($body =~ m/^filename=([\w\-\.]+)\s*$/ms) {
					$example_filename = $1;
				}
			}
			$first_node = 0;
		} else {
			$child_pod .= $child->pod;
			$first_node = 0;
		}
	}

	# Remove spaces and return.
	my $ret = _remove_spaces($child_pod);

	return ($ret, $example_filename);
}

# Get section name.
# XXX Hack to structure.
sub _get_section_name {
	my $pod_abstract_node = shift;
	return $pod_abstract_node->{'params'}->{'heading'}->{'tree'}
		->{'nodes'}->[0]->{'body'};
}

# Get sections.
sub _get_sections {
	my ($pod_abstract, $section, $number_of_example) = @_;

	# Default section.
	if (! $section) {
		$section = 'EXAMPLE';
	}

	my $section_re = quotemeta $section;

	# Concerete number of example.
	if ($number_of_example) {
		$section_re .= quotemeta $number_of_example;

	# Number of example as potential number.
	} else {
		$section_re .= '\d*';
	}