[BACK]Return to loncfile.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/loncfile.pm between versions 1.79 and 1.82

version 1.79, 2006/11/23 01:50:57 version 1.82, 2007/04/20 20:55:01
Line 72  use Apache::loncacc; Line 72  use Apache::loncacc;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonlocal;  use Apache::lonlocal;
 use lib '/home/httpd/lib/perl/';  use LONCAPA qw(:DEFAULT :match);
 use LONCAPA;  
    
   
 my $DEBUG=0;  my $DEBUG=0;
 my $r; # Needs to be global for some stuff RF.  my $r; # Needs to be global for some stuff RF.
Line 151  sub URLToPath { Line 150  sub URLToPath {
     $Url=~ s/\/+/\//g;      $Url=~ s/\/+/\//g;
     $Url=~ s/^http\:\/\/[^\/]+//;      $Url=~ s/^http\:\/\/[^\/]+//;
     $Url=~ s/^\///;      $Url=~ s/^\///;
     $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;      $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
     &Debug($r, "Returning $Url \n");      &Debug($r, "Returning $Url \n");
     return $Url;      return $Url;
 }  }
   
 sub url {  sub url {
     my $fn=shift;      my $fn=shift;
     $fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/;      $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;
     $fn=&HTML::Entities::encode($fn,'<>"&');      $fn=&HTML::Entities::encode($fn,'<>"&');
     return $fn;      return $fn;
 }  }
   
 sub display {  sub display {
     my $fn=shift;      my $fn=shift;
     $fn=~s-^/home/(\w+)/public_html-/priv/$1-;      $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
     return '<tt>'.$fn.'</tt>';      return '<tt>'.$fn.'</tt>';
 }  }
   
Line 301  sub checksuffix { Line 300  sub checksuffix {
     my $newsuffix;      my $newsuffix;
     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }      if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }      if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
     if ($oldsuffix ne $newsuffix) {      if (lc($oldsuffix) ne lc($newsuffix)) {
  $result.=   $result.=
             '<p><font color="red">'.&mt('Warning: change of MIME type!').'</font></p>';              '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>';
     }      }
     return $result;      return $result;
 }  }
Line 464  sub Rename1 { Line 463  sub Rename1 {
     if (-d $fn) {      if (-d $fn) {
  $newfilename=~/\.(\w+)$/;   $newfilename=~/\.(\w+)$/;
  if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {   if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
     $request->print('<br /><font color="red">'.      $request->print('<br /><span classr="LC_warning">'.
     &mt('Cannot change MIME type of a directory').      &mt('Cannot change MIME type of a directory').
     '</font>'.      '</span>'.
     '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
     return;      return;
  }   }
Line 750  sub NewFile1 { Line 749  sub NewFile1 {
     return;      return;
  }   }
  if ($newfilename !~ /\Q.$extension\E$/) {   if ($newfilename !~ /\Q.$extension\E$/) {
     if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) {      if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
  #already has an extension strip it and add in expected one   #already has an extension strip it and add in expected one
  $newfilename =~ s|.([^\.]+)$||;   $newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|;
     }      }
     $newfilename.=".$extension";      $newfilename.=".$extension";
  }   }
     }      }
     my $result=&exists($user,$domain,$newfilename);      my $result=&exists($user,$domain,$newfilename);
     if($result) {      if($result) {
  $request->print('<font color="red">'.$result.'</font></form>');   $request->print('<span class="LC_error">'.$result.'</span></form>');
     } else {      } else {
  $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');   $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
  $request->print('</form>');   $request->print('</form>');
Removed from v.1.79  
changed lines
  Added in v.1.82

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