view release on metacpan or  search on metacpan

lib/App/Framework.pm  view on Meta::CPAN

L<App::Framework::FeatureModules>,L<App::Framework::ExtensionModules>,L<App::Framework::CoreModules>

Used during installation.

=cut

sub modpod
{
	my $this = shift ;

	foreach my $name (qw/Core Extension Feature/)
	{
		my $podfile = "App/Framework/${name}Modules.pod" ;
		my %modules = App::Framework::Core->lib_glob("App/Framework/$name") ;	
		my $template = $this->_template($name) ;

		print "$podfile ...\n" ;
				
		my @list ;
		foreach my $module (sort keys %modules)
		{
			if ( open my $fh, "<$modules{$module}" )
			{
				my ($summary, $version, $line) ;
				my $modname = "App::Framework::${name}::${module}" ;
				while ( !($summary && $version) && defined($line = <$fh>) )
				{
					chomp $line ;

					# App::Framework::Feature::Args - Handle application command line arguments
					if ($line =~ m/$modname\s*\-\s*(\S.*)/)
					{
						$summary = $1 ;
					}

					# our $VERSION = "1.000" ;
					if ($line =~ m/(?:our|my)\s+\$VERSION\s*=\s*["']([\d\.]+)["']/)
					{
						$version = $1 ;
					}
				}
				close $fh ;
				
				if ($summary)
				{
					print "   $modname\n" ;
					push @list, {
						'module' 	=> $modname,
						'file'		=> $modules{$module},
						'summary'	=> $summary,
						'version'	=> $version,
					}
				}
			}
		}
		
		## Write file
		my $blib_pod = "blib/lib/$podfile" ;
		if (-f $blib_pod)
		{
			chmod 0755, $blib_pod ; 
		}
		if (open my $fh, ">$blib_pod")
		{
			my $list ;
			foreach my $href (@list)
			{
				my $version = $href->{version} ? "v$href->{version}" : "" ;
				$list .= "=item * L<$href->{module}>  $version\n\n" ;
				$list .= "$href->{summary}\n\n" ;
			}
			$template =~ s/<LIST>/$list/m ;

			print $fh $template ;
			
			close $fh ;
		}
		else
		{
			die "Error: unable to write pod file $blib_pod : $!" ;
		}
	}

}



#============================================================================================
# PRIVATE
#============================================================================================


##----------------------------------------------------------------------------------------------
## Create a new App::Framework object, then call the specified method
#sub _new_and_call
#{
#	my $class = shift ;
#	my ($method, %args) = @_ ;
#	my $this = new(%args) ;
#	$this->$method(%args) ;
#}

#----------------------------------------------------------------------------------------------
# Returns the pod file template for this named file
sub _template
{
	my $class = shift ;
	my ($name) = @_ ;
	my $template ;

	my $eq = '=' ;
	$template = <<TEMPLATE ;
${eq}head1 NAME

App::Framework::${name}Modules - Module list for installed ${name} modules 

${eq}head1 DESCRIPTION

The following list shows the ${name} modules installed on your system:

${eq}over 4