view release on metacpan or  search on metacpan

lib/Dir/List.pm  view on Meta::CPAN

				$self->{list}->{files}->{$_}->{last_modified} = $self->last_modified("$dir$_");
				# Check if this is a new file; Based on the new_is_max_sec.
				$self->{list}->{files}->{$_}->{new} = $self->is_new("$dir$_");
			}
		}

		# Check if caching is enabled and the cache has been defined
		if($self->{use_cache}) {
			if($self->{__cache}) {
				# Add some information to the cache (times)
				my @lt = localtime(time);
				$self->{list}->{cache_info}->{time_string} = strftime($self->{datetimeformat}, @lt);
				$self->{list}->{cache_info}->{time_epoch} = time;
				# Save it to the cache
				$self->{__cache}->set($dir, safeFreeze($self->{list}));
			}
		}
		# We don't need to give the caching info to the developer, if it's
		# not the cached version...
		delete $self->{list}->{cache_info};

		# Return the list...
		return $self->{list};
	} else {
		return undef;
	}
}

# Helper function to clear the cache (not used internal, developer's may use this)
sub clearcache {
	my $self = shift;
	if($self->{__cache}) {
		$self->{__cache}->clear();
	}
}

# Helper function to remove an entry from the cache (not used internal, developer's may use this)
sub remove_from_cache($) {
	my $self = shift;
	my $arg = shift;

	if($self->{__cache}) {
		$self->{__cache}->remove($arg);
	}
}

# Helper function to retrieve the uid from a file/directory
sub getuid($) {
	my $self = shift;
	my $arg = shift;
	# UID is number four in stat
	return (stat($arg))[4];
}

# Helper function to retrieve the userinformation for a uid
sub getuserinfo($) {
	my $self = shift;
	my $arg = shift;
	# If it's allready cached (within' this process/instance), don't ask the system again
	unless(defined $self->{uid_cache}->{$arg}) {
		my($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell,$expire) = getpwuid($arg);

		# Save the information to our current instance (caching).
		$self->{uid_cache}->{$arg} = {
			name	=> $name,
			passwd	=> $passwd,
			uid		=> $uid,
			gid		=> $gid,
			quota	=> $quota,
			comment	=> $comment,
			gcos	=> $gcos,
			dir		=> $dir,
			shell	=> $shell,
			expire	=> $expire,
		};
	}
	# We need to clone it, else we would get a reference to the existing hash
	return clone($self->{uid_cache}->{$arg});
}

# Helper function to retrieve the gid from a file/directory
sub getgid($) {
	my $self = shift;
	my $arg = shift;
	return (stat($arg))[5];
}

# Helper function to retrieve the groupinformation for a gid
sub getgroupinfo($) {
	my $self = shift;
	my $arg = shift;
	# If it's allready cached (within' this process/instance), don't ask the system again
	unless(defined $self->{gid_cache}->{$arg}) {
		my($name,$passwd,$gid,$members) = getgrgid($arg);
		$self->{gid_cache}->{$arg} = {
			gid		=> $gid,
			name	=> $name,
			passwd	=> $passwd,
			members	=> $members,
		};
	}
	# We need to clone it, else we would get a reference to the existing hash
	return clone($self->{gid_cache}->{$arg});
}

# We have an internal list of filetypes.
sub internaltype($) {
	my $self = shift;
	my $arg = shift;
	# Make an array containing hashes, that holds
	# our types.
	# This must be an array! Else it could be that .gz
	# would override the .tar.gz regex...
	my @types = (
		{	regex	=> "\.zip",			type	=> 'zip' },
		{	regex	=> "\.rar",			type	=> 'rar' },
		{	regex	=> "\.tgz",			type	=> 'tgz' },
		{	regex	=> "\.tar.gz",		type	=> 'tgz' },
		{	regex	=> "\.gz",			type	=> 'gz' },
		{	regex	=> "\.tar",			type	=> 'tar' },
		{	regex	=> "\.rpm",			type	=> 'rpm' },