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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.243 and 1.252

version 1.243, 2008/08/01 18:09:38 version 1.252, 2009/03/09 20:10:55
Line 118  use Apache::File; Line 118  use Apache::File;
 use File::Copy;  use File::Copy;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use HTML::LCParser;  use HTML::LCParser;
   use HTML::Entities;
   use Encode::Encoder;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::loncacc;  use Apache::loncacc;
 use DBI;  use DBI;
Line 264  sub metaread { Line 266  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>'.&mt('No file').':</b> <tt>'.          return '<div><b>'
     &Apache::loncfile::display($fn).'</tt>';                .&mt('No file: [_1]'
                     ,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');
     }      }
     print($logfile 'Processing '.$fn."\n");      print($logfile 'Processing '.$fn."\n");
     my $metastring;      my $metastring;
Line 274  sub metaread { Line 277  sub metaread {
  $metastring=join('',<$metafh>);   $metastring=join('',<$metafh>);
     }      }
     &metaeval($metastring,$prefix);      &metaeval($metastring,$prefix);
     return '<br /><b>'.&mt('Processed file').':</b> <tt>'.      return '<div><b>'
  &Apache::loncfile::display($fn).'</tt><br />';            .&mt('Processed file: [_1]'
                 ,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');
 }  }
   
 #########################################  #########################################
Line 691  sub fix_ids_and_indices { Line 695  sub fix_ids_and_indices {
                     $responsecounter=0;                      $responsecounter=0;
                 }                  }
                 if ($lctag=~/response$/) { $responsecounter++; }                  if ($lctag=~/response$/) { $responsecounter++; }
                   if ($lctag eq 'import') { $responsecounter++; }
  my %parms=%{$token->[2]};   my %parms=%{$token->[2]};
  $counter=$addid{$tag};   $counter=$addid{$tag};
  if (!$counter) { $counter=$addid{$lctag}; }   if (!$counter) { $counter=$addid{$lctag}; }
Line 843  sub store_metadata { Line 848  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='<span class="LC_error">WARNING: Cannot connect to '.          $error='<span class="LC_error">'
             'database!</span>';                .&mt('WARNING: Cannot connect to 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 ='<span class="LC_error">WARNING: The metadata table does not '.          $error ='<span class="LC_error">'
             'exist in the LON-CAPA database.</span>';                 .&mt('WARNING: The metadata table does not exist in the LON-CAPA database!')
                  .'</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
Line 866  sub store_metadata { Line 873  sub store_metadata {
                                                          \%metadata);                                                           \%metadata);
     }      }
     if (defined($status) && $status ne '') {      if (defined($status) && $status ne '') {
         $error='<span class="LC_error">Error occured saving new values in '.          $error='<span class="LC_error">'
             'metadata table in LON-CAPA database</span>';                .&mt('Error occurred saving new values in 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);
Line 940  backup copies, performs any automatic pr Line 948  backup copies, performs any automatic pr
 especially for rat and ssi files),  especially for rat and ssi files),
   
 Returns a 2 element array, the first is the string to be shown to the  Returns a 2 element array, the first is the string to be shown to the
 user, the second is an error code, either 1 (an error occured) or 0  user, the second is an error code, either 1 (an error occurred) or 0
 (no error occurred)  (no error occurred)
   
 I<Additional documentation needed.>  I<Additional documentation needed.>
Line 983  sub publish { Line 991  sub publish {
  if ($error) { return ($outstring,$error); }   if ($error) { return ($outstring,$error); }
 # ------------------------------------------------------------ Construct Allows  # ------------------------------------------------------------ Construct Allows
           
  $scrout.='<h3>'.&mt('Dependencies').'</h3>';          my $outdep=''; # Collect dependencies output data
         my $allowstr='';          my $allowstr='';
         foreach my $thisdep (sort(keys(%allow))) {          foreach my $thisdep (sort(keys(%allow))) {
    if ($thisdep !~ /[^\s]/) { next; }     if ($thisdep !~ /[^\s]/) { next; }
            if ($thisdep =~/\$/) {             if ($thisdep =~/\$/) {
               $scrout.='<br /><span class="LC_warning">'                $outdep.='<div class="LC_warning">'
                        .&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />'                         .&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />'
                        .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt>&lt;allow&gt;</tt>')                         .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt>&lt;allow&gt;</tt>')
                        .'</span><br />';                         ."</div>\n";
            }             }
            unless ($style eq 'rat') {              unless ($style eq 'rat') { 
               $allowstr.="\n".'<allow src="'.$thisdep.'" />';                $allowstr.="\n".'<allow src="'.$thisdep.'" />';
    }     }
            $scrout.='<br />';            $outdep.='<div>';
            if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {             if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
        $scrout.='<a href="'.$thisdep.'">';         $outdep.='<a href="'.$thisdep.'">';
            }             }
            $scrout.='<tt>'.$thisdep.'</tt>';             $outdep.='<tt>'.$thisdep.'</tt>';
            if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {             if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
        $scrout.='</a>';         $outdep.='</a>';
                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.= ' - <span class="LC_error">'.&mt('Currently not available').     $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
        '</span>';         '</span>';
                } else {                 } else {
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
Line 1019  sub publish { Line 1027  sub publish {
    }     }
        }         }
            }             }
              $outdep.='</div><br />';
           }
   
           if ($outdep) {
               $scrout.='<h3>'.&mt('Dependencies').'</h3>'
                       .$outdep
         }          }
         $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;          $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
   
Line 1172  sub publish { Line 1186  sub publish {
  $textonly=~s/\<script[^\<]+\<\/script\>//g;   $textonly=~s/\<script[^\<]+\<\/script\>//g;
  $textonly=~s/\<m\>[^\<]+\<\/m\>//g;   $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
  $textonly=~s/\<[^\>]*\>//g;   $textonly=~s/\<[^\>]*\>//g;
  $textonly=~tr/A-Z/a-z/;  
  $textonly=~s/[\$\&][a-z]\w*//g;  
  $textonly=~s/[^a-z\s]//g;  
   
  foreach ($textonly=~m/(\w+)/g) {  
     unless ($nokey{$_}) {  
  $keywords{$_}=1;  
     }   
  }  
     }  
   
           #this is a work simplification for german authors for present
           $textonly=HTML::Entities::decode($textonly);           #decode HTML-character
           $textonly=Encode::Encoder::encode('utf8', $textonly);  #encode to perl internal unicode
           $textonly=~tr/A-ZÜÄÖ/a-züäö/;      #add lowercase rule for german "Umlaute"
           $textonly=~s/[\$\&][a-z]\w*//g;
           $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g;  #dont delete german "Umlaute"
   
           foreach ($textonly=~m/[^\s]+/g) {  #match all but whitespaces
               unless ($nokey{$_}) {
                   $keywords{$_}=1;
               }
           }
   
   
       }
                           
     foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {      foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
  $addkey=~s/\s+/ /g;   $addkey=~s/\s+/ /g;
Line 1203  sub publish { Line 1222  sub publish {
     my $intr_scrout.='<br />'      my $intr_scrout.='<br />'
                     .'<form name="pubform" action="/adm/publish" method="post">';                      .'<form name="pubform" action="/adm/publish" method="post">';
     unless ($env{'form.makeobsolete'}) {      unless ($env{'form.makeobsolete'}) {
        $intr_scrout.='<p>'         $intr_scrout.='<p class="LC_warning">'
                     .&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')                      .&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')
                     .'</p>'                      .'</p>'
                     .'<p><input type="submit" value="'                      .'<p><input type="submit" value="'
Line 1242  END Line 1261  END
                 .'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'                  .'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'
                 .'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'                  .'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
                 .'</p><br />'                  .'</p><br />'
                 .&Apache::loncommon::start_data_table()                  .&Apache::loncommon::start_data_table();
                 .&Apache::loncommon::start_data_table_row();      my $cols_per_row = 10;
   
     my $colcount=0;      my $colcount=0;
       my $wordcount=0;
       my $numkeywords = scalar(keys(%keywords));
   
     foreach (sort keys %keywords) {      foreach my $word (sort(keys(%keywords))) {
  $colcount++;          if ($colcount == 0) {
  $keywordout.='<td><label>'.$colcount.'<input type="checkbox" name="keywords" value="'.$_.'"';              $keywordout .= &Apache::loncommon::start_data_table_row();
  if ($metadatafields{'keywords'}) {          }
     if ($metadatafields{'keywords'}=~/\Q$_\E/) {          $colcount++;
  $keywordout.=' checked="on"';          $wordcount++;
  $env{'form.keywords'}.=$_.',';          if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) {
     }              my $colspan = 1+$cols_per_row-$colcount;
  } elsif (&Apache::loncommon::keyword($_)) {              $keywordout .= '<td colspan="'.$colspan.'">';
     $keywordout.=' checked="on"';          } else {
     $env{'form.keywords'}.=$_.',';              $keywordout .= '<td>';
  }  
  $keywordout.=' />'.$_.'</label></td>';  
  if ($colcount>=10) {  
     $keywordout.=&Apache::loncommon::end_data_table_row()  
                         .&Apache::loncommon::start_data_table_row();  
     $colcount=0;  
  }  
     }  
     # Proper end of started table row:  
     if ($colcount != 0) { # has still to be improved: if amount of keywords mod 10 == 0, then do not start another table row  
         while ($colcount<10) {  
             $keywordout.='<td>&nbsp;</td>';  
             $colcount++;  
         }          }
           $keywordout.='<label><input type="checkbox" name="keywords" value="'.$word.'"';
           if ($metadatafields{'keywords'}) {
               if ($metadatafields{'keywords'}=~/\Q$word\E/) {
                   $keywordout.=' checked="on"';
                   $env{'form.keywords'}.=$word.',';
               }
           } elsif (&Apache::loncommon::keyword($word)) {
               $keywordout.=' checked="on"';
               $env{'form.keywords'}.=$word.',';
           }
           $keywordout.=' />'.$word.'</label></td>';
           if ($colcount == $cols_per_row) {
               $keywordout.=&Apache::loncommon::end_data_table_row();
               $colcount=0;
           }
       }
       if ($colcount > 0) {
           $keywordout .= &Apache::loncommon::end_data_table_row();
     }      }
   
     $env{'form.keywords'}=~s/\,$//;      $env{'form.keywords'}=~s/\,$//;
Line 1627  sub phasetwo { Line 1652  sub phasetwo {
                 unlink($srcd.'/'.$filename);                  unlink($srcd.'/'.$filename);
                 unlink($srcd.'/'.$filename.'.meta');                  unlink($srcd.'/'.$filename.'.meta');
             } else {              } else {
                 if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {                  if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
                     $maxversion=($1>$maxversion)?$1:$maxversion;                      $maxversion=($1>$maxversion)?$1:$maxversion;
                 }                  }
             }              }
Line 1853  sub publishdirectory { Line 1878  sub publishdirectory {
   &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('obsolete','make file(s) obsolete').                    &checkbox('obsolete','make file(s) obsolete').
   &checkbox('forceoverride','force directory level catalog information over existing').    &checkbox('forceoverride','force directory level metadata over existing').
   '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');    '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
         $lock=0;          $lock=0;
     } else {      } else {
Line 1924  sub defaultmetapublish { Line 1949  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(&Apache::loncommon::start_page('Catalog Information Publication'));      $r->print(&Apache::loncommon::start_page('Metadata Publication'));
   
 # ---------------------------------------------------------------- Write Source  # ---------------------------------------------------------------- Write Source
     my $copyfile=$target;      my $copyfile=$target;
Line 1959  sub defaultmetapublish { Line 1984  sub defaultmetapublish {
 # ------------------------------------------------------------------- Link back  # ------------------------------------------------------------------- Link back
     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 Metadata').'</a>');
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }  }
Line 2169  ENDCAPTION Line 2194  ENDCAPTION
         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))          $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
                  .'<tt>'.$thisdistarget.'</tt>'                   .'<tt>'.$thisdistarget.'</tt>'
                  );                   );
 # SB - ToDo:     
  if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {   if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
 #           $r->print(&Apache::lonhtmlcommon::row_title('<span class="LC_warning">'.&mt('Co-Author').'</span>')  
             $r->print(&Apache::lonhtmlcommon::row_closure()              $r->print(&Apache::lonhtmlcommon::row_closure()
                      .&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))                       .&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
                      .'<span class="LC_warning">'                       .'<span class="LC_warning">'
Line 2204  ENDDIFF Line 2227  ENDDIFF
     unless ($errorcount) {      unless ($errorcount) {
  my ($outstring,$error)=   my ($outstring,$error)=
     &publish($thisfn,$thistarget,$thisembstyle);      &publish($thisfn,$thistarget,$thisembstyle);
  $r->print('<hr />'.$outstring);   $r->print($outstring);
     } else {      } else {
  $r->print('<h3 class="LC_error">'.   $r->print('<h3 class="LC_error">'.
   &mt('The document contains errors and cannot be published.').    &mt('The document contains errors and cannot be published.').
Removed from v.1.243  
changed lines
  Added in v.1.252

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