[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml verify_domconfiguser.piml loncom loncapa_apache.conf lontrans.pm loncom/auth lonacc.pm loncom/html/res/adm/pages shorturls.png loncom/interface lonblockingmenu.pm loncommon.pm loncourserespicker.pm londocs.pm lontiny.pm

raeburn raeburn at source.lon-capa.org
Fri Jan 12 08:34:58 EST 2018


raeburn		Fri Jan 12 13:34:58 2018 EDT

  Added files:                 
    /loncom/interface	lontiny.pm 
    /loncom/html/res/adm/pages	shorturls.png 

  Modified files:              
    /doc/loncapafiles	verify_domconfiguser.piml 
    /loncom/interface	londocs.pm loncommon.pm loncourserespicker.pm 
                     	lonblockingmenu.pm 
    /loncom/auth	lonacc.pm 
    /loncom	lontrans.pm loncapa_apache.conf 
    /doc/loncapafiles	loncapafiles.lpml 
  Log:
  - Bug 6400 Tiny URL for deep-linking.
    Requires Short::URL and String::CRC32 modules from CPAN. Dependency on
    perl-Short-URL needs to be added to LONCAPA-prerequisites.
  
  
-------------- next part --------------
Index: doc/loncapafiles/verify_domconfiguser.piml
diff -u doc/loncapafiles/verify_domconfiguser.piml:1.20 doc/loncapafiles/verify_domconfiguser.piml:1.21
--- doc/loncapafiles/verify_domconfiguser.piml:1.20	Sun Feb 22 17:21:51 2015
+++ doc/loncapafiles/verify_domconfiguser.piml	Wed Mar  4 13:36:46 2015
@@ -3,7 +3,7 @@
 <!-- verify_domconfiguser.piml -->
 <!-- Stuart Raeburn -->
 
-<!-- $Id: verify_domconfiguser.piml,v 1.20 2015/02/22 17:21:51 raeburn Exp $ -->
+<!-- $Id: verify_domconfiguser.piml,v 1.21 2015/03/04 13:36:46 raeburn Exp $ -->
 
 <!--
 
@@ -183,7 +183,7 @@
         srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
         my $configpass = '';
         my @letts = qw( a b c d e f g h i j k l m n o p q r s t u v w x y z );
-        for (my $i=0; $i>8; $i++) {
+        for (my $i=0; $i<8; $i++) {
             my $lettnum = int (rand 2);
             my $item = '';
             if ($lettnum) {
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.650 loncom/interface/londocs.pm:1.651
--- loncom/interface/londocs.pm:1.650	Fri Jan 12 01:54:56 2018
+++ loncom/interface/londocs.pm	Fri Jan 12 13:33:37 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Documents
 #
-# $Id: londocs.pm,v 1.650 2018/01/12 01:54:56 raeburn Exp $
+# $Id: londocs.pm,v 1.651 2018/01/12 13:33:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -46,6 +46,7 @@
 use Apache::lonhomework();
 use Apache::lonpublisher();
 use Apache::lonparmset();
+use Apache::loncourserespicker();
 use HTML::Entities;
 use HTML::TokeParser;
 use GDBM_File;
@@ -4812,6 +4813,48 @@
     $r->print(&endContentScreen());
 }
 
+sub short_urls {
+    my ($r,$canedit) = @_;
+    my $crstype = &Apache::loncommon::course_type();
+    my $formname = 'shortenurl';
+    $r->print(&Apache::loncommon::start_page('Display/Set Shortened URLs'));
+    $r->print(&Apache::lonhtmlcommon::breadcrumbs('Shortened URLs'));
+    $r->print(&startContentScreen('tools'));
+    my ($navmap,$errormsg) =
+        &Apache::loncourserespicker::get_navmap_object($crstype,'shorturls');
+    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+    my (%maps,%resources,%titles);
+    if (!ref($navmap)) {
+        $r->print($errormsg.
+                  &endContentScreen());
+        return '';
+    } else {
+        $r->print('<h4 class="LC_info">'.&mt('Tiny URLs for deep-linking into course').'</h4>'."\n".
+        $r->rflush();
+        my $readonly;
+        if ($canedit) {
+            my ($numnew,$errors) = &Apache::loncommon::make_short_symbs($cdom,$cnum,$navmap);
+            if ($numnew) {
+                $r->print('<p class="LC_info">'.&mt('Created [quant,_1,URL]',$numnew).'</p>');
+            }
+            if ((ref($errors) eq 'ARRAY') && (@{$errors} > 0)) {
+                $r->print(&mt('The following errors occurred when processing your request to create shortened URLs:').'<br /><ul>');
+                foreach my $error (@{$errors}) {
+                    $r->print('<li>'.$error.'</li>');
+                }
+                $r->print('</ul><br />');
+            }
+        } else {
+            $readonly = 1;
+        }
+        my %currtiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
+        $r->print(&Apache::loncourserespicker::create_picker($navmap,'shorturls',$formname,$crstype,undef,
+                                                             undef,undef,undef,undef,undef,\%currtiny,$readonly));
+    }
+    $r->print(&endContentScreen());
+}
+
 sub contentverifyform {
     my ($r) = @_;
     my $crstype = &Apache::loncommon::course_type();
@@ -5347,6 +5390,9 @@
   } elsif ($allowed && $env{'form.listsymbs'}) {
       &init_breadcrumbs('listsymbs','List Content IDs');
       &list_symbs($r);
+  } elsif ($allowed && $env{'form.shorturls'}) {
+      &init_breadcrumbs('shorturls','Set/Display Shortened URLs','Docs_Short_URLs');
+      &short_urls($r,$canedit);
   } elsif ($allowed && $env{'form.docslog'}) {
       &init_breadcrumbs('docslog','Show Log');
       my $folder = $env{'form.folder'};
@@ -6936,6 +6982,7 @@
                                          'vc'   => 'Verify Content',
                                          'cv'   => 'Check/Set Resource Versions',
                                          'ls'   => 'List Resource Identifiers',
+                                         'ct'   => 'Display/Set Shortened URLs for Deep-linking',
                                          'imse' => 'Export contents to IMS Archive',
                                          'dcd'  => "Copy $crstype Content to Authoring Space",
             );
@@ -6986,6 +7033,13 @@
                     icon       => 'symbs.png',
                     linktitle  => "List the unique identifier used for each resource instance in your $lc_crstype"
                 },
+                {   linktext   => $lt{'ct'},
+                    url        => "javascript:injectData(document.courseverify,'dummy','shorturls','$lt{'ct'}')",
+                    permission => 'F',
+                    help       => 'Docs_Short_URLs',
+                    icon       => 'shorturls.png',
+                    linktitle  => "Set shortened URLs for a resource or folder in your $lc_crstype for use in deep-linking"
+                },
                 ]
         });
     if ($canedit) {
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1308 loncom/interface/loncommon.pm:1.1309
--- loncom/interface/loncommon.pm:1.1308	Wed Jan  3 04:20:54 2018
+++ loncom/interface/loncommon.pm	Fri Jan 12 13:33:38 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1308 2018/01/03 04:20:54 raeburn Exp $
+# $Id: loncommon.pm,v 1.1309 2018/01/12 13:33:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -86,6 +86,8 @@
 use MIME::Types;
 use File::Copy();
 use File::Path();
+use String::CRC32();
+use Short::URL();
 
 # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);
@@ -17850,6 +17852,142 @@
     return $plaintext;
 }
 
+sub make_short_symbs {
+    my ($cdom,$cnum,$navmap) = @_;
+    return unless (ref($navmap));
+    my ($numnew, at errors);
+    my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
+    if (@toshorten) {
+        my (%maps,%resources,%titles);
+        &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
+                                                               'shorturls',$cdom,$cnum);
+        my %tocreate;
+        if (keys(%resources)) {
+            foreach my $item (sort {$a <=> $b} (@toshorten)) {
+                my $symb = $resources{$item};
+                if ($symb) {
+                    $tocreate{$cnum.'&'.$symb} = 1;
+                }
+            }
+        }
+        if (keys(%tocreate)) {
+            my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
+            my $su = Short::URL->new(no_vowels => 1);
+            my $init = '';
+            my (%newunique,%addcourse,%courseonly,%failed);
+            # get lock on tiny db
+            my $now = time;
+            my $lockhash = {
+                                "lock\0$now" => $env{'user.name'}.
+                                                ':'.$env{'user.domain'},
+                            };
+            my $tries = 0;
+            my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
+            my ($code,$error);
+            while (($gotlock ne 'ok') && ($tries<3)) {
+                $tries ++;
+                sleep 1;
+                $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+            }
+            if ($gotlock eq 'ok') {
+                $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
+                                       \%addcourse,\%courseonly,\%failed);
+                if (keys(%failed)) {
+                    my $numfailed = scalar(keys(%failed));
+                    push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
+                }
+                if (keys(%newunique)) {
+                    my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
+                    if ($putres eq 'ok') {
+                        $numnew = scalar(keys(%newunique));
+                        my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
+                        unless ($newputres eq 'ok') {
+                            push(@errors,&mt('error: could not store course look-up of short URLs'));
+                        }
+                    } else {
+                        push(@errors,&mt('error: could not store unique six character URLs'));
+                    }
+                }
+                my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
+                unless ($dellockres eq 'ok') {
+                    push(@errors,&mt('error: could not release lockfile'));
+                }
+            } else {
+                push(@errors,&mt('error: could not obtain lockfile'));
+            }
+            if (keys(%courseonly)) {
+                my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
+                if ($result ne 'ok') {
+                    push(@errors,&mt('error: could not update course look-up of short URLs'));
+                }
+            }
+        }
+    }
+    return ($numnew,\@errors);
+}
+
+sub shorten_symbs {
+    my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
+    return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
+                   (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
+                   (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
+    my (%possibles,%collisions);
+    foreach my $key (keys(%{$tocreate})) {
+        my $num = String::CRC32::crc32($key);
+        my $tiny = $su->encode($num,$init);
+        if ($tiny) {
+            $possibles{$tiny} = $key;
+        }
+    }
+    if (!$init) {
+        $init = 1;
+    } else {
+        $init ++;
+    }
+    if (keys(%possibles)) {
+        my @posstiny = keys(%possibles);
+        my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+        my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
+        if (keys(%currtiny)) {
+            foreach my $key (keys(%currtiny)) {
+                next if ($currtiny{$key} eq '');
+                if ($currtiny{$key} eq $possibles{$key}) {
+                    my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
+                    unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
+                        $courseonly->{$tsymb} = $key;
+                    }
+                } else {
+                    $collisions{$possibles{$key}} = 1;
+                }
+                delete($possibles{$key});
+            }
+        }
+        foreach my $key (keys(%possibles)) {
+            $newunique->{$key} = $possibles{$key};
+            my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
+            unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
+                $addcourse->{$tsymb} = $key;
+            }
+        }
+    }
+    if (keys(%collisions)) {
+        if ($init <5) {
+            if (!$init) {
+                $init = 1;
+            } else {
+                $init ++;
+            }
+            $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
+                                   $newunique,$addcourse,$courseonly,$failed);
+        } else {
+            foreach my $key (keys(%collisions)) {
+                $failed->{$key} = 1;
+            }
+        }
+    }
+    return $init;
+}
+
 1;
 __END__;
 
Index: loncom/interface/loncourserespicker.pm
diff -u loncom/interface/loncourserespicker.pm:1.14 loncom/interface/loncourserespicker.pm:1.15
--- loncom/interface/loncourserespicker.pm:1.14	Sun Oct 16 21:49:51 2016
+++ loncom/interface/loncourserespicker.pm	Fri Jan 12 13:33:38 2018
@@ -1,6 +1,6 @@
 # The LearningOnline Network
 #
-# $Id: loncourserespicker.pm,v 1.14 2016/10/16 21:49:51 raeburn Exp $
+# $Id: loncourserespicker.pm,v 1.15 2018/01/12 13:33:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -39,6 +39,7 @@
 (a) exported to an IMS Content Package
 (b) subject to access blocking for the duriation of an exam/quiz.
 (c) dumped to an Authoring Space
+(d) receive shortened URLs to be used when deep-linking into a course
 
 =head1 DESCRIPTION
 
@@ -80,7 +81,8 @@
                 (encapsulates information about resources in the course). 
 
    - $context -- Context in which course resource selection is being made.
-                 Currently imsexport and examblock are supported.
+                 Currently imsexport, examblock, dumpdocs, and shorturls
+                 are supported.
 
    - $formname  -- Name of the form in the window from which the pop-up
                    used to select course items was launched. 
@@ -106,10 +108,13 @@
 
    - $uploadedfiles -- Reference to hash: keys are paths to files in
                        /home/httpd/lonUsers/$cdom/$1/$2/$3/$cnum/userfiles.
-   
+
+   - $tiny -- Reference to hash: keys are symbs of course items for which
+              shortened URLs have already been created.
+
    - $readonly -- if true, no "check all" or "uncheck all" buttons will
                   be displayed, and checkboxes will be disabled, if this 
-                  is for an exam block.
+                  is for an exam block or for shortened URL creation.
 
 
 Output: $output is the HTML mark-up for display/selection of content
@@ -211,9 +216,14 @@
 
 sub create_picker {
     my ($navmap,$context,$formname,$crstype,$blockedmaps,$blockedresources,$block,$preamble,
-        $numhome,$uploadedfiles,$readonly) = @_;
+        $numhome,$uploadedfiles,$tiny,$readonly) = @_;
     return unless (ref($navmap));
-    my ($it,$output,$numdisc,%maps,%resources,%discussiontime,%currmaps,%currresources,%files);
+    my ($it,$output,$numdisc,%maps,%resources,%discussiontime,%currmaps,%currresources,%files,
+        %shorturls,$chkname);
+    $chkname = 'archive';
+    if ($context eq 'shorturls') {
+        $chkname = 'addtiny';
+    }
     $it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
     if (ref($blockedmaps) eq 'HASH') {
         %currmaps = %{$blockedmaps};
@@ -222,6 +232,8 @@
         %currresources = %{$blockedresources};
     } elsif (ref($uploadedfiles) eq 'HASH') {
         %files = %{$uploadedfiles};
+    } elsif (ref($tiny) eq 'HASH') {
+        %shorturls = %{$tiny}; 
     }
     my @checked_maps;
     my $curRes;
@@ -256,7 +268,11 @@
                 &mt('Choose the uploaded course items and templated pages/problems to be copied to Authoring Space.').
                 '</span><br /><br />';
         $startcount = 3 + $numhome;
-        $onsubmit = ' onsubmit="return checkUnique(document.'.$formname.',document.'.$formname.'.archive);"';
+        $onsubmit = ' onsubmit="return checkUnique(document.'.$formname.',document.'.$formname.'.'.$chkname.');"';
+    } elsif ($context eq 'shorturls') {
+        $info = '<span class="LC_fontsize_medium">'.
+                &mt('Choose the resource(s) and/or folder(s) from Main Content for which shortened URL(s) are needed.').
+                '</span><br /><br />';
     } elsif ($context eq 'imsexport') {
         $info = &mt('Choose which items you wish to export from your '.$crstype.'.');
         $startcount = 5;
@@ -265,9 +281,9 @@
         $togglebuttons = '<br />';
     } else {
         $togglebuttons = '<input type="button" value="'.&mt('check all').'" '.
-                         'onclick="javascript:checkAll(document.'.$formname.'.archive)" />'.
+                         'onclick="javascript:checkAll(document.'.$formname.'.'.$chkname.')" />'.
                          '  <input type="button" value="'.&mt('uncheck all').'"'.
-                         ' onclick="javascript:uncheckAll(document.'.$formname.'.archive)" />';
+                         ' onclick="javascript:uncheckAll(document.'.$formname.'.'.$chkname.')" />';
     }
     $display = '<form name="'.$formname.'" action="" method="post"'.$onsubmit.'>'."\n";
     if ($context eq 'imsexport') {
@@ -290,7 +306,7 @@
                 '</fieldset>';
         }
         $display .= '</div>';
-    } elsif ($context eq 'examblock') {
+    } elsif (($context eq 'examblock') || ($context eq 'shorturls')) {
         $display .= $info.$togglebuttons;
     } elsif ($context eq 'dumpdocs') {
         $display .= $preamble.
@@ -311,9 +327,12 @@
         $display .= '<th>'.&mt('Access blocked?').'</th>';
     } elsif ($context eq 'dumpdocs') {
         $display .= '<th>'.&mt('Copy?').'</th>'.
-                    '<th>'.&mt("Title in $crstype").
+                    '<th>'.&mt("Title in $crstype").'</th>'.
                     '<th>'.&mt('Internal Identifier').'</th>'.
                     '<th>'.&mt('Save as ...').'</th>';
+    } elsif ($context eq 'shorturls') {
+        $display .= '<th colspan="2">'.&mt('Tiny URL').'</th>'.
+                    '<th>'.&mt("Title in $crstype").'</th>';
     }
     $display .= &Apache::loncommon::end_data_table_header_row();
     while ($curRes = $it->next()) {
@@ -339,35 +358,49 @@
                 }
             }
             $count ++;
-            my $currelem;
+            my ($currelem,$mapurl,$is_map);
             if ($context eq 'imsexport') {
                 $currelem = $count+$boards+$startcount;
             } else {
                 $currelem = $count+$startcount;
             }
-            $display .= &Apache::loncommon::start_data_table_row().
-                       '<td>'."\n".
-                       '<input type="checkbox" name="archive" value="'.$count.'" ';
+            $display .= &Apache::loncommon::start_data_table_row()."\n";
             if (($curRes->is_sequence()) || ($curRes->is_page())) {
                 $lastcontainer = $currelem;
-                $display .= 'onclick="javascript:checkFolder(document.'.$formname.','."'$currelem'".')" ';
-                my $mapurl = (&Apache::lonnet::decode_symb($symb))[2];
-                if ($currmaps{$mapurl}) {
-                    $display .= 'checked="checked"';
-                    push(@checked_maps,$currelem);
+                $mapurl = (&Apache::lonnet::decode_symb($symb))[2];
+                $is_map = 1;
+            }
+            if ($context eq 'shorturls') {
+                if ($shorturls{$symb}) {
+                    $display .= '<td> </td><td align="right"><b>'."/tiny/$cdom/$shorturls{$symb}".'</b></td>'."\n";
+                } else {
+                    $display .= '<td align="left"><label><input type="checkbox" name="'.$chkname.'" '.
+                                'value="'.$count.'"'.$disabled.' />'.&mt('Add').'</label></td>'.
+                                '<td> </td>'."\n";
                 }
             } else {
-                if ($curRes->is_problem()) {
-                    $numprobs ++;
-                }
-                $display .= 'onclick="javascript:checkResource(document.'.$formname.','."'$currelem'".')" ';
-                if ($currresources{$symb}) {
-                    $display .= 'checked="checked"';
+                $display .= '<td><input type="checkbox" name="'.$chkname.'" value="'.$count.'" ';
+                if ($is_map) {
+                    $display .= 'onclick="javascript:checkFolder(document.'.$formname.','."'$currelem'".')" ';
+                    if ($currmaps{$mapurl}) {
+                        $display .= 'checked="checked"';
+                        push(@checked_maps,$currelem);
+                    }
+                } else {
+                    if ($curRes->is_problem()) {
+                       $numprobs ++;
+                    }
+                    $display .= 'onclick="javascript:checkResource(document.'.$formname.','."'$currelem'".')" ';
+                    if ($currresources{$symb}) {
+                        $display .= 'checked="checked"';
+                    }
                 }
+                $display .= $disabled.' />'."\n";
             }
-            $display .= $disabled.' />'."\n";
             if ($context eq 'dumpdocs') {
                 $display .= '</td><td valign="top">';
+            } elsif ($context eq 'shorturls') {
+                $display .= '<td valign="top">';
             }
             for (my $i=0; $i<$depth; $i++) {
                 $display .= "$whitespace\n";
@@ -476,12 +509,19 @@
                     '<input type="submit" name="dumpcourse" value="'.&mt("Copy $crstype Content").'" />'.
                     '</div>';
         $numcount = $count + $startcount;
+    } elsif ($context eq 'shorturls') {
+        unless ($readonly) {
+            $display .=
+                '<p>'.
+                '<input type="submit" name="shorturls" value="'.
+                &mt('Create Tiny URL(s)').'" /></p>';
+        }
     }
     $display .= '</form>';
     my $scripttag = 
         &respicker_javascript($startcount,$numcount,$context,$formname,\%children,
-                              \%hierarchy,\@checked_maps,$numhome);
-    if ($context eq 'dumpdocs') {
+                              \%hierarchy,\@checked_maps,$numhome,$chkname);
+    if (($context eq 'dumpdocs') || ($context eq 'shorturls')) {
         return $scripttag.$display; 
     }
     my ($title,$crumbs,$args);
@@ -498,8 +538,8 @@
         $output .= &Apache::lonhtmlcommon::breadcrumbs('IMS Export').
                    &Apache::londocs::startContentScreen('tools');
     } elsif ($context eq 'dumpdocs') {
-         $output .= &Apache::lonhtmlcommon::breadcrumbs('Copying to Authoring Space').
-                    &Apache::londocs::startContentScreen('tools');
+        $output .= &Apache::lonhtmlcommon::breadcrumbs('Copying to Authoring Space').
+                   &Apache::londocs::startContentScreen('tools');
     }
     $output .= $display;
     if ($context eq 'examblock') {
@@ -512,21 +552,8 @@
 
 sub respicker_javascript {
     my ($startcount,$numitems,$context,$formname,$children,$hierarchy,
-        $checked_maps,$numhome) = @_;
-    return unless ((ref($children) eq 'HASH') && (ref($hierarchy) eq 'HASH')
-                   && (ref($checked_maps) eq 'ARRAY'));
-    my ($elem,$nested,$nameforelem);
-    if ($context eq 'dumpdocs') {
-        $elem='((parseInt(item)-'.$startcount.')*2)+'.$startcount;
-        $nested='((parseInt(nesting[item][i])-'.$startcount.')*2)+'.$startcount;
-        $nameforelem=$elem+1;
-    } else {
-        $elem='parseInt(item)';
-        $nested='parseInt(nesting[item][i])';
-    }
-    my $scripttag = <<"START";
-<script type="text/javascript">
-// <![CDATA[
+        $checked_maps,$numhome,$chkname) = @_;
+    my $check_uncheck = <<"FIRST";
 function checkAll(field) {
     if (field.length > 0) {
         for (i = 0; i < field.length; i++) {
@@ -546,6 +573,31 @@
         field.checked = false;
     }
 }
+FIRST
+    if ($context eq 'shorturls') {
+        return <<"END";
+<script type="text/javascript">
+// <![CDATA[
+$check_uncheck
+// ]]>
+</script>
+END
+    }
+    return unless ((ref($children) eq 'HASH') && (ref($hierarchy) eq 'HASH')
+                   && (ref($checked_maps) eq 'ARRAY'));
+    my ($elem,$nested,$nameforelem);
+    if ($context eq 'dumpdocs') {
+        $elem='((parseInt(item)-'.$startcount.')*2)+'.$startcount;
+        $nested='((parseInt(nesting[item][i])-'.$startcount.')*2)+'.$startcount;
+        $nameforelem=$elem+1;
+    } else {
+        $elem='parseInt(item)';
+        $nested='parseInt(nesting[item][i])';
+    }
+    my $scripttag = <<"START";
+<script type="text/javascript">
+// <![CDATA[
+$check_uncheck
 
 function checkFolder(form,item) {
     var elem = $elem;
@@ -699,8 +751,8 @@
 function writeToOpener(maps,resources) {
     var checkedmaps = '';
     var checkedresources = '';
-    for (var i=0; i<document.$formname.archive.length; i++) {
-        if (document.$formname.archive[i].checked) {
+    for (var i=0; i<document.$formname.${chkname}.length; i++) {
+        if (document.$formname.${chkname}[i].checked) {
             var isResource = 1;
             var include = 1;
             var elemnum = i+1+$startcount;
@@ -721,9 +773,9 @@
             }
             if (include == 1) {
                 if (isResource == 1) {
-                    checkedresources += document.$formname.archive[i].value+',';
+                    checkedresources += document.$formname.${chkname}[i].value+',';
                 } else {
-                    checkedmaps += document.$formname.archive[i].value+',';
+                    checkedmaps += document.$formname.${chkname}[i].value+',';
                 }
             }
         }
@@ -757,7 +809,9 @@
                                                        undef,{'only_body' => 1,}).
                       '<h2>'.&mt('Resource Display Failed').'</h2>';  
         } elsif ($context eq 'dumpdocs') {
-            $outcome = '<h2>'.&mt('Copying to Authoring Space unavailable');
+            $outcome = '<h2>'.&mt('Copying to Authoring Space unavailable').'</h2>';
+        } elsif ($context eq 'shorturls') {
+            $outcome = '<h2>'.&mt('Display/Setting of shortened URLs unavailable').'</h2>';
         }
         $outcome .= '<div class="LC_error">';
         if ($crstype eq 'Community') {
@@ -766,7 +820,7 @@
             $outcome .= &mt('Unable to retrieve information about course contents');
         }
         $outcome .= '</div>';
-        if (($context eq 'imsexport') || ($context eq 'dumpdocs')) {
+        if (($context eq 'imsexport') || ($context eq 'dumpdocs') || ($context eq 'shorturls') ) {
             $outcome .= '<a href="/adm/coursedocs">';
             if ($crstype eq 'Community') {
                 $outcome .= &mt('Return to Community Editor');
@@ -816,10 +870,14 @@
                     }
                 }
                 $count ++;
-                if (($curRes->is_sequence()) || ($curRes->is_page())) {
-                    $map_url->{$count} = (&Apache::lonnet::decode_symb($symb))[2];
-                } else {
+                if ($context eq 'shorturls') {
                     $resource_symb->{$count} = $ressymb;
+                } else {
+                    if (($curRes->is_sequence()) || ($curRes->is_page())) {
+                        $map_url->{$count} = (&Apache::lonnet::decode_symb($symb))[2];
+                    } else {
+                        $resource_symb->{$count} = $ressymb;
+                    }
                 }
                 $titleref->{$count} = $curRes->title();
             }
Index: loncom/interface/lonblockingmenu.pm
diff -u loncom/interface/lonblockingmenu.pm:1.25 loncom/interface/lonblockingmenu.pm:1.26
--- loncom/interface/lonblockingmenu.pm:1.25	Mon Jun 26 01:56:58 2017
+++ loncom/interface/lonblockingmenu.pm	Fri Jan 12 13:33:38 2018
@@ -2,7 +2,7 @@
 # Routines for configuring blocking of access to collaborative functions, 
 # and specific resources during an exam
 #
-# $Id: lonblockingmenu.pm,v 1.25 2017/06/26 01:56:58 raeburn Exp $
+# $Id: lonblockingmenu.pm,v 1.26 2018/01/12 13:33:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -527,7 +527,7 @@
             $r->print(&Apache::loncourserespicker::create_picker($navmap,
                                      'examblock','resourceblocks',$crstype,
                                      \%blockedmaps,\%blockedresources,
-                                     $env{'form.block'},'','',undef,$readonly));
+                                     $env{'form.block'},'','',undef,undef,$readonly));
         } else {
             $r->print($errormsg);
         }
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.168 loncom/auth/lonacc.pm:1.169
--- loncom/auth/lonacc.pm:1.168	Thu Dec 21 22:06:44 2017
+++ loncom/auth/lonacc.pm	Fri Jan 12 13:33:46 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Cookie Based Access Handler
 #
-# $Id: lonacc.pm,v 1.168 2017/12/21 22:06:44 raeburn Exp $
+# $Id: lonacc.pm,v 1.169 2018/01/12 13:33:46 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -584,7 +584,9 @@
                 $env{'form.origurl'} = $r->uri;
             }
         }
-
+        if ($requrl=~m{^/+tiny/+$match_domain/+\w+$}) {
+            return OK;
+        }
 # ---------------------------------------------------------------- Check access
 	my $now = time;
 	if ($requrl !~ m{^/(?:adm|public|prtspool)/}
Index: loncom/lontrans.pm
diff -u loncom/lontrans.pm:1.17 loncom/lontrans.pm:1.18
--- loncom/lontrans.pm:1.17	Thu Nov 30 15:14:58 2017
+++ loncom/lontrans.pm	Fri Jan 12 13:34:08 2018
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # URL translation for User Files
 #
-# $Id: lontrans.pm,v 1.17 2017/11/30 15:14:58 raeburn Exp $
+# $Id: lontrans.pm,v 1.18 2018/01/12 13:34:08 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -29,8 +29,8 @@
 package Apache::lontrans;
 
 use strict;
-use Apache::Constants qw(:common :remotehost REDIRECT);
-use Apache::lonnet();
+use Apache::Constants qw(:common :remotehost REDIRECT :http);
+use Apache::lonnet;
 use Apache::File();
 use LONCAPA qw(:DEFAULT :match);
 
@@ -46,6 +46,8 @@
             if ($realuri =~ m{^uploaded/$match_domain/$match_courseid/(default|supplemental)(|_\d+)\.(?:sequence|page)___\d+___.+$}) {
                 my ($map,$resid,$url) = split(/___/,$realuri);
                 $realuri = &Apache::lonnet::clutter($url).'?symb='.$realuri;
+            } elsif ($realuri =~ m{^tiny/$match_domain/\w+$}) {
+                $realuri = '/'.$realuri;    
             } elsif ($realuri =~ m{($match_domain)/($match_courseid)$}) {
                 $realuri = '/adm/navmaps';
             } else {
@@ -65,6 +67,64 @@
                 return REDIRECT;
             }
         }
+    } elsif ($r->uri =~ m{^/+tiny/+($match_domain)/+(\w+)$}) {
+        my ($cdom,$key) = ($1,$2);
+        if (&Apache::lonnet::domain($cdom) ne '') {
+            my %user;
+            my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
+            if ($handle ne '') {
+                my $lonidsdir=$r->dir_config('lonIDsDir');
+                &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
+                if ($env{'request.course.id'}) {
+                    my $tinyurl;
+                    my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
+                    if (defined($cached)) {
+                        $tinyurl = $result;
+                    } else {
+                        my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+                        my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
+                        if ($currtiny{$key} ne '') {
+                            $tinyurl = $currtiny{$key};
+                            &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
+                        }
+                    }
+                    if ($tinyurl ne '') {
+                        my ($cnum,$symb) = split(/\&/,$tinyurl);
+                        if (($cnum =~ /^$match_courseid$/) &&
+                            (&Apache::lonnet::homeserver($cnum,$cdom) ne 'no_host')) {
+                            if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+                                my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
+                                if (&Apache::lonnet::is_on_map($url)) {
+                                    my $realuri;
+                                    if ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
+                                        (!$env{'request.role.adv'})) {
+                                        $env{'user.error.msg'}=$r->uri.':bre:1:1:Access to resource denied';
+                                        return HTTP_NOT_ACCEPTABLE;
+                                    }
+                                    if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
+                                        (!$env{'request.role.adv'})) {
+                                        $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url)).
+                                                   '?symb='.&Apache::lonenc::encrypted($symb);
+                                    } else {
+                                        $realuri = &Apache::lonnet::clutter($url).'?symb='.$symb;
+                                    }
+                                    my $host = $r->headers_in->get('Host');
+                                    if ($host) {
+                                        my $protocol = 'http';
+                                        if ($r->get_server_port == 443) {
+                                            $protocol = 'https';
+                                        }
+                                        my $location = $protocol.'://'.$host.$realuri;
+                                        $r->headers_out->set(Location => $location);
+                                        return REDIRECT;
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
     } elsif ($r->uri=~m{^/raw/}) {
         my $host = $r->headers_in->get('Host');
         if ($host) {
@@ -93,7 +153,7 @@
 			 '/userfiles/'.(join('/', at ufile)));
         }
         return OK;
-    } else { 
+    } else {
         return DECLINED;
     }
 }
@@ -150,9 +210,3 @@
 1;
 __END__
 
-
-
-
-
-
-
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.261 loncom/loncapa_apache.conf:1.262
--- loncom/loncapa_apache.conf:1.261	Sat Dec  9 01:37:09 2017
+++ loncom/loncapa_apache.conf	Fri Jan 12 13:34:08 2018
@@ -2,7 +2,7 @@
 ## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
 ##
 
-# $Id: loncapa_apache.conf,v 1.261 2017/12/09 01:37:09 raeburn Exp $
+# $Id: loncapa_apache.conf,v 1.262 2018/01/12 13:34:08 raeburn Exp $
 
 #
 # LON-CAPA Section (extensions to httpd.conf daemon configuration)
@@ -1565,7 +1565,16 @@
 PerlHandler Apache::spellcheck
 </LocationMatch>
 
-
+<LocationMatch "^/tiny/[\w.]+/\w+$">
+AuthType LONCAPA
+Require valid-user
+PerlAuthzHandler Apache::lonacc
+SetHandler perl-script
+PerlHandler Apache::lontiny
+ErrorDocument     403 /adm/login
+ErrorDocument     406 /adm/roles
+ErrorDocument     500 /adm/errorhandler
+</LocationMatch>
 
 # ------------------------------------------------- Backdoor Adm Tests/Programs
 
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.962 doc/loncapafiles/loncapafiles.lpml:1.963
--- doc/loncapafiles/loncapafiles.lpml:1.962	Mon Dec 18 23:14:13 2017
+++ doc/loncapafiles/loncapafiles.lpml	Fri Jan 12 13:34:57 2018
@@ -2,7 +2,7 @@
  "http://lpml.sourceforge.net/DTD/lpml.dtd">
 <!-- loncapafiles.lpml -->
 
-<!-- $Id: loncapafiles.lpml,v 1.962 2017/12/18 23:14:13 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.963 2018/01/12 13:34:57 raeburn Exp $ -->
 
 <!--
 
@@ -6864,6 +6864,17 @@
 </dependencies>
 </file>
 <file>
+<source>loncom/interface/lontiny.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/lontiny.pm</target>
+<categoryname>handler</categoryname>
+<description>
+Extract domain, courseID, and symb from a shortened URL and and switch role 
+to a role in designated course.  If the user has multiple active roles in a 
+course, and one is a Coordinator role, that role will be selected, otherwise
+a list of available roles will be displayed for the user to select one.
+</description>
+</file>
+<file>
 <source>loncom/interface/lonsource.pm</source>
 <target dist='default'>home/httpd/lib/perl/Apache/lonsource.pm</target>
 <categoryname>handler</categoryname>
@@ -8319,6 +8330,7 @@
 selfenrl-queue.png;
 selfenrl-queue-22x22.png;
 sequence.png;
+shorturls.png;
 simple.png;
 simpprob.png;
 start-here.png;

Index: loncom/interface/lontiny.pm
+++ loncom/interface/lontiny.pm
# The LearningOnline Network with CAPA
# Extract domain, courseID, and symb from a shortened URL,
# and switch role to a role in designated course.
#
# $Id: lontiny.pm,v 1.1 2018/01/12 13:33:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::lontiny;

use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonroles;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);

sub handler {
    my $r = shift;
    my %user;
    my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
    if ($handle ne '') { 
        if ($r->uri =~ m{^/tiny/($match_domain)/(\w+)$}) {
            my ($cdom,$key) = ($1,$2);
            if (&Apache::lonnet::domain($cdom) ne '') {
                my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                my $tinyurl;
                my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
                if (defined($cached)) {
                    $tinyurl = $result;
                } else {
                    my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
                    if ($currtiny{$key} ne '') {
                        $tinyurl = $currtiny{$key};
                        &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
                    }
                }
                if ($tinyurl) {
                    my ($cnum,$symb) = split(/\&/,$tinyurl);
                    if ($cnum =~ /^$match_courseid$/) {
                        my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                        if ($chome ne 'no_host') {
                            my %crsenv = &Apache::lonnet::coursedescription("$cdom/$cnum");
                            my @possroles = ('in','ta','ep','st','cr','ad');
                            if ($crsenv{'type'} eq 'Community') {
                                unshift(@possroles,'co');
                            } else {
                                unshift(@possroles,'cc');
                            }
                            my %roleshash = &Apache::lonnet::get_my_roles($env{'user.uname'},
                                                                          $env{'user.domain'},
                                                                          'userroles',undef,
                                                                          \@possroles,[$cdom],1);
                            my (%possroles,$hassection);
                            if (keys(%roleshash)) {
                                foreach my $entry (keys(%roleshash)) {
                                    if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
                                        $possroles{$1} = $2;
                                        if ($2 ne '') {
                                            $hassection = 1;
                                        }
                                    }
                                }
                            }
                            my @allposs = keys(%possroles);
                            if (@allposs == 0) {
                                &show_roles($r,\%crsenv,\%possroles)
                            } elsif (@allposs == 1) {
                                my $newrole = "$allposs[0]./$cdom/$cnum";
                                $newrole = "$allposs[0]./$cdom/$cnum";
                                if ($possroles{$allposs[0]} ne '') {
                                    $newrole .= "/$possroles{$allposs[0]}"; 
                                }
                                my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
                                                   '&destinationurl='.&HTML::Entities::encode($r->uri);
                                &do_redirect($r,$destination);
                            } elsif (keys(%possroles) > 1) {
                                if (grep(/^(cc|co)$/, at allposs)) {
                                    my $newrole;
                                    if (exists($possroles{'cc'})) {
                                        $newrole = 'cc';
                                    } else {
                                        $newrole = 'co';
                                    }
                                    $newrole .= "./$cdom/$cnum";
                                    my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
                                                       '&destinationurl='.&HTML::Entities::encode($r->uri);
                                    &do_redirect($r,$destination);
                                } else {
                                    my $hascustom;
                                    if (grep(/^cr\//, at allposs)) {
                                        $hascustom = 1;
                                    }
                                    &show_roles($r,\%crsenv,\%possroles,$hassection,$hascustom);
                                }
                            }
                            return OK;
                        }
                    }
                }
            }
        }
        &generic_error($r);
        return OK;
    } else {
        return FORBIDDEN;
    }
}

sub do_redirect {
    my ($r,$destination) = @_;
    my $windowinfo = Apache::lonhtmlcommon::scripttag('self.name="loncapaclient";');
    my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
    my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
              &Apache::lonhtmlcommon::scripttag('self.name="loncapaclient";').
              '<h1>'.&mt('Welcome').'</h1>'.
              '<p>'.&mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>').'</p><p>'.
              '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
              &Apache::loncommon::end_page());
    return;
}

sub show_roles {
    my ($r,$crsenv,$possroles,$hassection,$hascustom) = @_;
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
    if (ref($crsenv) eq 'HASH') {
        $crsdesc = $crsenv->{'description'};
        $crstype = $crsenv->{'type'};
        $cdom = $crsenv->{'domain'};
        $cnum = $crsenv->{'num'};
    }
    if ($crstype eq '') {
        $crstype = 'Course';
    }
    my $lc_crstype = lc($crstype);
    if ($crsdesc ne '') {
        $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
                      '<i>'.$crsdesc.'</i>');
    }
    if (ref($possroles) eq 'HASH') {
        if (keys(%{$possroles}) > 0) {
            $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
            $title = 'Choose a role'; #Do not localize.
            if ($crstype eq 'Community') {
                $preamble = &mt('You have the following active roles in this community:');
            } else { 
                $preamble = &mt('You have the following active roles in this course:');
            }
            $datatable = '<form name="" action="/adm/roles">'.
                         '<input type="hidden" name="newrole" value="" />'.
                         '<input type="hidden" name="selectrole" value="1" />'.
                         '<input type="hidden" name="destinationurl" value="'.$r->uri.'" />'.
                         &Apache::loncommon::start_data_table().
                         &Apache::loncommon::start_data_table_header_row().
                         '<th></th><th>'.&mt('User role').'</th>';
            if ($hassection) {
                $datatable .= '<th>'.&mt('Section').'</th>';
            }
            if ($hascustom) {
                $datatable .= '<th>'.&mt('Information').'</th>';
            }
            $datatable .= &Apache::loncommon::end_data_table_header_row();
            my @available = sort(keys(%{$possroles}));
            foreach my $role ('ad','in','ta','ep','st','cr') {
                foreach my $key (@available) {
                    if ($key =~ m{^$role($|/)}) {
                        my $trolecode = "$key./$cdom/$cnum";
                        my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
                        my $sec = $possroles->{$key};
                        if ($sec ne '') {
                            $trolecode .= '/'.$sec;
                        }
                        my $buttonname=$trolecode;
                        $buttonname=~s/\W//g;
                        $datatable .= &Apache::loncommon::start_data_table_row().
                                      '<td><input name="'.$buttonname.'" type="button" value="'.
                                      &mt('Select').'" onclick="javascript:enterrole(this.form,'.
                                      "'$trolecode','$buttonname'".');" /></td>';
                        if ($key =~ /^cr\//) {
                            my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
                            $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
                            if ($hassection) {
                                $datatable .= '<td>'.$sec.'</td>';
                            }
                            $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
                                          &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
                                          '</td>';
                        } else {
                            if ($hassection) {
                                $datatable .= '<td>'.$rolename.'</td>';
                                if ($hascustom) {
                                    $datatable .= '<td colspan="2">'.$sec.'</td>';
                                } else {
                                    $datatable .= '<td>'.$sec.'</td>';
                                }
                            } elsif ($hascustom) {
                                $datatable .= '<td colspan="2">'.$rolename.'</td>';
                            } else {
                                $datatable .= '<td>'.$rolename.'</td>';
                            }
                        }
                        $datatable .= &Apache::loncommon::end_data_table_row();
                    }
                }
            }
            $datatable .= &Apache::loncommon::end_data_table().
                          '</form>';
            my $standby = &mt('Role selected. Please stand by.');
            $js = <<"ENDJS";
<script type="text/javascript">
// <![CDATA[

active=true;

function enterrole (thisform,rolecode,buttonname) {
    if (active) {
        active=false;
        document.title='$standby';
        window.status='$standby';
        thisform.newrole.value=rolecode;
        thisform.submit();
    } else {
       alert('$standby');
    }
}

// ]]>
</script>
ENDJS
        } else {
            $title = 'No active role';
            $preamble = &mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.");
            $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
        }
    }
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    $r->print(&Apache::loncommon::start_page($title,$js,$args).
              '<h3>'.$header.'</h3>'.
              '<div>'.$preamble.'</div>'.
              $datatable.
              &Apache::loncommon::end_page());
    return;
}

sub generic_error {
    my ($r) = @_;
    my $linktext;
    if ($env{'user.adv'}) {
        $linktext = &mt('Continue to your roles page');
    } else {
        $linktext = &mt('Continue to your courses page');
    }
    my $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
    my $msg = &mt('The page you requested does not exist.');
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
    $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
              '<div class="LC_error">'.$msg.'</div>'.
              '<p>'.$continuelink.'</p>'.
              &Apache::loncommon::end_page());
    return;
}

1;


More information about the LON-CAPA-cvs mailing list