view release on metacpan or  search on metacpan

lib/CIPP/Runtime/Request.pm  view on Meta::CPAN

	# profiling: print command duration
	if ( $self->get_profiling_active ) {
		$self->print_command_duration (
			command => "inc out",
			detail  => $file,
			time    => Time::HiRes::time() - $start_time,
		);
	}

	1;
}

sub resolve_inc_filename {
	my $self = shift;
	my %par = @_;
	my ($file) = @par{'file'};

	my $inc_dir   = $self->get_inc_dir;
	my $full_path = "$inc_dir/$file";

	if ( not -e $full_path ) {
		foreach my $inc_dir ( map   { $_."/inc" }
				      @{$self->get_add_prod_dirs} ) {
			$full_path = "$inc_dir/$file";
			last if -e $full_path;
		}

		# set full_path to this project's inc_dir, if not
		# found. This produces an error message in load_include_subroutine
		# containing the path belonging to this project.
		$full_path = "$inc_dir/".$file if not -e $full_path;
	}

	return $full_path;
}

sub load_include_subroutine {
	my $self = shift;
	my ($file) = @_;

	# no need to check or do anything if already loaded during this request
	# (changes made during one request are silently ignored)
	return $INCLUDE_SUBS{$file}
		if exists $self->{loaded_subroutines}->{$file};
	
	# search absolute filename for this subroutine
	# (search in inc_dir and additional projects)
	my $full_path = $self->resolve_inc_filename ( file => $file );

	# track start time if profiling is active
	my $start_time;
	$start_time = Time::HiRes::time() if $self->get_profiling_active;
	
	# filename of subroutine
	my $perl_code_file = $full_path;
	
	# subroutine already loaded and file didn't change in the meantime?
	# then we can return the sub reference immediately
	my $load_mtime = $INCLUDE_SUBS_LOADED_MTIME{$file};
	my $mtime      = (stat($perl_code_file))[9];
	if ( defined $INCLUDE_SUBS{$file} ) {
		return $INCLUDE_SUBS{$file} if $mtime == $load_mtime;
	}
	
	# otherwise load the subroutine perl code file
	open (PC, $perl_code_file) or croak "INCLUDE\tcan't read $perl_code_file";
	my $perl_code;
	$perl_code .= $_ while <PC>;
	close PC;
	
	# evalulate the code
	my $sub = eval_perl_code (\$perl_code);
	
	croak $self->stripped_exception (
		msg   => "Runtime error loading include file '$perl_code_file':\n$@",
		throw => "INCLUDE"
	) if $@ or not ref $sub;

	# store load mtime in global hash
	$INCLUDE_SUBS_LOADED_MTIME{$file} = $load_mtime;

	# store subroutine in global hash
	$INCLUDE_SUBS{$file} = $sub;
	
	# ok, subsequent include subroutine calls can call the subroutine
	# immediately, without the whole load and cache check stuff
	$self->{loaded_subroutines}->{$file} = 1;

	if ( 0 and $self->get_profiling_active ) {
		$self->print_command_duration (
			command => "load_inc",
			detail  => basename($full_path),
			time    => Time::HiRes::time() - $start_time,
		);
	}

	return $sub;
}

sub start_profiling {
	my $self = shift;
	my %par = @_;
	my  ($name, $deep, $filename, $filter, $scale_unit) =
	@par{'name','deep','filename','filter','scale_unit'};

	require Time::HiRes;

	$filename ||= $self->get_log_dir."/profile.log";

	my $open_mode;
	if ( -s $filename > 8589934592 ) {
		# remove profile file if size exceeds 8 MB
		$open_mode = ">";
	} else {
		$open_mode = ">>";
	}

	my $fh = FileHandle->new;
	open ($fh, "$open_mode $filename")
		or croak "profile\tCan't write $filename";