Diff for /loncom/publisher/lonpublisher.pm between versions 1.154 and 1.161

version 1.154, 2003/12/27 14:42:57 version 1.161, 2004/01/05 22:29:51
Line 126  use Apache::loncommon(); Line 126  use Apache::loncommon();
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::loncfile;  use Apache::loncfile;
   use Apache::lonmeta;
   use Apache::lonmsg;
 use vars qw(%metadatafields %metadatakeys);  use vars qw(%metadatafields %metadatakeys);
   
 my %addid;  my %addid;
Line 316  sub textfield { Line 318  sub textfield {
     $value=~s/\s+$//gs;      $value=~s/\s+$//gs;
     $value=~s/\s+/ /gs;      $value=~s/\s+/ /gs;
     $title=&mt($title);      $title=&mt($title);
     my $uctitle=uc($title);      return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
     return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".  
            "</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.'" />';
 }  }
Line 330  sub hiddenfield { Line 331  sub hiddenfield {
 sub selectbox {  sub selectbox {
     my ($title,$name,$value,$functionref,@idlist)=@_;      my ($title,$name,$value,$functionref,@idlist)=@_;
     $title=&mt($title);      $title=&mt($title);
     my $uctitle=uc($title);  
     $value=(split(/\s*,\s*/,$value))[-1];      $value=(split(/\s*,\s*/,$value))[-1];
     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".      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) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value=\''.$_.'\'';
Line 791  sub store_metadata { Line 791  sub store_metadata {
     ('metadata','url',$metadata{'url'});      ('metadata','url',$metadata{'url'});
     } else {      } else {
 # store new data  # store new data
   # adjust some values to metadatadatabase (e.g., "usage" is a reserved word)
  $metadata{'creationdate'}=   $metadata{'creationdate'}=
     &Apache::lonmysql::sqltime($metadata{'creationdate'});       &Apache::lonmysql::sqltime($metadata{'creationdate'}); 
  $metadata{'lastrevisiondate'}=   $metadata{'lastrevisiondate'}=
     &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});       &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});
  $status = &Apache::lonmysql::store_row('metadata',\%metadata);   $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=&Apache::lonmeta::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)) {
         $error='<font color="red">Error occured storing new values in '.          $error='<font color="red">Error occured storing new values in '.
Line 1004  sub publish { Line 1030  sub publish {
 # ------------------------------------------ See if anything new in file itself  # ------------------------------------------ See if anything new in file itself
     
  $allmeta=&parseformeta($source,$style);   $allmeta=&parseformeta($source,$style);
   
    }     }
   
                 
Line 1085  sub publish { Line 1112  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 $KEYWORDS=&mt('Keywords');
  my $CheckAll=&mt('check all');   my $CheckAll=&mt('check all');
  my $UncheckAll=&mt('uncheck all');   my $UncheckAll=&mt('uncheck all');
  my $keywordout=<<"END";   my $keywordout=<<"END";
Line 1136  END Line 1163  END
  $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});   $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
   
  $scrout.=   $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>';
Line 1146  END Line 1173  END
   
  $scrout.=   $scrout.=
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".      "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
     uc(&mt('Lowest Grade Level:')).      &mt('Lowest Grade Level').':'.
            "</b></font></p><br />".             "</b></font></p><br />".
    &Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').     &Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".      "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
     uc(&mt('Highest Grade Level:')).      &mt('Highest Grade Level').':'.
            "</b></font></p><br />".             "</b></font></p><br />".
    &Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').     &Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
            &textfield('Standards','standards',$metadatafields{'standards'});             &textfield('Standards','standards',$metadatafields{'standards'});
Line 1209  END Line 1236  END
     $scrout.=&textfield('Custom Distribution File','customdistributionfile',      $scrout.=&textfield('Custom Distribution File','customdistributionfile',
  $metadatafields{'customdistributionfile'}).   $metadatafields{'customdistributionfile'}).
     $copyright_help;      $copyright_help;
     my $uctitle=uc(&mt('Obsolete'));      my $uctitle=&mt('Obsolete');
             $scrout.=              $scrout.=
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
  '</b></font> <input type="checkbox" name="obsolete" ';   '</b></font> <input type="checkbox" name="obsolete" ';
Line 1409  sub phasetwo { Line 1436  sub phasetwo {
  $r->print($error);   $r->print($error);
  print $logfile "\n".$error;   print $logfile "\n".$error;
     }      }
   # --------------------------------------------- Delete author resource messages
       my $delresult=&Apache::lonmsg::del_url_author_res_msg($target); 
       $r->print('<p>'.&mt('Removing error messages:').' '.$delresult.'</p>');
       print $logfile "\nRemoving error messages: $delresult";
 # ----------------------------------------------------------- Copy old versions  # ----------------------------------------------------------- Copy old versions
         
     if (-e $target) {      if (-e $target) {
Line 1622  sub publishdirectory { Line 1652  sub publishdirectory {
     my $resdir=      my $resdir=
  $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.   $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.
  $thisdisfn;   $thisdisfn;
     $r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'.      $r->print('<h1>'.&mt('Directory').' <tt>'.$thisdisfn.'</tt></h1>'.
       '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.
   
Line 1661  sub publishdirectory { Line 1691  sub publishdirectory {
     if ($publishthis) {      if ($publishthis) {
                 &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);                  &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
     } else {      } else {
  $r->print('<br />Skipping '.$filename.'<br />');   $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
     }      }
     $r->rflush();      $r->rflush();
  }   }
     }      }
     closedir(DIR);      closedir(DIR);
 }  }
   
   #########################################
   # publish a default.meta file
   
   sub defaultmetapublish {
       my ($r,$fn,$cuname,$cudom)=@_;
       $fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//;
       unless (-e $fn) {
          return HTTP_NOT_FOUND;
       }
       my $target=$fn;
       $target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//;
   
   
       &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
   
       $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
       $r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));
   
   # ---------------------------------------------------------------- Write Source
       my $copyfile=$target;
       
       my @parts=split(/\//,$copyfile);
       my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
       
       my $count;
       for ($count=5;$count<$#parts;$count++) {
           $path.="/$parts[$count]";
           if ((-e $path)!=1) {
               $r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');
               mkdir($path,0777);
           }
       }
       
       if (copy($fn,$copyfile)) {
           $r->print('<p>'.&mt('Copied source file').'</p>');
       } else {
           return "<font color=\"red\">".
       &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";
       }
   
   # --------------------------------------------------- Send update notifications
   
       my @subscribed=&get_subscribed_hosts($target);
       foreach my $subhost (@subscribed) {
    $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;
    my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
    $r->print($reply.'</p><br />');$r->rflush;
       }
   # ------------------------------------------------------------------- Link back
       my $link=$fn;
       $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;
       $r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');
       $r->print('</body></html>');
       return OK;
   }
 #########################################  #########################################
   
 =pod  =pod
Line 1726  sub handler { Line 1813  sub handler {
   
     my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});      my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
   
       ($cuname,$cudom)=
    &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
   
   # special publication: default.meta file
       if ($fn=~/\/default.meta$/) {
    return &defaultmetapublish($r,$fn,$cuname,$cudom); 
       }
       $fn=~s/\.meta$//;
       
     unless ($fn) {       unless ($fn) { 
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
Line 1733  sub handler { Line 1828  sub handler {
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
     ($cuname,$cudom)=  
  &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));  
     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'}.

Removed from v.1.154  
changed lines
  Added in v.1.161


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