--- loncom/lonnet/perl/lonnet.pm 2006/02/14 20:28:57 1.711 +++ loncom/lonnet/perl/lonnet.pm 2006/02/21 22:39:28 1.712 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.711 2006/02/14 20:28:57 albertel Exp $ +# $Id: lonnet.pm,v 1.712 2006/02/21 22:39:28 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4667,6 +4667,36 @@ sub GetFileTimestamp { } } +sub stat_file { + my ($uri) = @_; + $uri = &clutter($uri); + my ($udom,$uname,$file,$dir); + if ($uri =~ m-^/(uploaded|editupload)/-) { + ($udom,$uname,$file) = + ($uri =~ m-/(?:uploaded|editupload)/?([^/]*)/?([^/]*)/?(.*)-); + $file = 'userfiles/'.$file; + $dir = &Apache::loncommon::propath($udom,$uname); + } + if ($uri =~ m-^/res/-) { + ($udom,$uname) = + ($uri =~ m-/(?:res)/?([^/]*)/?([^/]*)/-); + $file = $uri; + } + + if (!$udom || !$uname || !$file) { + # unable to handle the uri + return (); + } + + my ($result) = &dirlist($file,$udom,$uname,$dir); + my @stats = split('&', $result); + if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { + shift(@stats); #filename is first + return @stats; + } + return (); +} + # -------------------------------------------------------- Value of a Condition sub directcondval { @@ -7339,6 +7369,16 @@ getfile($file,$caller) : two cases - req - returns the entire contents of a file or -1; it properly subscribes to and replicates the file if neccessary. + +=item * + +stat_file($url) : $url is expected to be a /res/ or /uploaded/ style file + reference + +returns either a stat() list of data about the file or an empty list +if the file doesn't exist or couldn't find out about it (connection +problems or user unknown) + =item * filelocation($dir,$file) : returns file system location of a file