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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.212 and 1.226

version 1.212, 2006/09/13 21:43:26 version 1.226, 2007/07/13 19:23:33
Line 129  use Apache::loncfile; Line 129  use Apache::loncfile;
 use LONCAPA::lonmetadata;  use LONCAPA::lonmetadata;
 use Apache::lonmsg;  use Apache::lonmsg;
 use vars qw(%metadatafields %metadatakeys);  use vars qw(%metadatafields %metadatakeys);
 use lib '/home/httpd/lib/perl/';  use LONCAPA qw(:DEFAULT :match);
 use LONCAPA;  
     
   
 my %addid;  my %addid;
Line 184  sub metaeval { Line 183  sub metaeval {
  if ($token->[0] eq 'S') {   if ($token->[0] eq 'S') {
     my $entry=$token->[1];      my $entry=$token->[1];
     my $unikey=$entry;      my $unikey=$entry;
       next if ($entry =~ m/^(?:parameter|stores)_/);
     if (defined($token->[2]->{'package'})) {       if (defined($token->[2]->{'package'})) { 
  $unikey.='_package_'.$token->[2]->{'package'};   $unikey.="\0package\0".$token->[2]->{'package'};
     }       } 
     if (defined($token->[2]->{'part'})) {       if (defined($token->[2]->{'part'})) { 
  $unikey.='_'.$token->[2]->{'part'};    $unikey.="\0".$token->[2]->{'part'}; 
     }      }
     if (defined($token->[2]->{'id'})) {       if (defined($token->[2]->{'id'})) { 
  $unikey.='_'.$token->[2]->{'id'};   $unikey.="\0".$token->[2]->{'id'};
     }       } 
     if (defined($token->[2]->{'name'})) {       if (defined($token->[2]->{'name'})) { 
  $unikey.='_'.$token->[2]->{'name'};    $unikey.="\0".$token->[2]->{'name'}; 
     }      }
     foreach (@{$token->[3]}) {      foreach (@{$token->[3]}) {
  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};   $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
Line 281  sub metaread { Line 281  sub metaread {
 sub coursedependencies {  sub coursedependencies {
     my $url=&Apache::lonnet::declutter(shift);      my $url=&Apache::lonnet::declutter(shift);
     $url=~s/\.meta$//;      $url=~s/\.meta$//;
     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);      my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/});
     my $regexp=$url;      my $regexp=quotemeta($url);
     $regexp=~s/(\W)/\\$1/g;  
     $regexp='___'.$regexp.'___course';      $regexp='___'.$regexp.'___course';
     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,      my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
        $aauthor,$regexp);         $aauthor,$regexp);
Line 410  sub urlfixup { Line 409  sub urlfixup {
     if ($url =~ /^mailto:/i) { return $url; }      if ($url =~ /^mailto:/i) { return $url; }
     #internal document links need no fixing      #internal document links need no fixing
     if ($url =~ /^\#/) { return $url; }       if ($url =~ /^\#/) { return $url; } 
     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);      my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)});
     foreach (values %Apache::lonnet::hostname) {      my @lonids = &Apache::lonnet::machine_ids($host);
  if ($_ eq $host) {      if (@lonids) {
     $url=~s/^http\:\/\///;   $url=~s{^(?:http|https|ftp)://}{};
             $url=~s/^$host//;   $url=~s/^\Q$host\E//;
         }  
     }      }
     if ($url=~/^http\:\/\//) { return $url; }      if ($url=~m{^(?:http|https|ftp)://}) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;      $url=~s{\Q~$cuname\E}{res/$cudom/$cuname};
     return $url;      return $url;
 }  }
   
Line 469  sub set_allow { Line 467  sub set_allow {
     }      }
     if (($newurl !~ /^javascript:/i) &&      if (($newurl !~ /^javascript:/i) &&
  ($newurl !~ /^mailto:/i) &&   ($newurl !~ /^mailto:/i) &&
  ($newurl !~ /^http:/i) &&   ($newurl !~ /^(?:http|https|ftp):/i) &&
  ($newurl !~ /^\#/)) {   ($newurl !~ /^\#/)) {
  $$allow{&absoluteurl($newurl,$target)}=1;   $$allow{&absoluteurl($newurl,$target)}=1;
     }      }
     return $return_url      return $return_url;
 }  }
   
 #########################################  #########################################
Line 496  sub get_subscribed_hosts { Line 494  sub get_subscribed_hosts {
     $target=~/(.*)\/([^\/]+)$/;      $target=~/(.*)\/([^\/]+)$/;
     my $srcf=$2;      my $srcf=$2;
     opendir(DIR,$1);      opendir(DIR,$1);
       # cycle through listed files, subscriptions used to exist
       # as "filename.lonid"
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename=~/\Q$srcf\E\.(\w+)$/) {   if ($filename=~/\Q$srcf\E\.($match_lonid)$/) {
     my $subhost=$1;      my $subhost=$1;
     if (($subhost ne 'meta' && $subhost ne 'subscription' &&      if (($subhost ne 'meta' 
  $subhost ne 'tmp') &&   && $subhost ne 'subscription' 
    && $subhost ne 'meta.subscription'
    && $subhost ne 'tmp') &&
                 ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {                  ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
  push(@subscribed,$subhost);   push(@subscribed,$subhost);
     }      }
Line 509  sub get_subscribed_hosts { Line 511  sub get_subscribed_hosts {
     closedir(DIR);      closedir(DIR);
     my $sh;      my $sh;
     if ( $sh=Apache::File->new("$target.subscription") ) {      if ( $sh=Apache::File->new("$target.subscription") ) {
  &Apache::lonnet::logthis("opened $target.subscription");  
  while (my $subline=<$sh>) {   while (my $subline=<$sh>) {
     if ($subline =~ /(^\w+):/) {       if ($subline =~ /^($match_lonid):/) { 
                 if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {                   if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { 
                    push(@subscribed,$1);                     push(@subscribed,$1);
         }          }
             } else {  
  &Apache::lonnet::logthis("No Match for $subline");  
     }      }
  }   }
     } else {  
  &Apache::lonnet::logthis("Unable to open $target.subscription");  
     }      }
     return @subscribed;      return @subscribed;
 }  }
Line 657  sub fix_ids_and_indices { Line 654  sub fix_ids_and_indices {
    join(', ',@duplicatedids));     join(', ',@duplicatedids));
     if ($duplicateids) {      if ($duplicateids) {
  print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";   print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";
  my $outstring='<font color="red">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</font>';   my $outstring='<span class="LC_error">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</span>';
  return ($outstring,1);   return ($outstring,1);
     }      }
     if ($needsfixup) {      if ($needsfixup) {
Line 721  sub fix_ids_and_indices { Line 718  sub fix_ids_and_indices {
     ($lctag eq 'image')) {      ($lctag eq 'image')) {
     my $next_token=$parser[-1]->get_token();      my $next_token=$parser[-1]->get_token();
     if ($next_token->[0] eq 'T') {      if ($next_token->[0] eq 'T') {
                           $next_token->[1] =~ s/[\n\r\f]+//g;
  $next_token->[1]=&set_allow(\%allow,$logfile,   $next_token->[1]=&set_allow(\%allow,$logfile,
     $target,$tag,      $target,$tag,
     $next_token->[1]);      $next_token->[1]);
Line 827  sub store_metadata { Line 825  sub store_metadata {
     # Determine if the table exists      # Determine if the table exists
     my $status = &Apache::lonmysql::check_table('metadata');      my $status = &Apache::lonmysql::check_table('metadata');
     if (! defined($status)) {      if (! defined($status)) {
         $error='<font color="red">WARNING: Cannot connect to '.          $error='<span class="LC_error">WARNING: Cannot connect to '.
             'database!</font>';              'database!</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
     if ($status == 0) {      if ($status == 0) {
         # It would be nice to actually create the table....          # It would be nice to actually create the table....
         $error ='<font color="red">WARNING: The metadata table does not '.          $error ='<span class="LC_error">WARNING: The metadata table does not '.
             'exist in the LON-CAPA database.</font>';              'exist in the LON-CAPA database.</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
Line 846  sub store_metadata { Line 844  sub store_metadata {
  $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,   $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,
                                                        $metadata{'url'});                                                         $metadata{'url'});
     } else {      } else {
         $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,          $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef,
                                                          \%metadata);                                                           \%metadata);
     }      }
     if (defined($status) && $status ne '') {      if (defined($status) && $status ne '') {
         $error='<font color="red">Error occured storing new values in '.          $error='<span class="LC_error">Error occured saving new values in '.
             'metadata table in LON-CAPA database</font>';              'metadata table in LON-CAPA database</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         &Apache::lonnet::logthis($status);          &Apache::lonnet::logthis($status);
         return ($error,undef);          return ($error,undef);
     }      }
     return (undef,$status);      return (undef,'success');
 }  }
   
   
Line 873  sub checkonthis { Line 871  sub checkonthis {
     if (($errorcount) || ($warningcount)) {      if (($errorcount) || ($warningcount)) {
         $r->print('<br /><tt>'.$uri.'</tt>: ');          $r->print('<br /><tt>'.$uri.'</tt>: ');
  if ($errorcount) {   if ($errorcount) {
     $r->print('<img src="/adm/lonMisc/bomb.gif" /><font color="red"><b>'.      $r->print('<img src="/adm/lonMisc/bomb.gif" /><span class="LC_error"><b>'.
       $errorcount.' '.        $errorcount.' '.
       &mt('error(s)').'</b></font> ');        &mt('error(s)').'</b></span> ');
  }   }
  if ($warningcount) {   if ($warningcount) {
     $r->print('<font color="blue">'.      $r->print('<font color="blue">'.
Line 939  sub publish { Line 937  sub publish {
     my %allow=();      my %allow=();
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',1);   return ('<span class="LC_error">'.&mt('No write permission to user directory, FAIL').'</span>',1);
     }      }
     print $logfile       print $logfile 
 "\n\n================= Publish ".localtime()." Phase One  ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";  "\n\n================= Publish ".localtime()." Phase One  ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";
Line 953  sub publish { Line 951  sub publish {
     print $logfile "Copied original file to ".$copyfile."\n";      print $logfile "Copied original file to ".$copyfile."\n";
         } else {          } else {
     print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";      print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
     return ("<font color=\"red\">Failed to write backup copy, $!,FAIL</font>",1);      return ("<span class=\"LC_error\">Failed to write backup copy, $!,FAIL</span>",1);
         }          }
 # ------------------------------------------------------------- IDs and indices  # ------------------------------------------------------------- IDs and indices
   
Line 981  sub publish { Line 979  sub publish {
                if (                 if (
        &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.         &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                                             $thisdep.'.meta') eq '-1') {                                              $thisdep.'.meta') eq '-1') {
    $scrout.= ' - <font color="red">'.&mt('Currently not available').     $scrout.= ' - <span class="LC_error">'.&mt('Currently not available').
        '</font>';         '</span>';
                } else {                 } else {
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
                              &Apache::lonnet::declutter($thisdep).'___usage'                               &Apache::lonnet::declutter($thisdep).'___usage'
                                  => time);                                   => time);
                    $thisdep=~/^\/res\/(\w+)\/(\w+)\//;                     $thisdep=~m{^/res/($match_domain)/($match_username)/};
                    if ((defined($1)) && (defined($2))) {                     if ((defined($1)) && (defined($2))) {
                       &Apache::lonnet::put('nohist_resevaldata',\%temphash,                        &Apache::lonnet::put('nohist_resevaldata',\%temphash,
    $1,$2);     $1,$2);
Line 1003  sub publish { Line 1001  sub publish {
           my $org;            my $org;
           unless ($org=Apache::File->new('>'.$source)) {            unless ($org=Apache::File->new('>'.$source)) {
              print $logfile "No write permit to $source\n";               print $logfile "No write permit to $source\n";
              return ('<font color="red">'.&mt('No write permission to').               return ('<span class="LC_error">'.&mt('No write permission to').
      ' '.$source.       ' '.$source.
      ', '.&mt('FAIL').'</font>',1);       ', '.&mt('FAIL').'</span>',1);
   }    }
           print($org $outstring);            print($org $outstring);
         }          }
Line 1101  sub publish { Line 1099  sub publish {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($_=~/^parameter/) || ($_=~/^stores/)) {
     unless ($_=~/\.\w+$/) {       unless ($_=~/\.\w+$/) { 
  unless ($oldparmstores{$_}) {   unless ($oldparmstores{$_}) {
     print $logfile 'New: '.$_."\n";      my $disp_key = $_;
     $chparms.=$_.' ';      $disp_key =~ tr/\0/_/;
       print $logfile ('New: '.$disp_key."\n");
       $chparms .= $disp_key.' ';
  }   }
     }      }
  }   }
     }      }
     if ($chparms) {      if ($chparms) {
  $scrout.='<p><b>'.&mt('New parameters or stored values').   $scrout.='<p><b>'.&mt('New parameters or saved values').
     ':</b> '.$chparms.'</p>';      ':</b> '.$chparms.'</p>';
     }      }
   
Line 1117  sub publish { Line 1117  sub publish {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($_=~/^parameter/) || ($_=~/^stores/)) {
     unless (($metadatafields{$_.'.name'}) ||      unless (($metadatafields{$_.'.name'}) ||
     ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {      ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
  print $logfile 'Obsolete: '.$_."\n";   my $disp_key = $_;
  $chparms.=$_.' ';   $disp_key =~ tr/\0/_/;
    print $logfile ('Obsolete: '.$disp_key."\n");
    $chparms.=$disp_key.' ';
     }      }
  }   }
     }      }
     if ($chparms) {      if ($chparms) {
  $scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.   $scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '.
     $chparms.'</p><h1><font color="red">'.&mt('Warning!').      $chparms.'</p><h1><span class="LC_warning">'.&mt('Warning!').
     '</font></h1><p><font color="red" size="+1">'.      '</span></h1><p><span class="LC_warning">'.
     &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</font></p><hr />';      &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</span></p><hr />';
     }      }
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
Line 1412  sub phasetwo { Line 1414  sub phasetwo {
 #  #
     unless ($env{'form.obsolete'}) {      unless ($env{'form.obsolete'}) {
  if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {   if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
     $r->print(      $r->print('<span class="LC_error">'.
       '<font color="red">'.&mt('Unsupported character combination').        &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
       ' "<tt>'.$1.'</tt>" '.&mt('in filename, FAIL').'</font>');        '</span>');
     return 0;      return 0;
  }   }
  unless ($target=~/\.(\w+)$/) {   unless ($target=~/\.(\w+)$/) {
     $r->print('<font color="red">'.&mt('No valid extension found in filename, FAIL').'</font>');      $r->print('<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>');
     return 0;      return 0;
  }   }
  if ($target=~/\.(\d+)\.(\w+)$/) {   if ($target=~/\.(\d+)\.(\w+)$/) {
     $r->print('<font color="red">'.&mt('Cannot publish versioned resource, FAIL').'</font>');      $r->print('<span class="LC_error">'.&mt('Cannot publish versioned resource, FAIL').'</span>');
     return 0;      return 0;
  }   }
     }      }
Line 1434  sub phasetwo { Line 1436  sub phasetwo {
     my $logfile;      my $logfile;
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  $r->print(   $r->print(
         '<font color="red">'.          '<span class="LC_error">'.
  &mt('No write permission to user directory, FAIL').'</font>');   &mt('No write permission to user directory, FAIL').'</span>');
         return 0;          return 0;
     }      }
     print $logfile       print $logfile 
Line 1470  sub phasetwo { Line 1472  sub phasetwo {
     $metadatafields{'modifyinguser'}=$env{'user.name'}.':'.      $metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
                                  $env{'user.domain'};                                   $env{'user.domain'};
     $metadatafields{'authorspace'}=$cuname.':'.$cudom;      $metadatafields{'authorspace'}=$cuname.':'.$cudom;
       $metadatafields{'domain'}=$cudom;
           
     my $allkeywords=$env{'form.addkey'};      my $allkeywords=$env{'form.addkey'};
     if (exists($env{'form.keywords'})) {      if (exists($env{'form.keywords'})) {
Line 1491  sub phasetwo { Line 1494  sub phasetwo {
  my $file=$metadatafields{'customdistributionfile'};   my $file=$metadatafields{'customdistributionfile'};
  unless ($file=~/\.rights$/) {   unless ($file=~/\.rights$/) {
             $r->print(              $r->print(
                 '<font color="red">'.&mt('No valid custom distribution rights file specified, FAIL').                  '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
  '</font>');   '</span>');
     return 0;      return 0;
         }          }
     }      }
Line 1501  sub phasetwo { Line 1504  sub phasetwo {
         my $mfh;          my $mfh;
         unless ($mfh=Apache::File->new('>'.$source.'.meta')) {          unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
             $r->print(               $r->print( 
                 '<font color="red">'.&mt('Could not write metadata, FAIL').                  '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
  '</font>');   '</span>');
     return 0;      return 0;
         }          }
         foreach (sort keys %metadatafields) {          foreach (sort keys %metadatafields) {
Line 1555  sub phasetwo { Line 1558  sub phasetwo {
         unless ($srcd=~/^\/home\/httpd\/html\/res/) {          unless ($srcd=~/^\/home\/httpd\/html\/res/) {
             print $logfile "\nPANIC: Target dir is ".$srcd;              print $logfile "\nPANIC: Target dir is ".$srcd;
             $r->print(              $r->print(
  "<font color=\"red\">Invalid target directory, FAIL</font>");   "<span class=\"LC_error\">Invalid target directory, FAIL</span>");
     return 0;      return 0;
         }          }
         opendir(DIR,$srcd);          opendir(DIR,$srcd);
Line 1581  sub phasetwo { Line 1584  sub phasetwo {
             $r->print('<p>'.&mt('Copied old target file').'</p>');              $r->print('<p>'.&mt('Copied old target file').'</p>');
         } else {          } else {
     print $logfile "Unable to write ".$copyfile.':'.$!."\n";      print $logfile "Unable to write ".$copyfile.':'.$!."\n";
             $r->print("<font color=\"red\">".&mt('Failed to copy old target').              $r->print("<span class=\"LC_error\">".&mt('Failed to copy old target').
  ", $!, ".&mt('FAIL')."</font>");   ", $!, ".&mt('FAIL')."</span>");
     return 0;      return 0;
         }          }
                   
Line 1597  sub phasetwo { Line 1600  sub phasetwo {
     print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";      print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
             if (-e $target.'.meta') {              if (-e $target.'.meta') {
                 $r->print(                   $r->print( 
                     "<font color=\"red\">".                      "<span class=\"LC_error\">".
 &mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</font>");  &mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</span>");
  return 0;   return 0;
     }      }
         }          }
Line 1630  sub phasetwo { Line 1633  sub phasetwo {
         $r->print('<p>'.&mt('Copied source file').'</p>');          $r->print('<p>'.&mt('Copied source file').'</p>');
     } else {      } else {
         print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
         $r->print("<font color=\"red\">".          $r->print("<span class=\"LC_error\">".
     &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>");      &mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>");
  return 0;   return 0;
     }      }
           
Line 1645  sub phasetwo { Line 1648  sub phasetwo {
     } else {      } else {
         print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
         $r->print(          $r->print(
             "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>");              "<span class=\"LC_error\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</span>");
  return 0;   return 0;
     }      }
     $r->rflush;      $r->rflush;
Line 1668  sub phasetwo { Line 1671  sub phasetwo {
     unless ($batch) {      unless ($batch) {
                   
         my $thissrc=$source;          my $thissrc=$source;
         $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;          $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};
                   
         my $thissrcdir=$thissrc;          my $thissrcdir=$thissrc;
         $thissrcdir=~s/\/[^\/]+$/\//;          $thissrcdir=~s/\/[^\/]+$/\//;
Line 1823  sub publishdirectory { Line 1826  sub publishdirectory {
     my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];      my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
     my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];      my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
     if ( $meta_rmtime<$meta_cmtime ) {      if ( $meta_rmtime<$meta_cmtime ) {
  &Apache::lonnet::logthis("meta change!");  
  $publishthis=1;   $publishthis=1;
     }      }
  } else {   } else {
Line 1879  sub defaultmetapublish { Line 1881  sub defaultmetapublish {
     if (copy($fn,$copyfile)) {      if (copy($fn,$copyfile)) {
         $r->print('<p>'.&mt('Copied source file').'</p>');          $r->print('<p>'.&mt('Copied source file').'</p>');
     } else {      } else {
         return "<font color=\"red\">".          return "<span class=\"LC_error\">".
     &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";      &mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>";
     }      }
   
 # --------------------------------------------------- Send update notifications  # --------------------------------------------------- Send update notifications
Line 1994  sub handler { Line 1996  sub handler {
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
     }      }
   
     $fn=~s/^http\:\/\/[^\/]+//;      $fn=~s{^http://[^/]+}{};
     $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;      $fn=~s{^/~($match_username)}{/home/$1/public_html};
   
     my $targetdir='';      my $targetdir='';
     $docroot=$r->dir_config('lonDocRoot');       $docroot=$r->dir_config('lonDocRoot'); 
Removed from v.1.212  
changed lines
  Added in v.1.226

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.