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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.166 and 1.196

version 1.166, 2004/04/14 18:29:32 version 1.196, 2005/05/30 16:56:46
Line 121  use HTML::LCParser; Line 121  use HTML::LCParser;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::loncacc;  use Apache::loncacc;
 use DBI;  use DBI;
 use Apache::lonnet();  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonlocal;  use Apache::lonlocal;
Line 138  my $docroot; Line 138  my $docroot;
 my $cuname;  my $cuname;
 my $cudom;  my $cudom;
   
   my $registered_cleanup;
   my $modified_urls;
   
 =pod  =pod
   
 =item B<metaeval>  =item B<metaeval>
Line 199  sub metaeval { Line 202  sub metaeval {
  }   }
     }      }
     my $newentry=$parser->get_text('/'.$entry);      my $newentry=$parser->get_text('/'.$entry);
     if ($entry eq 'customdistributionfile') {      if (($entry eq 'customdistributionfile') ||
    ($entry eq 'sourcerights')) {
  $newentry=~s/^\s*//;   $newentry=~s/^\s*//;
  if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }   if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
     }      }
Line 322  sub textfield { Line 326  sub textfield {
     $value=~s/\s+$//gs;      $value=~s/\s+$//gs;
     $value=~s/\s+/ /gs;      $value=~s/\s+/ /gs;
     $title=&mt($title);      $title=&mt($title);
       $env{'form.'.$name}=$value;
     return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".      return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
            "</b></font></p><br />".             "</b></font></p><br />".
            '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';             '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';
 }  }
   
   sub text_with_browse_field {
       my ($title,$name,$value,$restriction)=@_;
       $value=~s/^\s+//gs;
       $value=~s/\s+$//gs;
       $value=~s/\s+/ /gs;
       $title=&mt($title);
       $env{'form.'.$name}=$value;
       return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
              "</b></font></p><br />".
              '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />'.
      '<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">Select</a>&nbsp;'.
      '<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">Search</a>';
      
   }
   
 sub hiddenfield {  sub hiddenfield {
     my ($name,$value)=@_;      my ($name,$value)=@_;
       $env{'form.'.$name}=$value;
     return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';      return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
 }  }
   
   sub checkbox {
       my ($name,$text)=@_;
       return "\n<br /><input type='checkbox' name='$name' /> ".&mt($text);
   }
   
 sub selectbox {  sub selectbox {
     my ($title,$name,$value,$functionref,@idlist)=@_;      my ($title,$name,$value,$functionref,@idlist)=@_;
     $title=&mt($title);      $title=&mt($title);
     $value=(split(/\s*,\s*/,$value))[-1];      $value=(split(/\s*,\s*/,$value))[-1];
       if (defined($value)) {
    $env{'form.'.$name}=$value;
       } else {
    $env{'form.'.$name}=$idlist[0];
       }
     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".      my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
  '</b></font></p><br /><select name="'.$name.'">';   '</b></font></p><br /><select name="'.$name.'">';
     foreach (@idlist) {      foreach (@idlist) {
Line 348  sub selectbox { Line 379  sub selectbox {
     return $selout.'</select>';      return $selout.'</select>';
 }  }
   
   sub select_level_form {
       my ($value,$name)=@_;
       $env{'form.'.$name}=$value;
       if (!defined($value)) { $env{'form.'.$name}=0; }
       return  &Apache::loncommon::select_level_form($value,$name);
   }
 #########################################  #########################################
 #########################################  #########################################
   
Line 458  sub get_subscribed_hosts { Line 495  sub get_subscribed_hosts {
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename=~/\Q$srcf\E\.(\w+)$/) {   if ($filename=~/\Q$srcf\E\.(\w+)$/) {
     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 $Apache::lonnet::perlvar{'lonHostID'})) {                  ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
  push(@subscribed,$subhost);   push(@subscribed,$subhost);
     }      }
Line 515  sub get_max_ids_indices { Line 553  sub get_max_ids_indices {
     my $counter;      my $counter;
     if ($counter=$addid{$token->[1]}) {      if ($counter=$addid{$token->[1]}) {
  if ($counter eq 'id') {   if ($counter eq 'id') {
     if (defined($token->[2]->{'id'})) {      if (defined($token->[2]->{'id'}) &&
    $token->[2]->{'id'} !~ /^\s*$/) {
  $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;   $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
  if (exists($allids{$token->[2]->{'id'}})) {   if (exists($allids{$token->[2]->{'id'}})) {
     $duplicateids=1;      $duplicateids=1;
Line 527  sub get_max_ids_indices { Line 566  sub get_max_ids_indices {
  $needsfixup=1;   $needsfixup=1;
     }      }
  } else {   } else {
     if (defined($token->[2]->{'index'})) {      if (defined($token->[2]->{'index'}) &&
    $token->[2]->{'index'} !~ /^\s*$/) {
  $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;   $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
     } else {      } else {
  $needsfixup=1;   $needsfixup=1;
Line 569  sub get_all_text_unbalanced { Line 609  sub get_all_text_unbalanced {
  } elsif ($token->[0] eq 'E')  {   } elsif ($token->[0] eq 'E')  {
     $result.=$token->[2];      $result.=$token->[2];
  }   }
  if ($result =~ /(.*)\Q$tag\E(.*)/s) {   if ($result =~ /\Q$tag\E/s) {
       ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
     #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);      #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
     #&Apache::lonnet::logthis('Result is :'.$1);      #&Apache::lonnet::logthis('Result is :'.$1);
     $result=$1;      $redo=$tag.$redo;
     my $redo=$tag.$2;  
     push (@$pars,HTML::LCParser->new(\$redo));      push (@$pars,HTML::LCParser->new(\$redo));
     $$pars[-1]->xml_mode('1');      $$pars[-1]->xml_mode('1');
     last;      last;
Line 641  sub fix_ids_and_indices { Line 681  sub fix_ids_and_indices {
  if (!$counter) { $counter=$addid{$lctag}; }   if (!$counter) { $counter=$addid{$lctag}; }
  if ($counter) {   if ($counter) {
     if ($counter eq 'id') {      if ($counter eq 'id') {
  unless (defined($parms{'id'})) {   unless (defined($parms{'id'}) &&
    $parms{'id'}!~/^\s*$/) {
     $maxid++;      $maxid++;
     $parms{'id'}=$maxid;      $parms{'id'}=$maxid;
     print $logfile 'ID: '.$tag.':'.$maxid."\n";      print $logfile 'ID: '.$tag.':'.$maxid."\n";
  }   }
     } elsif ($counter eq 'index') {      } elsif ($counter eq 'index') {
  unless (defined($parms{'index'})) {   unless (defined($parms{'index'}) &&
    $parms{'index'}!~/^\s*$/) {
     $maxindex++;      $maxindex++;
     $parms{'index'}=$maxindex;      $parms{'index'}=$maxindex;
     print $logfile 'Index: '.$tag.':'.$maxindex."\n";      print $logfile 'Index: '.$tag.':'.$maxindex."\n";
Line 788  sub store_metadata { Line 830  sub store_metadata {
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
       my $dbh = &Apache::lonmysql::get_dbh();
     if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') ||      if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') ||
  ($metadata{'copyright'} eq 'custom')) {   ($metadata{'copyright'} eq 'custom')) {
 # remove this entry          # remove this entry
  $status=&Apache::lonmysql::remove_from_table   $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,
     ('metadata','url',$metadata{'url'});                                                         $metadata{'url'});
     } else {      } else {
 # store new data          $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,
 # adjust some values to metadatadatabase (e.g., "usage" is a reserved word)                                                           \%metadata);
  $metadata{'creationdate'}=  
     &Apache::lonmysql::sqltime($metadata{'creationdate'});   
  $metadata{'lastrevisiondate'}=  
     &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});  
  $metadata{'sequsage'}=$metadata{'usage'};  
  $metadata{'sequsage_list'}=$metadata{'usage_list'};  
  my %newmetadata=();  
 # see if we have old entries  
  my @oldmeta=&Apache::lonmysql::get_rows('metadata',  
  "url LIKE BINARY '".  
  $metadata{'url'}."'");  
  if ($#oldmeta==0) {  
 # yes, there is one old entry, transfer to newmetadata  
     %newmetadata=&LONCAPA::lonmetadata::metadata_col_to_hash(@{$oldmeta[0]});  
 # remove old entry  
     $status=&Apache::lonmysql::remove_from_table  
  ('metadata','url',$metadata{'url'});  
  } elsif ($#oldmeta>0) {  
 # more than one entry fit - how did that happen?  
     $error='<font color="red">Error occured retrieving old values in '.  
       'metadata table in LON-CAPA database: '.$#oldmeta.  
       ' matches</font>';  
     &Apache::lonnet::logthis($error);  
     return ($error,undef);  
  }  
 # store new data on top of it  
  foreach (keys %metadata) {  
     $newmetadata{$_}=$metadata{$_};  
  }  
  $status = &Apache::lonmysql::store_row('metadata',\%newmetadata);  
     }      }
     if (! defined($status)) {      if (defined($status) && $status ne '') {
         $error='<font color="red">Error occured storing new values in '.          $error='<font color="red">Error occured storing new values in '.
             'metadata table in LON-CAPA database</font>';              'metadata table in LON-CAPA database</font>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
           &Apache::lonnet::logthis($status);
         return ($error,undef);          return ($error,undef);
     }      }
     return (undef,$status);      return (undef,$status);
 }  }
   
   
   # ========================================== Parse file for errors and warnings
   
   sub checkonthis {
       my ($r,$source)=@_;
       my $uri=&Apache::lonnet::hreflocation($source);
       $uri=~s/\/$//;
       my $result=&Apache::lonnet::ssi_body($uri,
    ('grade_target'=>'web',
     'return_only_error_and_warning_counts' => 1));
       my ($errorcount,$warningcount)=split(':',$result);
       if (($errorcount) || ($warningcount)) {
           $r->print('<br /><tt>'.$uri.'</tt>: ');
    if ($errorcount) {
       $r->print('<img src="/adm/lonMisc/bomb.gif" /><font color="red"><b>'.
         $errorcount.' '.
         &mt('error(s)').'</b></font> ');
    }
    if ($warningcount) {
       $r->print('<font color="blue">'.
         $warningcount.' '.
         &mt('warning(s)').'</font>');
    }
       } else {
    #$r->print('<font color="green">'.&mt('ok').'</font>');
       }
       $r->rflush();
       return ($warningcount,$errorcount);
   }
   
 # ============================================== Parse file itself for metadata  # ============================================== Parse file itself for metadata
 #  #
 # parses a file with target meta, sets global %metadatafields %metadatakeys   # parses a file with target meta, sets global %metadatafields %metadatakeys 
Line 890  sub publish { Line 933  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 943  sub publish { Line 986  sub publish {
        }         }
            }             }
         }          }
         $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;          $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
   
 # ------------------------------------------------------------- Write modified.  # ------------------------------------------------------------- Write modified.
   
Line 977  sub publish { Line 1020  sub publish {
     }      }
   
 # ------------------------------------------------ First, check out environment  # ------------------------------------------------ First, check out environment
      unless (-e $source.'.meta') {       if ((!(-e $source.'.meta')) || ($env{'form.forceoverride'})) {
         $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.          $metadatafields{'author'}=$env{'environment.firstname'}.' '.
                           $ENV{'environment.middlename'}.' '.                            $env{'environment.middlename'}.' '.
                   $ENV{'environment.lastname'}.' '.                    $env{'environment.lastname'}.' '.
                   $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;
Line 1002  sub publish { Line 1045  sub publish {
             $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);              $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
     $prefix=~s|^\.\./||;      $prefix=~s|^\.\./||;
         }          }
   
 # ----------------------------------------------------------- Parse file itself  # ----------------------------------------------------------- Parse file itself
 # read %metadatafields from file itself  # read %metadatafields from file itself
     
Line 1026  sub publish { Line 1070  sub publish {
  delete $metadatafields{$_};   delete $metadatafields{$_};
             }              }
         }          }
   # ------------------------------------------------------------- Save some stuff
           my %savemeta=();
           foreach ('title') {
               $savemeta{$_}=$metadatafields{$_};
    }
 # ------------------------------------------ See if anything new in file itself  # ------------------------------------------ See if anything new in file itself
     
  $allmeta=&parseformeta($source,$style);   $allmeta=&parseformeta($source,$style);
   # ----------------------------------------------------------- Restore the stuff
           foreach (keys %savemeta) {
       $metadatafields{$_}=$savemeta{$_};
    }
    }     }
   
                 
Line 1089  sub publish { Line 1141  sub publish {
     }      }
   
                           
     foreach (split(/\W+/,$metadatafields{'keywords'})) {      foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
  $keywords{$_}=1;   $addkey=~s/\s+/ /g;
    $addkey=~s/^\s//;
    $addkey=~s/\s$//;
    if ($addkey=~/\w/) {
       $keywords{$addkey}=1;
    }
     }      }
 # --------------------------------------------------- Now we also have keywords  # --------------------------------------------------- Now we also have keywords
 # =============================================================================  # =============================================================================
 # INTERACTIVE MODE  # interactive mode html goes into $intr_scrout
 #  # batch mode throws away this HTML
     unless ($batch) {  # additionally all of the field functions have a by product of setting
         $scrout.=  #   $env{'from.'..} so that it can be used by the phase two handler in
     '<form name="pubform" action="/adm/publish" method="post">'.  #    batch mode
             '<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.  
             &hiddenfield('phase','two').      my $intr_scrout.=
             &hiddenfield('filename',$ENV{'form.filename'}).   '<form name="pubform" action="/adm/publish" method="post">'.
     &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).   '<p>'.($env{'form.makeobsolete'}?'':'<input type="submit" value="'.&mt('Finalize Publication').'" />').'</p>'.
             &hiddenfield('dependencies',join(',',keys %allow)).   &hiddenfield('phase','two').
             &textfield('Title','title',$metadatafields{'title'}).   &hiddenfield('filename',$env{'form.filename'}).
             &textfield('Author(s)','author',$metadatafields{'author'}).   &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
     &textfield('Subject','subject',$metadatafields{'subject'});   &hiddenfield('dependencies',join(',',keys %allow));
       unless ($env{'form.makeobsolete'}) {
 # --------------------------------------------------- Scan content for keywords         $intr_scrout.=
    &textfield('Title','title',$metadatafields{'title'}).
         my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");   &textfield('Author(s)','author',$metadatafields{'author'}).
         my $KEYWORDS=&mt('Keywords');   &textfield('Subject','subject',$metadatafields{'subject'});
  my $CheckAll=&mt('check all');   # --------------------------------------------------- Scan content for keywords
  my $UncheckAll=&mt('uncheck all');  
  my $keywordout=<<"END";      my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
       my $KEYWORDS=&mt('Keywords');
       my $CheckAll=&mt('check all');
       my $UncheckAll=&mt('uncheck all');
       my $keywordout=<<"END";
 <script>  <script>
 function checkAll(field) {  function checkAll(field) {
     for (i = 0; i < field.length; i++)      for (i = 0; i < field.length; i++)
Line 1133  function uncheckAll(field) { Line 1194  function uncheckAll(field) {
 </p>  </p>
 <br />  <br />
 END  END
  $keywordout.='<table border="2"><tr>';      $keywordout.='<table border="2"><tr>';
  my $colcount=0;      my $colcount=0;
   
  foreach (sort keys %keywords) {      foreach (sort keys %keywords) {
     $keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';   $keywordout.='<td><label><input type="checkbox" name="keywords" value="'.$_.'"';
     if ($metadatafields{'keywords'}) {   if ($metadatafields{'keywords'}) {
  if ($metadatafields{'keywords'}=~/\Q$_\E/) {      if ($metadatafields{'keywords'}=~/\Q$_\E/) {
     $keywordout.=' checked="on"';  
  }  
     } elsif (&Apache::loncommon::keyword($_)) {  
  $keywordout.=' checked="on"';   $keywordout.=' checked="on"';
    $env{'form.keywords'}.=$_.',';
     }      }
     $keywordout.=' />'.$_.'</td>';   } elsif (&Apache::loncommon::keyword($_)) {
     if ($colcount>10) {      $keywordout.=' checked="on"';
  $keywordout.="</tr><tr>\n";      $env{'form.keywords'}.=$_.',';
  $colcount=0;  
     }  
     $colcount++;  
  }   }
    $keywordout.=' />'.$_.'</label></td>';
    if ($colcount>10) {
       $keywordout.="</tr><tr>\n";
       $colcount=0;
    }
    $colcount++;
       }
       $env{'form.keywords'}=~s/\,$//;
   
  $keywordout.='</tr></table>';      $keywordout.='</tr></table>';
   
  $scrout.=$keywordout;      $intr_scrout.=$keywordout;
   
  $scrout.=&textfield('Additional Keywords','addkey','');      $intr_scrout.=&textfield('Additional Keywords','addkey','');
   
  $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});      $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
   
  $scrout.=      $intr_scrout.=
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".&mt('Abstract').":".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".&mt('Abstract').":".
     "</b></font></p><br />".   "</b></font></p><br />".
     '<textarea cols="80" rows="5" name="abstract">'.   '<textarea cols="80" rows="5" name="abstract">'.
     $metadatafields{'abstract'}.'</textarea></p>';   $metadatafields{'abstract'}.'</textarea></p>';
   
  $source=~/\.(\w+)$/;      $source=~/\.(\w+)$/;
   
   
  $scrout.=      $intr_scrout.=
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
     &mt('Lowest Grade Level').':'.   &mt('Lowest Grade Level').':'.
            "</b></font></p><br />".   "</b></font></p><br />".
    &Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').   &select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
     &mt('Highest Grade Level').':'.   &mt('Highest Grade Level').':'.
            "</b></font></p><br />".   "</b></font></p><br />".
    &Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').   &select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
            &textfield('Standards','standards',$metadatafields{'standards'});   &textfield('Standards','standards',$metadatafields{'standards'});
   
   
   
   
  $scrout.=&hiddenfield('mime',$1);      $intr_scrout.=&hiddenfield('mime',$1);
   
  my $defaultlanguage=$metadatafields{'language'};      my $defaultlanguage=$metadatafields{'language'};
  $defaultlanguage =~ s/\s*notset\s*//g;      $defaultlanguage =~ s/\s*notset\s*//g;
  $defaultlanguage =~ s/^,\s*//g;      $defaultlanguage =~ s/^,\s*//g;
  $defaultlanguage =~ s/,\s*$//g;      $defaultlanguage =~ s/,\s*$//g;
   
  $scrout.=&selectbox('Language','language',      $intr_scrout.=&selectbox('Language','language',
     $defaultlanguage,       $defaultlanguage,
     \&Apache::loncommon::languagedescription,       \&Apache::loncommon::languagedescription,
     (&Apache::loncommon::languageids),       (&Apache::loncommon::languageids),
    );       );
   
  unless ($metadatafields{'creationdate'}) {      unless ($metadatafields{'creationdate'}) {
     $metadatafields{'creationdate'}=time;   $metadatafields{'creationdate'}=time;
  }      }
  $scrout.=&hiddenfield('creationdate',      $intr_scrout.=&hiddenfield('creationdate',
       &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));         &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));
   
  $scrout.=&hiddenfield('lastrevisiondate',time);      $intr_scrout.=&hiddenfield('lastrevisiondate',time);
   
   
  $scrout.=&textfield('Publisher/Owner','owner',      $intr_scrout.=&textfield('Publisher/Owner','owner',
     $metadatafields{'owner'});       $metadatafields{'owner'});
   
   # ---------------------------------------------- Retrofix for unused copyright
       if ($metadatafields{'copyright'} eq 'free') {
    $metadatafields{'copyright'}='default';
    $metadatafields{'sourceavail'}='open';
       }
   # ------------------------------------------------ Dial in reasonable defaults
       my $defaultoption=$metadatafields{'copyright'};
       unless ($defaultoption) { $defaultoption='default'; }
       my $defaultsourceoption=$metadatafields{'sourceavail'};
       unless ($defaultsourceoption) { $defaultsourceoption='closed'; }
       unless ($style eq 'prv') {
 # -------------------------------------------------- Correct copyright for rat.  # -------------------------------------------------- Correct copyright for rat.
         my $defaultoption=$metadatafields{'copyright'};   if ($style eq 'rat') {
         unless ($defaultoption) { $defaultoption='default'; }  # -------------------------------------- Retrofix for non-applicable copyright
  unless ($style eq 'prv') {      if ($metadatafields{'copyright'} eq 'public') { 
     if ($style eq 'rat') {   delete $metadatafields{'copyright'};
  if ($metadatafields{'copyright'} eq 'public') {    $defaultoption='default';
     delete $metadatafields{'copyright'};      }
                     $defaultoption='default';      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
  }       $defaultoption,
  $scrout.=&selectbox('Copyright/Distribution','copyright',       \&Apache::loncommon::copyrightdescription,
     $defaultoption,  
     \&Apache::loncommon::copyrightdescription,  
     (grep !/^public$/,(&Apache::loncommon::copyrightids)));      (grep !/^public$/,(&Apache::loncommon::copyrightids)));
     } else {  
  $scrout.=&selectbox('Copyright/Distribution','copyright',  
     $defaultoption,  
     \&Apache::loncommon::copyrightdescription,  
     (&Apache::loncommon::copyrightids));  
     }  
       
     my $copyright_help =  
  Apache::loncommon::help_open_topic('Publishing_Copyright');  
     $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;  
     $scrout.=&textfield('Custom Distribution File','customdistributionfile',  
  $metadatafields{'customdistributionfile'}).  
     $copyright_help;  
     my $uctitle=&mt('Obsolete');  
             $scrout.=  
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".  
  '</b></font> <input type="checkbox" name="obsolete" ';  
     if ($metadatafields{'obsolete'}) {  
  $scrout.=' checked="1" ';  
     }  
     $scrout.='/ ></p>'.  
  &textfield('Suggested Replacement for Obsolete File',  
     'obsoletereplacement',  
     $metadatafields{'obsoletereplacement'});  
  } else {   } else {
     $scrout.=&hiddenfield('copyright','private');      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
        $defaultoption,
        \&Apache::loncommon::copyrightdescription,
        (&Apache::loncommon::copyrightids));
    }
    my $copyright_help =
       Apache::loncommon::help_open_topic('Publishing_Copyright');
    $intr_scrout =~ s/Distribution:/'Distribution: ' . $copyright_help/ge;
    $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help;
    $intr_scrout.=&selectbox('Source Distribution','sourceavail',
    $defaultsourceoption,
    \&Apache::loncommon::source_copyrightdescription,
    (&Apache::loncommon::source_copyrightids));
    $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
    my $uctitle=&mt('Obsolete');
    $intr_scrout.=
       "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
       '</b></font> <input type="checkbox" name="obsolete" ';
    if ($metadatafields{'obsolete'}) {
       $intr_scrout.=' checked="1" ';
  }   }
  return ($scrout.'<p><input type="submit" value="'.   $intr_scrout.='/ ></p>'.
  &mt('Finalize Publication').'" /></p></form>',0);      &text_with_browse_field('Suggested Replacement for Obsolete File',
 # =============================================================================      'obsoletereplacement',
 # BATCH MODE      $metadatafields{'obsoletereplacement'});
 #  
     } else {      } else {
 # Transfer metadata directly to environment for stage 2   $intr_scrout.=&hiddenfield('copyright','private');
  foreach (keys %metadatafields) {      }
     $ENV{'form.'.$_}=$metadatafields{$_};     } else {
  }         $intr_scrout.=
  $ENV{'form.addkey'}='';   &hiddenfield('title',$metadatafields{'title'}).
  $ENV{'form.keywords'}='';   &hiddenfield('author',$metadatafields{'author'}).
  foreach (keys %keywords) {   &hiddenfield('subject',$metadatafields{'subject'}).
     if ($metadatafields{'keywords'}) {   &hiddenfield('keywords',$metadatafields{'keywords'}).
  if ($metadatafields{'keywords'}=~/\Q$_\E/) {    &hiddenfield('abstract',$metadatafields{'abstract'}).
     $ENV{'form.keywords'}.=$_.',';    &hiddenfield('notes',$metadatafields{'notes'}).
  }   &hiddenfield('mime',$metadatafields{'mime'}).
     } elsif (&Apache::loncommon::keyword($_)) {   &hiddenfield('creationdate',$metadatafields{'creationdate'}).
  $ENV{'form.keywords'}.=$_.',';   &hiddenfield('lastrevisiondate',time).
     }   &hiddenfield('owner',$metadatafields{'owner'}).
  }   &hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}).
  $ENV{'form.keywords'}=~s/\,$//;   &hiddenfield('standards',$metadatafields{'standards'}).
  unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }   &hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}).
  $ENV{'form.lastrevisiondate'}=time;   &hiddenfield('language',$metadatafields{'language'}).
  if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) ||   &hiddenfield('copyright',$metadatafields{'copyright'}).
     (!$ENV{'form.copyright'})) {    &hiddenfield('sourceavail',$metadatafields{'sourceavail'}).
     $ENV{'form.copyright'}='default';   &hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}).
  }   &hiddenfield('obsolete',1).
  $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);   &text_with_browse_field('Suggested Replacement for Obsolete File',
  return ($scrout,0);      'obsoletereplacement',
       $metadatafields{'obsoletereplacement'});
      }
       if (!$batch) {
    $scrout.=$intr_scrout.'<p><input type="submit" value="'.
       &mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication').'" /></p></form>';
     }      }
       return($scrout,0);
 }  }
   
 #########################################  #########################################
Line 1325  sub phasetwo { Line 1398  sub phasetwo {
     my ($r,$source,$target,$style,$distarget,$batch)=@_;      my ($r,$source,$target,$style,$distarget,$batch)=@_;
     $source=~s/\/+/\//g;      $source=~s/\/+/\//g;
     $target=~s/\/+/\//g;      $target=~s/\/+/\//g;
   #
     if ($target=~/\_\_\_/) {  # Unless trying to get rid of something, check name validity
  $r->print(  #
  '<font color="red">'.&mt('Unsupported character combination').      unless ($env{'form.obsolete'}) {
   ' "<tt>___</tt>" '.&mt('in filename, FAIL').'</font>');   if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
         return 0;      $r->print(
         '<font color="red">'.&mt('Unsupported character combination').
         ' "<tt>'.$1.'</tt>" '.&mt('in filename, FAIL').'</font>');
       return 0;
    }
    unless ($target=~/\.(\w+)$/) {
       $r->print('<font color="red">'.&mt('No valid extension found in filename, FAIL').'</font>');
       return 0;
    }
    if ($target=~/\.(\d+)\.(\w+)$/) {
       $r->print('<font color="red">'.&mt('Cannot publish versioned resource, FAIL').'</font>');
       return 0;
    }
     }      }
   
   #
   # End name check
   #
     $distarget=~s/\/+/\//g;      $distarget=~s/\/+/\//g;
     my $logfile;      my $logfile;
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
Line 1341  sub phasetwo { Line 1430  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(&Apache::lonnet::unescape($ENV{'form.allmeta'}));      $metadatafields{'title'}=$env{'form.title'};
           $metadatafields{'author'}=$env{'form.author'};
     $metadatafields{'title'}=$ENV{'form.title'};      $metadatafields{'subject'}=$env{'form.subject'};
     $metadatafields{'author'}=$ENV{'form.author'};      $metadatafields{'notes'}=$env{'form.notes'};
     $metadatafields{'subject'}=$ENV{'form.subject'};      $metadatafields{'abstract'}=$env{'form.abstract'};
     $metadatafields{'notes'}=$ENV{'form.notes'};      $metadatafields{'mime'}=$env{'form.mime'};
     $metadatafields{'abstract'}=$ENV{'form.abstract'};      $metadatafields{'language'}=$env{'form.language'};
     $metadatafields{'mime'}=$ENV{'form.mime'};      $metadatafields{'creationdate'}=$env{'form.creationdate'};
     $metadatafields{'language'}=$ENV{'form.language'};      $metadatafields{'lastrevisiondate'}=$env{'form.lastrevisiondate'};
     $metadatafields{'creationdate'}=$ENV{'form.creationdate'};      $metadatafields{'owner'}=$env{'form.owner'};
     $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};      $metadatafields{'copyright'}=$env{'form.copyright'};
     $metadatafields{'owner'}=$ENV{'form.owner'};      $metadatafields{'standards'}=$env{'form.standards'};
     $metadatafields{'copyright'}=$ENV{'form.copyright'};      $metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'};
     $metadatafields{'standards'}=$ENV{'form.standards'};      $metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'};
     $metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};  
     $metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};  
     $metadatafields{'customdistributionfile'}=      $metadatafields{'customdistributionfile'}=
                                  $ENV{'form.customdistributionfile'};                                   $env{'form.customdistributionfile'};
     $metadatafields{'obsolete'}=$ENV{'form.obsolete'};      $metadatafields{'sourceavail'}=$env{'form.sourceavail'};
       $metadatafields{'obsolete'}=$env{'form.obsolete'};
     $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;
           
     my $allkeywords=$ENV{'form.addkey'};      my $allkeywords=$env{'form.addkey'};
     if (exists($ENV{'form.keywords'})) {      if (exists($env{'form.keywords'})) {
         if (ref($ENV{'form.keywords'})) {          if (ref($env{'form.keywords'})) {
             $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});              $allkeywords .= ','.join(',',@{$env{'form.keywords'}});
         } else {          } else {
             $allkeywords .= ','.$ENV{'form.keywords'};              $allkeywords .= ','.$env{'form.keywords'};
         }          }
     }      }
     $allkeywords=~s/\W+/\,/;      $allkeywords=~s/[\"\']//g;
     $allkeywords=~s/^\,//;      $allkeywords=~s/\s*[\;\,]\s*/\,/g;
       $allkeywords=~s/\s+/ /g;
       $allkeywords=~s/^[ \,]//;
       $allkeywords=~s/[ \,]$//;
     $metadatafields{'keywords'}=$allkeywords;      $metadatafields{'keywords'}=$allkeywords;
           
 # check if custom distribution file is specified  # check if custom distribution file is specified
Line 1539  sub phasetwo { Line 1632  sub phasetwo {
             "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";              "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";
     }      }
     $r->rflush;      $r->rflush;
 # --------------------------------------------------- Send update notifications  
   
     my @subscribed=&get_subscribed_hosts($target);  
     foreach my $subhost (@subscribed) {  
  $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;  
  print $logfile "\nNotifying host ".$subhost.':';  
  my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);  
  $r->print($reply.'</p><br />');$r->rflush;  
  print $logfile $reply;  
     }  
       
 # ---------------------------------------- Send update notifications, meta only  
   
     my @subscribedmeta=&get_subscribed_hosts("$target.meta");  # ------------------------------------------------------------- Trigger updates
     foreach my $subhost (@subscribedmeta) {      push(@{$modified_urls},[$target,$source]);
  $r->print('<p>'.      unless ($registered_cleanup) {
 &mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush;   $r->register_cleanup(\&notify);
  print $logfile "\nNotifying host for metadata only ".$subhost.':';   $registered_cleanup=1;
  my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',  
     $subhost);  
  $r->print($reply.'</p><br />');$r->rflush;  
  print $logfile $reply;  
     }  
       
 # --------------------------------------------------- Notify subscribed courses  
     my %courses=&coursedependencies($target);  
     my $now=time;  
     foreach (keys %courses) {  
  $r->print('<p>'.&mt('Notifying course').' '.$_.':');$r->rflush;  
  print $logfile "\nNotifying host ".$_.':';  
         my ($cdom,$cname)=split(/\_/,$_);  
  my $reply=&Apache::lonnet::cput  
                   ('versionupdate',{$target => $now},$cdom,$cname);  
  $r->print($reply.'</p><br />');$r->rflush;  
  print $logfile $reply;  
     }      }
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
     unless ($batch) {      unless ($batch) {
Line 1596  sub phasetwo { Line 1660  sub phasetwo {
                    '"><font size="+2">'.                     '"><font size="+2">'.
   &mt('Back to Source Directory').'</font></a></p>');    &mt('Back to Source Directory').'</font></a></p>');
     }      }
       $logfile->close();
     return '<p><font color="green">'.&mt('Done').'</font></p>';      return '<p><font color="green">'.&mt('Done').'</font></p>';
 }  }
   
   # =============================================================== Notifications
   sub notify {  
   # --------------------------------------------------- Send update notifications
       foreach my $targetsource (@{$modified_urls}){
    my ($target,$source)=@{$targetsource};
    my $logfile=Apache::File->new('>>'.$source.'.log');
    print $logfile "\nCleanup phase: Notifications\n";
    my @subscribed=&get_subscribed_hosts($target);
    foreach my $subhost (@subscribed) {
       print $logfile "\nNotifying host ".$subhost.':';
       my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
       print $logfile $reply;
    }
   # ---------------------------------------- Send update notifications, meta only
    my @subscribedmeta=&get_subscribed_hosts("$target.meta");
    foreach my $subhost (@subscribedmeta) {
       print $logfile "\nNotifying host for metadata only ".$subhost.':';
       my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
    $subhost);
       print $logfile $reply;
    } 
   # --------------------------------------------------- Notify subscribed courses
    my %courses=&coursedependencies($target);
    my $now=time;
    foreach (keys %courses) {
       print $logfile "\nNotifying course ".$_.':';
       my ($cdom,$cname)=split(/\_/,$_);
       my $reply=&Apache::lonnet::cput
    ('versionupdate',{$target => $now},$cdom,$cname);
       print $logfile $reply;
    }
    print $logfile "\n============ Done ============\n";
    $logfile->close();
       }
       return OK;
   }
   
 #########################################  #########################################
   
 sub batchpublish {  sub batchpublish {
     my ($r,$srcfile,$targetfile)=@_;      my ($r,$srcfile,$targetfile)=@_;
     #publication pollutes %ENV with form.* values      #publication pollutes %env with form.* values
     my %oldENV=%ENV;      my %oldenv=%env;
     $srcfile=~s/\/+/\//g;      $srcfile=~s/\/+/\//g;
     $targetfile=~s/\/+/\//g;      $targetfile=~s/\/+/\//g;
     my $thisdisfn=$srcfile;      my $thisdisfn=$srcfile;
Line 1632  sub batchpublish { Line 1734  sub batchpublish {
     $r->print('<p>'.$outstring.'</p>');      $r->print('<p>'.$outstring.'</p>');
 # phase two takes  # phase two takes
 # my ($source,$target,$style,$distarget,batch)=@_;  # my ($source,$target,$style,$distarget,batch)=@_;
 # $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...  # $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
     if (!$error) {      if (!$error) {
  $r->print('<p>');   $r->print('<p>');
  &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);   &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
  $r->print('</p>');   $r->print('</p>');
     }      }
     %ENV=%oldENV;      %env=%oldenv;
     return '';      return '';
 }  }
   
Line 1655  sub publishdirectory { Line 1757  sub publishdirectory {
       &mt('Target').': <tt>'.$resdir.'</tt><br />');        &mt('Target').': <tt>'.$resdir.'</tt><br />');
   
     my $dirptr=16384; # Mask indicating a directory in stat.cmode.      my $dirptr=16384; # Mask indicating a directory in stat.cmode.
       unless ($env{'form.phase'} eq 'two') {
     opendir(DIR,$fn);  # ask user what they want
     my @files=sort(readdir(DIR));          $r->print('<form name="pubdirpref" method="post">'.
     foreach my $filename (@files) {    &hiddenfield('phase','two').
  my ($cdev,$cino,$cmode,$cnlink,    &hiddenfield('filename',$env{'form.filename'}).
             $cuid,$cgid,$crdev,$csize,    &checkbox('pubrec','include subdirectories').
             $catime,$cmtime,$cctime,    &checkbox('forcerepub','force republication of previously published files').
             $cblksize,$cblocks)=stat($fn.'/'.$filename);                    &checkbox('forceobsolete','make file(s) obsolete').
     &checkbox('forceoverride','force directory level catalog information over existing').
  my $extension='';    '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
  if ($filename=~/\.(\w+)$/) { $extension=$1; }      } else {
  if ($cmode&$dirptr) {  # actually publish things
     if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {   opendir(DIR,$fn);
  &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);   my @files=sort(readdir(DIR));
     }   foreach my $filename (@files) {
  } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&      my ($cdev,$cino,$cmode,$cnlink,
  ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {   $cuid,$cgid,$crdev,$csize,
    $catime,$cmtime,$cctime,
    $cblksize,$cblocks)=stat($fn.'/'.$filename);
       
       my $extension='';
       if ($filename=~/\.(\w+)$/) { $extension=$1; }
       if ($cmode&$dirptr) {
    if (($filename!~/^\./) && ($env{'form.pubrec'})) {
       &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
    }
       } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
        ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
 # find out publication status and/or exiting metadata  # find out publication status and/or exiting metadata
     my $publishthis=0;   my $publishthis=0;
     if (-e $resdir.'/'.$filename) {   if (-e $resdir.'/'.$filename) {
         my ($rdev,$rino,$rmode,$rnlink,      my ($rdev,$rino,$rmode,$rnlink,
     $ruid,$rgid,$rrdev,$rsize,   $ruid,$rgid,$rrdev,$rsize,
     $ratime,$rmtime,$rctime,   $ratime,$rmtime,$rctime,
     $rblksize,$rblocks)=stat($resdir.'/'.$filename);   $rblksize,$rblocks)=stat($resdir.'/'.$filename);
         if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'})) {      if (($rmtime<$cmtime) || ($env{'form.forcerepub'})) {
 # previously published, modified now  # previously published, modified now
     $publishthis=1;   $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 {
  $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');      $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
    }
    $r->rflush();
     }      }
     $r->rflush();  
  }   }
    closedir(DIR);
     }      }
     closedir(DIR);  
 }  }
   
 #########################################  #########################################
Line 1808  sub handler { Line 1922  sub handler {
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                             ['filename']);                                              ['filename']);
   
   # -------------------------------------- Flag and buffer for registered cleanup
       $registered_cleanup=0;
       @{$modified_urls}=();
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
     my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});      my $fn=&Apache::lonnet::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 1829  sub handler { Line 1946  sub handler {
   
     unless (($cuname) && ($cudom)) {      unless (($cuname) && ($cudom)) {
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish file '.$ENV{'form.filename'}.         ' trying to publish file '.$env{'form.filename'}.
        ' ('.$fn.') - not authorized',          ' ('.$fn.') - not authorized', 
        $r->filename);          $r->filename); 
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
Line 1841  sub handler { Line 1958  sub handler {
     foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; }  }      foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; }  }
     unless ($allowed) {      unless ($allowed) {
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish file '.$ENV{'form.filename'}.         ' trying to publish file '.$env{'form.filename'}.
        ' ('.$fn.') - not homeserver ('.$home.')',          ' ('.$fn.') - not homeserver ('.$home.')', 
        $r->filename);          $r->filename); 
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
Line 1855  sub handler { Line 1972  sub handler {
     if ($1 ne $cuname) {      if ($1 ne $cuname) {
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish unowned file '.         ' trying to publish unowned file '.
        $ENV{'form.filename'}.' ('.$fn.')',          $env{'form.filename'}.' ('.$fn.')', 
        $r->filename);          $r->filename); 
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
     } else {      } else {
Line 1866  sub handler { Line 1983  sub handler {
     unless (-e $fn) {       unless (-e $fn) { 
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish non-existing file '.         ' trying to publish non-existing file '.
        $ENV{'form.filename'}.' ('.$fn.')',          $env{'form.filename'}.' ('.$fn.')', 
        $r->filename);          $r->filename); 
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
     unless ($ENV{'form.phase'} eq 'two') {      unless ($env{'form.phase'} eq 'two') {
   
 # -------------------------------- File is there and owned, init lookup tables.  # -------------------------------- File is there and owned, init lookup tables.
   
Line 1901  sub handler { Line 2018  sub handler {
   
     &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>');      my $js=&Apache::loncommon::browser_and_searcher_javascript();
       $r->print('<html><head><title>LON-CAPA Publishing</title>
                 <script type="text/javascript">'.$js.'
                 </script></head>');
     $r->print(&Apache::loncommon::bodytag('Resource Publication'));      $r->print(&Apache::loncommon::bodytag('Resource Publication'));
   
   
Line 1922  sub handler { Line 2042  sub handler {
     if ($fn=~/\/$/) {      if ($fn=~/\/$/) {
 # -------------------------------------------------------- This is a directory  # -------------------------------------------------------- This is a directory
  &publishdirectory($r,$fn,$thisdisfn);   &publishdirectory($r,$fn,$thisdisfn);
  $r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'   $r->print('<hr /><a href="/priv/'
   .$cuname.'/'.$thisdisfn    .$cuname.'/'.$thisdisfn
   .'">'.&mt('Return to Directory').'</a>');    .'">'.&mt('Return to Directory').'</a>');
   
Line 1942  ENDCAPTION Line 2062  ENDCAPTION
         $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.          $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.
   $thisdistarget.'</tt><br />');    $thisdistarget.'</tt><br />');
         
  if (($cuname ne $ENV{'user.name'})||($cudom ne $ENV{'user.domain'})) {   if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
     $r->print('<h3><font color="red">'.&mt('Co-Author').': '.      $r->print('<h3><font color="red">'.&mt('Co-Author').': '.
       $cuname.&mt(' at ').$cudom.'</font></h3>');        $cuname.&mt(' at ').$cudom.'</font></h3>');
  }   }
Line 1957  ENDDIFF Line 2077  ENDDIFF
       
 # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.  # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
   
  unless ($ENV{'form.phase'} eq 'two') {   unless ($env{'form.phase'} eq 'two') {
     my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);  # ---------------------------------------------------------- Parse for problems
     $r->print('<hr />'.$outstring);      my ($warningcount,$errorcount);
       if ($thisembstyle eq 'ssi') {
    ($warningcount,$errorcount)=&checkonthis($r,$thisfn);
       }
       unless ($errorcount) {
    my ($outstring,$error)=
       &publish($thisfn,$thistarget,$thisembstyle);
    $r->print('<hr />'.$outstring);
       } else {
    $r->print('<h3>'.
     &mt('The document contains errors and cannot be published.').
     '</h3>');
       }
  } else {   } else {
     $r->print('<hr />'.      $r->print('<hr />'.
     &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));       &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget)); 
Removed from v.1.166  
changed lines
  Added in v.1.196

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