Diff for /loncom/publisher/lonpublisher.pm between versions 1.63 and 1.67

version 1.63, 2001/12/07 22:34:56 version 1.67, 2001/12/25 21:58:54
Line 40 Line 40
 # 12/04,12/05 Guy Albertelli  # 12/04,12/05 Guy Albertelli
 # 12/05 Gerd Kortemeyer  # 12/05 Gerd Kortemeyer
 # 12/05 Guy Albertelli  # 12/05 Guy Albertelli
 # 12/06 Gerd Kortemeyer  # 12/06,12/07 Gerd Kortemeyer
   # 12/15,12/16 Scott Harrison
   # 12/25 Gerd Kortemeyer
   #
   ###
   
   ###############################################################################
   ##                                                                           ##
   ## ORGANIZATION OF THIS PERL MODULE                                          ##
   ##                                                                           ##
   ## 1. Modules used by this module                                            ##
   ## 2. Various subroutines                                                    ##
   ## 3. Publication Step One                                                   ##
   ## 4. Phase Two                                                              ##
   ## 5. Main Handler                                                           ##
   ##                                                                           ##
   ###############################################################################
   
 package Apache::lonpublisher;  package Apache::lonpublisher;
   
   # ------------------------------------------------- modules used by this module
 use strict;  use strict;
 use Apache::File;  use Apache::File;
 use File::Copy;  use File::Copy;
Line 53  use Apache::lonxml; Line 70  use Apache::lonxml;
 use Apache::lonhomework;  use Apache::lonhomework;
 use Apache::loncacc;  use Apache::loncacc;
 use DBI;  use DBI;
   use Apache::lonnet();
   use Apache::loncommon();
   
 my %addid;  my %addid;
 my %nokey;  my %nokey;
 my %language;  
 my %cprtag;  
   
 my %metadatafields;  my %metadatafields;
 my %metadatakeys;  my %metadatakeys;
Line 68  my $cuname; Line 85  my $cuname;
 my $cudom;  my $cudom;
   
 # ----------------------------------------------- Evaluate string with metadata  # ----------------------------------------------- Evaluate string with metadata
   
 sub metaeval {  sub metaeval {
     my $metastring=shift;      my $metastring=shift;
         
Line 90  sub metaeval { Line 106  sub metaeval {
               if (defined($token->[2]->{'name'})) {                 if (defined($token->[2]->{'name'})) { 
                  $unikey.='_'.$token->[2]->{'name'};                    $unikey.='_'.$token->[2]->{'name'}; 
       }        }
                map {                foreach (@{$token->[3]}) {
   $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};    $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
                   if ($metadatakeys{$unikey}) {                    if ($metadatakeys{$unikey}) {
       $metadatakeys{$unikey}.=','.$_;        $metadatakeys{$unikey}.=','.$_;
                   } else {                    } else {
                       $metadatakeys{$unikey}=$_;                        $metadatakeys{$unikey}=$_;
                   }                    }
               } @{$token->[3]};                }
               if ($metadatafields{$unikey}) {                if ($metadatafields{$unikey}) {
   my $newentry=$parser->get_text('/'.$entry);    my $newentry=$parser->get_text('/'.$entry);
                   unless (($metadatafields{$unikey}=~/$newentry/) ||                    unless (($metadatafields{$unikey}=~/$newentry/) ||
Line 112  sub metaeval { Line 128  sub metaeval {
 }  }
   
 # -------------------------------------------------------- Read a metadata file  # -------------------------------------------------------- Read a metadata file
   
 sub metaread {  sub metaread {
     my ($logfile,$fn)=@_;      my ($logfile,$fn)=@_;
     unless (-e $fn) {      unless (-e $fn) {
Line 151  sub hiddenfield { Line 166  sub hiddenfield {
 }  }
   
 sub selectbox {  sub selectbox {
     my ($title,$name,$value,%options)=@_;      my ($title,$name,$value,$functionref,@idlist)=@_;
     my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';      my $uctitle=uc($title);
     map {      my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
         $selout.='<option value="'.$_.'"';   "</b></font><br />".'<select name="'.$name.'">';
         if ($_ eq $value) { $selout.=' selected'; }      foreach (@idlist) {
         $selout.='>'.$options{$_}.'</option>';          $selout.='<option value=\''.$_.'\'';
     } sort keys %options;          if ($_ eq $value) {
       $selout.=' selected>'.&{$functionref}($_).'</option>';
    }
           else {$selout.='>'.&{$functionref}($_).'</option>';}
       }
     return $selout.'</select>';      return $selout.'</select>';
 }  }
   
Line 167  sub urlfixup { Line 186  sub urlfixup {
     my ($url,$target)=@_;      my ($url,$target)=@_;
     unless ($url) { return ''; }      unless ($url) { return ''; }
     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);      my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
     map {      foreach (values %Apache::lonnet::hostname) {
  if ($_ eq $host) {   if ($_ eq $host) {
     $url=~s/^http\:\/\///;      $url=~s/^http\:\/\///;
             $url=~s/^$host//;              $url=~s/^$host//;
         }          }
     } values %Apache::lonnet::hostname;      }
     if ($url=~/^http\:\/\//) { return $url; }      if ($url=~/^http\:\/\//) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;      $url=~s/\~$cuname/res\/$cudom\/$cuname/;
     if ($target) {      if ($target) {
Line 281  sub publish { Line 300  sub publish {
       }        }
   }     } 
                                       
                   map {                    foreach ('src','href','background') {
                       if (defined($parms{$_})) {                        if (defined($parms{$_})) {
   my $oldurl=$parms{$_};    my $oldurl=$parms{$_};
                           my $newurl=&urlfixup($oldurl,$target);                            my $newurl=&urlfixup($oldurl,$target);
Line 292  sub publish { Line 311  sub publish {
   }    }
                           $allow{$newurl}=1;                            $allow{$newurl}=1;
                       }                        }
                   } ('src','href','background');                    }
   
                   if ($lctag eq 'applet') {                    if ($lctag eq 'applet') {
       my $codebase='';        my $codebase='';
Line 311  sub publish { Line 330  sub publish {
  }   }
                          $allow{$codebase.'/*'}=1;                           $allow{$codebase.'/*'}=1;
       } else {        } else {
                         map {                          foreach ('archive','code','object') {
                           if (defined($parms{$_})) {                            if (defined($parms{$_})) {
       my $oldurl=$parms{$_};        my $oldurl=$parms{$_};
                               my $newurl=&urlfixup($oldurl,$target);                                my $newurl=&urlfixup($oldurl,$target);
Line 321  sub publish { Line 340  sub publish {
   $newurl."\n";    $newurl."\n";
                               $allow{$newurl}=1;                                $allow{$newurl}=1;
                           }                            }
                         } ('archive','code','object');                          }
                       }                        }
                   }                    }
   
                   my $newparmstring='';                    my $newparmstring='';
                   my $endtag='';                    my $endtag='';
                   map {                    foreach (keys %parms) {
                     if ($_ eq '/') {                      if ($_ eq '/') {
                       $endtag=' /';                        $endtag=' /';
                     } else {                       } else { 
                       my $quote=($parms{$_}=~/\"/?"'":'"');                        my $quote=($parms{$_}=~/\"/?"'":'"');
                       $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;                        $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
     }      }
                   } keys %parms;                    }
   if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }    if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
   $outstring.='<'.$tag.$newparmstring.$endtag.'>';    $outstring.='<'.$tag.$newparmstring.$endtag.'>';
          } else {           } else {
Line 354  sub publish { Line 373  sub publish {
           
  $scrout.='<h3>Dependencies</h3>';   $scrout.='<h3>Dependencies</h3>';
         my $allowstr='';          my $allowstr='';
         map {          foreach (keys %allow) {
    my $thisdep=$_;     my $thisdep=$_;
            unless ($style eq 'rat') {              unless ($style eq 'rat') { 
               $allowstr.="\n".'<allow src="'.$thisdep.'" />';                $allowstr.="\n".'<allow src="'.$thisdep.'" />';
Line 381  sub publish { Line 400  sub publish {
    }     }
        }         }
            }             }
         } keys %allow;          }
         $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;          $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
   
 # ------------------------------------------------------------- Write modified  # ------------------------------------------------------------- Write modified
Line 436  sub publish { Line 455  sub publish {
   
         my $currentpath='/home/'.$cuname.'/';          my $currentpath='/home/'.$cuname.'/';
   
         map {          foreach (@urlparts) {
     $currentpath.=$_.'/';      $currentpath.=$_.'/';
             $scrout.=&metaread($logfile,$currentpath.'default.meta');              $scrout.=&metaread($logfile,$currentpath.'default.meta');
         } @urlparts;          }
   
 # ------------------- Clear out parameters and stores (there should not be any)  # ------------------- Clear out parameters and stores (there should not be any)
   
         map {          foreach (keys %metadatafields) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($_=~/^parameter/) || ($_=~/^stores/)) {
  delete $metadatafields{$_};   delete $metadatafields{$_};
             }              }
         } keys %metadatafields;          }
   
     } else {      } else {
 # ---------------------- Read previous metafile, remember parameters and stores  # ---------------------- Read previous metafile, remember parameters and stores
   
         $scrout.=&metaread($logfile,$source.'.meta');          $scrout.=&metaread($logfile,$source.'.meta');
   
         map {          foreach (keys %metadatafields) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($_=~/^parameter/) || ($_=~/^stores/)) {
                 $oldparmstores{$_}=1;                  $oldparmstores{$_}=1;
  delete $metadatafields{$_};   delete $metadatafields{$_};
             }              }
         } keys %metadatafields;          }
                   
     }      }
   
Line 476  sub publish { Line 495  sub publish {
 # ---------------- Find and document discrepancies in the parameters and stores  # ---------------- Find and document discrepancies in the parameters and stores
   
         my $chparms='';          my $chparms='';
         map {          foreach (sort keys %metadatafields) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($_=~/^parameter/) || ($_=~/^stores/)) {
                 unless ($_=~/\.\w+$/) {                   unless ($_=~/\.\w+$/) { 
                    unless ($oldparmstores{$_}) {                     unless ($oldparmstores{$_}) {
Line 485  sub publish { Line 504  sub publish {
                    }                     }
         }          }
             }              }
         } sort keys %metadatafields;          }
         if ($chparms) {          if ($chparms) {
     $scrout.='<p><b>New parameters or stored values:</b> '.      $scrout.='<p><b>New parameters or stored values:</b> '.
                      $chparms;                       $chparms;
         }          }
   
         my $chparms='';          my $chparms='';
         map {          foreach (sort keys %oldparmstores) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($_=~/^parameter/) || ($_=~/^stores/)) {
                 unless (($metadatafields{$_.'.name'}) ||                  unless (($metadatafields{$_.'.name'}) ||
                         ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {                          ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
Line 500  sub publish { Line 519  sub publish {
                     $chparms.=$_.' ';                      $chparms.=$_.' ';
                 }                  }
             }              }
         } sort keys %oldparmstores;          }
         if ($chparms) {          if ($chparms) {
     $scrout.='<p><b>Obsolete parameters or stored values:</b> '.      $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
                      $chparms;                       $chparms;
Line 523  sub publish { Line 542  sub publish {
   
  my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';   my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
         my $colcount=0;          my $colcount=0;
           my %keywords=();
                   
  if (length($content)<500000) {   if (length($content)<500000) {
     my $textonly=$content;      my $textonly=$content;
Line 533  sub publish { Line 553  sub publish {
             $textonly=~s/[\$\&][a-z]\w*//g;              $textonly=~s/[\$\&][a-z]\w*//g;
             $textonly=~s/[^a-z\s]//g;              $textonly=~s/[^a-z\s]//g;
   
             my %keywords=();              foreach ($textonly=~m/(\w+)/g) {
             map {  
  unless ($nokey{$_}) {   unless ($nokey{$_}) {
                    $keywords{$_}=1;                     $keywords{$_}=1;
                 }                   } 
             } ($textonly=~m/(\w+)/g);              }
           }
   
             map {              
               foreach (split(/\W+/,$metadatafields{'keywords'})) {
  $keywords{$_}=1;   $keywords{$_}=1;
             } split(/\W+/,$metadatafields{'keywords'});              }
   
             map {              foreach (sort keys %keywords) {
                 $keywordout.='<td><input type=checkbox name="key.'.$_.'"';                  $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
                 if ($metadatafields{'keywords'}=~/$_/) {                   if ($metadatafields{'keywords'}) {
                    $keywordout.=' checked';                      if ($metadatafields{'keywords'}=~/$_/) { 
                 }                        $keywordout.=' checked'; 
                      }
           } elsif (&Apache::loncommon::keyword($_)) {
       $keywordout.=' checked';
                   } 
                 $keywordout.='>'.$_.'</td>';                  $keywordout.='>'.$_.'</td>';
                 if ($colcount>10) {                  if ($colcount>10) {
     $keywordout.="</tr><tr>\n";      $keywordout.="</tr><tr>\n";
                     $colcount=0;                      $colcount=0;
                 }                  }
                 $colcount++;                  $colcount++;
             } sort keys %keywords;              }
   
         } else {  
     $keywordout.='<td>File too long for keyword analysis</td>';  
         }           
                   
  $keywordout.='</tr></table>';   $keywordout.='</tr></table>';
   
Line 578  sub publish { Line 599  sub publish {
  $scrout.=&hiddenfield('mime',$1);   $scrout.=&hiddenfield('mime',$1);
   
         $scrout.=&selectbox('Language','language',          $scrout.=&selectbox('Language','language',
                             $metadatafields{'language'},%language);                              $metadatafields{'language'},
       \&{Apache::loncommon::languagedescription},
       (&Apache::loncommon::languageids),
        );
   
         unless ($metadatafields{'creationdate'}) {          unless ($metadatafields{'creationdate'}) {
     $metadatafields{'creationdate'}=time;      $metadatafields{'creationdate'}=time;
Line 592  sub publish { Line 616  sub publish {
                             $metadatafields{'owner'});                              $metadatafields{'owner'});
 # --------------------------------------------------- Correct copyright for rat          # --------------------------------------------------- Correct copyright for rat        
     if ($style eq 'rat') {      if ($style eq 'rat') {
        if ($metadatafields{'copyright'} eq 'public') {    if ($metadatafields{'copyright'} eq 'public') { 
           delete $metadatafields{'copyright'};      delete $metadatafields{'copyright'};
        }   }
        delete $cprtag{'public'};  
    }  
   
         $scrout.=&selectbox('Copyright/Distribution','copyright',          $scrout.=&selectbox('Copyright/Distribution','copyright',
                             $metadatafields{'copyright'},%cprtag);                              $metadatafields{'copyright'},
       \&{Apache::loncommon::copyrightdescription},
        (grep !/^public$/,(&Apache::loncommon::copyrightids)));
       }
       else {
           $scrout.=&selectbox('Copyright/Distribution','copyright',
                               $metadatafields{'copyright'},
       \&{Apache::loncommon::copyrightdescription},
        (&Apache::loncommon::copyrightids));
       }
     return $scrout.      return $scrout.
       '<p><input type="submit" value="Finalize Publication" /></p></form>';        '<p><input type="submit" value="Finalize Publication" /></p></form>';
 }  }
Line 639  sub phasetwo { Line 668  sub phasetwo {
      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};       $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
   
      my $allkeywords=$ENV{'form.addkey'};       my $allkeywords=$ENV{'form.addkey'};
      map {       foreach (keys %ENV) {
          if ($_=~/^form\.key\.(\w+)/) {           if ($_=~/^form\.key\.(\w+)/) {
      $allkeywords.=','.$1;       $allkeywords.=','.$1;
          }           }
      } keys %ENV;       }
      $allkeywords=~s/\W+/\,/;       $allkeywords=~s/\W+/\,/;
      $allkeywords=~s/^\,//;       $allkeywords=~s/^\,//;
      $metadatafields{'keywords'}=$allkeywords;       $metadatafields{'keywords'}=$allkeywords;
Line 654  sub phasetwo { Line 683  sub phasetwo {
        unless ($mfh=Apache::File->new('>'.$source.'.meta')) {         unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
  return    return 
          '<font color=red>Could not write metadata, FAIL</font>';           '<font color=red>Could not write metadata, FAIL</font>';
        }             }
        map {         foreach (sort keys %metadatafields) {
  unless ($_=~/\./) {   unless ($_=~/\./) {
            my $unikey=$_;             my $unikey=$_;
            $unikey=~/^([A-Za-z]+)/;             $unikey=~/^([A-Za-z]+)/;
            my $tag=$1;             my $tag=$1;
            $tag=~tr/A-Z/a-z/;             $tag=~tr/A-Z/a-z/;
            print $mfh "\n\<$tag";             print $mfh "\n\<$tag";
            map {             foreach (split(/\,/,$metadatakeys{$unikey})) {
                my $value=$metadatafields{$unikey.'.'.$_};                 my $value=$metadatafields{$unikey.'.'.$_};
                $value=~s/\"/\'\'/g;                 $value=~s/\"/\'\'/g;
                print $mfh ' '.$_.'="'.$value.'"';                 print $mfh ' '.$_.'="'.$value.'"';
            } split(/\,/,$metadatakeys{$unikey});             }
    print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';     print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';
          }           }
        } sort keys %metadatafields;         }
        $scrout.='<p>Wrote Metadata';         $scrout.='<p>Wrote Metadata';
        print $logfile "\nWrote metadata";         print $logfile "\nWrote metadata";
      }       }
   
 # -------------------------------- Synchronize entry with SQL metadata database  # -------------------------------- Synchronize entry with SQL metadata database
     my %perlvar;    my $warning;
     open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";  
     my $configline;    unless ($metadatafields{'copyright'} eq 'priv') {
     while ($configline=<CONFIG>) {  
  if ($configline =~ /PerlSetVar/) {  
     my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);  
     chomp($varvalue);  
     $perlvar{$varname}=$varvalue;  
  }  
     }  
     close(CONFIG);  
   
     my $warning;  
     my $dbh;      my $dbh;
     {      {
  unless (   unless (
  $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})   $dbh = DBI->connect("DBI:mysql:loncapa","www",
       $Apache::lonnet::perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
  ) {    ) { 
     $warning='<font color=red>WARNING: Cannot connect to '.      $warning='<font color=red>WARNING: Cannot connect to '.
  'database!</font>';   'database!</font>';
Line 703  sub phasetwo { Line 724  sub phasetwo {
   'delete from metadata where url like binary'.    'delete from metadata where url like binary'.
   '"'.$sqldatafields{'url'}.'"');    '"'.$sqldatafields{'url'}.'"');
     $sth->execute();      $sth->execute();
     map {my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g;       foreach ('title','author','subject','keywords','notes','abstract',
  $sqldatafields{$_}=$field;}  
     ('title','author','subject','keywords','notes','abstract',  
      'mime','language','creationdate','lastrevisiondate','owner',       'mime','language','creationdate','lastrevisiondate','owner',
      'copyright');       'copyright') {
    my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; 
    $sqldatafields{$_}=$field;
       }
           
     $sth=$dbh->prepare('insert into metadata values ('.      $sth=$dbh->prepare('insert into metadata values ('.
        '"'.delete($sqldatafields{'title'}).'"'.','.         '"'.delete($sqldatafields{'title'}).'"'.','.
Line 736  sub phasetwo { Line 758  sub phasetwo {
  }   }
     }      }
   
   } else {
       $scrout.='<p>Private Publication - did not synchronize database';
       print $logfile "\nPrivate: Did not synchronize data into ".
    "SQL metadata database";
   }
 # ----------------------------------------------------------- Copy old versions  # ----------------------------------------------------------- Copy old versions
         
 if (-e $target) {  if (-e $target) {
Line 915  sub handler { Line 941  sub handler {
   
 # Get query string for limited number of parameters  # Get query string for limited number of parameters
   
     map {      foreach (split(/&/,$ENV{'QUERY_STRING'})) {
        my ($name, $value) = split(/=/,$_);         my ($name, $value) = split(/=/,$_);
        $value =~ tr/+/ /;         $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Line 924  sub handler { Line 950  sub handler {
               $ENV{'form.'.$name}=$value;                $ENV{'form.'.$name}=$value;
    }     }
        }         }
     } (split(/&/,$ENV{'QUERY_STRING'}));      }
   
   
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
Line 999  unless ($ENV{'form.phase'} eq 'two') { Line 1025  unless ($ENV{'form.phase'} eq 'two') {
   
   {    {
      my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');       my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
       map {        while (<$fh>) {
           my $word=$_;            my $word=$_;
           chomp($word);            chomp($word);
           $nokey{$word}=1;            $nokey{$word}=1;
       } <$fh>;        }
   }  
   
   %language=();  
   
   {  
      my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');  
       map {  
           $_=~/(\w+)\s+([\w\s\-]+)/;  
           $language{$1}=$2;  
       } <$fh>;  
   }  
   
   %cprtag=();  
   
   {  
      my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');  
       map {  
           $_=~/(\w+)\s+([\w\s\-]+)/;  
           $cprtag{$1}=$2;  
       } <$fh>;  
   }    }
   
 }  }
Line 1042  unless ($ENV{'form.phase'} eq 'two') { Line 1048  unless ($ENV{'form.phase'} eq 'two') {
   {    {
       $thisfn=~/\.(\w+)$/;        $thisfn=~/\.(\w+)$/;
       my $thistype=$1;        my $thistype=$1;
       my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);        my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
   
       my $thistarget=$thisfn;        my $thistarget=$thisfn;
               
Line 1056  unless ($ENV{'form.phase'} eq 'two') { Line 1062  unless ($ENV{'form.phase'} eq 'two') {
       $thisdisfn=~s/^\/home\/$cuname\/public_html\///;        $thisdisfn=~s/^\/home\/$cuname\/public_html\///;
   
       $r->print('<h2>Publishing '.        $r->print('<h2>Publishing '.
         &Apache::lonnet::filedescription($thistype).' <tt>'.          &Apache::loncommon::filedescription($thistype).' <tt>'.
         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');          $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
         
        if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {         if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {
Line 1064  unless ($ENV{'form.phase'} eq 'two') { Line 1070  unless ($ENV{'form.phase'} eq 'two') {
                '</font></h3>');                 '</font></h3>');
       }        }
   
       if (&Apache::lonnet::fileembstyle($thistype) eq 'ssi') {        if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
           $r->print('<br><a href="/adm/diff?filename=/~'.$cuname.'/'.            $r->print('<br><a href="/adm/diff?filename=/~'.$cuname.'/'.
                     $thisdisfn.                      $thisdisfn.
    '&versionone=priv" target=cat>Diffs with Current Version</a><p>');     '&versionone=priv" target=cat>Diffs with Current Version</a><p>');
Line 1089  unless ($ENV{'form.phase'} eq 'two') { Line 1095  unless ($ENV{'form.phase'} eq 'two') {
 1;  1;
 __END__  __END__
   
   =head1 NAME
   
   Apache::lonpublisher - Publication Handler
   
   =head1 SYNOPSIS
   
   Invoked by /etc/httpd/conf/srm.conf:
   
    <Location /adm/publish>
    PerlAccessHandler       Apache::lonacc
    SetHandler perl-script
    PerlHandler Apache::lonpublisher
    ErrorDocument     403 /adm/login
    ErrorDocument     404 /adm/notfound.html
    ErrorDocument     406 /adm/unauthorized.html
    ErrorDocument  500 /adm/errorhandler
    </Location>
   
   =head1 INTRODUCTION
   
   This module publishes a file.  This involves gathering metadata,
   versioning the file, copying file from construction space to
   publication space, and copying metadata from construction space
   to publication space.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   Get query string for limited number of parameters
   
   =item *
   
   Check filename
   
   =item *
   
   File is there and owned, init lookup tables
   
   =item *
   
   Start page output
   
   =item *
   
   Individual file
   
   =item *
   
   publish from $thisfn to $thistarget with $thisembstyle
   
   =back
   
   =head1 OTHER SUBROUTINES
   
   =over 4
   
   =item *
   
   metaeval() : Evaluate string with metadata
   
   =item *
   
   metaread() : Read a metadata file
   
   =item *
   
   sqltime() : convert 'time' format into a datetime sql format
   
   =item *
   
   textfield() : form field
   
   =item *
   
   hiddenfield() : form field
   
   =item *
   
   selectbox() : form field
   
   =item *
   
   urlfixup() : fixup URL (Publication Step One)
   
   =item *
   
   publish() : publish (Publication Step One)
   
   =item *
   
   phasetwo() : render second interface showing status of publication steps
   (Publication Step Two)
   
   =back
   
   =cut

Removed from v.1.63  
changed lines
  Added in v.1.67


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