--- loncom/publisher/lonpublisher.pm 2004/01/04 00:28:22 1.160 +++ loncom/publisher/lonpublisher.pm 2008/05/17 12:08:45 1.235 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.160 2004/01/04 00:28:22 www Exp $ +# $Id: lonpublisher.pm,v 1.235 2008/05/17 12:08:45 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -121,14 +121,16 @@ use HTML::LCParser; use Apache::lonxml; use Apache::loncacc; use DBI; -use Apache::lonnet(); +use Apache::lonnet; use Apache::loncommon(); use Apache::lonmysql; use Apache::lonlocal; use Apache::loncfile; -use Apache::lonmeta; +use LONCAPA::lonmetadata; use Apache::lonmsg; use vars qw(%metadatafields %metadatakeys); +use LONCAPA qw(:DEFAULT :match); + my %addid; my %nokey; @@ -138,6 +140,11 @@ my $docroot; my $cuname; my $cudom; +my $registered_cleanup; +my $modified_urls; + +my $lock; + =pod =item B @@ -178,17 +185,18 @@ sub metaeval { if ($token->[0] eq 'S') { my $entry=$token->[1]; my $unikey=$entry; + next if ($entry =~ m/^(?:parameter|stores)_/); if (defined($token->[2]->{'package'})) { - $unikey.='_package_'.$token->[2]->{'package'}; + $unikey.="\0package\0".$token->[2]->{'package'}; } if (defined($token->[2]->{'part'})) { - $unikey.='_'.$token->[2]->{'part'}; + $unikey.="\0".$token->[2]->{'part'}; } if (defined($token->[2]->{'id'})) { - $unikey.='_'.$token->[2]->{'id'}; + $unikey.="\0".$token->[2]->{'id'}; } if (defined($token->[2]->{'name'})) { - $unikey.='_'.$token->[2]->{'name'}; + $unikey.="\0".$token->[2]->{'name'}; } foreach (@{$token->[3]}) { $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; @@ -199,12 +207,17 @@ sub metaeval { } } my $newentry=$parser->get_text('/'.$entry); - if ($entry eq 'customdistributionfile') { + if (($entry eq 'customdistributionfile') || + ($entry eq 'sourcerights')) { $newentry=~s/^\s*//; if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; } } # actually store - $metadatafields{$unikey}=$newentry; + if ( $entry eq 'rule' && exists($metadatafields{$unikey})) { + $metadatafields{$unikey}.=','.$newentry; + } else { + $metadatafields{$unikey}=$newentry; + } } } } @@ -270,9 +283,8 @@ sub metaread { 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; + my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/}); + my $regexp=quotemeta($url); $regexp='___'.$regexp.'___course'; my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, $aauthor,$regexp); @@ -318,20 +330,48 @@ sub textfield { $value=~s/\s+$//gs; $value=~s/\s+/ /gs; $title=&mt($title); + $env{'form.'.$name}=$value; return "\n

$title:". "


". ''; } +sub text_with_browse_field { + my ($title,$name,$value,$restriction)=@_; + $value=~s/^\s+//gs; + $value=~s/\s+$//gs; + $value=~s/\s+/ /gs; + $title=&mt($title); + $env{'form.'.$name}=$value; + return "\n

$title:". + "


". + ''. + ''.&mt('Select').' '. + ''.&mt('Search').''; + +} + sub hiddenfield { my ($name,$value)=@_; + $env{'form.'.$name}=$value; return "\n".''; } +sub checkbox { + my ($name,$text)=@_; + return "\n
"; +} + sub selectbox { my ($title,$name,$value,$functionref,@idlist)=@_; $title=&mt($title); $value=(split(/\s*,\s*/,$value))[-1]; + if (defined($value)) { + $env{'form.'.$name}=$value; + } else { + $env{'form.'.$name}=$idlist[0]; + } my $selout="\n

$title:". '


'; } +sub select_level_form { + my ($value,$name)=@_; + $env{'form.'.$name}=$value; + if (!defined($value)) { $env{'form.'.$name}=0; } + return &Apache::loncommon::select_level_form($value,$name); +} ######################################### ######################################### @@ -365,15 +411,14 @@ sub urlfixup { if ($url =~ /^mailto:/i) { return $url; } #internal document links need no fixing if ($url =~ /^\#/) { return $url; } - my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); - foreach (values %Apache::lonnet::hostname) { - if ($_ eq $host) { - $url=~s/^http\:\/\///; - $url=~s/^$host//; - } + my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)}); + my @lonids = &Apache::lonnet::machine_ids($host); + if (@lonids) { + $url=~s{^(?:http|https|ftp)://}{}; + $url=~s/^\Q$host\E//; } - if ($url=~/^http\:\/\//) { return $url; } - $url=~s/\~$cuname/res\/$cudom\/$cuname/; + if ($url=~m{^(?:http|https|ftp)://}) { return $url; } + $url=~s{\Q~$cuname\E}{res/$cudom/$cuname}; return $url; } @@ -424,11 +469,11 @@ sub set_allow { } if (($newurl !~ /^javascript:/i) && ($newurl !~ /^mailto:/i) && - ($newurl !~ /^http:/i) && + ($newurl !~ /^(?:http|https|ftp):/i) && ($newurl !~ /^\#/)) { $$allow{&absoluteurl($newurl,$target)}=1; } - return $return_url + return $return_url; } ######################################### @@ -451,10 +496,15 @@ sub get_subscribed_hosts { $target=~/(.*)\/([^\/]+)$/; my $srcf=$2; opendir(DIR,$1); + # cycle through listed files, subscriptions used to exist + # as "filename.lonid" while ($filename=readdir(DIR)) { - if ($filename=~/\Q$srcf\E\.(\w+)$/) { + if ($filename=~/\Q$srcf\E\.($match_lonid)$/) { my $subhost=$1; - if (($subhost ne 'meta' && $subhost ne 'subscription') && + if (($subhost ne 'meta' + && $subhost ne 'subscription' + && $subhost ne 'meta.subscription' + && $subhost ne 'tmp') && ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) { push(@subscribed,$subhost); } @@ -463,19 +513,13 @@ sub get_subscribed_hosts { closedir(DIR); my $sh; if ( $sh=Apache::File->new("$target.subscription") ) { - &Apache::lonnet::logthis("opened $target.subscription"); while (my $subline=<$sh>) { - &Apache::lonnet::logthis("Trying $subline"); - if ($subline =~ /(^\w+):/) { + if ($subline =~ /^($match_lonid):/) { if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { push(@subscribed,$1); } - } else { - &Apache::lonnet::logthis("No Match for $subline"); } } - } else { - &Apache::lonnet::logthis("Unable to open $target.subscription"); } return @subscribed; } @@ -505,13 +549,15 @@ sub get_max_ids_indices { my %duplicatedids; my $parser=HTML::LCParser->new($content); + $parser->xml_mode(1); 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'})) { + if (defined($token->[2]->{'id'}) && + $token->[2]->{'id'} !~ /^\s*$/) { $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; if (exists($allids{$token->[2]->{'id'}})) { $duplicateids=1; @@ -523,7 +569,8 @@ sub get_max_ids_indices { $needsfixup=1; } } else { - if (defined($token->[2]->{'index'})) { + if (defined($token->[2]->{'index'}) && + $token->[2]->{'index'} !~ /^\s*$/) { $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex; } else { $needsfixup=1; @@ -565,11 +612,11 @@ sub get_all_text_unbalanced { } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } - if ($result =~ /(.*)\Q$tag\E(.*)/s) { + if ($result =~ /\Q$tag\E/s) { + ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is; #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2); #&Apache::lonnet::logthis('Result is :'.$1); - $result=$1; - my $redo=$tag.$2; + $redo=$tag.$redo; push (@$pars,HTML::LCParser->new(\$redo)); $$pars[-1]->xml_mode('1'); last; @@ -609,7 +656,7 @@ sub fix_ids_and_indices { join(', ',@duplicatedids)); if ($duplicateids) { print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n"; - my $outstring=''.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).''; + my $outstring=''.&mt('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) { @@ -632,30 +679,37 @@ sub fix_ids_and_indices { $allow{$token->[2]->{'src'}}=1; next; } + if ($lctag eq 'base') { next; } my %parms=%{$token->[2]}; $counter=$addid{$tag}; if (!$counter) { $counter=$addid{$lctag}; } if ($counter) { if ($counter eq 'id') { - unless (defined($parms{'id'})) { + unless (defined($parms{'id'}) && + $parms{'id'}!~/^\s*$/) { $maxid++; $parms{'id'}=$maxid; - print $logfile 'ID: '.$tag.':'.$maxid."\n"; + print $logfile 'ID(new) : '.$tag.':'.$maxid."\n"; + } else { + print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n"; } } elsif ($counter eq 'index') { - unless (defined($parms{'index'})) { + unless (defined($parms{'index'}) && + $parms{'index'}!~/^\s*$/) { $maxindex++; $parms{'index'}=$maxindex; print $logfile 'Index: '.$tag.':'.$maxindex."\n"; } } } - foreach my $type ('src','href','background','bgimg') { - foreach my $key (keys(%parms)) { - if ($key =~ /^$type$/i) { - $parms{$key}=&set_allow(\%allow,$logfile, - $target,$tag, - $parms{$key}); + unless ($parms{'type'} eq 'zombie') { + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + $parms{$key}=&set_allow(\%allow,$logfile, + $target,$tag, + $parms{$key}); + } } } } @@ -666,6 +720,7 @@ sub fix_ids_and_indices { ($lctag eq 'image')) { my $next_token=$parser[-1]->get_token(); if ($next_token->[0] eq 'T') { + $next_token->[1] =~ s/[\n\r\f]+//g; $next_token->[1]=&set_allow(\%allow,$logfile, $target,$tag, $next_token->[1]); @@ -720,7 +775,7 @@ sub fix_ids_and_indices { } if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; } $outstring.='<'.$tag.$newparmstring.$endtag.'>'; - if ($lctag eq 'm' || $lctag eq 'script' + if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer' || $lctag eq 'display' || $lctag eq 'tex') { $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); } @@ -772,67 +827,69 @@ sub store_metadata { # Determine if the table exists my $status = &Apache::lonmysql::check_table('metadata'); if (! defined($status)) { - $error='WARNING: Cannot connect to '. - 'database!'; + $error='WARNING: Cannot connect to '. + 'database!'; &Apache::lonnet::logthis($error); return ($error,undef); } if ($status == 0) { # It would be nice to actually create the table.... - $error ='WARNING: The metadata table does not '. - 'exist in the LON-CAPA database.'; + $error ='WARNING: The metadata table does not '. + 'exist in the LON-CAPA database.'; &Apache::lonnet::logthis($error); return ($error,undef); } + my $dbh = &Apache::lonmysql::get_dbh(); if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') || ($metadata{'copyright'} eq 'custom')) { -# remove this entry - $status=&Apache::lonmysql::remove_from_table - ('metadata','url',$metadata{'url'}); + # remove this entry + my $delitem = 'url = '.$dbh->quote($metadata{'url'}); + $status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem); + } else { -# store new data -# adjust some values to metadatadatabase (e.g., "usage" is a reserved word) - $metadata{'creationdate'}= - &Apache::lonmysql::sqltime($metadata{'creationdate'}); - $metadata{'lastrevisiondate'}= - &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'}); - $metadata{'sequsage'}=$metadata{'usage'}; - $metadata{'sequsage_list'}=$metadata{'usage_list'}; - my %newmetadata=(); -# see if we have old entries - my @oldmeta=&Apache::lonmysql::get_rows('metadata', - "url LIKE BINARY '". - $metadata{'url'}."'"); - if ($#oldmeta==0) { -# yes, there is one old entry, transfer to newmetadata - %newmetadata=&Apache::lonmeta::metadata_col_to_hash(@{$oldmeta[0]}); -# remove old entry - $status=&Apache::lonmysql::remove_from_table - ('metadata','url',$metadata{'url'}); - } elsif ($#oldmeta>0) { -# more than one entry fit - how did that happen? - $error='Error occured retrieving old values in '. - 'metadata table in LON-CAPA database: '.$#oldmeta. - ' matches'; - &Apache::lonnet::logthis($error); - return ($error,undef); - } -# store new data on top of it - foreach (keys %metadata) { - $newmetadata{$_}=$metadata{$_}; - } - $status = &Apache::lonmysql::store_row('metadata',\%newmetadata); + $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef, + \%metadata); } - if (! defined($status)) { - $error='Error occured storing new values in '. - 'metadata table in LON-CAPA database'; + if (defined($status) && $status ne '') { + $error='Error occured saving new values in '. + 'metadata table in LON-CAPA database'; &Apache::lonnet::logthis($error); + &Apache::lonnet::logthis($status); return ($error,undef); } - return (undef,$status); + return (undef,'success'); } +# ========================================== Parse file for errors and warnings + +sub checkonthis { + my ($r,$source)=@_; + my $uri=&Apache::lonnet::hreflocation($source); + $uri=~s/\/$//; + my $result=&Apache::lonnet::ssi_body($uri, + ('grade_target'=>'web', + 'return_only_error_and_warning_counts' => 1)); + my ($errorcount,$warningcount)=split(':',$result); + if (($errorcount) || ($warningcount)) { + $r->print('
'.$uri.': '); + if ($errorcount) { + $r->print(''. + $errorcount.' '. + &mt('error(s)').' '); + } + if ($warningcount) { + $r->print(''. + $warningcount.' '. + &mt('warning(s)').''); + } + } else { + #$r->print(''.&mt('ok').''); + } + $r->rflush(); + return ($warningcount,$errorcount); +} + # ============================================== Parse file itself for metadata # # parses a file with target meta, sets global %metadatafields %metadatakeys @@ -883,10 +940,10 @@ sub publish { my %allow=(); unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return (''.&mt('No write permission to user directory, FAIL').'',1); + return (''.&mt('No write permission to user directory, FAIL').'',1); } print $logfile -"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n"; +"\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n"; if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) { # ------------------------------------------------------- This needs processing @@ -897,7 +954,7 @@ 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",1); + return ("Failed to write backup copy, $!,FAIL",1); } # ------------------------------------------------------------- IDs and indices @@ -909,29 +966,34 @@ sub publish { $scrout.='

'.&mt('Dependencies').'

'; my $allowstr=''; - foreach (sort(keys(%allow))) { - my $thisdep=$_; + foreach my $thisdep (sort(keys(%allow))) { if ($thisdep !~ /[^\s]/) { next; } + if ($thisdep =~/\$/) { + $scrout.='
' + .&mt('The resource depends on another resource with variable filename, i.e., [_1].',''.$thisdep.'').'
' + .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<allow>') + .'

'; + } unless ($style eq 'rat') { $allowstr.="\n".''; } $scrout.='
'; - unless ($thisdep=~/\*/) { + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { $scrout.=''; } $scrout.=''.$thisdep.''; - unless ($thisdep=~/\*/) { + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { $scrout.=''; if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= ' - '.&mt('Currently not available'). - ''; + $scrout.= ' - '.&mt('Currently not available'). + ''; } else { my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' => time); - $thisdep=~/^\/res\/(\w+)\/(\w+)\//; + $thisdep=~m{^/res/($match_domain)/($match_username)/}; if ((defined($1)) && (defined($2))) { &Apache::lonnet::put('nohist_resevaldata',\%temphash, $1,$2); @@ -939,22 +1001,17 @@ sub publish { } } } - $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s; + $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s; -### FIXME: is this really what we want? -# I dont' think so, to will corrupt any UTF-8 resources at least, -# and any encoding other than ISO-8859-1 will probably break - #Encode any High ASCII characters - #$outstring=&HTML::Entities::encode($outstring,"\200-\377"); # ------------------------------------------------------------- Write modified. { my $org; unless ($org=Apache::File->new('>'.$source)) { print $logfile "No write permit to $source\n"; - return (''.&mt('No write permission to'). + return (''.&mt('No write permission to'). ' '.$source. - ', '.&mt('FAIL').'',1); + ', '.&mt('FAIL').'',1); } print($org $outstring); } @@ -978,14 +1035,14 @@ sub publish { } # ------------------------------------------------ First, check out environment - unless (-e $source.'.meta') { - $metadatafields{'author'}=$ENV{'environment.firstname'}.' '. - $ENV{'environment.middlename'}.' '. - $ENV{'environment.lastname'}.' '. - $ENV{'environment.generation'}; + if ((!(-e $source.'.meta')) || ($env{'form.forceoverride'})) { + $metadatafields{'author'}=$env{'environment.firstname'}.' '. + $env{'environment.middlename'}.' '. + $env{'environment.lastname'}.' '. + $env{'environment.generation'}; $metadatafields{'author'}=~s/\s+/ /g; $metadatafields{'author'}=~s/\s+$//; - $metadatafields{'owner'}=$cuname.'@'.$cudom; + $metadatafields{'owner'}=$cuname.':'.$cudom; # ------------------------------------------------ Check out directory hierachy @@ -1003,6 +1060,7 @@ sub publish { $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); $prefix=~s|^\.\./||; } + # ----------------------------------------------------------- Parse file itself # read %metadatafields from file itself @@ -1017,9 +1075,6 @@ sub publish { } } else { -# ------------------------------------------ See if anything new in file itself - - $allmeta=&parseformeta($source,$style); # ---------------------- Read previous metafile, remember parameters and stores $scrout.=&metaread($logfile,$source.'.meta'); @@ -1030,6 +1085,18 @@ sub publish { delete $metadatafields{$_}; } } +# ------------------------------------------------------------- Save some stuff + my %savemeta=(); + foreach ('title') { + $savemeta{$_}=$metadatafields{$_}; + } +# ------------------------------------------ See if anything new in file itself + + $allmeta=&parseformeta($source,$style); +# ----------------------------------------------------------- Restore the stuff + foreach (keys %savemeta) { + $metadatafields{$_}=$savemeta{$_}; + } } @@ -1040,14 +1107,16 @@ sub publish { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless ($_=~/\.\w+$/) { unless ($oldparmstores{$_}) { - print $logfile 'New: '.$_."\n"; - $chparms.=$_.' '; + my $disp_key = $_; + $disp_key =~ tr/\0/_/; + print $logfile ('New: '.$disp_key."\n"); + $chparms .= $disp_key.' '; } } } } if ($chparms) { - $scrout.='

'.&mt('New parameters or stored values'). + $scrout.='

'.&mt('New parameters or saved values'). ': '.$chparms.'

'; } @@ -1056,16 +1125,23 @@ sub publish { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless (($metadatafields{$_.'.name'}) || ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { - print $logfile 'Obsolete: '.$_."\n"; - $chparms.=$_.' '; + my $disp_key = $_; + $disp_key =~ tr/\0/_/; + print $logfile ('Obsolete: '.$disp_key."\n"); + $chparms.=$disp_key.' '; } } } if ($chparms) { - $scrout.='

'.&mt('Obsolete parameters or stored values').': '. - $chparms.'

'.&mt('Warning!'). - '

'. - &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'


'; + $scrout.='

'.&mt('Obsolete parameters or saved values').': '. + $chparms.'

'.&mt('Warning!'). + '

'. + &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'


'; + } + if ($metadatafields{'copyright'} eq 'priv') { + $scrout.='

'.&mt('Warning!'). + '

'. + &mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.').'


'; } # ------------------------------------------------------- Now have all metadata @@ -1089,32 +1165,41 @@ sub publish { } - foreach (split(/\W+/,$metadatafields{'keywords'})) { - $keywords{$_}=1; + foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) { + $addkey=~s/\s+/ /g; + $addkey=~s/^\s//; + $addkey=~s/\s$//; + if ($addkey=~/\w/) { + $keywords{$addkey}=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'}); - -# --------------------------------------------------- Scan content for keywords - - my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); - my $KEYWORDS=&mt('Keywords'); - my $CheckAll=&mt('check all'); - my $UncheckAll=&mt('uncheck all'); - my $keywordout=<<"END"; +# interactive mode html goes into $intr_scrout +# batch mode throws away this HTML +# additionally all of the field functions have a by product of setting +# $env{'from.'..} so that it can be used by the phase two handler in +# batch mode + + my $intr_scrout.= + ''. + '

'.($env{'form.makeobsolete'}?'':'').'

'. + &hiddenfield('phase','two'). + &hiddenfield('filename',$env{'form.filename'}). + &hiddenfield('allmeta',&escape($allmeta)). + &hiddenfield('dependencies',join(',',keys %allow)); + unless ($env{'form.makeobsolete'}) { + $intr_scrout.= + &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 $KEYWORDS=&mt('Keywords'); + my $CheckAll=&mt('check all'); + my $UncheckAll=&mt('uncheck all'); + my $keywordout=<<"END"; '; + $r->print(&Apache::loncommon::start_page('Resource Publication',$js)); my $thisfn=$fn; @@ -1920,7 +2093,7 @@ sub handler { if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory &publishdirectory($r,$fn,$thisdisfn); - $r->print('
'.&mt('Done').'
'.&mt('Return to Directory').''); @@ -1930,6 +2103,7 @@ sub handler { $thisfn=~/\.(\w+)$/; my $thistype=$1; my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); + if ($thistype eq 'page') { $thisembstyle = 'rat'; } $r->print('

'.&mt('Publishing').' '. &Apache::loncommon::filedescription($thistype).' '); @@ -1940,7 +2114,7 @@ ENDCAPTION $r->print('

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

'.&mt('Co-Author').': '. $cuname.&mt(' at ').$cudom.'

'); } @@ -1955,15 +2129,27 @@ ENDDIFF # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. - unless ($ENV{'form.phase'} eq 'two') { - my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); - $r->print('
'.$outstring); + unless ($env{'form.phase'} eq 'two') { +# ---------------------------------------------------------- Parse for problems + my ($warningcount,$errorcount); + if ($thisembstyle eq 'ssi') { + ($warningcount,$errorcount)=&checkonthis($r,$thisfn); + } + unless ($errorcount) { + my ($outstring,$error)= + &publish($thisfn,$thistarget,$thisembstyle); + $r->print('
'.$outstring); + } else { + $r->print('

'. + &mt('The document contains errors and cannot be published.'). + '

'); + } } else { - $r->print('
'. - &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget)); + &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); + $r->print('
'); } } - $r->print(''); + $r->print(&Apache::loncommon::end_page()); return OK; }