view release on metacpan or  search on metacpan

lib/App/Framework/Base/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::Base::Object::DumpObj to print out variable information. Automatically enables
object print out
 
=cut

sub prt_data 
{
	my $this = shift ;
	my (@args) = @_ ;
	
	App::Framework::Base::Object::DumpObj::print_objects_flag(1) ;
	App::Framework::Base::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::Base::Object::DumpObj::prefix("$pkg ::  ") ;
		$obj->prt_data(@$items_aref) ;
		App::Framework::Base::Object::DumpObj::prefix($prefix) ;
	}
}



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