--- loncom/publisher/lonpublisher.pm 2000/11/28 22:15:11 1.1 +++ loncom/publisher/lonpublisher.pm 2000/11/30 16:22:13 1.6 @@ -5,26 +5,294 @@ # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # -# 11/28 Gerd Kortemeyer +# 11/28,11/29,11/30 Gerd Kortemeyer package Apache::lonpublisher; use strict; use Apache::File; -use Apache::Constants qw(:common); +use Apache::Constants qw(:common :http :methods); +use HTML::TokeParser; +use Apache::lonxml; +use Apache::lonhomework; + +my %addid; +my %nokey; + +sub publish { + + my ($source,$target,$style)=@_; + my $logfile; + my $scrout=''; + + 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 + +# ----------------------------------------------------------------- Backup Copy + 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 { + print $logfile "Unable to write backup ".$copyfile."\n"; + return "Failed to write backup copy, FAIL"; + } +# ------------------------------------------------------------- IDs and indices + + my $maxindex=10; + my $maxid=10; + my $content=''; + my $needsfixup=0; + + { + my $org=Apache::File->new($source); + $content=join('',<$org>); + } + { + my $parser=HTML::TokeParser->new(\$content); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $counter; + if ($counter=$addid{$token->[1]}) { + if ($counter eq 'id') { + if (defined($token->[2]->{'id'})) { + $maxid= + ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; + } else { + $needsfixup=1; + } + } else { + if (defined($token->[2]->{'index'})) { + $maxindex= + ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex; + } else { + $needsfixup=1; + } + } + } + } + } + } + if ($needsfixup) { + print $logfile "Needs ID and/or index fixup\n". + "Max ID : $maxid (min 10)\n". + "Max Index: $maxindex (min 10)\n"; + + my $outstring=''; + my $parser=HTML::TokeParser->new(\$content); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $counter; + if ($counter=$addid{$token->[1]}) { + if ($counter eq 'id') { + if (defined($token->[2]->{'id'})) { + $outstring.=$token->[4]; + } else { + $maxid++; + my $thisid=' id="'.$maxid.'"'; + my $fixup=$token->[4]; + $fixup=~s/(\<\w+)/$1$thisid/; + $outstring.=$fixup; + print $logfile 'ID: '.$fixup."\n"; + } + } else { + if (defined($token->[2]->{'index'})) { + $outstring.=$token->[4]; + } else { + $maxindex++; + my $thisindex=' index="'.$maxindex.'"'; + my $fixup=$token->[4]; + $fixup=~s/(\<\w+)/$1$thisindex/; + $outstring.=$fixup; + print $logfile 'Index: '.$fixup."\n"; + } + } + } else { + $outstring.=$token->[4]; + } + } elsif ($token->[0] eq 'E') { + $outstring.=$token->[2]; + } else { + $outstring.=$token->[1]; + } + } + { + my $org; + unless ($org=Apache::File->new('>'.$source)) { + print $logfile "No write permit to $source\n"; + return "No write permission to $source, FAIL"; + } + print $org $outstring; + } + $content=$outstring; + print $logfile "End of ID and/or index fixup\n". + "Max ID : $maxid (min 10)\n". + "Max Index: $maxindex (min 10)\n"; + } else { + print $logfile "Does not need ID and/or index fixup\n"; + } +# -------------------------------------------------- Parse content for metadata + + my $allmeta=''; + if ($source=~/\.problem$/) { + $allmeta=Apache::lonhomework::subhandler('meta',$content); + } else { + $allmeta=Apache::lonxml::xmlparse('meta',$content); + } + +# DEBUG: + + $scrout=$allmeta; + +# --------------------------------------------------- Scan content for keywords + { + my $textonly=$content; + $textonly=~s/\//g; + $textonly=~s/\[^\<]+\<\/m\>//g; + $textonly=~s/\<[^\>]*\>//g; + $textonly=~tr/A-Z/a-z/; + $textonly=~s/[\$\&][a-z]\w*//g; + $textonly=~s/[^a-z\s]//g; + + my %keywords=(); + map { + unless ($nokey{$_}) { + $keywords{$_}=1; + } + } ($textonly=~m/(\w+)/g); + +# DEBUG: + + $scrout.=join('
',sort keys %keywords); + + } + + + } + return $scrout; +} # ================================================================ 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; + } + + unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) { + $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + + $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; + } + } + + %nokey=(); + + { + my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); + map { + my $word=$_; + chomp($word); + $nokey{$word}=1; + } <$fh>; + } +# ----------------------------------------------------------- Start page output + $r->content_type('text/html'); $r->send_http_header; - return OK if $r->header_only; - $r->print('LON-CAPA Publishing'); $r->print(''); - $r->print('

'.$ENV{'form.filename'}.'

'); + 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('

Publishing '. + &Apache::lonnet::filedescription($thistype).' '. + $thisdisfn.'

Target: '.$thisdistarget.'

'); + +# ------------ We are publishing from $thisfn to $thistarget with $thisembstyle + + $r->print('Result: '.&publish($thisfn,$thistarget,$thisembstyle)); + + } + $r->print(''); return OK;