--- loncom/publisher/lonpublisher.pm 2004/02/27 17:27:51 1.164 +++ loncom/publisher/lonpublisher.pm 2005/02/28 21:28:18 1.185 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.164 2004/02/27 17:27:51 albertel Exp $ +# $Id: lonpublisher.pm,v 1.185 2005/02/28 21:28:18 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -126,7 +126,7 @@ 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); @@ -138,6 +138,9 @@ my $docroot; my $cuname; my $cudom; +my $registered_cleanup; +my $modified_urls; + =pod =item B @@ -199,7 +202,8 @@ 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; } } @@ -322,13 +326,30 @@ 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:". + "


". + ''. + 'Select '. + 'Search'; + +} + sub hiddenfield { my ($name,$value)=@_; + $ENV{'form.'.$name}=$value; return "\n".''; } @@ -336,6 +357,11 @@ 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); +} ######################################### ######################################### @@ -458,7 +490,8 @@ sub get_subscribed_hosts { while ($filename=readdir(DIR)) { if ($filename=~/\Q$srcf\E\.(\w+)$/) { my $subhost=$1; - if (($subhost ne 'meta' && $subhost ne 'subscription') && + if (($subhost ne 'meta' && $subhost ne 'subscription' && + $subhost ne 'tmp') && ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) { push(@subscribed,$subhost); } @@ -569,11 +602,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; @@ -788,55 +821,56 @@ sub store_metadata { &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 + $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef, + $metadata{'url'}); } 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, + \%metadata); } - if (! defined($status)) { + if (defined($status) && $status ne '') { $error='Error occured storing new values in '. 'metadata table in LON-CAPA database'; &Apache::lonnet::logthis($error); + &Apache::lonnet::logthis($status); return ($error,undef); } return (undef,$status); } +# ========================================== Parse file for errors and warnings + +sub checkonthis { + my ($r,$source)=@_; + my $oldpath=$ENV{'request.filename'}; + $ENV{'request.filename'}=$source; + &Apache::lonxml::xmlparse($r,'web', + &Apache::lonnet::getfile($source)); + undef($Apache::lonhomework::parsing_a_problem); + $ENV{'request.filename'}=$oldpath; + if (($Apache::lonxml::errorcount) || + ($Apache::lonxml::warningcount)) { + if ($Apache::lonxml::errorcount) { + $r->print(''. + $Apache::lonxml::errorcount.' '. + &mt('error(s)').' '); + } + if ($Apache::lonxml::warningcount) { + $r->print(''. + $Apache::lonxml::warningcount.' '. + &mt('warning(s)').''); + } + } else { + $r->print(''.&mt('ok').''); + } + $r->rflush(); + return ($Apache::lonxml::warningcount,$Apache::lonxml::errorcount); +} + # ============================================== Parse file itself for metadata # # parses a file with target meta, sets global %metadatafields %metadatakeys @@ -943,13 +977,8 @@ 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. { @@ -1007,6 +1036,7 @@ sub publish { $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); $prefix=~s|^\.\./||; } + # ----------------------------------------------------------- Parse file itself # read %metadatafields from file itself @@ -1094,32 +1124,40 @@ 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'}); +# 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.= + ''. + '

'. + &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"; + 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::bodytag('Resource Publication')); @@ -1963,6 +2008,8 @@ ENDDIFF # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. unless ($ENV{'form.phase'} eq 'two') { +# ---------------------------------------------------------- Parse for problems + &checkonthis($r,$thisfn); my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); $r->print('
'.$outstring); } else {