--- loncom/publisher/lonpublisher.pm 2002/10/18 13:49:49 1.103 +++ loncom/publisher/lonpublisher.pm 2003/03/07 17:55:05 1.114 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.103 2002/10/18 13:49:49 www Exp $ +# $Id: lonpublisher.pm,v 1.114 2003/03/07 17:55:05 albertel 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,19 +117,16 @@ 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; @@ -262,8 +255,6 @@ sub metaread { } ######################################### - -######################################### ######################################### sub coursedependencies { @@ -492,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; @@ -502,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; } @@ -515,7 +516,8 @@ sub get_max_ids_indices { } } } - return ($needsfixup,$maxid,$maxindex); + return ($needsfixup,$maxid,$maxindex,$duplicateids, + (keys(%duplicatedids))); } ######################################### @@ -547,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; @@ -584,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". @@ -709,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); } ######################################### @@ -779,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 @@ -795,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"; @@ -810,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

'; @@ -860,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); } @@ -1110,8 +1124,7 @@ END my $copyright_help = Apache::loncommon::help_open_topic('Publishing_Copyright'); $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; - return $scrout. - '

'; + return ($scrout.'

',0); # ============================================================================= # BATCH MODE # @@ -1139,7 +1152,7 @@ END $ENV{'form.copyright'}='default'; } $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); - return $scrout; + return ($scrout,0); } } @@ -1186,11 +1199,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"; @@ -1230,7 +1250,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 ($_=~/\./) { @@ -1282,7 +1302,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)) { @@ -1307,7 +1327,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 @@ -1321,7 +1341,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"; } } @@ -1352,7 +1372,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 @@ -1365,7 +1385,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 @@ -1453,13 +1473,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 ''; } @@ -1574,7 +1597,7 @@ sub handler { # -------------------------------------------------------------- Check filename - my $fn=$ENV{'form.filename'}; + my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); unless ($fn) { @@ -1698,19 +1721,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('');