Diff for /loncom/publisher/lonpublisher.pm between versions 1.59 and 1.69

version 1.59, 2001/12/05 21:12:04 version 1.69, 2002/01/09 20:45:16
Line 39 Line 39
 # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 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/04,12/05 Guy Albertelli
 # 12/05 Gerd Kortemeyer  # 12/05 Gerd Kortemeyer
   # 12/05 Guy Albertelli
   # 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 51  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 66  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 88  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 110  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 149  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 164  sub selectbox { Line 185  sub selectbox {
 sub urlfixup {  sub urlfixup {
     my ($url,$target)=@_;      my ($url,$target)=@_;
     unless ($url) { return ''; }      unless ($url) { return ''; }
       #javascript code needs no fixing
       if ($url =~ /^javascript:/i) { return $url; }
       if ($url =~ /^mailto:/i) { return $url; }
       #internal document links need no fixing
       if ($url =~ /^\#/) { return $url; } 
     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 279  sub publish { Line 305  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 290  sub publish { Line 316  sub publish {
   }    }
                           $allow{$newurl}=1;                            $allow{$newurl}=1;
                       }                        }
                   } ('src','href','background');                    }
   
                   if ($lctag eq 'applet') {                    if ($lctag eq 'applet') {
       my $codebase='';        my $codebase='';
Line 309  sub publish { Line 335  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 319  sub publish { Line 345  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 349  sub publish { Line 375  sub publish {
               }                }
           }            }
 # ------------------------------------------------------------ Construct Allows  # ------------------------------------------------------------ Construct Allows
      unless ($style eq 'rat') {      
  $scrout.='<h3>Dependencies</h3>';   $scrout.='<h3>Dependencies</h3>';
  my $allowstr="\n";          my $allowstr='';
         map {          foreach (keys %allow) {
    my $thisdep=$_;     my $thisdep=$_;
            $allowstr.='<allow src="'.$thisdep.'" />'."\n";             unless ($style eq 'rat') { 
                 $allowstr.="\n".'<allow src="'.$thisdep.'" />';
      }
            $scrout.='<br>';             $scrout.='<br>';
            unless ($thisdep=~/\*/) {             unless ($thisdep=~/\*/) {
        $scrout.='<a href="'.$thisdep.'">';         $scrout.='<a href="'.$thisdep.'">';
Line 377  sub publish { Line 405  sub publish {
    }     }
        }         }
            }             }
         } keys %allow;          }
         $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;          $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
     }  
 # ------------------------------------------------------------- Write modified  # ------------------------------------------------------------- Write modified
   
         {          {
Line 432  sub publish { Line 460  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 472  sub publish { Line 500  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 481  sub publish { Line 509  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 496  sub publish { Line 524  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 506  sub publish { Line 534  sub publish {
   
         $scrout.=          $scrout.=
      '<form action="/adm/publish" method="post">'.       '<form action="/adm/publish" method="post">'.
          '<p><input type="submit" value="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 518  sub publish { Line 547  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 528  sub publish { Line 558  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 573  sub publish { Line 604  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 587  sub publish { Line 621  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"></form>';        '<p><input type="submit" value="Finalize Publication" /></p></form>';
 }  }
   
 # -------------------------------------------------------- Publication Step Two  # -------------------------------------------------------- Publication Step Two
Line 631  sub phasetwo { Line 670  sub phasetwo {
      $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};       $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
      $metadatafields{'owner'}=$ENV{'form.owner'};       $metadatafields{'owner'}=$ENV{'form.owner'};
      $metadatafields{'copyright'}=$ENV{'form.copyright'};       $metadatafields{'copyright'}=$ENV{'form.copyright'};
        $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 648  sub phasetwo { Line 688  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 697  sub phasetwo { Line 729  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 730  sub phasetwo { Line 763  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 909  sub handler { Line 946  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 918  sub handler { Line 955  sub handler {
               $ENV{'form.'.$name}=$value;                $ENV{'form.'.$name}=$value;
    }     }
        }         }
     } (split(/&/,$ENV{'QUERY_STRING'}));      }
   
   
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
Line 993  unless ($ENV{'form.phase'} eq 'two') { Line 1030  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 1036  unless ($ENV{'form.phase'} eq 'two') { Line 1053  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 1050  unless ($ENV{'form.phase'} eq 'two') { Line 1067  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 1058  unless ($ENV{'form.phase'} eq 'two') { Line 1075  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 1083  unless ($ENV{'form.phase'} eq 'two') { Line 1100  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.59  
changed lines
  Added in v.1.69


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