--- loncom/publisher/lonpublisher.pm 2000/11/29 19:52:34 1.3 +++ loncom/publisher/lonpublisher.pm 2000/12/01 12:08:01 1.8 @@ -5,7 +5,7 @@ # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # -# 11/28,11/29 Gerd Kortemeyer +# 11/28,11/29,11/30,12/01 Gerd Kortemeyer package Apache::lonpublisher; @@ -13,20 +13,89 @@ use strict; use Apache::File; use Apache::Constants qw(:common :http :methods); use HTML::TokeParser; +use Apache::lonxml; +use Apache::lonhomework; my %addid; +my %nokey; + +my %metadatafields; +my %metadatakeys; + +sub metaeval { + my $metastring=shift; + + my $parser=HTML::TokeParser->new(\$metastring); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $entry=$token->[1]; + my $unikey=$entry; + if (defined($token->[2]->{'part'})) { + $unikey.='_'.$token->[2]->{'part'}; + } + if (defined($token->[2]->{'name'})) { + $unikey.='_'.$token->[2]->{'name'}; + } + map { + $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; + if ($metadatakeys{$unikey}) { + $metadatakeys{$unikey}.=','.$_; + } else { + $metadatakeys{$unikey}=$_; + } + } @{$token->[3]}; + if ($metadatafields{$unikey}) { + my $newentry=$parser->get_text('/'.$entry); + unless ($metadatafields{$unikey}=~/$newentry/) { + $metadatafields{$unikey}.=', '.$newentry; + } + } else { + $metadatafields{$unikey}=$parser->get_text('/'.$entry); + } + } + } +} + +sub metaread { + my ($logfile,$fn)=@_; + unless (-e $fn) { + print $logfile 'No file '.$fn."\n"; + return '
No file: '.$fn.''; + } + print $logfile 'Processing '.$fn."\n"; + my $metastring; + { + my $metafh=Apache::File->new($fn); + $metastring=join('',<$metafh>); + } + &metaeval($metastring); + return '
Processed file: '.$fn.''; +} + +sub textfield { + my ($title,$value)=@_; + return "\n

$title:
". + ''; +} 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'; + 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); @@ -36,13 +105,258 @@ sub publish { if (-e $copyfile) { print $logfile "Copied original file to ".$copyfile."\n"; } else { - return "Failed to write backup copy, FAIL"; + 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"; + } +# --------------------------------------------- Initial step done, now metadata + +# ---------------------------------------- Storage for metadata keys and fields + + %metadatafields=(); + %metadatakeys=(); + + my %oldparmstores=(); + +# ------------------------------------------------ First, check out environment + unless (-e $source.'.meta') { + $metadatafields{'author'}=$ENV{'environment.firstname'}.' '. + $ENV{'environment.middlename'}.' '. + $ENV{'environment.lastname'}.' '. + $ENV{'environment.generation'}; + $metadatafields{'author'}=~s/\s+/ /g; + $metadatafields{'author'}=~s/\s+$//; + +# ------------------------------------------------ Check out directory hierachy + + my $thisdisfn=$source; + $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///; + + my @urlparts=split(/\//,$thisdisfn); + $#urlparts--; + + my $currentpath='/home/'.$ENV{'user.name'}.'/'; + + map { + $currentpath.=$_.'/'; + $scrout.=&metaread($logfile,$currentpath.'default.meta'); + } @urlparts; + +# ------------------- Clear out parameters and stores (there should not be any) + + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + delete $metadatafields{$_}; + } + } keys %metadatafields; + + } else { +# ---------------------- Read previous metafile, remember parameters and stores + + $scrout.=&metaread($logfile,$source.'.meta'); + + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + $oldparmstores{$_}=1; + delete $metadatafields{$_}; + } + } keys %metadatafields; + } - my $version=''; - - return 'Version '.$version.', SUCCESS'; + +# -------------------------------------------------- Parse content for metadata + + my $allmeta=''; + if ($source=~/\.problem$/) { + $allmeta=Apache::lonhomework::subhandler('meta',$content); + } else { + $allmeta=Apache::lonxml::xmlparse('meta',$content); + } + &metaeval($allmeta); + +# ---------------- Find and document discrepancies in the parameters and stores + + my $chparms=''; + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + unless ($_=~/\.\w+$/) { + unless ($oldparmstores{$_}) { + print $logfile 'New: '.$_."\n"; + $chparms.=$_.' '; + } + } + } + } sort keys %metadatafields; + if ($chparms) { + $scrout.='

New parameters or stored values: '. + $chparms; + } + + my $chparms=''; + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) { + print $logfile 'Obsolete: '.$_."\n"; + $chparms.=$_.' '; + } + } + } sort keys %oldparmstores; + if ($chparms) { + $scrout.='

Obsolete parameters or stored values: '. + $chparms; + } + +# ------------------------------------------------------- Now have all metadata + + $scrout.= + '

'. + ''. + ''. + &textfield('Title',$metadatafields{'title'}). + &textfield('Author(s)',$metadatafields{'author'}). + &textfield('Subject',$metadatafields{'subject'}); + +# --------------------------------------------------- Scan content for keywords + + my $keywordout='

Keywords:
'; + my $colcount=0; + + { + 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); + + + map { + $keywordout.='\n"; + $colcount=0; + } + $colcount++; + } sort keys %keywords; + $keywordout.='
'; + if ($colcount>10) { + $keywordout.="
'; + + } + +# DEGUG + + $scrout.=$keywordout; + } + return $scrout. + '

'; } # ================================================================ Main Handler @@ -66,6 +380,14 @@ sub handler { 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=''; @@ -99,6 +421,17 @@ sub handler { $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'); @@ -131,7 +464,7 @@ sub handler { # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle - $r->print('Result: '.&publish($thisfn,$thistarget,$thisembstyle)); + $r->print('
'.&publish($thisfn,$thistarget,$thisembstyle)); }