--- loncom/publisher/lonpublisher.pm 2002/10/10 15:05:36 1.102 +++ loncom/publisher/lonpublisher.pm 2003/03/14 02:26:12 1.115 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.102 2002/10/10 15:05:36 www Exp $ +# $Id: lonpublisher.pm,v 1.115 2003/03/14 02:26:12 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 # ### @@ -121,27 +117,21 @@ 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; -######################################### -######################################### - =pod =item B @@ -267,48 +257,6 @@ sub metaread { ######################################### ######################################### -=pod - -=item B - -Convert 'time' format into a datetime sql format - -Parameters: - -=over 4 - -=item I<$timef> - -Seconds since 00:00:00 UTC, January 1, 1970. - -=back - -Returns: - -=over 4 - -=item Scalar string - -MySQL-compatible datetime string. - -=back - -=cut - -######################################### -######################################### -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$//; @@ -535,6 +483,10 @@ sub get_max_ids_indices { my $maxindex=10; my $maxid=10; my $needsfixup=0; + my $duplicateids=0; + + my %allids; + my %duplicatedids; my $parser=HTML::LCParser->new($content); my $token; @@ -545,6 +497,12 @@ sub get_max_ids_indices { if ($counter eq 'id') { if (defined($token->[2]->{'id'})) { $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; + if (exists($allids{$token->[2]->{'id'}})) { + $duplicateids=1; + $duplicatedids{$token->[2]->{'id'}}=1; + } else { + $allids{$token->[2]->{'id'}}=1; + } } else { $needsfixup=1; } @@ -558,7 +516,8 @@ sub get_max_ids_indices { } } } - return ($needsfixup,$maxid,$maxindex); + return ($needsfixup,$maxid,$maxindex,$duplicateids, + (keys(%duplicatedids))); } ######################################### @@ -590,7 +549,7 @@ sub get_all_text_unbalanced { } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } - if ($result =~ /(.*)$tag(.*)/) { + if ($result =~ /(.*)\Q$tag\E(.*)/s) { #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2); #&Apache::lonnet::logthis('Result is :'.$1); $result=$1; @@ -627,8 +586,16 @@ sub fix_ids_and_indices { $content=join('',<$org>); } - my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content); + my ($needsfixup,$maxid,$maxindex,$duplicateids,@duplicatedids)= + &get_max_ids_indices(\$content); + print $logfile ("Got $needsfixup,$maxid,$maxindex,$duplicateids--". + join(', ',@duplicatedids)); + if ($duplicateids) { + print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n"; + my $outstring='Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are: '.join(', ',@duplicatedids).''; + return ($outstring,1); + } if ($needsfixup) { print $logfile "Needs ID and/or index fixup\n". "Max ID : $maxid (min 10)\n". @@ -752,7 +719,7 @@ sub fix_ids_and_indices { print $logfile "Does not need ID and/or index fixup\n"; } - return ($outstring,%allow); + return ($outstring,0,%allow); } ######################################### @@ -822,6 +789,10 @@ This is the workhorse function of this m backup copies, performs any automatic processing (prior to publication, especially for rat and ssi files), +Returns a 2 element array, the first is the string to be shown to the +user, the second is an error code, either 1 (an error occured) or 0 +(no error occurred) + I =cut @@ -838,8 +809,7 @@ sub publish { my %allow=(); unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return - 'No write permission to user directory, FAIL'; + return ('No write permission to user directory, FAIL',1); } print $logfile "\n\n================= Publish ".localtime()." Phase One ================\n"; @@ -853,12 +823,14 @@ sub publish { print $logfile "Copied original file to ".$copyfile."\n"; } else { print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; - return "Failed to write backup copy, $!,FAIL"; + return ("Failed to write backup copy, $!,FAIL",1); } # ------------------------------------------------------------- IDs and indices - my $outstring; - ($outstring,%allow)=&fix_ids_and_indices($logfile,$source,$target); + my ($outstring,$error); + ($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source, + $target); + if ($error) { return ($outstring,$error); } # ------------------------------------------------------------ Construct Allows $scrout.='

Dependencies

'; @@ -903,9 +875,8 @@ sub publish { 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); } @@ -1124,7 +1095,8 @@ END unless ($metadatafields{'creationdate'}) { $metadatafields{'creationdate'}=time; } - $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'}); + $scrout.=&hiddenfield('creationdate', + &Apache::loncommon::unsqltime($metadatafields{'creationdate'})); $scrout.=&hiddenfield('lastrevisiondate',time); @@ -1133,7 +1105,8 @@ END $metadatafields{'owner'}); # -------------------------------------------------- Correct copyright for rat. - if ($style eq 'rat') { + unless ($style eq 'prv') { + if ($style eq 'rat') { if ($metadatafields{'copyright'} eq 'public') { delete $metadatafields{'copyright'}; } @@ -1141,19 +1114,23 @@ END $metadatafields{'copyright'}, \&Apache::loncommon::copyrightdescription, (grep !/^public$/,(&Apache::loncommon::copyrightids))); - } - else { + } else { $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'}, \&Apache::loncommon::copyrightdescription, - (&Apache::loncommon::copyrightids)); - } + (&Apache::loncommon::copyrightids)); + } - my $copyright_help = + my $copyright_help = Apache::loncommon::help_open_topic('Publishing_Copyright'); - $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; - return $scrout. - '

'; + $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 # @@ -1181,7 +1158,7 @@ END $ENV{'form.copyright'}='default'; } $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); - return $scrout; + return ($scrout,0); } } @@ -1228,11 +1205,18 @@ 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')) { - return - 'No write permission to user directory, FAIL'; + $r->print( + 'No write permission to user directory, FAIL'); + return 0; } print $logfile "\n================= Publish ".localtime()." Phase Two ================\n"; @@ -1249,12 +1233,12 @@ sub phasetwo { $metadatafields{'abstract'}=$ENV{'form.abstract'}; $metadatafields{'mime'}=$ENV{'form.mime'}; $metadatafields{'language'}=$ENV{'form.language'}; - $metadatafields{'creationdate'}= - &sqltime($ENV{'form.creationdate'}); - $metadatafields{'lastrevisiondate'}= - &sqltime($ENV{'form.lastrevisiondate'}); + $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'}; @@ -1274,7 +1258,7 @@ sub phasetwo { my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { return - 'Could not write metadata, FAIL'; + 'Could not write metadata, FAIL'; } foreach (sort keys %metadatafields) { unless ($_=~/\./) { @@ -1326,7 +1310,7 @@ sub phasetwo { my $srcd=$1; unless ($srcd=~/^\/home\/httpd\/html\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; - return "Invalid target directory, FAIL"; + return "Invalid target directory, FAIL"; } opendir(DIR,$srcd); while ($filename=readdir(DIR)) { @@ -1351,7 +1335,7 @@ sub phasetwo { $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 @@ -1365,7 +1349,7 @@ sub phasetwo { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { return - "Failed to write old metadata copy, $!, FAIL"; + "Failed to write old metadata copy, $!, FAIL"; } } @@ -1396,7 +1380,7 @@ sub phasetwo { $r->print('

Copied source file'); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy source, $!, FAIL"; + return "Failed to copy source, $!, FAIL"; } # --------------------------------------------------------------- Copy Metadata @@ -1409,7 +1393,7 @@ sub phasetwo { } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; return - "Failed to write metadata copy, $!, FAIL"; + "Failed to write metadata copy, $!, FAIL"; } $r->rflush; # --------------------------------------------------- Send update notifications @@ -1497,13 +1481,16 @@ sub batchpublish { # phase one takes # my ($source,$target,$style,$batch)=@_; - $r->print('

'.&publish($srcfile,$targetfile,$thisembstyle,1).'

'); + 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'},... - $r->print('

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

'); + if (!$error) { + $r->print('

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

'); + } return ''; } @@ -1618,7 +1605,7 @@ sub handler { # -------------------------------------------------------------- Check filename - my $fn=$ENV{'form.filename'}; + my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); unless ($fn) { @@ -1742,19 +1729,18 @@ unless ($ENV{'form.phase'} eq 'two') { if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { $r->print('
Diffs with Current Version

'); + '&versiontwo=priv" target="cat">Diffs with Current Version

'); } # ------------------ 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($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); - } - + } } $r->print('');