view release on metacpan or  search on metacpan

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

		}
		
		
		## Check all of the values
		foreach my $val (@values)
		{
			
			++$idx ;
			my $arg_optional = $arg_names_href->{$name}{'optional'} ;
			
$this->_dbg_prt([" + checking $name value=$val, type=$type, optional=$arg_optional ..\n"], 2) ;
		
			# First check that an arg has been specified
			if ($idx >= scalar(@$argv_aref))
			{
				# Ignore if * type -OR- optional
				if ( ($arg_names_href->{$name}{'dest_type'} ne '*') && (! $arg_optional) )
				{
					$this->_complain_usage_exit("Must specify input $type\"$name\"") ;
				}
			}
			
			next unless $val ;
			
			## Input
			if ($arg_names_href->{$name}{'direction'} eq 'i')
			{
	$this->_dbg_prt([" + Check $val for existence\n"], 2) ;
				
				## skip checks if optional and no value specified (i.e. do the check if a default is specified)
				if (!$arg_optional && $val)
				{
					# File check
					if ( ($arg_names_href->{$name}{'type'} eq 'f') && (! -f $val) )
					{
						$this->_complain_usage_exit("Must specify a valid input filename for \"$name\"") ;
					}
					# Directory check
					if ( ($arg_names_href->{$name}{'type'} eq 'd') && (! -d $val) )
					{
						$this->_complain_usage_exit("Must specify a valid input directory for \"$name\"") ;
					}
				}
				else
				{
	$this->_dbg_prt([" + Skipped checks opt=$arg_optional val=$val bool=".."...\n"], 2) ;
					
				}	
				
				
				## File open
				if ($open_in && ($arg_names_href->{$name}{'type'} eq 'f'))
				{
					open my $fh, "<$val" ;
					if ($fh)
					{
						push @$fh_aref, $fh ;
						
						if ($arg_names_href->{$name}{'mode'} eq 'b')
						{
							binmode $fh ;
						}
	
						# Create new entry
						my $href = $this->_new_arg_entry($fh_name) ;
						$arg_names_href->{$fh_name} = $href ;
						
						# set value
						if ($arg_names_href->{$name}{'dest_type'})
						{
							$args_href->{$fh_name} ||= [] ;
							push @{$args_href->{$fh_name}}, $fh ;
						}
						else
						{
							$args_href->{$fh_name} = $fh ;
						}
					}
					else
					{
						$this->_complain_usage_exit("Unable to read file \"$val\" : $!") ;
					}
				}
			}
			
			## Output
			if ($open_out)
			{
				if (($arg_names_href->{$name}{'direction'} eq 'o') && ($arg_names_href->{$name}{'type'} eq 'f'))
				{
					my $mode = '>' ;	
					if ($arg_names_href->{$name}{'append'})
					{
						$mode .= '>' ;
					}
					
					open my $fh, "$mode$val" ;
					if ($fh)
					{
						push @$fh_aref, $fh ;
						
						if ($arg_names_href->{$name}{'mode'} eq 'b')
						{
							binmode $fh ;
						}
	
						# Create new entry
						my $href = $this->_new_arg_entry($fh_name) ;
						$arg_names_href->{$fh_name} = $href ;
						
						# set value
						$args_href->{$fh_name} = $fh ;
					}
					else
					{
						my $md = $arg_names_href->{$name}{'append'} ? 'append' : 'write' ;
		
						$this->_complain_usage_exit("Unable to $md file \"$val\" : $!") ;
					}
				}
			}
		}
	}
		
}

#-----------------------------------------------------------------------------

=item B< close_args() >

If any arguements cause files/devices to be opened, this shuts them down

=cut

sub close_args 
{
	my $this = shift ;

	# File handles
	my $fh_aref = $this->_fh_list() ;
	
	foreach my $fh (@$fh_aref)
	{
		close $fh ;
	}

}



#----------------------------------------------------------------------------

=item B<get_args()>

Finish any args processing and return the arguments list

=cut

sub get_args
{
	my $this = shift ;

	# save @ARGV
	$this->argv(\@ARGV) ;