view release on metacpan or  search on metacpan

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

}

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

=item B<clone()>

Create a copy of this object and return the copy.

=cut

sub clone
{
	my $this = shift ;

	my $clone ;
	
	# TODO: WRITE IT!
	
	return $clone ;
}



# ============================================================================================
# UTILITY METHODS
# ============================================================================================



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

=item B<quote_str($str)>

Returns a quoted version of the string.
 
=cut

sub quote_str
{
	my $this = shift ;
	my ($str) = @_ ;
	
	##my $class = $this->class() ;

	# skip on Windows machines
	unless ($^O eq 'MSWin32')
	{
		# first escape any existing quotes
		$str =~ s%\\'%'%g ;
		$str =~ s%'%'\\''%g ;
	
		$str = "'".$str."'" ;
	}
	
	
	return $str ;
}

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

=item B<expand_vars($string, \%vars)>

Work through string expanding any variables, replacing them with the value stored in the %vars hash.
If variable is not stored in %vars, then that variable is left.

Returns expanded string.

=cut

sub expand_vars 
{
	my $this = shift ;
	my ($string, $vars_href) = @_ ;


	# Do replacement
	$string =~ s{
				     \$                         # find a literal dollar sign
				     \{{0,1}					# optional brace
				    (\w+)                       # find a "word" and store it in $1
				     \}{0,1}					# optional brace
				}{
				    no strict 'refs';           # for $$1 below
				    if (defined $vars_href->{$1}) {
				        $vars_href->{$1};            # expand variable
				    } else {
				        "\${$1}";  				# leave it
				    }
				}egx;

	return $string ;
}



##---------------------------------------------------------------------
#
#=item B<prt_data(@args)>
#
#Use App::Framework::Lite::Object::DumpObj to print out variable information. Automatically enables
#object print out
# 
#=cut
#
#sub prt_data 
#{
#	my $this = shift ;
#	my (@args) = @_ ;
#	
#	App::Framework::Lite::Object::DumpObj::print_objects_flag(1) ;
#	App::Framework::Lite::Object::DumpObj::prt_data(@args) ;
#}
#
##----------------------------------------------------------------------------
##
##=item B<_dbg_prt($items_aref [, $min_debug])>
##
##Print out the items in the $items_aref ARRAY ref iff the calling object's debug level is >0. 
##If $min_debug is specified, will only print out items if the calling object's debug level is >= $min_debug.
##
##=cut
##
#sub _dbg_prt
#{
#	my $obj = shift ;
#	my ($items_aref, $min_debug) = @_ ;
#
#	$min_debug ||= 1 ;
#	
#	## check debug level setting
#	if ($obj->debug >= $min_debug)
#	{
#		my $pkg = ref($obj) ;
#		$pkg =~ s/App::Framework/ApFw/ ;
#		
#		my $prefix = App::Framework::Lite::Object::DumpObj::prefix("$pkg ::  ") ;
#		$obj->prt_data(@$items_aref) ;
#		App::Framework::Lite::Object::DumpObj::prefix($prefix) ;
#	}
#}



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