view release on metacpan or  search on metacpan

lib/Apache2/AutoIndex/XSLT.pm  view on Meta::CPAN

			'                  group     CDATA #IMPLIED',
			'                  uid       CDATA #REQUIRED',
			'                  gid       CDATA #REQUIRED',
			'                  ctime     CDATA #REQUIRED',
			'                  nicectime CDATA #IMPLIED',
			'                  mtime     CDATA #REQUIRED',
			'                  nicemtime CDATA #IMPLIED',
			'                  perms     CDATA #REQUIRED',
			'                  size      CDATA #REQUIRED',
			'                  nicesize  CDATA #IMPLIED',
			'                  icon      CDATA #IMPLIED',
			'                  alt       CDATA #IMPLIED',
			'                  ext       CDATA #IMPLIED>',
			'  <!ELEMENT dir   EMPTY>',
			'  <!ATTLIST dir   href      CDATA #REQUIRED',
			'                  title     CDATA #REQUIRED',
			'                  desc      CDATA #IMPLIED',
			'                  owner     CDATA #IMPLIED',
			'                  group     CDATA #IMPLIED',
			'                  uid       CDATA #REQUIRED',
			'                  gid       CDATA #REQUIRED',
			'                  ctime     CDATA #REQUIRED',
			'                  nicectime CDATA #IMPLIED',
			'                  mtime     CDATA #REQUIRED',
			'                  nicemtime CDATA #IMPLIED',
			'                  perms     CDATA #REQUIRED',
			'                  size      CDATA #REQUIRED',
			'                  nicesize  CDATA #IMPLIED',
			'                  alt       CDATA #IMPLIED',
			'                  icon      CDATA #IMPLIED>',
			']>',
		);

	return $xml;
}


sub glob2regex {
	my $glob = shift || '';
	$glob =~ s/\./\\./g; # . is a dot
	$glob =~ s/\?/./g;   # ? is any single character
	$glob =~ s/\*/.*/g;  # * means any number of any characters
	$glob =~ s/(?<!\\)([\(\)\[\]\+])/\\$1/g; # Escape metacharacters
	return $glob;        # Now a regex
}


sub comify {
	local $_ = shift;
	s/^\s+|\s+$//g;
	1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
	return $_;
}


sub stat_file {
	my ($r,$filename) = @_;

	my %stat;
	@stat{qw(dev ino mode nlink uid gid rdev size
			atime mtime ctime blksize blocks)} = lstat($filename);

	my %rtn;
	$rtn{$_} = $stat{$_} for qw(uid gid mtime ctime size);
	$rtn{perms} = file_mode($stat{mode});
	$rtn{owner} = scalar getpwuid($rtn{uid});
	$rtn{group} = scalar getgrgid($rtn{gid});

	$rtn{nicesize} = comify(sprintf('%d KB',
						($rtn{size} + ($rtn{size} ? 1024 : 0))/1024
					));

	# Reformat times to this format: yyyy-mm-ddThh:mm-tz:tz
	for (qw(mtime ctime)) {
		my $time = $rtn{$_};
		$rtn{$_} = Apache2::Util::ht_time(
				$r->pool, $time,
				'%Y-%m-%dT%H:%M-00:00',
				0,
			);
		$rtn{"nice$_"} = Apache2::Util::ht_time(
				$r->pool, $time,
				'%d/%m/%Y %H:%M',
				0,
			);
	}

	return \%rtn;
}


sub file_mode {
	my $mode = shift;

	# This block of code is taken with thanks from
	# http://zarb.org/~gc/resource/find_recent,
	# written by Guillaume Cottenceau.
	return (
		Fcntl::S_ISREG($mode)  ? '-' :
		Fcntl::S_ISDIR($mode)  ? 'd' :
		Fcntl::S_ISLNK($mode)  ? 'l' :
		Fcntl::S_ISBLK($mode)  ? 'b' :
		Fcntl::S_ISCHR($mode)  ? 'c' :
		Fcntl::S_ISFIFO($mode) ? 'p' :
		Fcntl::S_ISSOCK($mode) ? 's' : '?' ) .

		( ($mode & Fcntl::S_IRUSR()) ? 'r' : '-' ) .
		( ($mode & Fcntl::S_IWUSR()) ? 'w' : '-' ) .
		( ($mode & Fcntl::S_ISUID()) ? (($mode & Fcntl::S_IXUSR()) ? 's' : 'S')
									 : (($mode & Fcntl::S_IXUSR()) ? 'x' : '-') ) .

		( ($mode & Fcntl::S_IRGRP()) ? 'r' : '-' ) .
		( ($mode & Fcntl::S_IWGRP()) ? 'w' : '-' ) .
		( ($mode & Fcntl::S_ISGID()) ? (($mode & Fcntl::S_IXGRP()) ? 's' : 'S')
									 : (($mode & Fcntl::S_IXGRP()) ? 'x' : '-') ) .

		( ($mode & Fcntl::S_IROTH()) ? 'r' : '-' ) .
		( ($mode & Fcntl::S_IWOTH()) ? 'w' : '-' ) .
		( ($mode & Fcntl::S_ISVTX()) ? (($mode & Fcntl::S_IXOTH()) ? 't' : 'T')
									 : (($mode & Fcntl::S_IXOTH()) ? 'x' : '-') );
}