--- loncom/interface/loncommon.pm	2022/01/16 23:25:47	1.1075.2.161.2.2
+++ loncom/interface/loncommon.pm	2022/01/23 00:53:02	1.1075.2.164
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1075.2.161.2.2 2022/01/16 23:25:47 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.164 2022/01/23 00:53:02 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -83,8 +83,6 @@ use Crypt::DES;
 use DynaLoader; # for Crypt::DES version
 use File::Copy();
 use File::Path();
-use String::CRC32();
-use Short::URL();
 
 # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);
@@ -4755,6 +4753,17 @@ sub blockcheck {
                     }
                 }
             }
+        } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
+                ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
+            my $checkrole;
+            if ($env{'request.role.domain'} eq '') {
+                $checkrole = "cm./$env{'user.domain'}/";
+            } else {
+                $checkrole = "cm./$env{'request.role.domain'}/";
+            }
+            if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
+                $has_evb = 1;
+            }
         }
         unless ($has_evb || $check_ipaccess) {
             my @machinedoms = &Apache::lonnet::current_machine_domains();
@@ -4800,6 +4809,9 @@ sub blockcheck {
                 }
             }
         }
+        if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
+            return ();
+        }
     }
     if (defined($udom) && defined($uname)) {
         # If uname and udom are for a course, check for blocks in the course.
@@ -4825,9 +4837,8 @@ sub blockcheck {
     # boards, chat or groups, check for blocking in current course only.
 
     if (($activity eq 'boards' || $activity eq 'chat' ||
-         $activity eq 'groups' || $activity eq 'printout' ||
-         $activity eq 'search' || $activity eq 'reinit' ||
-         $activity eq 'alert') && ($env{'request.course.id'})) {
+         $activity eq 'groups' || $activity eq 'printout') &&
+        ($env{'request.course.id'})) {
         foreach my $key (keys(%live_courses)) {
             if ($key ne $env{'request.course.id'}) {
                 delete($live_courses{$key});
@@ -5161,10 +5172,6 @@ END_MYBLOCK
         $text = &mt('Gradebook Blocked');
     } elsif ($activity eq 'search') {
         $text = &mt('Search Blocked');
-    } elsif ($activity eq 'alert') {
-        $text = &mt('Checking Critical Messages Blocked');
-    } elsif ($activity eq 'reinit') {
-        $text = &mt('Checking Course Update Blocked');
     } elsif ($activity eq 'about') {
         $text = &mt('Access to User Information Pages Blocked');
     } elsif ($activity eq 'wishlist') {
@@ -5205,34 +5212,13 @@ sub check_ip_acc {
     }
 
     my $name;
-    my %access = (
-                     allowfrom => 1,
-                     denyfrom  => 0,
-                 );
-    my @allows;
-    my @denies;
-    foreach my $item (split(',',$acc)) {
-        $item =~ s/^\s*//;
-        $item =~ s/\s*$//;
-        if ($item =~ /^\!(.+)$/) {
-            push(@denies,$1);
-        } else {
-            push(@allows,$item);
-        }
-    }
-    my $numdenies = scalar(@denies);
-    my $numallows = scalar(@allows);
-    my $count = 0;
-    foreach my $pattern (@denies,@allows) {
-        $count ++;
-        my $acctype = 'allowfrom';
-        if ($count <= $numdenies) {
-            $acctype = 'denyfrom';
-        }
+    foreach my $pattern (split(',',$acc)) {
+        $pattern =~ s/^\s*//;
+        $pattern =~ s/\s*$//;
         if ($pattern =~ /\*$/) {
             #35.8.*
             $pattern=~s/\*//;
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
+            if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
             #35.8.3.[34-56]
             my $low=$2;
@@ -5240,7 +5226,7 @@ sub check_ip_acc {
             $pattern=$1;
             if ($ip =~ /^\Q$pattern\E/) {
                 my $last=(split(/\./,$ip))[3];
-                if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
+                if ($last <=$high && $last >=$low) { $allowed=1; }
             }
         } elsif ($pattern =~ /^\*/) {
             #*.msu.edu
@@ -5250,10 +5236,10 @@ sub check_ip_acc {
                 my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);
             }
-            if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
+            if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
             #127.0.0.1
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
+            if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
         } else {
             #some.name.com
             if (!defined($name)) {
@@ -5261,16 +5247,9 @@ sub check_ip_acc {
                 my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);
             }
-            if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
-        }
-        if ($allowed =~ /^(0|1)$/) { last; }
-    }
-    if ($allowed eq '') {
-        if ($numdenies && !$numallows) {
-            $allowed = 1;
-        } else {
-            $allowed = 0;
+            if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
         }
+        if ($allowed) { last; }
     }
     return $allowed;
 }
@@ -5695,19 +5674,6 @@ Inputs:
             inlineremote items to be added in "Functions" menu below
             breadcrumbs.
 
-=item * $ltiscope, optional argument, will be one of: resource, map or
-            course, if LON-CAPA is in LTI Provider context. Value is
-            the scope of use, i.e., launch was for access to a single, a map
-            or the entire course.
-
-=item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
-            context, this will contain the URL for the landing item in
-            the course, after launch from an LTI Consumer
-
-=item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
-            context, this will contain a reference to hash of items
-            to be included in the page header and/or inline menu.
-
 =back
 
 Returns: A uniform header for LON-CAPA web pages.  
@@ -5719,8 +5685,7 @@ other decorations will be returned.
 
 sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
-        $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref,
-        $ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref)=@_;
+        $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
 
     my $public;
     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
@@ -5804,46 +5769,16 @@ sub bodytag {
 	undef($role);
     }
 
-    my $showcrstitle = 1;
-    if (($cid) && ($env{'request.lti.login'})) {
-        if (ref($ltimenu) eq 'HASH') {
-            unless ($ltimenu->{'role'}) {
-                undef($role);
-            }
-            unless ($ltimenu->{'coursetitle'}) {
-                $realm='&nbsp;';
-                $showcrstitle = 0;
-            }
-        }
-    } elsif (($cid) && ($menucoll)) {
-        if (ref($menuref) eq 'HASH') {
-            unless ($menuref->{'role'}) {
-                undef($role);
-            }
-            unless ($menuref->{'crs'}) {
-                $realm='&nbsp;';
-                $showcrstitle = 0;
-            }
-        }
-    }
-
     my $titleinfo = '<h1>'.$title.'</h1>';
     #
     # Extra info if you are the DC
     my $dc_info = '';
-    if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
+    if (($env{'user.adv'}) && ($env{'request.course.id'}) &&
         (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
         $dc_info =~ s/\s+$//;
     }
 
-    my $crstype;
-    if ($cid) {
-        $crstype = $env{'course.'.$cid.'.type'};
-    } elsif ($args->{'crstype'}) {
-        $crstype = $args->{'crstype'};
-    }
-
     $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
 
     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
@@ -5871,29 +5806,27 @@ sub bodytag {
         $bodytag .= Apache::lonhtmlcommon::scripttag(
             Apache::lonmenu::utilityfunctions($httphost), 'start');
 
-        unless ($args->{'no_primary_menu'}) {
-            my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
+        my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
 
-            if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
-                if ($dc_info) {
-                    $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
-                }
-                $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
-                               <em>$realm</em> $dc_info</div>|;
-                return $bodytag;
+        if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
+            if ($dc_info) {
+                $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
             }
+            $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
+                           <em>$realm</em> $dc_info</div>|;
+            return $bodytag;
+        }
 
-            unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
-                $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
-            }
+        unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
+            $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
+        }
 
-            $bodytag .= $right;
+        $bodytag .= $right;
 
-            if ($dc_info) {
-                $dc_info = &dc_courseid_toggle($dc_info);
-            }
-            $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
+        if ($dc_info) {
+            $dc_info = &dc_courseid_toggle($dc_info);
         }
+        $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
 
         #if directed to not display the secondary menu, don't.
         if ($args->{'no_secondary_menu'}) {
@@ -5901,22 +5834,17 @@ sub bodytag {
         }
         #don't show menus for public users
         if (!$public){
-            unless ($args->{'no_inline_menu'}) {
-                $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
-                                                            $args->{'no_primary_menu'},
-                                                            $menucoll,$menuref,
-                                                            $args->{'links_disabled'});
-            }
+            $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'});
             $bodytag .= Apache::lonmenu::serverform();
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
-                                $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
+                                $args->{'bread_crumbs'},'','',$hostname);
             } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'},
                                                             $args->{'hide_buttons'},
-                                                            $hostname,$ltiscope,$ltiuri);
+                                                            $hostname);
             } else {
                 my $forbodytag;
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
@@ -8235,7 +8163,7 @@ ADDMETA
                         my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
                         if (($newserver eq '') && ($offloadoth)) {
                             my @domains = &Apache::lonnet::current_machine_domains();
-                            if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
+                            if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { 
                                 ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
                             }
                         }
@@ -8551,81 +8479,11 @@ sub start_page {
     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
 
     $env{'internal.start_page'}++;
-    my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
+    my ($result,@advtools);
 
     if (! exists($args->{'skip_phases'}{'head'}) ) {
         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
     }
-
-    if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
-        if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
-            unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
-                $args->{'no_primary_menu'} = 1;
-            }
-            unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
-                $args->{'no_inline_menu'} = 1;
-            }
-            if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
-                map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
-            }
-        } else {
-            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
-            my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
-            if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
-                unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
-                    $args->{'no_primary_menu'} = 1;
-                }
-                unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
-                    $args->{'no_inline_menu'} = 1;
-                }
-                if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
-                    map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
-                }
-            }
-        }
-        ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
-                                  $env{'course.'.$env{'request.course.id'}.'.domain'},
-                                  $env{'course.'.$env{'request.course.id'}.'.num'});
-    } elsif ($env{'request.course.id'}) {
-        my $expiretime=600;
-        if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
-            &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
-        }
-        my ($deeplinkmenu,$menuref);
-        ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
-        if ($menucoll) {
-            if (ref($menuref) eq 'HASH') {
-                %menu = %{$menuref};
-            }
-            if ($menu{'top'} eq 'n') {
-                $args->{'no_primary_menu'} = 1;
-            }
-            if ($menu{'inline'} eq 'n') {
-                unless (&Apache::lonnet::allowed('opa')) {
-                    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
-                    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-                    my $crstype = &course_type();
-                    my $now = time;
-                    my $ccrole;
-                    if ($crstype eq 'Community') {
-                        $ccrole = 'co';
-                    } else {
-                        $ccrole = 'cc';
-                    }
-                    if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
-                        my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
-                        if ((($start) && ($start<0)) ||
-                            (($end) && ($end<$now))  ||
-                            (($start) && ($now<$start))) {
-                            $args->{'no_inline_menu'} = 1;
-                        }
-                    } else {
-                        $args->{'no_inline_menu'} = 1;
-                    }
-                }
-            }
-        }
-    }
     
     if (! exists($args->{'skip_phases'}{'body'}) ) {
 	if ($args->{'frameset'}) {
@@ -8639,8 +8497,7 @@ sub start_page {
                          $args->{'only_body'},      $args->{'domain'},
                          $args->{'force_register'}, $args->{'no_nav_bar'},
                          $args->{'bgcolor'},        $args->{'no_inline_link'},
-                         $args,                     \@advtools,
-                         $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
+                         $args,                     \@advtools);
         }
     }
 
@@ -8675,8 +8532,7 @@ sub start_page {
                 }
                 my $menulink;
                 # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
-                if ((exists($args->{'bread_crumbs_nomenu'})) ||
-                    ($ltiscope eq 'map') || ($ltiscope eq 'resource')) {
+                if (exists($args->{'bread_crumbs_nomenu'})) {
                     $menulink = 0;
                 } else {
                     undef($menulink);
@@ -8684,7 +8540,7 @@ sub start_page {
 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
 		if(exists($args->{'bread_crumbs_component'})){
 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
-		} else {
+		}else{
 			$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
 		}
     } elsif (($env{'environment.remote'} eq 'on') &&
@@ -8728,103 +8584,6 @@ sub end_page {
     return $result;
 }
 
-sub menucoll_in_effect {
-    my ($menucoll,$deeplinkmenu,%menu);
-    if ($env{'request.course.id'}) {
-        $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
-        if ($env{'request.deeplink.login'}) {
-            my ($deeplink_symb,$deeplink,$check_login_symb);
-            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
-            if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
-                if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
-                    my $navmap = Apache::lonnavmaps::navmap->new();
-                    if (ref($navmap)) {
-                        $deeplink = $navmap->get_mapparam(undef,
-                                                          &Apache::lonnet::declutter($env{'request.noversionuri'}),
-                                                          '0.deeplink');
-                    } else {
-                        $check_login_symb = 1;
-                    }
-                } else {
-                    my $symb=&Apache::lonnet::symbread();
-                    if ($symb) {
-                        $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
-                    } else {
-                        $check_login_symb = 1;
-                    }
-                }
-            } else {
-                $check_login_symb = 1;
-            }
-            if ($check_login_symb) {
-                $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
-                if ($deeplink_symb =~ /\.(page|sequence)$/) {
-                    my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
-                    my $navmap = Apache::lonnavmaps::navmap->new();
-                    if (ref($navmap)) {
-                        $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
-                    }
-                } else {
-                    $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
-                }
-            }
-            if ($deeplink ne '') {
-                my ($state,$others,$listed,$scope,$protect,$display) = split(/,/,$deeplink);
-                if ($display =~ /^\d+$/) {
-                    $deeplinkmenu = 1;
-                    $menucoll = $display;
-                }
-            }
-        }
-        if ($menucoll) {
-            %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
-        }
-    }
-    return ($menucoll,$deeplinkmenu,\%menu);
-}
-
-sub deeplink_login_symb {
-    my ($cnum,$cdom) = @_;
-    my $login_symb;
-    if ($env{'request.deeplink.login'}) {
-        $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
-    }
-    return $login_symb;
-}
-
-sub symb_from_tinyurl {
-    my ($url,$cnum,$cdom) = @_;
-    if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
-        my $key = $1;
-        my ($tinyurl,$login);
-        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 ($cnumreq,$symb) = split(/\&/,$tinyurl);
-            if (wantarray) {
-                return ($cnumreq,$symb);
-            } elsif ($cnumreq eq $cnum) {
-                return $symb;
-            }
-        }
-    }
-    if (wantarray) {
-        return ();
-    } else {
-        return;
-    }
-}
-
 sub wishlist_window {
     return(<<'ENDWISHLIST');
 <script type="text/javascript">
@@ -15152,7 +14911,7 @@ sub recurse_categories {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
             my $name = $cats->[$depth]{$category}[$k];
             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
-            my $trailstr = join(' -&gt; ',(@{$parents},$category));
+            my $trailstr = join(' &raquo; ',(@{$parents},$category));
             if ($allitems->{$item} eq '') {
                 push(@{$trails},$trailstr);
                 $allitems->{$item} = scalar(@{$trails})-1;
@@ -15542,8 +15301,7 @@ sub check_clone {
     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
-    my $clonetitle;
-    my @clonemsg;
+    my $clonemsg;
     my $can_clone = 0;
     my $lctype = lc($args->{'crstype'});
     if ($lctype ne 'community') {
@@ -15551,38 +15309,16 @@ sub check_clone {
     }
     if ($clonehome eq 'no_host') {
         if ($args->{'crstype'} eq 'Community') {
-            push(@clonemsg,({
-                              mt => 'No new community created.',
-                              args => [],
-                            },
-                            {
-                              mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
-                              args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
-                            }));
+            $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
         } else {
-            push(@clonemsg,({
-                              mt => 'No new course created.',
-                              args => [],
-                            },
-                            {
-                              mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
-                              args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
-                            }));
-        }
+            $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+        }     
     } else {
 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
-        $clonetitle = $clonedesc{'description'};
         if ($args->{'crstype'} eq 'Community') {
             if ($clonedesc{'type'} ne 'Community') {
-                push(@clonemsg,({
-                                  mt => 'No new community created.',
-                                  args => [],
-                                },
-                                {
-                                  mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
-                                  args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
-                                }));
-                return ($can_clone,\@clonemsg,$cloneid,$clonehome);
+                 $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+                return ($can_clone, $clonemsg, $cloneid, $clonehome);
             }
         }
 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
@@ -15671,34 +15407,20 @@ sub check_clone {
             }
             unless ($can_clone) {
                 if ($args->{'crstype'} eq 'Community') {
-                    push(@clonemsg,({
-                                      mt => 'No new community created.',
-                                      args => [],
-                                    },
-                                    {
-                                      mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
-                                      args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
-                                    }));
+                    $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
                 } else {
-                    push(@clonemsg,({
-                                      mt => 'No new course created.',
-                                      args => [],
-                                    },
-                                    {
-                                      mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
-                                      args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
-                                    }));
+                    $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
 	        }
 	    }
         }
     }
-    return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
+    return ($can_clone, $clonemsg, $cloneid, $clonehome);
 }
 
 sub construct_course {
     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
-        $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
-    my ($outcome,$msgref,$clonemsgref);
+        $cnum,$category,$coderef) = @_;
+    my $outcome;
     my $linefeed =  '<br />'."\n";
     if ($context eq 'auto') {
         $linefeed = "\n";
@@ -15707,11 +15429,18 @@ sub construct_course {
 #
 # Are we cloning?
 #
-    my ($can_clone,$cloneid,$clonehome,$clonetitle);
+    my ($can_clone, $clonemsg, $cloneid, $clonehome);
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
-	($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
+	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
+	if ($context ne 'auto') {
+            if ($clonemsg ne '') {
+	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
+            }
+	}
+	$outcome .= $clonemsg.$linefeed;
+
         if (!$can_clone) {
-	    return (0,$outcome,$clonemsgref);
+	    return (0,$outcome);
 	}
     }
 
@@ -15729,20 +15458,15 @@ sub construct_course {
                                              $args->{'ccuname'}.':'.
                                              $args->{'ccdomain'},
                                              $args->{'crstype'},
-                                             $cnum,$context,$category,
-                                             $callercontext);
+                                             $cnum,$context,$category);
 
     # Note: The testing routines depend on this being output; see 
     # Utils::Course. This needs to at least be output as a comment
     # if anyone ever decides to not show this, and Utils::Course::new
     # will need to be suitably modified.
-    if (($callercontext eq 'auto') && ($user_lh ne '')) {
-        $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
-    } else {
-        $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
-    }
+    $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
     if ($$courseid =~ /^error:/) {
-        return (0,$outcome,$clonemsgref);
+        return (0,$outcome);
     }
 
 #
@@ -15751,37 +15475,23 @@ sub construct_course {
     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     if ($crsuhome eq 'no_host') {
-        if (($callercontext eq 'auto') && ($user_lh ne '')) {
-            $outcome .= &mt_user($user_lh,
-                            'Course creation failed, unrecognized course home server.');
-        } else {
-            $outcome .= &mt('Course creation failed, unrecognized course home server.');
-        }
-        $outcome .= $linefeed;
-        return (0,$outcome,$clonemsgref);
+        $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
+        return (0,$outcome);
     }
     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
 
 #
 # Do the cloning
-#
-    my @clonemsg;
+#   
     if ($can_clone && $cloneid) {
-        push(@clonemsg,
-                      {
-                          mt => 'Created [_1] by cloning from [_2]',
-                          args => [$crstype,$clonetitle],
-                      });
+	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
+	if ($context ne 'auto') {
+	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
+	}
+	$outcome .= $clonemsg.$linefeed;
 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
 # Copy all files
-        my @info =
-            &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
-                                                     $args->{'dateshift'},$args->{'crscode'},
-                                                     $args->{'ccuname'}.':'.$args->{'ccdomain'},
-                                                     $args->{'tinyurls'});
-        if (@info) {
-            push(@clonemsg,@info);
-        }
+	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
 # Restore URL
 	$cenv{'url'}=$oldcenv{'url'};
 # Restore title
@@ -16087,7 +15797,7 @@ sub construct_course {
         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
     }
 
-    return (1,$outcome,\@clonemsg);
+    return (1,$outcome);
 }
 
 sub make_unique_code {
@@ -17255,12 +16965,8 @@ sub needs_coursereinit {
         $interval = 600;
     }
     if (($now-$env{'request.course.timechecked'})>$interval) {
-        &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
-        my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
-        if ($blocked) {
-            return ();
-        }
         my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
+        &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
         if ($lastchange > $env{'request.course.tied'}) {
             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
@@ -17722,28 +17428,12 @@ sub cleanup_html {
 
 # Checks for critical messages and returns a redirect url if one exists.
 # $interval indicates how often to check for messages.
-# $context is the calling context -- roles, grades, contents, menu or flip.
 sub critical_redirect {
-    my ($interval,$context) = @_;
+    my ($interval) = @_;
     unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
         return ();
     }
     if ((time-$env{'user.criticalcheck.time'})>$interval) {
-        if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
-            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
-            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-            my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
-            if ($blocked) {
-                my $checkrole = "cm./$cdom/$cnum";
-                if ($env{'request.course.sec'} ne '') {
-                    $checkrole .= "/$env{'request.course.sec'}";
-                }
-                unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
-                        ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
-                    return;
-                }
-            }
-        }
         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                                         $env{'user.name'});
         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
@@ -17809,158 +17499,6 @@ sub des_decrypt {
     return $plaintext;
 }
 
-sub get_requested_shorturls {
-    my ($cdom,$cnum,$navmap) = @_;
-    return unless (ref($navmap));
-    my ($numnew,$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);
-        if (keys(%resources)) {
-            my %tocreate;
-            foreach my $item (sort {$a <=> $b} (@toshorten)) {
-                my $symb = $resources{$item};
-                if ($symb) {
-                    $tocreate{$cnum.'&'.$symb} = 1;
-                }
-            }
-            if (keys(%tocreate)) {
-                ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
-                                                      \%tocreate);
-            }
-        }
-    }
-    return ($numnew,$errors);
-}
-
-sub make_short_symbs {
-    my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
-    my ($numnew,@errors);
-    if (ref($tocreateref) eq 'HASH') {
-        my %tocreate = %{$tocreateref};
-        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;
-            if ($lockuser eq '') {
-                $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
-            }
-            my $lockhash = {
-                                "lock\0$now" => $lockuser,
-                            };
-            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('tiny',$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;
-                $failed->{$key} = 1;
-            }
-        }
-    }
-    return $init;
-}
-
 sub is_nonframeable {
     my ($url,$absolute,$hostname,$ip,$nocache) = @_;
     my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
@@ -18114,37 +17652,6 @@ sub is_nonframeable {
     return $uselink;
 }
 
-sub page_menu {
-    my ($menucolls,$menunum) = @_;
-    my %menu;
-    foreach my $item (split(/;/,$menucolls)) {
-        my ($num,$value) = split(/\%/,$item);
-        if ($num eq $menunum) {
-            my @entries = split(/\&/,$value);
-            foreach my $entry (@entries) {
-                my ($name,$fields) = split(/=/,$entry);
-                if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
-                    $menu{$name} = $fields;
-                } else {
-                    my @shown;
-                    if ($fields =~ /,/) {
-                        @shown = split(/,/,$fields);
-                    } else {
-                        @shown = ($fields);
-                    }
-                    if (@shown) {
-                        foreach my $field (@shown) {
-                            next if ($field eq '');
-                            $menu{$field} = 1;
-                        }
-                    }
-                }
-            }
-        }
-    }
-    return %menu;
-}
-
 1;
 __END__;