--- loncom/publisher/lonpublisher.pm 2002/05/23 21:12:44 1.82 +++ loncom/publisher/lonpublisher.pm 2003/07/15 20:18:30 1.125 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.82 2002/05/23 21:12:44 albertel Exp $ +# $Id: lonpublisher.pm,v 1.125 2003/07/15 20:18:30 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,18 +33,14 @@ # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer # 03/23 Guy Albertelli # 03/24,03/29,04/03 Gerd Kortemeyer -# 04/16/2001 Scott Harrison # 05/03,05/05,05/07 Gerd Kortemeyer -# 05/28/2001 Scott Harrison # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer # 12/04,12/05 Guy Albertelli # 12/05 Gerd Kortemeyer # 12/05 Guy Albertelli # 12/06,12/07 Gerd Kortemeyer -# 12/15,12/16 Scott Harrison # 12/25 Gerd Kortemeyer # YEAR=2002 -# 1/16,1/17 Scott Harrison # 1/17 Gerd Kortemeyer # ### @@ -61,6 +57,57 @@ ## ## ############################################################################### + +###################################################################### +###################################################################### + +=pod + +=head1 NAME + +lonpublisher - LON-CAPA publishing handler + +=head1 SYNOPSIS + +B is used by B inside B. This is the +invocation by F: + + + PerlAccessHandler Apache::lonacc + SetHandler perl-script + PerlHandler Apache::lonpublisher + ErrorDocument 403 /adm/login + ErrorDocument 404 /adm/notfound.html + ErrorDocument 406 /adm/unauthorized.html + ErrorDocument 500 /adm/errorhandler + + +=head1 DESCRIPTION + +B takes the proper steps to add resources to the LON-CAPA +digital library. This includes updating the metadata table in the +LON-CAPA database. + +B is many things to many people. + +This module publishes a file. This involves gathering metadata, +versioning the file, copying file from construction space to +publication space, and copying metadata from construction space +to publication space. + +=head2 SUBROUTINES + +Many of the undocumented subroutines implement various magical +parsing shortcuts. + +=over 4 + +=cut + +###################################################################### +###################################################################### + + package Apache::lonpublisher; # ------------------------------------------------- modules used by this module @@ -70,24 +117,48 @@ use File::Copy; use Apache::Constants qw(:common :http :methods); use HTML::LCParser; use Apache::lonxml; -use Apache::lonhomework; use Apache::loncacc; use DBI; use Apache::lonnet(); use Apache::loncommon(); +use Apache::lonmysql; +use vars qw(%metadatafields %metadatakeys); my %addid; my %nokey; -my %metadatafields; -my %metadatakeys; - my $docroot; my $cuname; my $cudom; -# ----------------------------------------------- Evaluate string with metadata +=pod + +=item B + +Evaluates a string that contains metadata. This subroutine +stores values inside I<%metadatafields> and I<%metadatakeys>. +The hash key is a I<$unikey> corresponding to a unique id +that is descriptive of the parser location inside the XML tree. + +Parameters: + +=over 4 + +=item I<$metastring> + +A string that contains metadata. + +=back + +Returns: + +nothing + +=cut + +######################################### +######################################### sub metaeval { my $metastring=shift; @@ -119,7 +190,7 @@ sub metaeval { } if ($metadatafields{$unikey}) { my $newentry=$parser->get_text('/'.$entry); - unless (($metadatafields{$unikey}=~/$newentry/) || + unless (($metadatafields{$unikey}=~/\Q$newentry\E/) || ($newentry eq '')) { $metadatafields{$unikey}.=', '.$newentry; } @@ -130,50 +201,126 @@ sub metaeval { } } -# -------------------------------------------------------- Read a metadata file +######################################### +######################################### + +=pod + +=item B + +Read a metadata file + +Parameters: + +=over + +=item I<$logfile> + +File output stream to output errors and warnings to. + +=item I<$fn> + +File name (including path). + +=back + +Returns: + +=over 4 + +=item Scalar string (if successful) + +XHTML text that indicates successful reading of the metadata. + +=back + +=cut + +######################################### +######################################### sub metaread { my ($logfile,$fn)=@_; unless (-e $fn) { - print $logfile 'No file '.$fn."\n"; - return '
No file: '.$fn.''; + print($logfile 'No file '.$fn."\n"); + return '
No file: '.$fn.''; } - print $logfile 'Processing '.$fn."\n"; + print($logfile 'Processing '.$fn."\n"); my $metastring; { my $metafh=Apache::File->new($fn); $metastring=join('',<$metafh>); } &metaeval($metastring); - return '
Processed file: '.$fn.''; + return '
Processed file: '.$fn.''; } -# ---------------------------- convert 'time' format into a datetime sql format -sub sqltime { - my $timef=shift @_; - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = - localtime($timef); - $mon++; $year+=1900; - return "$year-$mon-$mday $hour:$min:$sec"; +######################################### +######################################### + +sub coursedependencies { + my $url=&Apache::lonnet::declutter(shift); + $url=~s/\.meta$//; + my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); + my $regexp=$url; + $regexp=~s/(\W)/\\$1/g; + $regexp='___'.$regexp.'___course'; + my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, + $aauthor,$regexp); + my %courses=(); + foreach (keys %evaldata) { + if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { + $courses{$1}=1; + } + } + return %courses; } +######################################### +######################################### + + +=pod + +=item Form-field-generating subroutines. + +For input parameters, these subroutines take in values +such as I<$name>, I<$value> and other form field metadata. +The output (scalar string that is returned) is an XHTML +string which presents the form field (foreseeably inside +
tags). -# --------------------------------------------------------- Various form fields +=over 4 + +=item B + +=item B +=item B + +=back + +=cut + +######################################### +######################################### sub textfield { my ($title,$name,$value)=@_; - return "\n

$title:
". - ''; + my $uctitle=uc($title); + return "\n

$uctitle:". + "


". + ''; } sub hiddenfield { my ($name,$value)=@_; - return "\n".''; + return "\n".''; } sub selectbox { my ($title,$name,$value,$functionref,@idlist)=@_; my $uctitle=uc($title); + $value=(split(/\s*,\s*/,$value))[-1]; my $selout="\n

$uctitle:". - "
".''; foreach (@idlist) { $selout.='

Dependencies

'; @@ -421,7 +844,7 @@ sub publish { unless ($style eq 'rat') { $allowstr.="\n".''; } - $scrout.='
'; + $scrout.='
'; unless ($thisdep=~/\*/) { $scrout.=''; } @@ -431,55 +854,52 @@ sub publish { if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= - ' - Currently not available'; + $scrout.= ' - Currently not available'. + ''; } else { my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' => time); $thisdep=~/^\/res\/(\w+)\/(\w+)\//; if ((defined($1)) && (defined($2))) { - &Apache::lonnet::put('resevaldata',\%temphash,$1,$2); + &Apache::lonnet::put('nohist_resevaldata',\%temphash, + $1,$2); } } } } - $allowstr=~s/\n+/\n/g; - $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s; + $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s; #Encode any High ASCII characters $outstring=&HTML::Entities::encode($outstring,"\200-\377"); -# ------------------------------------------------------------- Write modified +# ------------------------------------------------------------- Write modified. { my $org; unless ($org=Apache::File->new('>'.$source)) { print $logfile "No write permit to $source\n"; - return - "No write permission to $source, FAIL"; + return ('No write permission to '.$source. + ', FAIL',1); } - print $org $outstring; + print($org $outstring); } $content=$outstring; - if ($needsfixup) { - 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 +# -------------------------------------------- Initial step done, now metadata. -# ---------------------------------------- Storage for metadata keys and fields +# --------------------------------------- Storage for metadata keys and fields. %metadatafields=(); %metadatakeys=(); my %oldparmstores=(); - $scrout.='

Metadata Information

'; + unless ($batch) { + $scrout.='

Metadata Information ' . + Apache::loncommon::help_open_topic("Metadata_Description") + . '

'; + } # ------------------------------------------------ First, check out environment unless (-e $source.'.meta') { @@ -490,11 +910,14 @@ sub publish { $metadatafields{'author'}=~s/\s+/ /g; $metadatafields{'author'}=~s/\s+$//; $metadatafields{'owner'}=$cuname.'@'.$cudom; + $metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'. + $ENV{'user.domain'}; + $metadatafields{'authorspace'}=$cuname.'@'.$cudom; # ------------------------------------------------ Check out directory hierachy my $thisdisfn=$source; - $thisdisfn=~s/^\/home\/$cuname\///; + $thisdisfn=~s/^\/home\/\Q$cuname\E\///; my @urlparts=split(/\//,$thisdisfn); $#urlparts--; @@ -529,7 +952,7 @@ sub publish { } # -------------------------------------------------- Parse content for metadata - if ($style eq 'ssi') { + if (($style eq 'ssi') || ($style eq 'prv')) { my $oldenv=$ENV{'request.uri'}; $ENV{'request.uri'}=$target; @@ -540,463 +963,647 @@ sub publish { } # ---------------- Find and document discrepancies in the parameters and stores - my $chparms=''; - foreach (sort keys %metadatafields) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless ($_=~/\.\w+$/) { - unless ($oldparmstores{$_}) { - print $logfile 'New: '.$_."\n"; - $chparms.=$_.' '; - } - } - } - } - if ($chparms) { - $scrout.='

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

New parameters or stored values: '.$chparms.'

'; + } - $chparms=''; - foreach (sort keys %oldparmstores) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_.'.name'}) || - ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { - print $logfile 'Obsolete: '.$_."\n"; - $chparms.=$_.' '; - } - } - } - if ($chparms) { - $scrout.='

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

Obsolete parameters or stored values: '. + $chparms.'

'; + } # ------------------------------------------------------- Now have all metadata + my %keywords=(); + + if (length($content)<500000) { + 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; + + foreach ($textonly=~m/(\w+)/g) { + unless ($nokey{$_}) { + $keywords{$_}=1; + } + } + } + + + foreach (split(/\W+/,$metadatafields{'keywords'})) { + $keywords{$_}=1; + } +# --------------------------------------------------- Now we also have keywords +# ============================================================================= +# INTERACTIVE MODE +# + unless ($batch) { $scrout.= - '
'. - '

'. - &hiddenfield('phase','two'). - &hiddenfield('filename',$ENV{'form.filename'}). - &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). - &hiddenfield('dependencies',join(',',keys %allow)). - &textfield('Title','title',$metadatafields{'title'}). - &textfield('Author(s)','author',$metadatafields{'author'}). - &textfield('Subject','subject',$metadatafields{'subject'}); + ''. + '

'. + &hiddenfield('phase','two'). + &hiddenfield('filename',$ENV{'form.filename'}). + &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). + &hiddenfield('dependencies',join(',',keys %allow)). + &textfield('Title','title',$metadatafields{'title'}). + &textfield('Author(s)','author',$metadatafields{'author'}). + &textfield('Subject','subject',$metadatafields{'subject'}); # --------------------------------------------------- Scan content for keywords + my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); my $keywordout=<<"END"; -

Keywords: - - +

KEYWORDS: + $keywords_help + + +


END - $keywordout.=''; - my $colcount=0; - my %keywords=(); - - if (length($content)<500000) { - 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; - - foreach ($textonly=~m/(\w+)/g) { - unless ($nokey{$_}) { - $keywords{$_}=1; - } - } - } + $keywordout.='
'; + my $colcount=0; - - foreach (split(/\W+/,$metadatafields{'keywords'})) { - $keywords{$_}=1; - } + foreach (sort keys %keywords) { + $keywordout.='\n"; + $colcount=0; + } + $colcount++; + } - foreach (sort keys %keywords) { - $keywordout.='\n"; - $colcount=0; - } - $colcount++; - } - $keywordout.='
'; + if ($colcount>10) { + $keywordout.="
'; - if ($colcount>10) { - $keywordout.="
'; - $scrout.=$keywordout; + $scrout.=$keywordout; - $scrout.=&textfield('Additional Keywords','addkey',''); + $scrout.=&textfield('Additional Keywords','addkey',''); - $scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); + $scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); - $scrout.= - '

Abstract:
'; + $scrout.= + "\n

ABSTRACT:". + "


". + '

'; $source=~/\.(\w+)$/; $scrout.=&hiddenfield('mime',$1); - $scrout.=&selectbox('Language','language', - $metadatafields{'language'}, + my $defaultlanguage=$metadatafields{'language'}; + $defaultlanguage =~ s/\s*notset\s*//g; + $defaultlanguage =~ s/^,\s*//g; + $defaultlanguage =~ s/,\s*$//g; + + $scrout.=&selectbox('Language','language', + $defaultlanguage, \&Apache::loncommon::languagedescription, (&Apache::loncommon::languageids), - ); + ); - unless ($metadatafields{'creationdate'}) { + unless ($metadatafields{'creationdate'}) { $metadatafields{'creationdate'}=time; - } - $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'}); + } + $scrout.=&hiddenfield('creationdate', + &Apache::loncommon::unsqltime($metadatafields{'creationdate'})); + + $scrout.=&hiddenfield('lastrevisiondate',time); - $scrout.=&hiddenfield('lastrevisiondate',time); - $scrout.=&textfield('Publisher/Owner','owner', - $metadatafields{'owner'}); -# --------------------------------------------------- Correct copyright for rat - if ($style eq 'rat') { - if ($metadatafields{'copyright'} eq 'public') { - delete $metadatafields{'copyright'}; + $metadatafields{'owner'}); + +# -------------------------------------------------- Correct copyright for rat. + my $defaultoption=$metadatafields{'copyright'}; + unless ($defaultoption) { $defaultoption='default'; } + unless ($style eq 'prv') { + if ($style eq 'rat') { + if ($metadatafields{'copyright'} eq 'public') { + delete $metadatafields{'copyright'}; + $defaultoption='default'; + } + $scrout.=&selectbox('Copyright/Distribution','copyright', + $defaultoption, + \&Apache::loncommon::copyrightdescription, + (grep !/^public$/,(&Apache::loncommon::copyrightids))); + } else { + $scrout.=&selectbox('Copyright/Distribution','copyright', + $defaultoption, + \&Apache::loncommon::copyrightdescription, + (&Apache::loncommon::copyrightids)); + } + + my $copyright_help = + Apache::loncommon::help_open_topic('Publishing_Copyright'); + $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; + $scrout.=&textfield('Custom Distribution File','customdistributionfile', + $metadatafields{'customdistributionfile'}). + $copyright_help; + } else { + $scrout.=&hiddenfield('copyright','private'); + } + return ($scrout.'

',0); +# ============================================================================= +# BATCH MODE +# + } else { +# Transfer metadata directly to environment for stage 2 + foreach (keys %metadatafields) { + $ENV{'form.'.$_}=$metadatafields{$_}; + } + $ENV{'form.addkey'}=''; + $ENV{'form.keywords'}=''; + foreach (keys %keywords) { + if ($metadatafields{'keywords'}) { + if ($metadatafields{'keywords'}=~/\Q$_\E/) { + $ENV{'form.keywords'}.=$_.','; + } + } elsif (&Apache::loncommon::keyword($_)) { + $ENV{'form.keywords'}.=$_.','; + } + } + $ENV{'form.keywords'}=~s/\,$//; + unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; } + $ENV{'form.lastrevisiondate'}=time; + if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) || + (!$ENV{'form.copyright'})) { + $ENV{'form.copyright'}='default'; } - $scrout.=&selectbox('Copyright/Distribution','copyright', - $metadatafields{'copyright'}, - \&Apache::loncommon::copyrightdescription, - (grep !/^public$/,(&Apache::loncommon::copyrightids))); - } - else { - $scrout.=&selectbox('Copyright/Distribution','copyright', - $metadatafields{'copyright'}, - \&Apache::loncommon::copyrightdescription, - (&Apache::loncommon::copyrightids)); + $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); + return ($scrout,0); } - return $scrout. - '

'; } -# -------------------------------------------------------- Publication Step Two +######################################### +######################################### -sub phasetwo { +=pod - my ($source,$target,$style,$distarget)=@_; - my $logfile; - my $scrout=''; - unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return - 'No write permission to user directory, FAIL'; - } - print $logfile -"\n================= Publish ".localtime()." Phase Two ================\n"; +=item B - %metadatafields=(); - %metadatakeys=(); +Render second interface showing status of publication steps. +This is publication step two. - &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'})); +Parameters: - $metadatafields{'title'}=$ENV{'form.title'}; - $metadatafields{'author'}=$ENV{'form.author'}; - $metadatafields{'subject'}=$ENV{'form.subject'}; - $metadatafields{'notes'}=$ENV{'form.notes'}; - $metadatafields{'abstract'}=$ENV{'form.abstract'}; - $metadatafields{'mime'}=$ENV{'form.mime'}; - $metadatafields{'language'}=$ENV{'form.language'}; - $metadatafields{'creationdate'}=$ENV{'form.creationdate'}; - $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; - $metadatafields{'owner'}=$ENV{'form.owner'}; - $metadatafields{'copyright'}=$ENV{'form.copyright'}; - $metadatafields{'dependencies'}=$ENV{'form.dependencies'}; - - my $allkeywords=$ENV{'form.addkey'}; - if (exists($ENV{'form.keywords'}) && (ref($ENV{'form.keywords'}))) { - my @Keywords = @{$ENV{'form.keywords'}}; - foreach (@Keywords) { - $allkeywords.=','.$_; - } - } - $allkeywords=~s/\W+/\,/; - $allkeywords=~s/^\,//; - $metadatafields{'keywords'}=$allkeywords; - - { - print $logfile "\nWrite metadata file for ".$source; - my $mfh; - unless ($mfh=Apache::File->new('>'.$source.'.meta')) { - return - 'Could not write metadata, FAIL'; - } - foreach (sort keys %metadatafields) { - unless ($_=~/\./) { - my $unikey=$_; - $unikey=~/^([A-Za-z]+)/; - my $tag=$1; - $tag=~tr/A-Z/a-z/; - print $mfh "\n\<$tag"; - foreach (split(/\,/,$metadatakeys{$unikey})) { - my $value=$metadatafields{$unikey.'.'.$_}; - $value=~s/\"/\'\'/g; - print $mfh ' '.$_.'="'.$value.'"'; - } - print $mfh '>'. - &HTML::Entities::encode($metadatafields{$unikey}) - .''; - } - } - $scrout.='

Wrote Metadata'; - print $logfile "\nWrote metadata"; - } +=over 4 -# -------------------------------- Synchronize entry with SQL metadata database - my $warning; +=item I<$source> + +=item I<$target> + +=item I<$style> - unless ($metadatafields{'copyright'} eq 'priv') { +=item I<$distarget> - my $dbh; +=back + +Returns: + +=over 4 + +=item Scalar string + +String contains status (errors and warnings) and information associated with +the server's attempts at publication. + +=cut + +#'stupid emacs +######################################### +######################################### +sub phasetwo { + + my ($r,$source,$target,$style,$distarget,$batch)=@_; + $source=~s/\/+/\//g; + $target=~s/\/+/\//g; + + if ($target=~/\_\_\_/) { + $r->print( + 'Unsupported character combination "___" in filename, FAIL'); + return 0; + } + $distarget=~s/\/+/\//g; + my $logfile; + unless ($logfile=Apache::File->new('>>'.$source.'.log')) { + $r->print( + 'No write permission to user directory, FAIL'); + return 0; + } + print $logfile + "\n================= Publish ".localtime()." Phase Two ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n"; + + %metadatafields=(); + %metadatakeys=(); + + &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'})); + + $metadatafields{'title'}=$ENV{'form.title'}; + $metadatafields{'author'}=$ENV{'form.author'}; + $metadatafields{'subject'}=$ENV{'form.subject'}; + $metadatafields{'notes'}=$ENV{'form.notes'}; + $metadatafields{'abstract'}=$ENV{'form.abstract'}; + $metadatafields{'mime'}=$ENV{'form.mime'}; + $metadatafields{'language'}=$ENV{'form.language'}; + $metadatafields{'creationdate'}=$ENV{'form.creationdate'}; + $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; + $metadatafields{'owner'}=$ENV{'form.owner'}; + $metadatafields{'copyright'}=$ENV{'form.copyright'}; + $metadatafields{'customdistributionfile'}= + $ENV{'form.customdistributionfile'}; + $metadatafields{'dependencies'}=$ENV{'form.dependencies'}; + + my $allkeywords=$ENV{'form.addkey'}; + if (exists($ENV{'form.keywords'})) { + if (ref($ENV{'form.keywords'})) { + $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}}); + } else { + $allkeywords .= ','.$ENV{'form.keywords'}; + } + } + $allkeywords=~s/\W+/\,/; + $allkeywords=~s/^\,//; + $metadatafields{'keywords'}=$allkeywords; + { - unless ( - $dbh = DBI->connect("DBI:mysql:loncapa","www", - $Apache::lonnet::perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) - ) { - $warning='WARNING: Cannot connect to '. - 'database!'; - } - else { - my %sqldatafields; - $sqldatafields{'url'}=$distarget; - my $sth=$dbh->prepare( - 'delete from metadata where url like binary'. - '"'.$sqldatafields{'url'}.'"'); - $sth->execute(); - foreach ('title','author','subject','keywords','notes','abstract', - 'mime','language','creationdate','lastrevisiondate','owner', - 'copyright') { - my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; - $sqldatafields{$_}=$field; - } - - $sth=$dbh->prepare('insert into metadata values ('. - '"'.delete($sqldatafields{'title'}).'"'.','. - '"'.delete($sqldatafields{'author'}).'"'.','. - '"'.delete($sqldatafields{'subject'}).'"'.','. - '"'.delete($sqldatafields{'url'}).'"'.','. - '"'.delete($sqldatafields{'keywords'}).'"'.','. - '"'.'current'.'"'.','. - '"'.delete($sqldatafields{'notes'}).'"'.','. - '"'.delete($sqldatafields{'abstract'}).'"'.','. - '"'.delete($sqldatafields{'mime'}).'"'.','. - '"'.delete($sqldatafields{'language'}).'"'.','. - '"'. - sqltime(delete($sqldatafields{'creationdate'})) - .'"'.','. - '"'. - sqltime(delete( - $sqldatafields{'lastrevisiondate'})).'"'.','. - '"'.delete($sqldatafields{'owner'}).'"'.','. - '"'.delete( - $sqldatafields{'copyright'}).'"'.')'); - $sth->execute(); - $dbh->disconnect; - $scrout.='

Synchronized SQL metadata database'; - print $logfile "\nSynchronized SQL metadata database"; - } + print $logfile "\nWrite metadata file for ".$source; + my $mfh; + unless ($mfh=Apache::File->new('>'.$source.'.meta')) { + return + 'Could not write metadata, FAIL'; + } + foreach (sort keys %metadatafields) { + unless ($_=~/\./) { + my $unikey=$_; + $unikey=~/^([A-Za-z]+)/; + my $tag=$1; + $tag=~tr/A-Z/a-z/; + print $mfh "\n\<$tag"; + foreach (split(/\,/,$metadatakeys{$unikey})) { + my $value=$metadatafields{$unikey.'.'.$_}; + $value=~s/\"/\'\'/g; + print $mfh ' '.$_.'="'.$value.'"'; + } + print $mfh '>'. + &HTML::Entities::encode($metadatafields{$unikey}) + .''; + } + } + $r->print('

Wrote Metadata

'); + print $logfile "\nWrote metadata"; } + +# -------------------------------- Synchronize entry with SQL metadata database -} else { - $scrout.='

Private Publication - did not synchronize database'; - print $logfile "\nPrivate: Did not synchronize data into ". - "SQL metadata database"; -} + $metadatafields{'url'} = $distarget; + $metadatafields{'version'} = 'current'; + unless ($metadatafields{'copyright'} eq 'priv') { + my ($error,$success) = &store_metadata(\%metadatafields); + if ($success) { + $r->print('

Synchronized SQL metadata database

'); + print $logfile "\nSynchronized SQL metadata database"; + } else { + $r->print($error); + print $logfile "\n".$error; + } + } else { + $r->print('

Private Publication - did not synchronize database

'); + print $logfile "\nPrivate: Did not synchronize data into ". + "SQL metadata database"; + } # ----------------------------------------------------------- Copy old versions -if (-e $target) { - my $filename; - my $maxversion=0; - $target=~/(.*)\/([^\/]+)\.(\w+)$/; - my $srcf=$2; - my $srct=$3; - my $srcd=$1; - unless ($srcd=~/^\/home\/httpd\/html\/res/) { - print $logfile "\nPANIC: Target dir is ".$srcd; - return "Invalid target directory, FAIL"; - } - opendir(DIR,$srcd); - while ($filename=readdir(DIR)) { - if ($filename=~/$srcf\.(\d+)\.$srct$/) { - $maxversion=($1>$maxversion)?$1:$maxversion; - } - } - closedir(DIR); - $maxversion++; - $scrout.='

Creating old version '.$maxversion; - print $logfile "\nCreating old version ".$maxversion; - - my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; - + if (-e $target) { + my $filename; + my $maxversion=0; + $target=~/(.*)\/([^\/]+)\.(\w+)$/; + my $srcf=$2; + my $srct=$3; + my $srcd=$1; + unless ($srcd=~/^\/home\/httpd\/html\/res/) { + print $logfile "\nPANIC: Target dir is ".$srcd; + return "Invalid target directory, FAIL"; + } + opendir(DIR,$srcd); + while ($filename=readdir(DIR)) { + if (-l $srcd.'/'.$filename) { + unlink($srcd.'/'.$filename); + unlink($srcd.'/'.$filename.'.meta'); + } else { + if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) { + $maxversion=($1>$maxversion)?$1:$maxversion; + } + } + } + closedir(DIR); + $maxversion++; + $r->print('

Creating old version '.$maxversion.'

'); + print $logfile "\nCreating old version ".$maxversion."\n"; + + my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; + if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; - $scrout.='

Copied old target file'; + $r->print('

Copied old target file

'); } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy old target, $!, FAIL"; + return "Failed to copy old target, $!, FAIL"; } - + # --------------------------------------------------------------- Copy Metadata $copyfile=$copyfile.'.meta'; - + if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $scrout.='

Copied old metadata'; + $r->print('

Copied old metadata

') } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { - return - "Failed to write old metadata copy, $!, FAIL"; + return + "Failed to write old metadata copy, $!, FAIL"; } } - - -} else { - $scrout.='

Initial version'; - print $logfile "\nInitial version"; -} + + + } else { + $r->print('

Initial version

'); + print $logfile "\nInitial version"; + } # ---------------------------------------------------------------- Write Source - my $copyfile=$target; + my $copyfile=$target; + + my @parts=split(/\//,$copyfile); + my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; + + my $count; + for ($count=5;$count<$#parts;$count++) { + $path.="/$parts[$count]"; + if ((-e $path)!=1) { + print $logfile "\nCreating directory ".$path; + $r->print('

Created directory '.$parts[$count].'

'); + mkdir($path,0777); + } + } + + if (copy($source,$copyfile)) { + print $logfile "\nCopied original source to ".$copyfile."\n"; + $r->print('

Copied source file

'); + } else { + print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; + return "Failed to copy source, $!, FAIL"; + } + +# --------------------------------------------------------------- Copy Metadata - my @parts=split(/\//,$copyfile); - my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; + $copyfile=$copyfile.'.meta'; + + if (copy($source.'.meta',$copyfile)) { + print $logfile "\nCopied original metadata to ".$copyfile."\n"; + $r->print('

Copied metadata

'); + } else { + print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; + return + "Failed to write metadata copy, $!, FAIL"; + } + $r->rflush; +# --------------------------------------------------- Send update notifications - my $count; - for ($count=5;$count<$#parts;$count++) { - $path.="/$parts[$count]"; - if ((-e $path)!=1) { - print $logfile "\nCreating directory ".$path; - $scrout.='

Created directory '.$parts[$count]; - mkdir($path,0777); - } - } + my @subscribed=&get_subscribed_hosts($target); + foreach my $subhost (@subscribed) { + $r->print('

Notifying host '.$subhost.':');$r->rflush; + print $logfile "\nNotifying host ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + $r->print($reply.'


');$r->rflush; + print $logfile $reply; + } + +# ---------------------------------------- Send update notifications, meta only - if (copy($source,$copyfile)) { - print $logfile "Copied original source to ".$copyfile."\n"; - $scrout.='

Copied source file'; - } else { - print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy source, $!, FAIL"; - } + my @subscribedmeta=&get_subscribed_hosts("$target.meta"); + foreach my $subhost (@subscribedmeta) { + $r->print('

Notifying host for metadata only '.$subhost.':');$r->rflush; + print $logfile "\nNotifying host for metadata only ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', + $subhost); + $r->print($reply.'


');$r->rflush; + print $logfile $reply; + } + +# --------------------------------------------------- Notify subscribed courses + my %courses=&coursedependencies($target); + my $now=time; + foreach (keys %courses) { + $r->print('

Notifying course '.$_.':');$r->rflush; + print $logfile "\nNotifying host ".$_.':'; + my ($cdom,$cname)=split(/\_/,$_); + my $reply=&Apache::lonnet::cput + ('versionupdate',{$target => $now},$cdom,$cname); + $r->print($reply.'


');$r->rflush; + print $logfile $reply; + } +# ------------------------------------------------ Provide link to new resource + unless ($batch) { + my $thisdistarget=$target; + $thisdistarget=~s/^\Q$docroot\E//; + + my $thissrc=$source; + $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/; + + my $thissrcdir=$thissrc; + $thissrcdir=~s/\/[^\/]+$/\//; + + + $r->print( + '
'. + 'View Published Version'. + '

Back to Source

'. + '

Back to Source Directory

'); + } +} -# --------------------------------------------------------------- Copy Metadata +######################################### - $copyfile=$copyfile.'.meta'; +sub batchpublish { + my ($r,$srcfile,$targetfile)=@_; + $srcfile=~s/\/+/\//g; + $targetfile=~s/\/+/\//g; + my $thisdisfn=$srcfile; + $thisdisfn=~s/\/home\/korte\/public_html\///; + $srcfile=~s/\/+/\//g; + + my $docroot=$r->dir_config('lonDocRoot'); + my $thisdistarget=$targetfile; + $thisdistarget=~s/^\Q$docroot\E//; - if (copy($source.'.meta',$copyfile)) { - print $logfile "Copied original metadata to ".$copyfile."\n"; - $scrout.='

Copied metadata'; - } else { - print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; - return - "Failed to write metadata copy, $!, FAIL"; - } -# --------------------------------------------------- Send update notifications + undef %metadatafields; + undef %metadatakeys; + %metadatafields=(); + %metadatakeys=(); + $srcfile=~/\.(\w+)$/; + my $thistype=$1; -{ - my $filename; - - $target=~/(.*)\/([^\/]+)$/; - my $srcf=$2; - opendir(DIR,$1); - while ($filename=readdir(DIR)) { - if ($filename=~/$srcf\.(\w+)$/) { - my $subhost=$1; - if ($subhost ne 'meta') { - $scrout.='

Notifying host '.$subhost.':'; - print $logfile "\nNotifying host '.$subhost.':'"; - my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); - $scrout.=$reply; - print $logfile $reply; - } - } + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); + + $r->print('

Publishing '.$thisdisfn.'

'); + +# phase one takes +# my ($source,$target,$style,$batch)=@_; + my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1); + $r->print('

'.$outstring.'

'); +# phase two takes +# my ($source,$target,$style,$distarget,batch)=@_; +# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},... + if (!$error) { + $r->print('

'); + &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); + $r->print('

'); } - closedir(DIR); + return ''; +} + +######################################### +sub publishdirectory { + my ($r,$fn,$thisdisfn)=@_; + $fn=~s/\/+/\//g; + $thisdisfn=~s/\/+/\//g; + my $resdir= + $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. + $thisdisfn; + $r->print('

Directory '.$thisdisfn.'

'. + 'Target: '.$resdir.'
'); + + my $dirptr=16384; # Mask indicating a directory in stat.cmode. + + opendir(DIR,$fn); + my @files=sort(readdir(DIR)); + foreach my $filename (@files) { + my ($cdev,$cino,$cmode,$cnlink, + $cuid,$cgid,$crdev,$csize, + $catime,$cmtime,$cctime, + $cblksize,$cblocks)=stat($fn.'/'.$filename); + + my $extension=''; + if ($filename=~/\.(\w+)$/) { $extension=$1; } + if ($cmode&$dirptr) { + if (($filename!~/^\./) && ($ENV{'form.pubrec'})) { + &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename); + } + } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && + ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { +# find out publication status and/or exiting metadata + my $publishthis=0; + if (-e $resdir.'/'.$filename) { + my ($rdev,$rino,$rmode,$rnlink, + $ruid,$rgid,$rrdev,$rsize, + $ratime,$rmtime,$rctime, + $rblksize,$rblocks)=stat($resdir.'/'.$filename); + if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'})) { +# previously published, modified now + $publishthis=1; + } + } else { +# never published + $publishthis=1; + } + if ($publishthis) { + &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); + } else { + $r->print('
Skipping '.$filename.'
'); + } + $r->rflush(); + } + } + closedir(DIR); } +######################################### -# ---------------------------------------- Send update notifications, meta only +=pod -{ +=item B - my $filename; - - $target=~/(.*)\/([^\/]+)$/; - my $srcf=$2.'.meta'; - opendir(DIR,$1); - while ($filename=readdir(DIR)) { - if ($filename=~/$srcf\.(\w+)$/) { - my $subhost=$1; - if ($subhost ne 'meta') { - $scrout.= - '

Notifying host for metadata only '.$subhost.':'; - print $logfile - "\nNotifying host for metadata only '.$subhost.':'"; - my $reply=&Apache::lonnet::critical( - 'update:'.$target.'.meta',$subhost); - $scrout.=$reply; - print $logfile $reply; - } - } - } - closedir(DIR); +A basic outline of the handler subroutine follows. -} +=over 4 -# ------------------------------------------------ Provide link to new resource +=item * - my $thisdistarget=$target; - $thisdistarget=~s/^$docroot//; +Get query string for limited number of parameters. - my $thissrc=$source; - $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/; +=item * - my $thissrcdir=$thissrc; - $thissrcdir=~s/\/[^\/]+$/\//; +Check filename. +=item * - return $warning.$scrout. - '


View Published Version'. - '

Back to Source'. - '

Back to Source Directory'; +File is there and owned, init lookup tables. -} +=item * + +Start page output. + +=item * -# ================================================================ Main Handler +Evaluate individual file, and then output information. +=item * + +Publishing from $thisfn to $thistarget with $thisembstyle. + +=back + +=cut + +######################################### +######################################### sub handler { my $r=shift; @@ -1013,7 +1620,7 @@ sub handler { # -------------------------------------------------------------- Check filename - my $fn=$ENV{'form.filename'}; + my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); unless ($fn) { @@ -1068,7 +1675,7 @@ sub handler { unless ($ENV{'form.phase'} eq 'two') { -# --------------------------------- File is there and owned, init lookup tables +# -------------------------------- File is there and owned, init lookup tables. %addid=(); @@ -1092,58 +1699,63 @@ unless ($ENV{'form.phase'} eq 'two') { } -# ----------------------------------------------------------- Start page output +# ---------------------------------------------------------- Start page output. $r->content_type('text/html'); $r->send_http_header; $r->print('LON-CAPA Publishing'); - $r->print( - ''); + $r->print(&Apache::loncommon::bodytag('Resource Publication')); + + my $thisfn=$fn; - -# ------------------------------------------------------------- Individual file - { - $thisfn=~/\.(\w+)$/; - my $thistype=$1; - my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - my $thistarget=$thisfn; + my $thistarget=$thisfn; - $thistarget=~s/^\/home/$targetdir/; - $thistarget=~s/\/public\_html//; + $thistarget=~s/^\/home/$targetdir/; + $thistarget=~s/\/public\_html//; + + my $thisdistarget=$thistarget; + $thisdistarget=~s/^\Q$docroot\E//; + + my $thisdisfn=$thisfn; + $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///; - my $thisdistarget=$thistarget; - $thisdistarget=~s/^$docroot//; + if ($fn=~/\/$/) { +# -------------------------------------------------------- This is a directory + &publishdirectory($r,$fn,$thisdisfn); - my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/$cuname\/public_html\///; + } else { +# ---------------------- Evaluate individual file, and then output information. + $thisfn=~/\.(\w+)$/; + my $thistype=$1; + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); $r->print('

Publishing '. &Apache::loncommon::filedescription($thistype).' '. - $thisdisfn.'

Target: '.$thisdistarget.'

'); + ''.$thisdisfn. + 'Target: '.$thisdistarget.'
'); - if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { - $r->print('

Co-Author: '.$cuname.' at '.$cudom. - '

'); + if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { + $r->print('

Co-Author: '.$cuname.' at '.$cudom. + '

'); } if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { - $r->print('
Diffs with Current Version

'); + '&versiontwo=priv" target="cat">Diffs with Current Version
'); } -# ------------ We are publishing from $thisfn to $thistarget with $thisembstyle +# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. unless ($ENV{'form.phase'} eq 'two') { - $r->print( - '


'.&publish($thisfn,$thistarget,$thisembstyle)); + my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); + $r->print('
'.$outstring); } else { - $r->print( - '
'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); - } - + $r->print('
'); + &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); + } } $r->print(''); @@ -1153,107 +1765,9 @@ unless ($ENV{'form.phase'} eq 'two') { 1; __END__ -=head1 NAME - -Apache::lonpublisher - Publication Handler - -=head1 SYNOPSIS - -Invoked by /etc/httpd/conf/srm.conf: - - - PerlAccessHandler Apache::lonacc - SetHandler perl-script - PerlHandler Apache::lonpublisher - ErrorDocument 403 /adm/login - ErrorDocument 404 /adm/notfound.html - ErrorDocument 406 /adm/unauthorized.html - ErrorDocument 500 /adm/errorhandler - - -=head1 INTRODUCTION - -This module publishes a file. This involves gathering metadata, -versioning the file, copying file from construction space to -publication space, and copying metadata from construction space -to publication space. - -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. - -=head1 HANDLER SUBROUTINE - -This routine is called by Apache and mod_perl. - -=over 4 - -=item * - -Get query string for limited number of parameters - -=item * - -Check filename - -=item * - -File is there and owned, init lookup tables - -=item * - -Start page output - -=item * - -Individual file - -=item * - -publish from $thisfn to $thistarget with $thisembstyle - -=back - -=head1 OTHER SUBROUTINES - -=over 4 - -=item * - -metaeval() : Evaluate string with metadata - -=item * - -metaread() : Read a metadata file - -=item * - -sqltime() : convert 'time' format into a datetime sql format - -=item * - -textfield() : form field - -=item * - -hiddenfield() : form field - -=item * - -selectbox() : form field - -=item * - -urlfixup() : fixup URL (Publication Step One) - -=item * - -publish() : publish (Publication Step One) - -=item * - -phasetwo() : render second interface showing status of publication steps -(Publication Step Two) +=pod =back =cut + 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.