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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.143 and 1.150

version 1.143, 2003/11/04 16:15:56 version 1.150, 2003/12/26 16:27:20
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 #   
 # (TeX Content Handler  
 #  
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  
 #  
 # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer  
 # 03/23 Guy Albertelli  
 # 03/24,03/29,04/03 Gerd Kortemeyer  
 # 05/03,05/05,05/07 Gerd Kortemeyer  
 # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer  
 # 12/04,12/05 Guy Albertelli  
 # 12/05 Gerd Kortemeyer  
 # 12/05 Guy Albertelli  
 # 12/06,12/07 Gerd Kortemeyer  
 # 12/25 Gerd Kortemeyer  
 # YEAR=2002  
 # 1/17 Gerd Kortemeyer  
 #  
 ###  ###
   
 ###############################################################################  ###############################################################################
Line 143  use Apache::lonnet(); Line 125  use Apache::lonnet();
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::loncfile;
 use vars qw(%metadatafields %metadatakeys);  use vars qw(%metadatafields %metadatakeys);
   
 my %addid;  my %addid;
Line 180  nothing Line 163  nothing
   
 #########################################  #########################################
 #########################################  #########################################
   #
   # Modifies global %metadatafields %metadatakeys 
   #
   
 sub metaeval {  sub metaeval {
     my ($metastring,$prefix)=@_;      my ($metastring,$prefix)=@_;
         
Line 214  sub metaeval { Line 201  sub metaeval {
  $newentry=~s/^\s*//;   $newentry=~s/^\s*//;
  if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }   if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
     }      }
     unless ($metadatafields{$unikey}=~/\w/) {  # actually store
  $metadatafields{$unikey}=$newentry;      $metadatafields{$unikey}=$newentry;
     }  
  }   }
     }      }
 }  }
Line 262  sub metaread { Line 248  sub metaread {
     my ($logfile,$fn,$prefix)=@_;      my ($logfile,$fn,$prefix)=@_;
     unless (-e $fn) {      unless (-e $fn) {
  print($logfile 'No file '.$fn."\n");   print($logfile 'No file '.$fn."\n");
         return '<br /><b>No file:</b> <tt>'.$fn.'</tt>';          return '<br /><b>'.&mt('No file').':</b> <tt>'.
       &Apache::loncfile::display($fn).'</tt>';
     }      }
     print($logfile 'Processing '.$fn."\n");      print($logfile 'Processing '.$fn."\n");
     my $metastring;      my $metastring;
Line 271  sub metaread { Line 258  sub metaread {
  $metastring=join('',<$metafh>);   $metastring=join('',<$metafh>);
     }      }
     &metaeval($metastring,$prefix);      &metaeval($metastring,$prefix);
     return '<br /><b>Processed file:</b> <tt>'.$fn.'</tt>';      return '<br /><b>'.&mt('Processed file').':</b> <tt>'.
    &Apache::loncfile::display($fn).'</tt>';
 }  }
   
 #########################################  #########################################
Line 621  sub fix_ids_and_indices { Line 609  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">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='<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>';
  return ($outstring,1);   return ($outstring,1);
     }      }
     if ($needsfixup) {      if ($needsfixup) {
Line 686  sub fix_ids_and_indices { Line 674  sub fix_ids_and_indices {
  }   }
  if ($lctag eq 'applet') {   if ($lctag eq 'applet') {
     my $codebase='';      my $codebase='';
     if (defined($parms{'codebase'})) {      my $havecodebase=0;
  my $oldcodebase=$parms{'codebase'};      foreach my $key (keys(%parms)) {
    if (lc($key) eq 'codebase') { 
       $codebase=$parms{$key};
       $havecodebase=1; 
    }
       }
       if ($havecodebase) {
    my $oldcodebase=$codebase;
  unless ($oldcodebase=~/\/$/) {   unless ($oldcodebase=~/\/$/) {
     $oldcodebase.='/';      $oldcodebase.='/';
  }   }
Line 701  sub fix_ids_and_indices { Line 696  sub fix_ids_and_indices {
  }   }
  $allow{&absoluteurl($codebase,$target).'/*'}=1;   $allow{&absoluteurl($codebase,$target).'/*'}=1;
     } else {      } else {
  foreach ('archive','code','object') {   foreach my $key (keys(%parms)) {
     if (defined($parms{$_})) {      if ($key =~ /(archive|code|object)/i) {
  my $oldurl=$parms{$_};   my $oldurl=$parms{$key};
  my $newurl=&urlfixup($oldurl,$target);   my $newurl=&urlfixup($oldurl,$target);
  $newurl=~s/\/[^\/]+$/\/\*/;   $newurl=~s/\/[^\/]+$/\/\*/;
  print $logfile 'Allow: applet '.$_.':'.   print $logfile 'Allow: applet '.lc($key).':'.
     $oldurl.' allows '.      $oldurl.' allows '.$newurl."\n";
  $newurl."\n";  
  $allow{&absoluteurl($newurl,$target)}=1;   $allow{&absoluteurl($newurl,$target)}=1;
     }      }
  }   }
Line 812  sub store_metadata { Line 806  sub store_metadata {
   
   
 # ============================================== Parse file itself for metadata  # ============================================== Parse file itself for metadata
   #
   # parses a file with target meta, sets global %metadatafields %metadatakeys 
   
 sub parseformeta {  sub parseformeta {
     my ($source,$style)=@_;      my ($source,$style)=@_;
Line 860  sub publish { Line 855  sub publish {
     my %allow=();      my %allow=();
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return ('<font color="red">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";
Line 884  sub publish { Line 879  sub publish {
  if ($error) { return ($outstring,$error); }   if ($error) { return ($outstring,$error); }
 # ------------------------------------------------------------ Construct Allows  # ------------------------------------------------------------ Construct Allows
           
  $scrout.='<h3>Dependencies</h3>';   $scrout.='<h3>'.&mt('Dependencies').'</h3>';
         my $allowstr='';          my $allowstr='';
         foreach (sort(keys(%allow))) {          foreach (sort(keys(%allow))) {
    my $thisdep=$_;     my $thisdep=$_;
Line 902  sub publish { Line 897  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">Currently not available'.     $scrout.= ' - <font color="red">'.&mt('Currently not available').
        '</font>';         '</font>';
                } else {                 } else {
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
Line 941  sub publish { Line 936  sub publish {
 # -------------------------------------------- Initial step done, now metadata.  # -------------------------------------------- Initial step done, now metadata.
   
 # --------------------------------------- Storage for metadata keys and fields.  # --------------------------------------- Storage for metadata keys and fields.
   # these are globals
   #
      %metadatafields=();       %metadatafields=();
      %metadatakeys=();       %metadatakeys=();
             
Line 966  sub publish { Line 962  sub publish {
                                  $ENV{'user.domain'};                                   $ENV{'user.domain'};
  $metadatafields{'authorspace'}=$cuname.'@'.$cudom;   $metadatafields{'authorspace'}=$cuname.'@'.$cudom;
   
 # ----------------------------------------------------------- Parse file itself  
   
  &parseformeta($source,$style);  
 # ------------------------------------------------ Check out directory hierachy  # ------------------------------------------------ Check out directory hierachy
   
         my $thisdisfn=$source;          my $thisdisfn=$source;
Line 985  sub publish { Line 978  sub publish {
             $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);              $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
     $prefix=~s|^\.\./||;      $prefix=~s|^\.\./||;
         }          }
   # ----------------------------------------------------------- Parse file itself
   # read %metadatafields from file itself
    
    $allmeta=&parseformeta($source,$style);
   
 # ------------------- Clear out parameters and stores (there should not be any)  # ------------------- Clear out parameters and stores (there should not be any)
   
Line 1005  sub publish { Line 1002  sub publish {
  delete $metadatafields{$_};   delete $metadatafields{$_};
             }              }
         }          }
           
     }  
 # ------------------------------------------ See if anything new in file itself  # ------------------------------------------ See if anything new in file itself
     
     $allmeta=&parseformeta($source,$style);   $allmeta=&parseformeta($source,$style);
      }
   
          
 # ---------------- Find and document discrepancies in the parameters and stores  # ---------------- Find and document discrepancies in the parameters and stores
   
     my $chparms='';      my $chparms='';
Line 1041  sub publish { Line 1038  sub publish {
     }      }
     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>';      $chparms.'</p><h1><font color="red">'.&mt('Warning!').
       '</font></h1><p><font color="red" size="+1">'.
       &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</font></p><hr />';
     }      }
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
Line 1075  sub publish { Line 1074  sub publish {
     unless ($batch) {      unless ($batch) {
         $scrout.=          $scrout.=
     '<form name="pubform" action="/adm/publish" method="post">'.      '<form name="pubform" action="/adm/publish" method="post">'.
             '<p><input type="submit" value="Finalize Publication" /></p>'.              '<p><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',&Apache::lonnet::escape($allmeta)).
Line 1087  sub publish { Line 1086  sub publish {
 # --------------------------------------------------- Scan content for keywords  # --------------------------------------------------- Scan content for keywords
   
         my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");          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";   my $keywordout=<<"END";
 <script>  <script>
 function checkAll(field) {  function checkAll(field) {
Line 1099  function uncheckAll(field) { Line 1101  function uncheckAll(field) {
         field[i].checked = false ;          field[i].checked = false ;
 }  }
 </script>  </script>
 <p><font color="#800000" face="helvetica"><b>KEYWORDS:</b></font>  <p><font color="#800000" face="helvetica"><b>$KEYWORDS:</b></font>
  $keywords_help</b>   $keywords_help</b>
 <input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)" />   <input type="button" value="$CheckAll" onclick="javascript:checkAll(document.pubform.keywords)" /> 
 <input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)" />   <input type="button" value="$UncheckAll" onclick="javascript:uncheckAll(document.pubform.keywords)" /> 
 </p>  </p>
 <br />  <br />
 END  END
Line 1135  END Line 1137  END
  $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});   $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
   
  $scrout.=   $scrout.=
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>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.=
       "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
       uc(&mt('Lowest Grade Level:')).
              "</b></font></p><br />".
      &Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
       "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
       uc(&mt('Highest Grade Level:')).
              "</b></font></p><br />".
      &Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
              &textfield('Standards','standards',$metadatafields{'standards'});
   
   
   
   
  $scrout.=&hiddenfield('mime',$1);   $scrout.=&hiddenfield('mime',$1);
   
  my $defaultlanguage=$metadatafields{'language'};   my $defaultlanguage=$metadatafields{'language'};
Line 1336  sub phasetwo { Line 1353  sub phasetwo {
     $allkeywords=~s/^\,//;      $allkeywords=~s/^\,//;
     $metadatafields{'keywords'}=$allkeywords;      $metadatafields{'keywords'}=$allkeywords;
           
   # check if custom distribution file is specified
       if ($metadatafields{'copyright'} eq 'custom') {
    my $file=$metadatafields{'customdistributionfile'};
    unless ($file=~/\.rights$/) {
               return 
                   '<font color="red">'.&mt('No valid custom distribution rights file specified, FAIL').
    '</font>';
           }
       }
     {      {
         print $logfile "\nWrite metadata file for ".$source;          print $logfile "\nWrite metadata file for ".$source;
         my $mfh;          my $mfh;
Line 1541  sub phasetwo { Line 1567  sub phasetwo {
                    '"><font size="+2">'.                     '"><font size="+2">'.
   &mt('Back to Source Directory').'</font></a></p>');    &mt('Back to Source Directory').'</font></a></p>');
     }      }
       return '<p><font color="green">'.&mt('Done').'</font></p>';
 }  }
   
 #########################################  #########################################
Line 1840  ENDDIFF Line 1867  ENDDIFF
     my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);      my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
     $r->print('<hr />'.$outstring);      $r->print('<hr />'.$outstring);
  } else {   } else {
     $r->print('<hr />');      $r->print('<hr />'.
     &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);       &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget)); 
  }   }
     }      }
     $r->print('</body></html>');      $r->print('</body></html>');
Removed from v.1.143  
changed lines
  Added in v.1.150

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