view release on metacpan or  search on metacpan

lib/App/Pods2Site/Args.pm  view on Meta::CPAN

# Parses a commandline packaged as a list (e.g. normally just pass @ARGV)
# and processes it into real objects for later use by various functions
# in the Pods2Site universe
#
package App::Pods2Site::Args;

use strict;
use warnings;

our $VERSION = '1.003';
my $version = $VERSION;
$VERSION = eval $VERSION;

use App::Pods2Site::Util qw(slashify trim readData writeData expandAts $IS_PACKED $IS_WINDOWS $SHELL_ARG_DELIM $PATH_SEP);
use App::Pods2Site::SiteBuilderFactory;

use Config;
use FindBin qw($RealBin $Script);
use Getopt::Long qw(GetOptionsFromArray :config require_order no_ignore_case bundling);
use File::Spec;
use File::Basename;
use File::Temp qw(tempdir);
use File::Path qw(make_path);
use Config qw(%Config);
use Pod::Usage;
use Pod::Simple::Search;
use List::MoreUtils qw(uniq);
use Grep::Query;
use POSIX;

# CTOR
#
sub new
{
	my $class = shift;
	my $version = shift;

	my $self = bless( {}, $class);
	$self->__parseArgv($version, @_);

	return $self;
}

sub getSiteDir
{
	my $self = shift;
	
	return $self->{sitedir};
}

sub getBinDirs
{
	my $self = shift;
	
	return @{$self->{bindirs}};
}

sub getLibDirs
{
	my $self = shift;
	
	return @{$self->{libdirs}};
}

sub getTitle
{
	my $self = shift;
	
	return $self->{title};
}

sub getMainpage
{
	my $self = shift;

	return $self->{mainpage};
}

sub getStyle
{
	my $self = shift;
	
	return $self->{style};
}

sub getUpdating
{
	my $self = shift;

	return $self->{updating};
}

sub getWorkDir
{
	my $self = shift;
	
	return $self->{workdir};
}

sub getGroupDefs
{
	my $self = shift;
	
	return $self->{groupdefs};
}

sub getCSS
{
	my $self = shift;
	
	return $self->{css};
}

sub getSiteBuilder
{
	my $self = shift;
	
	return $self->{sitebuilder};
}

sub isVerboseLevel
{
	my $self = shift;
	my $level = shift;
	
	return $self->{verbose} >= $level;	
}

# PRIVATE
#

# these options are persisted to the site
# and can't be used when updating
#
my @STICKYOPTS =
	qw
		(
			bindirectory
			libdirectory
			group
			css
			style
			title
			mainpage
		);

sub __parseArgv
{
	my $self = shift;
	my $version = shift;
	my @argv = @_;

	my %rawOpts =
		(
			usage => 0,
			help => 0,
			manual => 0,
			v => 0,
			workdirectory => undef,
			quiet => 0,
			
			# hidden
			#
			_help => 0,
			_pp => 0,					# print basic PAR::Packer 'pp' command line
		);
		
	my @specs =
		(
			'usage|?',
			'help',
			'manual',
			'version',
			'v|verbose+',
			'workdirectory=s',
			'quiet',
			'bindirectory=s@',
			'libdirectory=s@',
			'group=s@',
			'css=s',
			'style=s',
			'title=s',
			'mainpage=s',
			
			# hidden
			#
			'_help',
			'_pp',
		);

	my $_argsPodName = 'App/Pods2Site/_Args.pod';
	my $_argsPodInput = Pod::Simple::Search->find($_argsPodName);
	my $argsPodName = 'App/Pods2Site/Args.pod';
	my $argsPodInput = Pod::Simple::Search->find($argsPodName);
	my $manualPodName = 'App/Pods2Site.pod';
	my $manualPodInput = Pod::Simple::Search->find($manualPodName);

	# for consistent error handling below, trap getopts problems
	# 
	eval
	{
		@argv = expandAts('.', @argv);
		local $SIG{__WARN__} = sub { die(@_) };
		GetOptionsFromArray(\@argv, \%rawOpts, @specs)
	};
	if ($@)
	{
		pod2usage(-input => $argsPodInput, -message => "Failure parsing options:\n  $@", -exitval => 255, -verbose => 0);
	}

	# help with the hidden flags...
	#
	pod2usage(-input => $_argsPodInput, -exitval => 0, -verbose => 2, -noperldoc => 1) if $rawOpts{_help};

	# for the special selection of using --_pp, print command line and exit
	#
	if ($rawOpts{_pp})
	{
		$self->__print_pp_cmdline
					(
						$version,
						$argsPodName, $argsPodInput,
						$manualPodName, $manualPodInput
					);
		exit(0);
	}

	# if any of the doc switches made, display the pod
	#
	pod2usage(-input => $manualPodInput, -exitval => 0, -verbose => 2, -noperldoc => 1) if $rawOpts{manual};
	pod2usage(-input => $argsPodInput, -exitval => 0, -verbose => 2, -noperldoc => 1) if $rawOpts{help};
	pod2usage(-input => $argsPodInput, -exitval => 0, -verbose => 0) if $rawOpts{usage};
	pod2usage(-message => slashify($0) . " version $App::Pods2Site::VERSION", -exitval => 0, -verbose => 99, -sections => '_') if $rawOpts{version};

	# if -quiet has been given, it trumps any verbosity
	#	
	$self->{verbose} = $rawOpts{quiet} ? -1 : $rawOpts{v};

	# manage the sitedir
	# assume we need to create it
	#
	$self->{newsitedir} = 1;
	my $sitedir = $self->__getSiteDir($argv[0]);
	die("You must provide a sitedir (use ':std' for a default location)\n") unless $sitedir;
	$sitedir = slashify(File::Spec->rel2abs($sitedir));
	if (-e $sitedir)
	{
		$self->{newsitedir} = 0;
		
		# if the sitedir exists as a dir, our sticky opts better be found in it
		# otherwise it's not a sitedir
		#
		die("The output '$sitedir' exists, but is not a directory\n") unless -d $sitedir;
		my $savedOpts = readData($sitedir, 'opts');
		die("The sitedir '$sitedir' exists, but is missing our marker file\n") unless $savedOpts;
		$self->{updating} = 1;
		# clean up any sticky opts given by the user
		#
		print "NOTE: updating '$sitedir' - reusing options used when created!\n" if $self->isVerboseLevel(0);
		foreach my $opt (@STICKYOPTS)
		{
			warn("WARNING: The option '$opt' ignored when updating the existing site '$sitedir'\n") if exists($rawOpts{$opt});
			delete($rawOpts{$opt});
		}
		%rawOpts = ( %rawOpts, %$savedOpts );
	}
	else
	{
		print "Creating '$sitedir'...\n" if $self->isVerboseLevel(0);
		$self->{updating} = 0;
	}
	
	# fix up any user given bindir locations or get us the standard ones
	#
	my @bindirs = uniq($self->__getBinLocations($rawOpts{bindirectory}));
	warn("WARNING: No bin directories found\n") unless @bindirs;
	$self->{bindirs} = $rawOpts{bindirectory} = \@bindirs;

	# fix up any user given libdir locations or get us the standard ones
	#
	my @libdirs = uniq($self->__getLibLocations($rawOpts{libdirectory}));
	warn("WARNING: No lib directories found\n") unless @libdirs;
	$self->{libdirs} = $rawOpts{libdirectory} = \@libdirs;

	my $workdir;
	if ($rawOpts{workdirectory})
	{
		# if user specifies a workdir this implies that it should be kept
		# just make sure there is no such directory beforehand, and create it here
		# (similar to below; tempdir() will also create one)
		#
		$workdir = slashify(File::Spec->rel2abs($rawOpts{workdirectory}));
		die("The workdir '$workdir' already exists\n") if -e $workdir;
		make_path($workdir) or die("Failed to create workdir '$workdir': $!\n");
	}
	else
	{
		# create a temp dir; use automatic cleanup
		#
		$workdir = slashify(tempdir("pods2site-XXXX", TMPDIR => 1, CLEANUP => 1));
	}
	$self->{workdir} = $workdir;

	# Ensure we have group definitions, and test queries before storing
	# 
	my @rawGroupDefs  = $self->__getRawGroupDefs($rawOpts{group});
	my @groupDefs;
	my %groupsSeen;
	foreach my $rawGroupDef (@rawGroupDefs)
	{
		eval
		{
			die("Group definition not in form 'name=query': '$rawGroupDef'\n") unless $rawGroupDef =~ /^([^=]*)=(.+)/s;
			my ($name, $query) = (trim($1 || ''), trim($2));
			die("Group '$name' multiply defined\n") if $groupsSeen{$name};
			$groupsSeen{$name} = 1;
			push(@groupDefs, { name => $name, query => Grep::Query->new($query) });
		};
		pod2usage(-message => "Problem with group definition '$rawGroupDef':\n  $@", -exitval => 255, -verbose => 0) if $@;
	}
	$rawOpts{group} = \@rawGroupDefs;
	$self->{groupdefs} = \@groupDefs;

	# fix up any css path given by user
	#	
	if ($rawOpts{css})
	{
		my $css = slashify(File::Spec->rel2abs($rawOpts{css}));
		die("No such file: -css '$css'\n") unless -f $css;
		$self->{css} = $css;
	}

	$rawOpts{title} = $rawOpts{title} || 'Pods2Site';
	$self->{title} = $rawOpts{title};
	
	$rawOpts{mainpage} = $rawOpts{mainpage} || ':std';
	$self->{mainpage} = $rawOpts{mainpage};