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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.1 and 1.2

version 1.1, 2000/11/28 22:15:11 version 1.2, 2000/11/29 12:28:46
Line 5 Line 5
 #  #
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  # 05/29/00,05/30,10/11 Gerd Kortemeyer)
 #  #
 # 11/28 Gerd Kortemeyer  # 11/28,11/29 Gerd Kortemeyer
   
 package Apache::lonpublisher;  package Apache::lonpublisher;
   
 use strict;  use strict;
 use Apache::File;  use Apache::File;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common :http :methods);
   use HTML::TokeParser;
   
   sub publish {
       my ($source,$target,$style)=@_;
       my $logfile;
       unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
    return 'No write permission to user directory, FAIL';
       }
       print $logfile 
   "\n\n================== Publish ".localtime()." =================\n";
   
       my $version='';
      
       return 'Version '.$version.', SUCCESS';
   }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
 sub handler {  sub handler {
   my $r=shift;    my $r=shift;
   
     if ($r->header_only) {
        $r->content_type('text/html');
        $r->send_http_header;
        return OK;
     }
   
   # -------------------------------------------------------------- Check filename
   
     my $fn=$ENV{'form.filename'};
   
     unless ($fn) { 
        $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
            ' trying to publish empty filename', $r->filename); 
        return HTTP_NOT_FOUND;
     } 
   
     $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
   
     my $targetdir='';
     my $docroot=$r->dir_config('lonDocRoot'); 
     if ($1 ne $ENV{'user.name'}) {
        $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
            ' trying to publish unowned file '.$ENV{'form.filename'}.
            ' ('.$fn.')', 
            $r->filename); 
        return HTTP_NOT_ACCEPTABLE;
     } else {
         $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
     }
                                    
     
     unless (-e $fn) { 
        $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
            ' trying to publish non-existing file '.$ENV{'form.filename'}.
            ' ('.$fn.')', 
            $r->filename); 
        return HTTP_NOT_FOUND;
     } 
   
   # --------------------------------- File is there and owned, init lookup tables
   
   # ----------------------------------------------------------- Start page output
   
   $r->content_type('text/html');    $r->content_type('text/html');
   $r->send_http_header;    $r->send_http_header;
   
   return OK if $r->header_only;  
   
   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');    $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
   $r->print('<body bgcolor="#FFFFFF">');    $r->print('<body bgcolor="#FFFFFF">');
   $r->print('<h1>'.$ENV{'form.filename'}.'</h1>');    my $thisfn=$fn;
      
   # ------------------------------------------------------------- Individual file
     {
         $thisfn=~/\.(\w+)$/;
         my $thistype=$1;
         my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
   
         my $thistarget=$thisfn;
         
         $thistarget=~s/^\/home/$targetdir/;
         $thistarget=~s/\/public\_html//;
   
         my $thisdistarget=$thistarget;
         $thisdistarget=~s/^$docroot//;
   
         my $thisdisfn=$thisfn;
         $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
   
         $r->print('<h2>Publishing '.
           &Apache::lonnet::filedescription($thistype).' <tt>'.
           $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
   
   # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
   
         $r->print('<b>Result:</b> '.&publish($thisfn,$thistarget,$thisembstyle));
         
     }  
   
   $r->print('</body></html>');    $r->print('</body></html>');
   
   return OK;    return OK;
Removed from v.1.1  
changed lines
  Added in v.1.2

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