CIPP

 view release on metacpan or  search on metacpan

lib/CIPP/Compile/Cache.pm  view on Meta::CPAN

	$DEBUG && print STDERR "dep_file exists\n";

	open (IN, $dep_file) or confess "can't read $dep_file";
	my $line = <IN>;
	chomp $line;

	my ($src_file, $cache_file, $err_file);
	($src_file, $cache_file, $err_file) = split(/\t/, $line);

	my $src_file_mtime = (stat($src_file))[9];

	# check for cached error

	$DEBUG && print STDERR "err_file=$err_file\n";

	my $has_cached_err = 0;

	my $err_file_mtime;
	if ( -f $err_file ) {
		$DEBUG && print STDERR "err-file $err_file OLDER $src_file : ";
		$err_file_mtime = (stat($err_file))[9];
		if ( $err_file_mtime < $src_file_mtime ) {
			# cache is dirty, if err_file is older than src_file
			close IN;
			$DEBUG && print STDERR "YES\n";
			$DEBUG && print STDERR "Status: $dirty\n";
			return $dirty;
		} else {
			# ok has cached err. beyond we check if any
			# includes interface file is newer than our cached
			# error. in this case the cache is dirty, because

lib/CIPP/Compile/Cache.pm  view on Meta::CPAN

	$DEBUG && print STDERR "cache_file=$cache_file ",(-f$cache_file?"exist":"missing"),"\n";

	if ( not -f $cache_file and not $has_cached_err ) {
		$DEBUG && print STDERR "no cache file present and no cached err\n";
		$DEBUG && print STDERR "Status: $dirty\n";
		return $dirty;
	}

	$DEBUG && print STDERR "$cache_file OLDER $src_file : ";

	my $cache_file_mtime = (stat($cache_file))[9];

	if ( -f $cache_file and $cache_file_mtime < $src_file_mtime ) {
		# cache is dirty, if cache_file is older than src_file
		close IN;
		$DEBUG && print STDERR "YES\n";
		$DEBUG && print STDERR "Status: $dirty\n";
		return $dirty;
	}

	$DEBUG && print STDERR "NO\n";

lib/CIPP/Compile/Cache.pm  view on Meta::CPAN

		}

		if ( not -f $if_file ) {
			$DEBUG && print STDERR "if_file doesn't exist\n";
			$status = $dirty;
			last;
		}

#		$DEBUG && print STDERR "consistency check: $src_file OLDER $if_file : ";
#		
#		if ( (stat($src_file))[9] < (stat($if_file))[9] ) {
#			$DEBUG && print STDERR "YES!!!\n";
#			$DEBUG && print STDERR "removing $if_file, must be regenerated\n";
#			unlink $if_file;
#			$status = $dirty;
#			last;
#		}

		$DEBUG && print STDERR "$cache_file OLDER $src_file : ";

		if ( (stat($cache_file))[9] < (stat($src_file))[9] ) {
			# cache is dirty if one cache_file is older
			# than corresponding src_file
			$status = $dirty;
			$DEBUG && print STDERR "YES\n";
			last;
		}
		$DEBUG && print STDERR "NO\n";
		
		if ( $has_cached_err ) {
			$DEBUG && print STDERR "$err_file OLDER $if_file (incompat. interface?) : ";

			if ( $err_file_mtime < (stat($if_file))[9] ) {
				# cache is dirty if the cached error is older than
				# the if_file (which indicates incompatible
				# interface change)
				$DEBUG && print STDERR "YES\n";
				$status = $dirty;
				last;
			}
			
			$DEBUG && print STDERR "NO\n";
		}

		$DEBUG && print STDERR "$cache_file OLDER $if_file : ";

		if ( $cache_file_mtime < (stat($if_file))[9] ) {
			# cache is dirty if the cache_file_mtime of
			# our object is older than one if_file
			$DEBUG && print STDERR "YES\n";
			$status = $dirty if not $has_cached_err;
			last;
		}

		$DEBUG && print STDERR "NO\n";

	}

lib/CIPP/Compile/Parser.pm  view on Meta::CPAN

	#-------------------------------------------------------------
	# Now update meta data: interface and dependecy information
	#-------------------------------------------------------------

	my $iface_filename = $self->get_iface_filename;

	# remember atime and mtime of the interface file
	my ($last_interface_atime, $last_interface_mtime);
	($last_interface_atime, $last_interface_mtime) = 
		(stat($iface_filename))[8,9] if -f $iface_filename;

	# remember old interface (interface file may not exist)
	my $old_interface = eval { $self->read_include_interface_file };
	
	# store (possibly) new Include interface
	my $new_interface = $self->store_include_interface_file;

	# update dependencies
	$self->write_dependencies;
	

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

sub Read_Config {
	my ($filename, $nocache) = @_;

	$nocache = 1;

	confess "CONFIG\tFile '$filename' not found\n".
		"working directory:".cwd()."\n".
		"\@INC = ".(join(",",@::INC))."\n"
		if not -f $filename;
	
	my $file_timestamp = (stat($filename))[9];
	
	if ( $nocache or not defined $CIPP::Runtime::cfg_timestamp{$filename} or
	     $CIPP::Runtime::cfg_timestamp{$filename} < $file_timestamp ) {
		my $fh = new FileHandle;
		open ($fh, $filename);
		eval join ('', "no strict;\n", <$fh>)."\n1;";
		confess "CONFIG\t$@" if $@;
		close $fh;
		$CIPP::Runtime::cfg_timestamp{$filename} = $file_timestamp;
		debug($filename);

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

	# 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;