Return to lonpublisher.pm CVS log

Up to [LON-CAPA] / loncom / publisher

Annotation of loncom/publisher/lonpublisher.pm, revision 1.3

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Publication Handler
                      3: # 
                      4: # (TeX Content Handler
                      5: #
                      6: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
                      7: #
1.2       www         8: # 11/28,11/29 Gerd Kortemeyer
1.1       www         9: 
                     10: package Apache::lonpublisher;
                     11: 
                     12: use strict;
                     13: use Apache::File;
1.2       www        14: use Apache::Constants qw(:common :http :methods);
                     15: use HTML::TokeParser;
                     16: 
1.3     ! www        17: my %addid;
        !            18: 
1.2       www        19: sub publish {
                     20:     my ($source,$target,$style)=@_;
                     21:     my $logfile;
                     22:     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
                     23: 	return 'No write permission to user directory, FAIL';
                     24:     }
                     25:     print $logfile 
                     26: "\n\n================== Publish ".localtime()." =================\n";
                     27: 
1.3     ! www        28:     if (($style eq 'ssi') || ($style eq 'rat')) {
        !            29: # ------------------------------------------------------- This needs processing
        !            30: 	my $copyfile=$source.'.save';
        !            31:         {
        !            32: 	    my $org=Apache::File->new($source);
        !            33:             my $cop=Apache::File->new('>'.$copyfile);
        !            34:             while (my $line=<$org>) { print $cop $line; }
        !            35:         }
        !            36:         if (-e $copyfile) {
        !            37: 	    print $logfile "Copied original file to ".$copyfile."\n";
        !            38:         } else {
        !            39:             return "Failed to write backup copy, FAIL";
        !            40:         }
        !            41: 
        !            42:     }
1.2       www        43:     my $version='';
                     44:    
                     45:     return 'Version '.$version.', SUCCESS';
                     46: }
1.1       www        47: 
                     48: # ================================================================ Main Handler
                     49: 
                     50: sub handler {
                     51:   my $r=shift;
1.2       www        52: 
                     53:   if ($r->header_only) {
                     54:      $r->content_type('text/html');
                     55:      $r->send_http_header;
                     56:      return OK;
                     57:   }
                     58: 
                     59: # -------------------------------------------------------------- Check filename
                     60: 
                     61:   my $fn=$ENV{'form.filename'};
                     62: 
                     63:   unless ($fn) { 
                     64:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                     65:          ' trying to publish empty filename', $r->filename); 
                     66:      return HTTP_NOT_FOUND;
                     67:   } 
                     68: 
                     69:   $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
                     70: 
                     71:   my $targetdir='';
                     72:   my $docroot=$r->dir_config('lonDocRoot'); 
                     73:   if ($1 ne $ENV{'user.name'}) {
                     74:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                     75:          ' trying to publish unowned file '.$ENV{'form.filename'}.
                     76:          ' ('.$fn.')', 
                     77:          $r->filename); 
                     78:      return HTTP_NOT_ACCEPTABLE;
                     79:   } else {
                     80:       $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
                     81:   }
                     82:                                  
                     83:   
                     84:   unless (-e $fn) { 
                     85:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                     86:          ' trying to publish non-existing file '.$ENV{'form.filename'}.
                     87:          ' ('.$fn.')', 
                     88:          $r->filename); 
                     89:      return HTTP_NOT_FOUND;
                     90:   } 
                     91: 
                     92: # --------------------------------- File is there and owned, init lookup tables
                     93: 
1.3     ! www        94:   %addid=();
        !            95: 
        !            96:   {
        !            97:       my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
        !            98:       while (<$fh>=~/(\w+)\s+(\w+)/) {
        !            99:           $addid{$1}=$2;
        !           100:       }
        !           101:   }
1.2       www       102: # ----------------------------------------------------------- Start page output
                    103: 
1.1       www       104:   $r->content_type('text/html');
                    105:   $r->send_http_header;
                    106: 
                    107:   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
                    108:   $r->print('<body bgcolor="#FFFFFF">');
1.2       www       109:   my $thisfn=$fn;
                    110:    
                    111: # ------------------------------------------------------------- Individual file
                    112:   {
                    113:       $thisfn=~/\.(\w+)$/;
                    114:       my $thistype=$1;
                    115:       my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
                    116: 
                    117:       my $thistarget=$thisfn;
                    118:       
                    119:       $thistarget=~s/^\/home/$targetdir/;
                    120:       $thistarget=~s/\/public\_html//;
                    121: 
                    122:       my $thisdistarget=$thistarget;
                    123:       $thisdistarget=~s/^$docroot//;
                    124: 
                    125:       my $thisdisfn=$thisfn;
                    126:       $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
                    127: 
                    128:       $r->print('<h2>Publishing '.
                    129:         &Apache::lonnet::filedescription($thistype).' <tt>'.
                    130:         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
                    131: 
                    132: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
                    133: 
                    134:       $r->print('<b>Result:</b> '.&publish($thisfn,$thistarget,$thisembstyle));
                    135:       
                    136:   }  
                    137: 
1.1       www       138:   $r->print('</body></html>');
                    139: 
                    140:   return OK;
                    141: }
                    142: 
                    143: 1;
                    144: __END__
                    145: 
                    146: 
                    147: 
                    148: 
                    149: 
                    150: 
                    151: