Diff for /loncom/publisher/lonpublisher.pm between versions 1.147 and 1.151

version 1.147, 2003/12/16 14:42:34 version 1.151, 2003/12/26 18:25:29
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 219  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 693  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 708  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 780  Returns: (error,status).  error is undef Line 767  Returns: (error,status).  error is undef
 #########################################  #########################################
 #########################################  #########################################
 sub store_metadata {  sub store_metadata {
     my %metadata = %{shift()};      my %metadata = @_;
     my $error;      my $error;
     # Determine if the table exists      # Determine if the table exists
     my $status = &Apache::lonmysql::check_table('metadata');      my $status = &Apache::lonmysql::check_table('metadata');
Line 797  sub store_metadata { Line 784  sub store_metadata {
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
     # Remove old value from table  
     $status = &Apache::lonmysql::remove_from_table  
         ('metadata','url',$metadata{'url'});  
     if (! defined($status)) {  
         $error = '<font color="red">Error when removing old values from '.  
             'metadata table in LON-CAPA database.</font>';  
         &Apache::lonnet::logthis($error);  
         return ($error,undef);  
     }  
     # Store data in table.  
     $status = &Apache::lonmysql::store_row('metadata',\%metadata);      $status = &Apache::lonmysql::store_row('metadata',\%metadata);
     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 975  sub publish { Line 952  sub publish {
                                  $ENV{'user.domain'};                                   $ENV{'user.domain'};
  $metadatafields{'authorspace'}=$cuname.'@'.$cudom;   $metadatafields{'authorspace'}=$cuname.'@'.$cudom;
   
 # ----------------------------------------------------------- Parse file itself  
 # read %metadatafields from file itself  
    
  $allmeta=&parseformeta($source,$style);  
 # ------------------------------------------------ Check out directory hierachy  # ------------------------------------------------ Check out directory hierachy
   
         my $thisdisfn=$source;          my $thisdisfn=$source;
Line 995  sub publish { Line 968  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 1157  END Line 1134  END
   
  $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 1351  sub phasetwo { Line 1343  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 1556  sub phasetwo { Line 1557  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 1855  ENDDIFF Line 1857  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.147  
changed lines
  Added in v.1.151


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