--- loncom/interface/loncommon.pm	2019/02/07 16:45:53	1.1075.2.127.2.8
+++ loncom/interface/loncommon.pm	2019/07/28 14:05:38	1.1075.2.133
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1075.2.127.2.8 2019/02/07 16:45:53 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.133 2019/07/28 14:05:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -82,8 +82,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);
@@ -2264,7 +2262,11 @@ sub select_form {
     if ($onchange) {
         $onchange = ' onchange="'.$onchange.'"';
     }
-    my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
+    my $disabled;
+    if ($readonly) {
+        $disabled = ' disabled="disabled"';
+    }
+    my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
     my @keys;
     if (exists($hashref->{'select_form_order'})) {
 	@keys=@{$hashref->{'select_form_order'}};
@@ -4722,7 +4724,7 @@ sub blockcheck {
                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
         next if ($no_userblock);
 
-        # Retrieve blocking times and identity of locker for course
+        # Retrieve blocking times and identity of blocker for course
         # of specified user, unless user has 'evb' privilege.
         
         my ($start,$end,$trigger) = 
@@ -4996,87 +4998,6 @@ sub check_ip_acc {
     return $allowed;
 }
 
-sub check_slotip_acc {
-    my ($acc,$clientip)=@_;
-    &Apache::lonxml::debug("acc is $acc");
-    if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
-        return 1;
-    }
-    my $allowed;
-    my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
-
-    my $name;
-    my %access = (
-                     allowfrom => 1,
-                     denyfrom  => 0,
-                 );
-    my @allows;
-    my @denies;
-    foreach my $item (split(',',$acc)) {
-        $item =~ s/^\s*//;
-        $item =~ s/\s*$//;
-        my $pattern;
-        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';
-        }
-        if ($pattern =~ /\*$/) {
-            #35.8.*
-            $pattern=~s/\*//;
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
-        } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
-            #35.8.3.[34-56]
-            my $low=$2;
-            my $high=$3;
-            $pattern=$1;
-            if ($ip =~ /^\Q$pattern\E/) {
-                my $last=(split(/\./,$ip))[3];
-                if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
-            }
-        } elsif ($pattern =~ /^\*/) {
-            #*.msu.edu
-            $pattern=~s/\*//;
-            if (!defined($name)) {
-                use Socket;
-                my $netaddr=inet_aton($ip);
-                ($name)=gethostbyaddr($netaddr,AF_INET);
-            }
-            if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
-        } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
-            #127.0.0.1
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
-        } else {
-            #some.name.com
-            if (!defined($name)) {
-                use Socket;
-                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;
-        }
-    }
-    return $allowed;
-}
-
 ###############################################
 
 =pod
@@ -5473,6 +5394,10 @@ Inputs:
 
 =item * $args, optional argument valid values are
             no_auto_mt_title -> prevents &mt()ing the title arg
+            use_absolute     -> for external resource or syllabus, this will
+                                contain https://<hostname> if server uses
+                                https (as per hosts.tab), but request is for http
+            hostname         -> hostname, from $r->hostname().
 
 =item * $advtoolsref, optional argument, ref to an array containing
             inlineremote items to be added in "Functions" menu below
@@ -5498,6 +5423,7 @@ sub bodytag {
     }
     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
     my $httphost = $args->{'use_absolute'};
+    my $hostname = $args->{'hostname'};
 
     $function = &get_users_function() if (!$function);
     my $img =    &designparm($function.'.img',$domain);
@@ -5586,7 +5512,7 @@ sub bodytag {
         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                             $forcereg,$args->{'group'},
                                             $args->{'bread_crumbs'},
-                                            $advtoolsref,'',\$forbodytag);
+                                            $advtoolsref,'','',\$forbodytag);
         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
             $funclist = $forbodytag;
         }
@@ -5632,17 +5558,19 @@ sub bodytag {
             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
             if ($env{'request.state'} eq 'construct') {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
-                                $args->{'bread_crumbs'});
+                                $args->{'bread_crumbs'},'','',$hostname);
             } elsif ($forcereg) {
                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                                                             $args->{'group'},
-                                                            $args->{'hide_buttons'});
+                                                            $args->{'hide_buttons',
+                                                            $hostname});
             } else {
                 my $forbodytag;
                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                                                     $forcereg,$args->{'group'},
                                                     $args->{'bread_crumbs'},
-                                                    $advtoolsref,'',\$forbodytag);
+                                                    $advtoolsref,'',$hostname,
+                                                    \$forbodytag);
                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                     $bodytag .= $forbodytag;
                 }
@@ -8168,6 +8096,10 @@ $args - additional optional args support
                                     to lonhtmlcommon::breadcrumbs
              group          -> includes the current group, if page is for a
                                specific group
+             use_absolute   -> for request for external resource or syllabus, this
+                               will contain https://<hostname> if server uses
+                               https (as per hosts.tab), but request is for http
+             hostname       -> hostname, originally from $r->hostname(), (optional).
 
 =back
 
@@ -8473,8 +8405,9 @@ sub end_togglebox {
 }
 
 sub LCprogressbar_script {
-   my ($id)=@_;
-   return(<<ENDPROGRESS);
+   my ($id,$number_to_do)=@_;
+   if ($number_to_do) {
+       return(<<ENDPROGRESS);
 <script type="text/javascript">
 // <![CDATA[
 \$('#progressbar$id').progressbar({
@@ -8487,21 +8420,43 @@ sub LCprogressbar_script {
 // ]]>
 </script>
 ENDPROGRESS
+   } else {
+       return(<<ENDPROGRESS);
+<script type="text/javascript">
+// <![CDATA[
+\$('#progressbar$id').progressbar({
+  value: false,
+  create: function(event, ui) {
+    \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
+    \$('.ui-progressbar-overlay', this).css({'margin':'0'});
+  }
+});
+// ]]>
+</script>
+ENDPROGRESS
+   }
 }
 
 sub LCprogressbarUpdate_script {
    return(<<ENDPROGRESSUPDATE);
 <style type="text/css">
 .ui-progressbar { position:relative; }
+.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
 .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
 </style>
 <script type="text/javascript">
 // <![CDATA[
 var LCprogressTxt='---';
 
-function LCupdateProgress(percent,progresstext,id) {
+function LCupdateProgress(percent,progresstext,id,maxnum) {
    LCprogressTxt=progresstext;
-   \$('#progressbar'+id).progressbar('value',percent);
+   if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
+       \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
+   } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
+       \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
+   } else {
+       \$('#progressbar'+id).progressbar('value',percent);
+   }
 }
 // ]]>
 </script>
@@ -8513,37 +8468,54 @@ my $LCidcnt;
 my $LCcurrentid;
 
 sub LCprogressbar {
-    my ($r)=(@_);
+    my ($r,$number_to_do,$preamble)=@_;
     $LClastpercent=0;
     $LCidcnt++;
     $LCcurrentid=$$.'_'.$LCidcnt;
-    my $starting=&mt('Starting');
-    my $content=(<<ENDPROGBAR);
+    my ($starting,$content);
+    if ($number_to_do) {
+        $starting=&mt('Starting');
+        $content=(<<ENDPROGBAR);
+$preamble
   <div id="progressbar$LCcurrentid">
     <span class="pblabel">$starting</span>
   </div>
 ENDPROGBAR
-    &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
+    } else {
+        $starting=&mt('Loading...');
+        $LClastpercent='false';
+        $content=(<<ENDPROGBAR);
+$preamble
+  <div id="progressbar$LCcurrentid">
+      <div class="progress-label">$starting</div>
+  </div>
+ENDPROGBAR
+    }
+    &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
 }
 
 sub LCprogressbarUpdate {
-    my ($r,$val,$text)=@_;
-    unless ($val) { 
-       if ($LClastpercent) {
-           $val=$LClastpercent;
-       } else {
-           $val=0;
-       }
+    my ($r,$val,$text,$number_to_do)=@_;
+    if ($number_to_do) {
+        unless ($val) { 
+            if ($LClastpercent) {
+                $val=$LClastpercent;
+            } else {
+                $val=0;
+            }
+        }
+        if ($val<0) { $val=0; }
+        if ($val>100) { $val=0; }
+        $LClastpercent=$val;
+        unless ($text) { $text=$val.'%'; }
+    } else {
+        $val = 'false';
     }
-    if ($val<0) { $val=0; }
-    if ($val>100) { $val=0; }
-    $LClastpercent=$val;
-    unless ($text) { $text=$val.'%'; }
     $text=&js_ready($text);
     &r_print($r,<<ENDUPDATE);
 <script type="text/javascript">
 // <![CDATA[
-LCupdateProgress($val,'$text','$LCcurrentid');
+LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
 // ]]>
 </script>
 ENDUPDATE
@@ -12188,8 +12160,7 @@ sub process_decompression {
                     if (ref($newdirlistref) eq 'ARRAY') {
                         foreach my $dir_line (@{$newdirlistref}) {
                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
-                            unless (($item =~ /^\.+$/) || ($item eq $file) || 
-                                    ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
+                            unless (($item =~ /^\.+$/) || ($item eq $file)) { 
                                 push(@newitems,$item);
                                 if ($dirptr&$testdir) {
                                     $is_dir{$item} = 1;
@@ -12777,7 +12748,7 @@ sub process_extracted_files {
                             $newseqid{$i} = $newidx;
                             unless ($errtext) {
                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',
-                                                       &HTML::Entities::encode($docstitle,'<>&"')).
+                                                       &HTML::Entities::encode($docstitle,'<>&"'))..
                                             '</li>'."\n";
                             }
                         }
@@ -12802,7 +12773,7 @@ sub process_extracted_files {
                                             $fetch =~ s/^\Q$prefix$dir\E//;
                                             $prompttofetch{$fetch} = 1;
                                         }
-                                    }
+                                   }
                                 }
                                 $LONCAPA::map::resources[$newidx]=
                                     $docstitle.':'.$url.':false:normal:res';
@@ -12902,11 +12873,11 @@ sub process_extracted_files {
                                 $result .= '<li>'.&mt('[_1] included as a dependency',
                                                       &HTML::Entities::encode($showpath,'<>&"')).
                                            '</li>'."\n";
-                            }
-                            unless ($ishome) {
-                                my $fetch = "$fullpath/$title";
-                                $fetch =~ s/^\Q$prefix$dir\E//;
-                                $prompttofetch{$fetch} = 1;
+                                unless ($ishome) {
+                                    my $fetch = "$fullpath/$title";
+                                    $fetch =~ s/^\Q$prefix$dir\E//;
+                                    $prompttofetch{$fetch} = 1;
+                                }
                             }
                         }
                     }
@@ -13193,9 +13164,10 @@ sub upfile_store {
     $env{'form.upfile'}=~s/\n+$//gs;
 
     my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
-	                             '_enroll_'.$env{'request.course.id'}.'_'.
+                                     '_enroll_'.$env{'request.course.id'}.'_'.
                                      time.'_'.$$);
     return if ($datatoken eq '');
+
     {
         my $datafile = $r->dir_config('lonDaemons').
                            '/tmp/'.$datatoken.'.tmp';
@@ -14128,13 +14100,6 @@ defdom (domain for which to retrieve con
 origmail (scalar - email address of recipient from loncapa.conf,
 i.e., predates configuration by DC via domainprefs.pm
 
-$requname username of requester (if mailing type is helpdeskmail)
-
-$requdom domain of requester (if mailing type is helpdeskmail)
-
-$reqemail e-mail address of requester (if mailing type is helpdeskmail)
-
-
 Returns: comma separated list of addresses to which to send e-mail.
 
 =back
@@ -14144,7 +14109,7 @@ Returns: comma separated list of address
 ############################################################
 ############################################################
 sub build_recipient_list {
-    my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
+    my ($defmail,$mailing,$defdom,$origmail) = @_;
     my @recipients;
     my ($otheremails,$lastresort,$allbcc,$addtext);
     my %domconfig =
@@ -14185,94 +14150,6 @@ sub build_recipient_list {
         } elsif ($origmail ne '') {
             $lastresort = $origmail;
         }
-        if ($mailing eq 'helpdeskmail') {
-            if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
-                (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
-                my ($inststatus,$inststatus_checked);
-                if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
-                    ($env{'user.domain'} ne 'public')) {
-                    $inststatus_checked = 1;
-                    $inststatus = $env{'environment.inststatus'};
-                }
-                unless ($inststatus_checked) {
-                    if (($requname ne '') && ($requdom ne '')) {
-                        if (($requname =~ /^$match_username$/) &&
-                            ($requdom =~ /^$match_domain$/) &&
-                            (&Apache::lonnet::domain($requdom))) {
-                            my $requhome = &Apache::lonnet::homeserver($requname,
-                                                                      $requdom);
-                            unless ($requhome eq 'no_host') {
-                                my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
-                                $inststatus = $userenv{'inststatus'};
-                                $inststatus_checked = 1;
-                            }
-                        }
-                    }
-                }
-                unless ($inststatus_checked) {
-                    if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
-                        my %srch = (srchby     => 'email',
-                                    srchdomain => $defdom,
-                                    srchterm   => $reqemail,
-                                    srchtype   => 'exact');
-                        my %srch_results = &Apache::lonnet::usersearch(\%srch);
-                        foreach my $uname (keys(%srch_results)) {
-                            if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
-                                $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
-                                $inststatus_checked = 1;
-                                last;
-                            }
-                        }
-                        unless ($inststatus_checked) {
-                            my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
-                            if ($dirsrchres eq 'ok') {
-                                foreach my $uname (keys(%srch_results)) {
-                                    if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
-                                        $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
-                                        $inststatus_checked = 1;
-                                        last;
-                                    }
-                                }
-                            }
-                        }
-                    }
-                }
-                if ($inststatus ne '') {
-                    foreach my $status (split(/\:/,$inststatus)) {
-                        if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
-                            my @contacts = ('adminemail','supportemail');
-                            foreach my $item (@contacts) {
-                                if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
-                                    my $addr = $domconfig{'contacts'}{'overrides'}{$status};
-                                    if (!grep(/^\Q$addr\E$/,@recipients)) {
-                                        push(@recipients,$addr);
-                                    }
-                                }
-                            }
-                            $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
-                            if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
-                                my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
-                                my @ok_bccs;
-                                foreach my $bcc (@bccs) {
-                                    $bcc =~ s/^\s+//g;
-                                    $bcc =~ s/\s+$//g;
-                                    if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
-                                        if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
-                                            push(@ok_bccs,$bcc);
-                                        }
-                                    }
-                                }
-                                if (@ok_bccs > 0) {
-                                    $allbcc = join(', ',@ok_bccs);
-                                }
-                            }
-                            $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
-                            last;
-                        }
-                    }
-                }
-            }
-        }
     } elsif ($origmail ne '') {
         $lastresort = $origmail;
     }
@@ -14462,6 +14339,8 @@ jsarray (reference to array of categorie
 subcats (reference to hash of arrays containing all subcategories within each 
          category, -recursive)
 
+maxd (reference to hash used to hold max depth for all top-level categories).
+
 Returns: nothing
 
 Side effects: populates trails and allitems hash references.
@@ -14469,7 +14348,7 @@ Side effects: populates trails and allit
 =cut
 
 sub extract_categories {
-    my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
+    my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
     if (ref($categories) eq 'HASH') {
         &gather_categories($categories,$cats,$idx,$jsarray);
         if (ref($cats->[0]) eq 'ARRAY') {
@@ -14495,12 +14374,15 @@ sub extract_categories {
                         if (ref($subcats) eq 'HASH') {
                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                         }
-                        &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
+                        &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
                     }
                 } else {
                     if (ref($subcats) eq 'HASH') {
                         $subcats->{$item} = [];
                     }
+                    if (ref($maxd) eq 'HASH') {
+                        $maxd->{$name} = 1;
+                    }
                 }
             }
         }
@@ -14538,7 +14420,7 @@ Side effects: populates trails and allit
 =cut
 
 sub recurse_categories {
-    my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
+    my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
     my $shallower = $depth - 1;
     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
@@ -14565,16 +14447,21 @@ sub recurse_categories {
                 }
             }
             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
-                                $subcats);
+                                $subcats,$maxd);
             pop(@{$parents});
         }
     } else {
         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;
         }
+        if (ref($maxd) eq 'HASH') {
+            if ($depth > $maxd->{$parents->[0]}) {
+                $maxd->{$parents->[0]} = $depth;
+            }
+        }
     }
     return;
 }
@@ -14606,8 +14493,8 @@ sub assign_categories_table {
     my ($cathash,$currcat,$type,$disabled) = @_;
     my $output;
     if (ref($cathash) eq 'HASH') {
-        my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
-        &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
+        my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
+        &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
         $maxdepth = scalar(@cats);
         if (@cats > 0) {
             my $itemcount = 0;
@@ -15660,7 +15547,8 @@ sub init_user_environment {
 
     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
     my ($tmp) = keys(%userenv);
-    if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
+    if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+    } else {
 	undef(%userenv);
     }
     if (($userenv{'interface'}) && (!$form->{'interface'})) {
@@ -17057,130 +16945,6 @@ sub des_decrypt {
     return $plaintext;
 }
 
-sub make_short_symbs {
-    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);
-        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('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'));
-                    }
-                }
-            }
-        }
-    }
-    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__;