File:  [LON-CAPA] / loncom / publisher / lonpublisher.pm
Revision 1.3: download - view: text, annotated - select for diffs
Wed Nov 29 19:52:34 2000 UTC (23 years, 5 months ago) by www
Branches: MAIN
CVS tags: HEAD
Reads addid.tab, makes backup copy

# The LearningOnline Network with CAPA
# Publication Handler
# 
# (TeX Content Handler
#
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
# 11/28,11/29 Gerd Kortemeyer

package Apache::lonpublisher;

use strict;
use Apache::File;
use Apache::Constants qw(:common :http :methods);
use HTML::TokeParser;

my %addid;

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";

    if (($style eq 'ssi') || ($style eq 'rat')) {
# ------------------------------------------------------- This needs processing
	my $copyfile=$source.'.save';
        {
	    my $org=Apache::File->new($source);
            my $cop=Apache::File->new('>'.$copyfile);
            while (my $line=<$org>) { print $cop $line; }
        }
        if (-e $copyfile) {
	    print $logfile "Copied original file to ".$copyfile."\n";
        } else {
            return "Failed to write backup copy, FAIL";
        }

    }
    my $version='';
   
    return 'Version '.$version.', SUCCESS';
}

# ================================================================ Main Handler

sub handler {
  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

  %addid=();

  {
      my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
      while (<$fh>=~/(\w+)\s+(\w+)/) {
          $addid{$1}=$2;
      }
  }
# ----------------------------------------------------------- Start page output

  $r->content_type('text/html');
  $r->send_http_header;

  $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
  $r->print('<body bgcolor="#FFFFFF">');
  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>');

  return OK;
}

1;
__END__








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