Diff for /loncom/interface/londocs.pm between versions 1.314.2.8 and 1.315

version 1.314.2.8, 2010/02/02 01:33:02 version 1.315, 2008/11/17 14:46:10
Line 26 Line 26
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
   
   =head1 NAME
   
   Apache::londocs
   
   =head1 SYNOPSIS
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 SUBROUTINES
   
   =over
   
   =cut
   
 package Apache::londocs;  package Apache::londocs;
   
 use strict;  use strict;
Line 53  my %alreadyseen=(); Line 69  my %alreadyseen=();
   
 my $hadchanges;  my $hadchanges;
   
 # Available help topics  
   =pod
   
   =item %help=()
   
    Available help topics
   
   =cut
   
 my %help=();  my %help=();
   
 # Mapread read maps into LONCAPA::map:: global arrays   =pod
 # @order and @resources, determines status  
 # sets @order - pointer to resources in right order  =item mapread()
 # sets @resources - array with the resources with correct idx  
 #  Mapread read maps into LONCAPA::map:: global arrays 
   @order and @resources, determines status
   sets @order - pointer to resources in right order
   sets @resources - array with the resources with correct idx
   
   =cut
   
 sub mapread {  sub mapread {
     my ($coursenum,$coursedom,$map)=@_;      my ($coursenum,$coursedom,$map)=@_;
Line 81  sub storemap { Line 109  sub storemap {
     return ($errtext,0);      return ($errtext,0);
 }  }
   
 # ----------------------------------------- Return hash with valid author names  
   =pod
   
   =item authorhosts()
   
       Return hash with valid author names
   
   =cut
   
 sub authorhosts {  sub authorhosts {
     my %outhash=();      my %outhash=();
Line 116  sub authorhosts { Line 151  sub authorhosts {
     }      }
     return ($home,$other,%outhash);      return ($home,$other,%outhash);
 }  }
 # ------------------------------------------------------ Generate "dump" button  =pod
   
   =item dumpbutton()
   
       Generate "dump" button
   
   =cut
   
 sub dumpbutton {  sub dumpbutton {
     my ($home,$other,%outhash)=&authorhosts();      my ($home,$other,%outhash)=&authorhosts();
Line 141  sub clean { Line 182  sub clean {
     $title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;      $title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;
     return $title;      return $title;
 }  }
 # -------------------------------------------------------- Actually dump course  
   =pod
   
   =item dumpcourse()
   
       Actually dump course
   
   =cut
   
 sub dumpcourse {  sub dumpcourse {
     my ($r) = @_;      my ($r) = @_;
Line 263  sub dumpcourse { Line 311  sub dumpcourse {
     }      }
 }  }
   
 # ------------------------------------------------------ Generate "export" button  =pod
   
   =item exportbutton()
   
       Generate "export" button
   
   =cut
   
 sub exportbutton {  sub exportbutton {
     my $type = &Apache::loncommon::course_type();      my $type = &Apache::loncommon::course_type();
Line 273  sub exportbutton { Line 327  sub exportbutton {
     &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs').'</div>';      &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs').'</div>';
 }  }
   
   =pod
   
   =item exportcourse()
   
   =cut
   
 sub exportcourse {  sub exportcourse {
     my $r=shift;      my $r=shift;
     my $type = &Apache::loncommon::course_type();      my $type = &Apache::loncommon::course_type();
Line 280  sub exportcourse { Line 340  sub exportcourse {
                                                $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'});                                                 $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'});
     my $numdisc = keys %discussiontime;      my $numdisc = keys %discussiontime;
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
     if (!defined($navmap)) {  
         $r->print(&Apache::loncommon::start_page('Export '.lc($type).' to IMS content package').  
                   '<h2>IMS Export Failed</h2>'.  
                   '<div class="LC_error">'.  
                   &mt('Unable to retrieve information about course contents').  
                   '</div><a href="/adm/coursedocs">'.&mt('Return to Course Editor').'</a>');  
         &Apache::lonnet::logthis('IMS export failed - could not create navmap object in '.lc($type).':'.$env{'request.course.id'});  
         return;  
     }  
     my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);      my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);
     my $curRes;      my $curRes;
     my $outcome;      my $outcome;
Line 480  function containerCheck(item) { Line 531  function containerCheck(item) {
  $r->print($display.'</table>'.   $r->print($display.'</table>'.
                   '<p><input type="hidden" name="finishexport" value="1">'.                    '<p><input type="hidden" name="finishexport" value="1">'.
                   '<input type="submit" name="exportcourse" value="'.                    '<input type="submit" name="exportcourse" value="'.
                   &mt('Export '.$type.' DOCS').'" /></p></form>');                    &mt('Export '.$type.' DOCS').'" /></p></form>'.
     &Apache::loncommon::end_page());
     }      }
 }  }
   
Line 919  sub store_template { Line 971  sub store_template {
     }      }
 }  }
   
 # Imports the given (name, url) resources into the course  =pod
 # coursenum, coursedom, and folder must precede the list  
   =item group_import()
   
       Imports the given (name, url) resources into the course
       coursenum, coursedom, and folder must precede the list
   
   =cut
   
 sub group_import {  sub group_import {
     my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_;      my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_;
   
Line 1081  sub log_docs { Line 1140  sub log_docs {
     }      }
 }  }
   
   =pod
   
   =item docs_change_log()
   
   =cut
   
 #  
 # Docs Change Log  
 #  
 sub docs_change_log {  sub docs_change_log {
     my ($r)=@_;      my ($r)=@_;
     my $folder=$env{'form.folder'};      my $folder=$env{'form.folder'};
Line 1228  sub update_paste_buffer { Line 1289  sub update_paste_buffer {
         &Apache::lonnet::appenv({'docs.markedcopy_supplemental' => $title});          &Apache::lonnet::appenv({'docs.markedcopy_supplemental' => $title});
  ($title) = &parse_supplemental_title($title);   ($title) = &parse_supplemental_title($title);
     } elsif ($env{'docs.markedcopy_supplemental'}) {      } elsif ($env{'docs.markedcopy_supplemental'}) {
         &Apache::lonnet::delenv('docs.markedcopy_supplemental');          &Apache::lonnet::delenv('docs\\.markedcopy_supplemental');
     }      }
     $url=~s{http(&colon;|:)//https(&colon;|:)//}{https$2//};      $url=~s{http(&colon;|:)//https(&colon;|:)//}{https$2//};
   
Line 1287  sub do_paste_from_buffer { Line 1348  sub do_paste_from_buffer {
 # Maps need to be copied first  # Maps need to be copied first
     if (($url=~/\.(page|sequence)$/) && ($url=~/^\/uploaded\//)) {      if (($url=~/\.(page|sequence)$/) && ($url=~/^\/uploaded\//)) {
  $title=&mt('Copy of').' '.$title;   $title=&mt('Copy of').' '.$title;
         my $newid=$$.int(rand(100)).time;   my $newid=$$.time;
  my ($oldid,$ext) = ($url=~/^(.+)\.(\w+)$/);   $url=~/^(.+)\.(\w+)$/;
         if ($oldid =~ m{^(/uploaded/\Q$coursedom\E/\Q$coursenum\E/)(\D+)(\d+)$}) {   my $newurl=$1.$newid.'.'.$2;
             my $path = $1;  
             my $prefix = $2;  
             my $ancestor = $3;  
             if (length($ancestor) > 10) {  
                 $ancestor = substr($ancestor,-10,10);  
             }  
             $oldid = $path.$prefix.$ancestor;  
         }  
         my $counter = 0;  
         my $newurl=$oldid.$newid.'.'.$ext;  
         my $is_unique = &uniqueness_check($newurl);  
         while (!$is_unique && $counter < 100) {  
             $counter ++;  
             $newid ++;  
             $newurl = $oldid.$newid;  
             $is_unique = &uniqueness_check($newurl);  
         }  
         if (!$is_unique) {  
             if ($url=~/\.page$/) {  
                 return &mt('Paste failed: an error occurred creating a unique URL for the composite page');  
             } else {  
                 return &mt('Paste failed: an error occurred creating a unique URL for the folder');  
             }  
         }  
  my $storefn=$newurl;   my $storefn=$newurl;
  $storefn=~s{^/\w+/$match_domain/$match_username/}{};   $storefn=~s{^/\w+/$match_domain/$match_username/}{};
  &Apache::lonclonecourse::writefile($env{'request.course.id'},$storefn,   &Apache::lonclonecourse::writefile($env{'request.course.id'},$storefn,
Line 1322  sub do_paste_from_buffer { Line 1359  sub do_paste_from_buffer {
     }      }
 # published maps can only exists once, so remove it from paste buffer when done  # published maps can only exists once, so remove it from paste buffer when done
     if (($url=~/\.(page|sequence)$/) && ($url=~m {^/res/})) {      if (($url=~/\.(page|sequence)$/) && ($url=~m {^/res/})) {
  &Apache::lonnet::delenv('docs.markedcopy');   &Apache::lonnet::delenv('docs\\.markedcopy');
     }      }
     if ($url=~ m{/smppg$}) {      if ($url=~ m{/smppg$}) {
  my $db_name = &Apache::lonsimplepage::get_db_name($url);   my $db_name = &Apache::lonsimplepage::get_db_name($url);
Line 1362  sub do_paste_from_buffer { Line 1399  sub do_paste_from_buffer {
 # Store the result  # Store the result
 }  }
   
 sub uniqueness_check {  
     my ($newurl) = @_;  
     my $unique = 1;  
     foreach my $res (@LONCAPA::map::order) {  
         my ($name,$url)=split(/\:/,$LONCAPA::map::resources[$res]);  
         $url=&LONCAPA::map::qtescape($url);  
         if ($newurl eq $url) {  
             $unique = 0;  
             last;      
         }  
     }  
     return $unique;  
 }  
   
 my %parameter_type = ( 'randompick'     => 'int_pos',  my %parameter_type = ( 'randompick'     => 'int_pos',
        'hiddenresource' => 'string_yesno',         'hiddenresource' => 'string_yesno',
        'encrypturl'     => 'string_yesno',         'encrypturl'     => 'string_yesno',
Line 1699  sub parse_supplemental_title { Line 1722  sub parse_supplemental_title {
  $foldertitle=&Apache::lontexconvert::msgtexconverted($4);   $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
  my $name =  &Apache::loncommon::plainname($uname,$udom);   my $name =  &Apache::loncommon::plainname($uname,$udom);
  $name = &HTML::Entities::encode($name,'"<>&\'');   $name = &HTML::Entities::encode($name,'"<>&\'');
         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');  
  $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.   $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
     $name.': <br />'.$foldertitle;      $name.': <br />'.$foldertitle;
     }      }
Line 1765  sub entryline { Line 1787  sub entryline {
  '<select name="newpos" onChange="this.form.submit()">';   '<select name="newpos" onChange="this.form.submit()">';
     for (my $i=1;$i<=$#LONCAPA::map::order+1;$i++) {      for (my $i=1;$i<=$#LONCAPA::map::order+1;$i++) {
  if ($i==$incindex) {   if ($i==$incindex) {
     $selectbox.='<option value="" selected="selected">('.$i.')</option>';      $selectbox.='<option value="" selected="1">('.$i.')</option>';
  } else {   } else {
     $selectbox.='<option value="'.$i.'">'.$i.'</option>';      $selectbox.='<option value="'.$i.'">'.$i.'</option>';
  }   }
Line 1889  END Line 1911  END
     }      }
           
     my $orig_url = $url;      my $orig_url = $url;
     $orig_url=~s{http(&colon;|:)//https(&colon;|:)//}{https$2//};  
     my $external = ($url=~s{^http(|s)(&colon;|:)//}{/adm/wrapper/ext/});      my $external = ($url=~s{^http(|s)(&colon;|:)//}{/adm/wrapper/ext/});
     if ((!$isfolder) && ($residx) && ($folder!~/supplemental/) && (!$ispage)) {      if ((!$isfolder) && ($residx) && ($folder!~/supplemental/) && (!$ispage)) {
  my $symb=&Apache::lonnet::symbclean(   my $symb=&Apache::lonnet::symbclean(
Line 1952  END Line 1973  END
     my $ro_set=      my $ro_set=
     ((&LONCAPA::map::getparameter($orderidx,'parameter_randomorder'))[0]=~/^yes$/i?' checked="checked"':'');      ((&LONCAPA::map::getparameter($orderidx,'parameter_randomorder'))[0]=~/^yes$/i?' checked="checked"':'');
  $rand_order_text ='   $rand_order_text ='
 <span class="LC_nobreak"><label><input type="checkbox" name="randomorder_'.$orderidx.'" onClick="this.form.changeparms.value=\'randomorder\';this.form.submit()" '.$ro_set.' /> '.&mt('Random Order').' </label></span>';  <nobr><label><input type="checkbox" name="randomorder_'.$orderidx.'" onClick="this.form.changeparms.value=\'randomorder\';this.form.submit()" '.$ro_set.' /> '.&mt('Random Order').' </label></nobr>';   
     }      }
     if ($ispage) {      if ($ispage) {
         my $pagename=&escape($pagetitle);          my $pagename=&escape($pagetitle);
Line 1990  END Line 2011  END
        'hd' => 'Hidden',         'hd' => 'Hidden',
        'ec' => 'URL hidden');         'ec' => 'URL hidden');
  my $enctext=   my $enctext=
     ((&LONCAPA::map::getparameter($orderidx,'parameter_encrypturl'))[0]=~/^yes$/i?' checked="checked"':'');      ((&LONCAPA::map::getparameter($orderidx,'parameter_encrypturl'))[0]=~/^yes$/i?' checked="1"':'');
  my $hidtext=   my $hidtext=
     ((&LONCAPA::map::getparameter($orderidx,'parameter_hiddenresource'))[0]=~/^yes$/i?' checked="checked"':'');      ((&LONCAPA::map::getparameter($orderidx,'parameter_hiddenresource'))[0]=~/^yes$/i?' checked="1"':'');
  $line.=(<<ENDPARMS);   $line.=(<<ENDPARMS);
   <td class="LC_docs_entry_parameter">    <td class="LC_docs_entry_parameter">
     $form_start      $form_start
Line 2012  ENDPARMS Line 2033  ENDPARMS
     return $line;      return $line;
 }  }
   
 # ---------------------------------------------------------------- tie the hash  =pod
   
   =item tiehash()
   
   tie the hash
   
   =cut
   
 sub tiehash {  sub tiehash {
     my ($mode)=@_;      my ($mode)=@_;
Line 2038  sub untiehash { Line 2065  sub untiehash {
     return OK;      return OK;
 }  }
   
 # --------------------------------------------------------------- check on this  
   =pod
   
   =item checkonthis()
   
   check on this
   
   =cut
   
   
 sub checkonthis {  sub checkonthis {
     my ($r,$url,$level,$title)=@_;      my ($r,$url,$level,$title)=@_;
Line 2112  sub checkonthis { Line 2147  sub checkonthis {
 }  }
   
   
 #  
 # ----------------------------------------------------------------- List Symbs  =pod
 #   
   =item list_symbs()
   
   List Symbs
   
   =cut
   
 sub list_symbs {  sub list_symbs {
     my ($r) = @_;      my ($r) = @_;
   
     my $type = &Apache::loncommon::course_type();  
     $r->print(&Apache::loncommon::start_page('Symb List'));      $r->print(&Apache::loncommon::start_page('Symb List'));
     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Symb List'));      $r->print(&Apache::lonhtmlcommon::breadcrumbs('Symb List'));
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
     if (!defined($navmap)) {      $r->print("<pre>\n");
         $r->print('<h2>'.&mt('Retrieval of List Failed').'</h2>'.      foreach my $res ($navmap->retrieveResources()) {
                   '<div class="LC_error">'.   $r->print($res->compTitle()."\t".$res->symb()."\n");
                   &mt('Unable to retrieve information about course contents').  
                   '</div>');  
         &Apache::lonnet::logthis('Symb list failed - could not create navmap object in '.lc($type).':'.$env{'request.course.id'});  
     } else {  
         $r->print("<pre>\n");  
         foreach my $res ($navmap->retrieveResources()) {  
     $r->print($res->compTitle()."\t".$res->symb()."\n");  
         }  
         $r->print("\n</pre>\n");  
     }      }
       $r->print("\n</pre>\n");
     $r->print('<a href="/adm/coursedocs">'.&mt('Return to DOCS').'</a>');      $r->print('<a href="/adm/coursedocs">'.&mt('Return to DOCS').'</a>');
 }  }
   
   
 #  =pod
 # -------------------------------------------------------------- Verify Content  
 #   =item verifycontent()
   
   Verify Content
   
   =cut
   
 sub verifycontent {  sub verifycontent {
     my ($r) = @_;      my ($r) = @_;
     my $type = &Apache::loncommon::course_type();      my $type = &Apache::loncommon::course_type();
Line 2171  sub verifycontent { Line 2208  sub verifycontent {
      &mt('Return to DOCS').'</a>');       &mt('Return to DOCS').'</a>');
 }  }
   
   =pod
   
   =item devalidateversioncache() & checkversions()
   
 # -------------------------------------------------------------- Check Versions  Check Versions
   
   =cut
   
 sub devalidateversioncache {  sub devalidateversioncache {
     my $src=shift;      my $src=shift;
Line 2476  sub changewarning { Line 2518  sub changewarning {
 $help{'Caching'}.'</span></h3></form>'."\n\n");  $help{'Caching'}.'</span></h3></form>'."\n\n");
 }  }
   
 # =========================================== Breadcrumbs for special functions  =pod
   
   =item init_breadcrumbs()
   
   Breadcrumbs for special functions
   
   =cut
   
 sub init_breadcrumbs {  sub init_breadcrumbs {
     my ($form,$text)=@_;      my ($form,$text)=@_;
Line 2492  sub init_breadcrumbs { Line 2540  sub init_breadcrumbs {
     bug=>'Instructor Interface'});      bug=>'Instructor Interface'});
 }  }
   
 # ================================================================ Main Handler  
   =pod
   
   =item handler()
   
   Main Handler
   
   =cut
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
Line 3114  ENDBLOCK Line 3170  ENDBLOCK
 </span>  </span>
 <br /><br />  <br /><br />
 $lt{'comment'}:<br />  $lt{'comment'}:<br />
 <textarea cols="50" rows="4" name="comment">  <textarea cols=50 rows=4 name='comment'>
 </textarea>  </textarea>
 <br />  <br />
 <input type="hidden" name="folderpath" value="$path" />  <input type="hidden" name="folderpath" value="$path" />
Line 3397  ENDNEWSCRIPT Line 3453  ENDNEWSCRIPT
 }  }
 1;  1;
 __END__  __END__
   
   =pod
   
   =back
   
   =cut

Removed from v.1.314.2.8  
changed lines
  Added in v.1.315


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>