loncom/publisher/loncfile.pm - diff

Return to loncfile.pm CVS log

Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/loncfile.pm between versions 1.18 and 1.22

-version 1.18, 2002/09/10 02:31:26
+version 1.22, 2003/02/04 21:54:17
  Line 128  sub Debug {
    my $log     = $r->log;
    my $message = shift;
-   # Put out the indicated message butonly if DEBUG is false.
+   # Put out the indicated message butonly if DEBUG is true.
    if ($DEBUG) {
      $log->debug($message);
  Line 323  sub exists {
    my ($user, $domain, $dir, $file) = @_;
    # Create complete paths in publication and construction space.
+   my $relativedir=$dir;
-   my $published = &PublicationPath($domain, $user, $dir, $file);
+   $relativedir=s|/home/\Q$user\E/public_html||;
-   my $construct = &ConstructionPath($user, $dir, $file);
+   my $published = &PublicationPath($domain, $user, $relativedir, $file);
+   my $construct = &ConstructionPath($user, $relativedir, $file);
    # If the resource exists in either space indicate this fact.
    # Note that the check for existence in resource space is stricter.
    my $result;
+   if ( -d $construct ) {
+       return 'Error: destination for operation is a directory.';
+   }
    if ( -e $published) {
-     $result.='<p><font color=red>Warning: target file exists, and has been published!</font></p>';
+       $result.='<p><font color=red>Warning: target file exists, and has been published!</font></p>';
    }
    elsif ( -e $construct) {
-     $result.='<p><font color=red>Warning: target file exists!</font></p>';
+       $result.='<p><font color=red>Warning: target file exists!</font></p>';
-    }
+   }
    return $result;
- Line 409  sub CloseForm1 {
+ Line 413  sub CloseForm1 {
     &Debug($request, "Cancel url is: ".$cancelurl);
     $request->print('<p><input type=submit value=Continue></p></form>');
     $request->print('<form action="'.$cancelurl.
- 		   '" method=GET"><p><input type=submit value=Cancel><p></form>');
+ 		   '" method="GET"><p><input type=submit value=Cancel><p></form>');
  }
- Line 492  sub Rename1 {
+ Line 496  sub Rename1 {
  	if($ENV{'form.newfilename'}) {
  	    my $newfilename = $ENV{'form.newfilename'};
  	    $request->print(&checksuffix($filename, $newfilename));
- 	    $request->print(&exists($user, $domain, $dir, $newfilename));
+ 	    my $return=&exists($user, $domain, $dir, $newfilename);
+ 	    $request->print($return);
+ 	    if ($return =~/^Error:/) {
+ 		$request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');
+ 		return;
+ 	    }
+ 	    my $dest=&SimplifyDir($dir,$newfilename);
  	    $request->print('<input type=hidden name=newfilename value="'.
  			    $newfilename.
- 			    '"><p>Rename <tt>'.$filename.'</tt> to <tt>'.
+ 			    '"><p>Rename <tt>'.$filename.'</tt><br /> to <tt>'.
- 			    $dir.'/'.$newfilename.'</tt>?</p>');
+ 			    $dest.'</tt>?</p>');
  	    &CloseForm1($request, $cancelurl);
  	} else {
  	    $request->print('<p>No new filename specified</p></form>');
- Line 587  sub Copy1 {
+ Line 597  sub Copy1 {
    $cancelurl    =~ s/\/public_html//;
    if(-e $filename) {
      $request->print(&checksuffix($filename,$newfilename));
-     $request->print(&exists($user, $domain, $dir, $newfilename));
+     my $return=&exists($user, $domain, $dir, $newfilename);
+     $request->print($return);
+     if ($return =~/^Error:/) {
+ 	$request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');
+ 	return;
+     }
+     my $dest=&SimplifyDir($dir,$newfilename);
      $request->print('<input type = hidden name = newfilename value = "'.
  		    $dir.'/'.$newfilename.
- 		    '"><p>Copy <tt>'.$filename.'</tt> to'.
+ 		    '"><p>Copy <tt>'.$filename.'</tt><br />  to '.
- 		    '<tt>'.$dir.'/'.$newfilename.'</tt>/?</p>');
+ 		    '<tt>'.$dest.'</tt>?</p>');
      &CloseForm1($request, $cancelurl);
    } else {
      $request->print('<p>No such file <tt>'.$filename.'</p></form>');
- Line 603  sub Copy1 {
+ Line 618  sub Copy1 {
  =pod
+ =item SimplifyDir
+   Removes all extra / and all .. references
+ Parameters:
+ =over 4
+ =item $dir - string [in] a directory name
+ =item $file - string [in] a file reference relative to $dir
+ =back
+ Results: the concatenated path.
+ =cut
+ sub SimplifyDir {
+     my ($dir,$file) = @_;
+     my $location = $dir. '/'.$file;
+     $location=~s://+:/:g; # remove duplicate /
+     while ($location=~m:/\.\./:) {$location=~s:/[^/]+/\.\./:/:g;}#remove dir/..
+     return $location;
+ }
+ =pod
  =item NewDir1
    Does all phase 1 processing of directory creation:
- Line 663  sub NewDir1
+ Line 706  sub NewDir1
  =pod
+ =item NewFile1
+   Does all phase 1 processing of file creation:
+   Ensures that the user provides a new filename, adds proper extension
+   if needed and that the file does not already exist, if it is a html,
+   problem, page, or sequence, it then creates a form link to hand the
+   actual creation off to the proper handler.
+ Parameters:
+ =over 4
+ =item   $request  - Apache Request Object [in] - Server request object for the
+                current url.
+ =item   $username - Name of the user that is requesting the directory creation.
+ =item   $domain   - Name of the domain of the user
+ =item   $dir      - current absolute diretory
+ =item   $newfilename
+                   - Name of the file to be created; no path information
+ =back
+ Side Effects:
+ =over 4
+ =item 2 new forms are displayed.  Clicking on the confirmation button
+ causes the browser to attempt to load the specfied URL, allowing the
+ proper handler to take care of file creation. There is also a Cancle
+ button which returns you to the driectory listing you came from
+ =back
+ =cut
+ sub NewFile1 {
+     my ($request, $user, $domain, $dir, $newfilename) = @_;
+     &Debug($request, "Dir is : ".$dir);
+     &Debug($request, "Newfile is : ".$newfilename);
+     my $cancelurl = "/priv/".$dir;
+     $cancelurl    =~ s/\/home\///;
+     $cancelurl    =~ s/\/public_html//;
+     if ($ENV{'form.action'} =~ /new(.+)file/) {
+ 	my $extension=$1;
+ 	if ($newfilename !~ /\Q.$extension\E$/) {
+ 	    $newfilename.=".$extension";
+ 	}
+     }
+     my $fullpath = $dir.'/'.$newfilename;
+     &Debug($request, "Full path is : ".$fullpath);
+     if(-e $fullpath) {
+ 	$request->print('<p>File exists.</p></form>');
+     }
+     else {
+ 	$request->print('<p>Make new file <tt>'.$newfilename.'</tt>?</p>');
+ 	my $dest=&MakeFinalUrl($request,$fullpath);
+ 	&Debug($request, "Cancel url is: ".$cancelurl);
+ 	&Debug($request, "Dest url is: ".$dest);
+ 	$request->print('</form>');
+ 	$request->print('<form action="'.$dest.
+ 			'" method="GET"><p><input type="submit" value="Continue" /></p></form>');
+ 	$request->print('<form action="'.$cancelurl.
+ 			'" method="GET"><p><input type="submit" value="Cancel" /></p></form>');
+     }
+ }
+ =pod
  =item phaseone($r, $fn, $uname, $udom)
    Peforms phase one processing of the request.  In phase one, error messages
- Line 722  sub phaseone {
+ Line 843  sub phaseone {
      }
    } elsif ($ENV{'form.action'} eq 'newdir') {
      &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'});
+   }  elsif ($ENV{'form.action'} eq 'newfile' ||
+ 	    $ENV{'form.action'} eq 'newhtmlfile' ||
+ 	    $ENV{'form.action'} eq 'newproblemfile') {
+     if($ENV{'form.newfilename'}) {
+       my $newfilename = $ENV{'form.newfilename'};
+       if (!defined($dir)) {
+ 	  $fn=~m:(.*)/:;
+ 	  $dir=$1;
+       }
+       &NewFile1($r, $uname, $udom, $dir, $fn, $newfilename);
+     }else {
+       $r->print('<p>No new filename specified.</p></form>');
+     }
    }
  }
  =pod
- Line 988  sub phasetwo {
+ Line 1121  sub phasetwo {
  	# Once a resource is deleted, we just list the directory that
  	# previously held it.
  	#
- 	$dest = $dir."/";		# Parent dir.
+ 	$dest = $dir."/.";		# Parent dir.
      } elsif ($ENV{'form.action'} eq 'copy') {
  	if($ENV{'form.newfilename'}) {
  	    if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
- Line 1016  sub phasetwo {
+ Line 1149  sub phasetwo {
      #  Substitute for priv for the first home in $dir to get our
      # construction space path.
      #
+     $dest=&MakeFinalUrl($r,$dest);
+     $r->print('<h3><a href="'.$dest.'">Done</a></h3>');
+ }
+ sub MakeFinalUrl {
+     my($r,$dest)=@_;
      &Debug($r, "Final url is: $dest");
-     $dest =~ s/\/home\//\/priv\//;
+     $dest =~ s|/home/|/priv/|;
-     $dest =~ s/\/public_html//;
+     $dest =~ s|/public_html||;
      my $base = &File::Basename::basename($dest);
      my $dpath= &File::Basename::dirname($dest);
+     if ($base eq '.') { $base=''; }
      $dest = &HTML::Entities::encode($dpath.'/'.$base);
      &Debug($r, "Final url after rewrite: $dest");
+     return $dest;
-     $r->print('<h3><a href="'.$dest.'">Done</a></h3>');
  }
  sub handler {
- Line 1042  sub handler {
+ Line 1181  sub handler {
    my $fn;
    if ($ENV{'form.filename'}) {
-       $fn=$ENV{'form.filename'};
+       $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
        &Debug($r, "loncfile::handler - raw url: $fn");
  #      $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
  #      $fn=~s/^http\:\/\/[^\/]+//;
- Line 1109  sub handler {
+ Line 1248  sub handler {
        $r->print('<h3>New Directory</h3>');
    } elsif ($ENV{'form.action'} eq 'copy') {
        $r->print('<h3>Copy</h3>');
+   } elsif ($ENV{'form.action'} eq 'newfile' ||
+ 	   $ENV{'form.action'} eq 'newhtmlfile' ||
+ 	   $ENV{'form.action'} eq 'newproblemfile') {
+       $r->print('<h3>New Resource</h3>');
    } else {
       $r->print('<p>Unknown Action</body></html>');
       return OK;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.18
changed lines
	Added in v.1.22