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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.204 and 1.220

version 1.204, 2006/01/11 20:35:19 version 1.220, 2007/02/21 21:01:59
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 LONCAPA qw(:DEFAULT :match);
    
   
 my %addid;  my %addid;
 my %nokey;  my %nokey;
Line 181  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 278  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 407  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=~/(?:(?:http|https|ftp)\:\/\/)*([^\/]+)/);
     foreach (values %Apache::lonnet::hostname) {      foreach (values %Apache::lonnet::hostname) {
  if ($_ eq $host) {   if ($_ eq $host) {
     $url=~s/^http\:\/\///;      $url=~s/^(?:http|https|ftp)\:\/\///;
             $url=~s/^$host//;              $url=~s/^$host//;
         }          }
     }      }
     if ($url=~/^http\:\/\//) { return $url; }      if ($url=~/^(?:http|https|ftp)\:\/\//) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;      $url=~s/\~$cuname/res\/$cudom\/$cuname/;
     return $url;      return $url;
 }  }
Line 466  sub set_allow { Line 468  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 494  sub get_subscribed_hosts { Line 496  sub get_subscribed_hosts {
     my $srcf=$2;      my $srcf=$2;
     opendir(DIR,$1);      opendir(DIR,$1);
     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 'subscription' &&
  $subhost ne 'tmp') &&   $subhost ne 'tmp') &&
Line 506  sub get_subscribed_hosts { Line 508  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 547  sub get_max_ids_indices { Line 544  sub get_max_ids_indices {
     my %duplicatedids;      my %duplicatedids;
   
     my $parser=HTML::LCParser->new($content);      my $parser=HTML::LCParser->new($content);
       $parser->xml_mode(1);
     my $token;      my $token;
     while ($token=$parser->get_token) {      while ($token=$parser->get_token) {
  if ($token->[0] eq 'S') {   if ($token->[0] eq 'S') {
Line 686  sub fix_ids_and_indices { Line 684  sub fix_ids_and_indices {
  $parms{'id'}!~/^\s*$/) {   $parms{'id'}!~/^\s*$/) {
     $maxid++;      $maxid++;
     $parms{'id'}=$maxid;      $parms{'id'}=$maxid;
     print $logfile 'ID: '.$tag.':'.$maxid."\n";      print $logfile 'ID(new) : '.$tag.':'.$maxid."\n";
    } else {
       print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n";
  }   }
     } elsif ($counter eq 'index') {      } elsif ($counter eq 'index') {
  unless (defined($parms{'index'}) &&   unless (defined($parms{'index'}) &&
Line 715  sub fix_ids_and_indices { Line 715  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 840  sub store_metadata { Line 841  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 '') {
Line 850  sub store_metadata { Line 851  sub store_metadata {
         &Apache::lonnet::logthis($status);          &Apache::lonnet::logthis($status);
         return ($error,undef);          return ($error,undef);
     }      }
     return (undef,$status);      return (undef,'success');
 }  }
   
   
Line 936  sub publish { Line 937  sub publish {
  return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',1);   return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',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";
   
     if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) {      if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) {
 # ------------------------------------------------------- This needs processing  # ------------------------------------------------------- This needs processing
Line 981  sub publish { Line 982  sub publish {
                    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 1030  sub publish { Line 1031  sub publish {
                   $env{'environment.generation'};                    $env{'environment.generation'};
         $metadatafields{'author'}=~s/\s+/ /g;          $metadatafields{'author'}=~s/\s+/ /g;
         $metadatafields{'author'}=~s/\s+$//;          $metadatafields{'author'}=~s/\s+$//;
         $metadatafields{'owner'}=$cuname.'@'.$cudom;          $metadatafields{'owner'}=$cuname.':'.$cudom;
   
 # ------------------------------------------------ Check out directory hierachy  # ------------------------------------------------ Check out directory hierachy
   
Line 1095  sub publish { Line 1096  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.' ';
  }   }
     }      }
  }   }
Line 1111  sub publish { Line 1114  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 stored 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 1165  sub publish { Line 1170  sub publish {
  '<p>'.($env{'form.makeobsolete'}?'':'<input type="submit" value="'.&mt('Finalize Publication').'" />').'</p>'.   '<p>'.($env{'form.makeobsolete'}?'':'<input type="submit" value="'.&mt('Finalize Publication').'" />').'</p>'.
  &hiddenfield('phase','two').   &hiddenfield('phase','two').
  &hiddenfield('filename',$env{'form.filename'}).   &hiddenfield('filename',$env{'form.filename'}).
  &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).   &hiddenfield('allmeta',&escape($allmeta)).
  &hiddenfield('dependencies',join(',',keys %allow));   &hiddenfield('dependencies',join(',',keys %allow));
     unless ($env{'form.makeobsolete'}) {      unless ($env{'form.makeobsolete'}) {
        $intr_scrout.=         $intr_scrout.=
Line 1433  sub phasetwo { Line 1438  sub phasetwo {
         return 0;          return 0;
     }      }
     print $logfile       print $logfile 
         "\n================= Publish ".localtime()." Phase Two  ================\n".$env{'user.name'}.'@'.$env{'user.domain'}."\n";          "\n================= Publish ".localtime()." Phase Two  ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";
           
     %metadatafields=();      %metadatafields=();
     %metadatakeys=();      %metadatakeys=();
   
     &metaeval(&Apache::lonnet::unescape($env{'form.allmeta'}));      &metaeval(&unescape($env{'form.allmeta'}));
           
     $metadatafields{'title'}=$env{'form.title'};      $metadatafields{'title'}=$env{'form.title'};
     $metadatafields{'author'}=$env{'form.author'};      $metadatafields{'author'}=$env{'form.author'};
Line 1461  sub phasetwo { Line 1466  sub phasetwo {
     $metadatafields{'obsoletereplacement'}=      $metadatafields{'obsoletereplacement'}=
                         $env{'form.obsoletereplacement'};                          $env{'form.obsoletereplacement'};
     $metadatafields{'dependencies'}=$env{'form.dependencies'};      $metadatafields{'dependencies'}=$env{'form.dependencies'};
     $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 1662  sub phasetwo { Line 1668  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 1782  sub publishdirectory { Line 1788  sub publishdirectory {
   &hiddenfield('filename',$env{'form.filename'}).    &hiddenfield('filename',$env{'form.filename'}).
   &checkbox('pubrec','include subdirectories').    &checkbox('pubrec','include subdirectories').
   &checkbox('forcerepub','force republication of previously published files').    &checkbox('forcerepub','force republication of previously published files').
                   &checkbox('forceobsolete','make file(s) obsolete').                    &checkbox('obsolete','make file(s) obsolete').
   &checkbox('forceoverride','force directory level catalog information over existing').    &checkbox('forceoverride','force directory level catalog information over existing').
   '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');    '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
     } else {      } else {
Line 1814  sub publishdirectory { Line 1820  sub publishdirectory {
 # previously published, modified now  # previously published, modified now
  $publishthis=1;   $publishthis=1;
     }      }
       my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
       my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
       if ( $meta_rmtime<$meta_cmtime ) {
    $publishthis=1;
       }
  } else {   } else {
 # never published  # never published
     $publishthis=1;      $publishthis=1;
  }   }
   
  if ($publishthis) {   if ($publishthis) {
     &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);      &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
  } else {   } else {
Line 1846  sub defaultmetapublish { Line 1858  sub defaultmetapublish {
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
   
     $r->print('<html><head><title>LON-CAPA Publishing</title></head>');      $r->print(&Apache::loncommon::start_page('Catalog Information Publication'));
     $r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));  
   
 # ---------------------------------------------------------------- Write Source  # ---------------------------------------------------------------- Write Source
     my $copyfile=$target;      my $copyfile=$target;
Line 1883  sub defaultmetapublish { Line 1894  sub defaultmetapublish {
     my $link=$fn;      my $link=$fn;
     $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;      $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;
     $r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');      $r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }  }
 #########################################  #########################################
Line 1945  sub handler { Line 1956  sub handler {
     @{$modified_urls}=();      @{$modified_urls}=();
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
     my $fn=&Apache::lonnet::unescape($env{'form.filename'});      my $fn=&unescape($env{'form.filename'});
   
     ($cuname,$cudom)=      ($cuname,$cudom)=
  &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));   &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
Line 1982  sub handler { Line 1993  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'); 
Line 2006  sub handler { Line 2017  sub handler {
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
     unless ($env{'form.phase'} eq 'two') {  
   
 # -------------------------------- File is there and owned, init lookup tables.  # -------------------------------- File is there and owned, init lookup tables.
   
  %addid=();      %addid=();
       
  {      {
     my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');   my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
     while (<$fh>=~/(\w+)\s+(\w+)/) {   while (<$fh>=~/(\w+)\s+(\w+)/) {
  $addid{$1}=$2;      $addid{$1}=$2;
     }  
  }   }
       }
   
  %nokey=();      %nokey=();
   
  {      {
     my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');   my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
     while (<$fh>) {   while (<$fh>) {
  my $word=$_;      my $word=$_;
  chomp($word);      chomp($word);
  $nokey{$word}=1;      $nokey{$word}=1;
     }  
  }   }
   
     }      }
   
 # ---------------------------------------------------------- Start page output.  # ---------------------------------------------------------- Start page output.
Line 2037  sub handler { Line 2044  sub handler {
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
           
     my $js=&Apache::loncommon::browser_and_searcher_javascript();      my $js='<script type="text/javascript">'.
     $r->print('<html><head><title>LON-CAPA Publishing</title>   &Apache::loncommon::browser_and_searcher_javascript().
               <script type="text/javascript">'.$js.'   '</script>';
               </script></head>');      $r->print(&Apache::loncommon::start_page('Resource Publication',$js));
     $r->print(&Apache::loncommon::bodytag('Resource Publication'));  
   
   
     my $thisfn=$fn;      my $thisfn=$fn;
Line 2116  ENDDIFF Line 2122  ENDDIFF
     $r->print('<hr />');      $r->print('<hr />');
  }   }
     }      }
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page());
   
     return OK;      return OK;
 }  }
Removed from v.1.204  
changed lines
  Added in v.1.220

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