--- loncom/interface/lonsupportreq.pm 2006/09/01 21:07:11 1.37
+++ loncom/interface/lonsupportreq.pm 2006/12/12 16:04:40 1.40
@@ -1,5 +1,5 @@
#
-# $Id: lonsupportreq.pm,v 1.37 2006/09/01 21:07:11 raeburn Exp $
+# $Id: lonsupportreq.pm,v 1.40 2006/12/12 16:04:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,7 +36,7 @@ use Apache::loncommon();
use Apache::lonnet;
use Apache::lonlocal;
use Apache::lonacc();
-use lib '/home/httpd/lib/perl/';
+use Apache::courseclassifier;
use LONCAPA;
@@ -83,20 +83,59 @@ sub print_request_form {
$usec = $env{'request.course.sec'};
$cid = $env{'request.course.id'};
$formname = 'logproblem';
- if ($origurl =~ m-^http://-) {
+ my $machine = &Apache::lonnet::absolute_url();
+ if ($origurl =~ m-^https?://-) {
$server = $origurl;
} else {
- $server = 'http://'.$ENV{'SERVER_NAME'}.$origurl;
+ $server = $machine.$origurl;
}
- my $scripttag = (<<'END');
+ my %lt = &Apache::lonlocal::texthash (
+ email => 'The e-mail address you entered',
+ notv => 'is not a valid e-mail address',
+ rsub => 'You must include a subject',
+ rdes => 'You must include a description',
+ name => 'Name',
+ subm => 'Submit Request',
+ emad => 'E-mail address',
+ unme => 'username',
+ doma => 'domain',
+ entr => 'Enter the username you use to log-in to your LON-CAPA system, and choose your domain.',
+ urlp => 'URL of page',
+ phon => 'Phone',
+ crsd => 'Course Details',
+ enin => 'Enter institutional course code',
+ pick => 'Pick',
+ enct => 'Enter course title',
+ secn => 'Section Number',
+ sele => 'Select',
+ titl => 'Title',
+ lsec => 'LON-CAPA sec',
+ subj => 'Subject',
+ detd => 'Detailed Description',
+ opfi => 'Optional file upload',
+ uplf => 'Upload a file (e.g., a screenshot) relevant to your support request (128 KB max. size)',
+ fini => 'Finish',
+ clfm => 'Clear Form',
+ );
+ my $scripttag = (<<"END");
function validate() {
if (validmail(document.logproblem.email) == false) {
- alert("The e-mail address you entered: "+document.logproblem.email.value+" is not a valid e-mail address.");
+ alert("$lt{'email'}: "+document.logproblem.email.value+" $lt{'notv'}.");
+ return;
+ }
+ if (document.logproblem.subject.value == '') {
+ alert("$lt{'rsub'}.");
+ return;
+ }
+ if (document.logproblem.description.value == '') {
+ alert("$lt{'rdes'}.");
return;
}
document.logproblem.submit();
}
+END
+ $scripttag .= <<'END';
function validmail(field) {
var str = field.value;
if (window.RegExp) {
@@ -120,7 +159,7 @@ function validmail(field) {
END
if ($cid =~ m/_/) {
- ($cdom,$cnum) = split/_/,$cid;
+ ($cdom,$cnum) = split(/_/,$cid);
}
if ($cdom && $cnum) {
my %csettings = &Apache::lonnet::get('environment',['description','internal.coursecode','internal.sectionnums'],$cdom,$cnum);
@@ -140,10 +179,10 @@ END
if ($env{'environment.firstname'}) {
$firstname = $env{'environment.firstname'};
}
- my @sections = split/,/,$sectionlist;
- my %groupid = ();
- foreach (@sections) {
- my ($sec,$grp) = split/:/,$_;
+ my @sections = split(/,/,$sectionlist);
+ my %groupid;
+ foreach my $section (@sections) {
+ my ($sec,$grp) = split(/:/,$section);
$groupid{$sec} = $grp;
}
my $codedom = $Apache::lonnet::perlvar{'lonDefDomain'};
@@ -155,14 +194,14 @@ END
if ($codedom) {
$details_title = ' ('.$codedom.')';
}
- my %coursecodes = ();
- my %codes = ();
- my @codetitles = ();
- my %cat_titles = ();
- my %cat_order = ();
- my %idlist = ();
- my %idnums = ();
- my %idlist_titles = ();
+ my %coursecodes;
+ my %codes;
+ my @codetitles;
+ my %cat_titles;
+ my %cat_order;
+ my %idlist;
+ my %idnums;
+ my %idlist_titles;
my $caller = 'global';
my $totcodes = 0;
my $format_reply;
@@ -178,22 +217,27 @@ function initialize_codes() {
if ($cnum) {
$coursecodes{$cnum} = $ccode;
if ($ccode eq '') {
- $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
+ $totcodes = &Apache::courseclassifier::retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
} else {
$coursecodes{$cnum} = $ccode;
$caller = $cnum;
$totcodes ++;
}
} else {
- $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
+ $totcodes = &Apache::courseclassifier::retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
}
if ($totcodes > 0) {
if ($ccode eq '') {
$format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
if ($format_reply eq 'ok') {
my $numtypes = @codetitles;
- &build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
- &javascript_code_selections($formname,$numtypes,\%cat_titles,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
+ &Apache::courseclassifier::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
+ my ($scripttext,$longtitles) = &Apache::courseclassifier::javascript_definitions(\@codetitles,\%idlist,\%idlist_titles,\%idnums,\%cat_titles);
+ my $longtitles_str = join('","',@{$longtitles});
+ my $allidlist = $idlist{$codetitles[0]};
+ $jscript .= &Apache::courseclassifier::courseset_js_start($formname,$longtitles_str,$allidlist);
+ $jscript .= $scripttext;
+ $jscript .= &Apache::courseclassifier::javascript_code_selections($formname,@codetitles);
$loaditems = '';
}
}
@@ -231,7 +275,7 @@ function initialize_codes() {
@@ -254,7 +298,7 @@ END
$r->print(' ');
}
$r->print(<
+
@@ -269,7 +313,7 @@ END
- E-mail address:
+ $lt{'emad'}:
@@ -293,7 +337,7 @@ END
- username/domain:
+ $lt{'unme'}/$lt{'doma'}:
@@ -306,23 +350,23 @@ END
my $udom_input = ' ';
my $uname_input = ' ';
if (defined($uname) && defined($udom)) {
- $r->print('username : '.$uname.' domain : '.$udom.$udom_input.$uname_input);
+ $r->print(''.$lt{'unme'}.' : '.$uname.' '.$lt{'doma'}.' : '.$udom.$udom_input.$uname_input);
} else {
my $udomform = '';
my $unameform = '';
if (defined($udom)) {
- $udomform = 'domain : '.$udom.$udom_input;
+ $udomform = ''.$lt{'doma'}.' : '.$udom.$udom_input;
} elsif (defined($uname)) {
- $unameform = 'username : '.$uname.' '.$uname_input;
+ $unameform = ''.$lt{'unme'}.' : '.$uname.' '.$uname_input;
}
if ($udomform eq '') {
- $udomform = 'domain : ';
+ $udomform = ''.$lt{'doma'}.' : ';
$udomform .= &Apache::loncommon::select_dom_form($codedom,'udom');
}
if ($unameform eq '') {
- $unameform= 'username : ';
+ $unameform= ''.$lt{'unme'}.' : ';
}
- $r->print($unameform.$udomform.' Enter the username you use to log-in to your LON-CAPA system, and choose your domain.');
+ $r->print($unameform.$udomform.' '.$lt{'entr'});
}
$r->print(<
@@ -339,7 +383,7 @@ END
- URL of page:
+ $lt{'urlp'}:
@@ -363,7 +407,7 @@ END
- Phone #:
+ $lt{'phon'} #:
@@ -387,7 +431,7 @@ END
- Course Details: $details_title
+ $lt{'crsd'}: $details_title
@@ -399,19 +443,19 @@ END
END
if ($cnum) {
if ($coursecodes{$cnum}) {
- foreach (@codetitles) {
- $r->print(''.$_.' : '.$codes{$cnum}{$_}.'; ');
+ foreach my $item (@codetitles) {
+ $r->print(''.$item.' : '.$codes{$cnum}{$item}.'; ');
}
$r->print(' ');
} else {
- $r->print('Enter institutional course code:
+ $r->print($lt{'enin'}.':
');
}
} else {
if ($totcodes > 0) {
my $numtitles = @codetitles;
if ($numtitles == 0) {
- $r->print('Enter institutional course code:
+ $r->print($lt{'enin'}.':
');
} else {
my $lasttitle = $numtitles;
@@ -420,17 +464,17 @@ END
}
$r->print(''.$codetitles[0].' '."\n".
''."\n".
- ' Select'."\n");
+ ' '.$lt{'sele'}."\n");
my @items = ();
my @longitems = ();
if ($idlist{$codetitles[0]} =~ /","/) {
- @items = split/","/,$idlist{$codetitles[0]};
+ @items = split(/","/,$idlist{$codetitles[0]});
} else {
$items[0] = $idlist{$codetitles[0]};
}
if (defined($idlist_titles{$codetitles[0]})) {
if ($idlist_titles{$codetitles[0]} =~ /","/) {
- @longitems = split/","/,$idlist_titles{$codetitles[0]};
+ @longitems = split(/","/,$idlist_titles{$codetitles[0]});
} else {
$longitems[0] = $idlist_titles{$codetitles[0]};
}
@@ -449,7 +493,7 @@ END
for (my $i=1; $i<$numtitles; $i++) {
$r->print(''.$codetitles[$i].' '."\n".
''."\n".
- '<-Pick '.$codetitles[$i-1].' '."\n".
+ '<-'.$lt{'pick'}.' '.$codetitles[$i-1].' '."\n".
' '."\n".
' '
);
@@ -458,19 +502,19 @@ END
if ($numtitles > 4) {
$r->print(' '.$codetitles[$numtitles].' '."\n".
''."\n".
- '<-Pick '.$codetitles[$numtitles-1].' '."\n".
+ '<-'.$lt{'pick'}.' '.$codetitles[$numtitles-1].' '."\n".
' '."\n");
}
}
} else {
- $r->print('Enter institutional course code:
+ $r->print($lt{'enin'}.':
');
}
}
if ($ctitle) {
- $r->print('Title : '.$ctitle.' ');
+ $r->print(''.$lt{'titl'}.' : '.$ctitle.' ');
} else {
- $r->print(' Enter course title:
+ $r->print(' '.$lt{'enct'}.':
');
}
$r->print(<
- Section Number:
+ $lt{'secn'}:
@@ -500,12 +544,12 @@ END
END
if ($sectionlist) {
$r->print("".
- " Select \n");
- foreach (sort keys %groupid) {
- if ($_ eq $groupid{$_} || $groupid{$_} eq '') {
- $r->print(" $_ \n");
+ " $lt{'sele'} \n");
+ foreach my $id (sort(keys(%groupid))) {
+ if ($id eq $groupid{$id} || $groupid{$id} eq '') {
+ $r->print(" $id \n");
} else {
- $r->print(" $_ - (LON-CAPA sec: $groupid{$_}) \n");
+ $r->print(" $id - ($lt{'lsec'}: $groupid{$id}) \n");
}
}
$r->print(" ");
@@ -527,7 +571,7 @@ END
@@ -551,7 +595,7 @@ END
- Detailed description:
+ $lt{'detd'}:
@@ -578,7 +622,7 @@ END
- Optional file upload:
+ $lt{'opfi'}:
@@ -587,7 +631,7 @@ END
@@ -606,7 +650,7 @@ END
@@ -616,11 +660,11 @@ END
-
+
-
+
@@ -674,30 +718,48 @@ sub print_request_receipt {
$coursecode .= $env{'form.Number'};
}
}
+ my %lt = &Apache::lonlocal::texthash (
+ name => 'Name',
+ email => 'Email',
+ unme => 'Username/domain',
+ tel => 'Tel',
+ crsi => 'Course Information',
+ subj => 'Subject',
+ desc => 'Description',
+ date => 'Date/Time',
+ secn => 'Section',
+ asup => 'A support request has been sent to',
+ warn => 'Warning: Problem with support e-mail address',
+ your => 'Your support request contained the following information',
+ sect => 'section',
+ info => 'Information supplied',
+ adin => 'Additional information recorded',
+ );
+
my $supportmsg = qq|
-Name: $env{'form.username'}
-Email: $env{'form.email'}
-Username/domain: $env{'form.uname'} - $env{'form.udom'}
-Tel: $env{'form.phone'}
-Course Information: $env{'form.title'} - $coursecode - section: $env{'form.section'}
-Subject: $env{'form.subject'}
-Description: $env{'form.description'}
+$lt{'name'}: $env{'form.username'}
+$lt{'email'}: $env{'form.email'}
+$lt{'unme'}: $env{'form.uname'} - $env{'form.udom'}
+$lt{'tel'}: $env{'form.phone'}
+$lt{'crsi'}: env{'form.title'} - $coursecode - $lt{'secn'}: $env{'form.section'}
+$lt{'subj'}: $env{'form.subject'}
+$lt{'desc'}: $env{'form.description'}
URL: $env{'form.sourceurl'}
-Date/Time: $reporttime
+$lt{'date'}: $reporttime
|;
my $descrip = $env{'form.description'};
$descrip =~ s#\n# #g;
my $displaymsg = qq|
-Name: $env{'form.username'}
-Email: $env{'form.email'}
-Username/domain: $env{'form.uname'} - $env{'form.udom'}
-Tel: $env{'form.phone'}
-Course Information: $env{'form.title'} - $coursecode - section: $env{'form.section'}
-Subject: $env{'form.subject'}
-Description: $descrip
+$lt{'name'}: $env{'form.username'}
+$lt{'email'}: $env{'form.email'}
+$lt{'unme'}: $env{'form.uname'} - $env{'form.udom'}
+$lt{'tel'}: $env{'form.phone'}
+$lt{'crsi'}: $env{'form.title'} - $coursecode - $lt{'sect'}: $env{'form.section'}
+$lt{'subj'}: $env{'form.subject'}
+$lt{'desc'}: $descrip
URL: $env{'form.sourceurl'}
-Date/Time: $reporttime
+$lt{'date'}: $reporttime
|;
my $start_page =
@@ -719,17 +781,15 @@ END
&print_header($r,$url,'process');
}
if ($to =~ m/^[^\@]+\@[^\@]+$/) {
- $r->print("A support request has been sent to $to ");
+ $r->print(''.$lt{'asup'}.' '.$to.' ');
} else {
$to = $admin;
if ($to =~ m/^[^\@]+\@[^\@]+$/) {
- $r->print("A support request has been sent to $to ");
-END
+ $r->print(''.$lt{'asup'}.' '.$to.' ');
} else {
- $r->print(<Warning: Problem with support e-mail address
-As the e-mail address provided for this LON-CAPA server ($to) does not appear to be a valid e-mail address, your support request has not been sent to the LON-CAPA support staff or administrator at your institution. Instead a copy has been sent to the LON-CAPA support team at Michigan State University.
-END
+ $r->print('
+ '.$lt{'warn'}.' '.
+&mt('As the e-mail address provided for this LON-CAPA server ([_1]) does not appear to be a valid e-mail address, your support request has not been sent to the LON-CAPA support staff or administrator at your institution.',$to).' '.&mt('Instead a copy has been sent to the LON-CAPA support team at Michigan State University.'));
$to = 'helpdesk@lon-capa.org';
}
}
@@ -754,31 +814,31 @@ END
if ($env{'form.screenshot.filename'}) {
$attachmentsize = length($env{'form.screenshot'});
if ($attachmentsize > 131072) {
- $displaymsg .= " The uploaded screenshot file ($attachmentsize bytes) included with your request exceeded the maximum allowed size - 128 KB, and has therefore been discarded.";
+ $displaymsg .= ' '.&mt('The uploaded screenshot file ([_1] bytes) included with your request exceeded the maximum allowed size - 128 KB, and has therefore been discarded.',$attachmentsize);
} else {
$attachmentpath=&Apache::lonnet::userfileupload('screenshot',undef,'helprequests');
}
}
}
- my %cookies = ();
+ my %cookies;
my $cookie=CGI::Cookie->parse($r->header_in('Cookie'));
- if ($$cookie{'lonID'} =~ /lonID=(\w+);/) {
+ if ($$cookie{'lonID'} =~ /lonID=($LONCAPA::handle_re);/) {
$cookies{'lonID'} = $1;
}
if ($attachmentpath =~ m-/([^/]+)$-) {
$fname = $1;
- $displaymsg .= " An uploaded screenshot file - $fname ($attachmentsize bytes) was included in the request sent by $env{'user.name'} from LON-CAPA domain: $env{'user.domain'}";
+ $displaymsg .= ' '.&mt('An uploaded screenshot file - [_1] ([_2] bytes) was included in the request sent by [_3] from LON-CAPA domain',$fname,$attachmentsize,$env{'user.name'}.': '.$env{'user.domain'});
$supportmsg .= "\n";
- foreach (@cookievars) {
- $supportmsg .= "$_: $cookies{$_}\n";
+ foreach my $var (@cookievars) {
+ $supportmsg .= "$var: $cookies{$var}\n";
}
- foreach (@ENVvars) {
- $supportmsg .= "$_: $ENV{$_}\n";
+ foreach my $var(@ENVvars) {
+ $supportmsg .= "$var: $ENV{$var}\n";
}
- foreach (@envvars) {
- $supportmsg .= "$_: $env{$_}\n";
+ foreach my $var (@envvars) {
+ $supportmsg .= "$var: $env{$var}\n";
}
}
@@ -799,17 +859,17 @@ END
} else {
my $envdata = '';
- foreach (@cookievars) {
- $envdata .= "$_: $cookies{$_}\n";
+ foreach my $var (@cookievars) {
+ $envdata .= "$var: $cookies{$var}\n";
}
- foreach (@ENVvars) {
- $envdata .= "$_: $ENV{$_}\n";
+ foreach my $var (@ENVvars) {
+ $envdata .= "$var: $ENV{$var}\n";
}
- foreach (@envvars) {
- $envdata .= "$_: $env{$_}\n";
+ foreach my $var (@envvars) {
+ $envdata .= "$var: $env{$var}\n";
}
- foreach (@loncvars) {
- $envdata .= "$_: $env{$_}\n";
+ foreach my $var (@loncvars) {
+ $envdata .= "$var: $env{$var}\n";
}
$msg->attach(Type => 'TEXT',
Data => $envdata);
@@ -822,7 +882,7 @@ END
unlink($attachmentpath);
}
$r->print(qq|
- Your support request contained the following information :
+ $lt{'your'} :
@@ -837,7 +897,7 @@ END
- Information supplied
+ $lt{'info'}
@@ -859,7 +919,7 @@ END
- Additional information recorded
+ $lt{'adin'}
@@ -869,19 +929,19 @@ END
|);
- foreach (@cookievars) {
- unless($cookies{$_} eq '') {
- $r->print("$_: $cookies{$_} , ");
+ foreach my $var (@cookievars) {
+ unless($cookies{$var} eq '') {
+ $r->print("$var: $cookies{$var} , ");
}
}
- foreach (@ENVvars) {
- unless($ENV{$_} eq '') {
- $r->print("$_: $ENV{$_} , ");
+ foreach my $var (@ENVvars) {
+ unless($ENV{$var} eq '') {
+ $r->print("$var: $ENV{$var} , ");
}
}
- foreach (@envvars) {
- unless($env{$_} eq '') {
- $r->print("$_: $env{$_} , ");
+ foreach my $var (@envvars) {
+ unless($env{$var} eq '') {
+ $r->print("$var: $env{$var} , ");
}
}
$r->print("
@@ -939,9 +999,9 @@ sub print_header {
@@ -974,409 +1034,4 @@ Please review the information in "Log-in
return;
}
-sub retrieve_instcodes {
- my ($coursecodes,$codedom,$totcodes) = @_;
- my %courses = &Apache::lonnet::courseiddump($codedom,'.',1,'.','.','.',
- undef,undef,'Course');
- foreach my $course (keys %courses) {
- if ($courses{$course} =~ m/^[^:]*:([^:]+)/) {
- $$coursecodes{$course} = &unescape($1);
- $totcodes ++;
- }
- }
- return $totcodes;
-}
-
-sub build_code_selections {
- my ($codes,$codetitles,$cat_titles,$cat_order,$idlist,$idnums,$idlist_titles) = @_;
- my %idarrays = ();
- for (my $i=1; $i<@{$codetitles}; $i++) {
- %{$idarrays{$$codetitles[$i]}} = ();
- }
- foreach my $cid (sort keys %{$codes}) {
- &recurse_list($cid,$codetitles,$codes,0,\%idarrays);
- }
- for (my $num=0; $num<@{$codetitles}; $num++) {
- if ($num == 0) {
- my @contents = ();
- my @contents_titles = ();
- &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[0]}},\@contents);
- if (defined($$cat_titles{$$codetitles[0]})) {
- foreach (@contents) {
- push @contents_titles, $$cat_titles{$$codetitles[0]}{$_};
- }
- }
- $$idlist{$$codetitles[0]} = join('","',@contents);
- $$idnums{$$codetitles[0]} = scalar(@contents);
- if (defined($$cat_titles{$$codetitles[0]})) {
- $$idlist_titles{$$codetitles[0]} = join('","',@contents_titles);
- }
- } elsif ($num == 1) {
- %{$$idlist{$$codetitles[1]}} = ();
- %{$$idlist_titles{$$codetitles[1]}} = ();
- foreach my $key_a (keys %{$idarrays{$$codetitles[1]}}) {
- my @sorted_a = ();
- my @sorted_a_titles = ();
- &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[1]}{$key_a}},\@sorted_a);
- if (defined($$cat_titles{$$codetitles[1]})) {
- foreach (@sorted_a) {
- push @sorted_a_titles, $$cat_titles{$$codetitles[1]}{$_};
- }
- }
- $$idlist{$$codetitles[1]}{$key_a} = join('","',@sorted_a);
- $$idnums{$$codetitles[1]}{$key_a} = scalar(@sorted_a);
- if (defined($$cat_titles{$$codetitles[1]})) {
- $$idlist_titles{$$codetitles[1]}{$key_a} = join('","',@sorted_a_titles);
- }
- }
- } elsif ($num == 2) {
- %{$$idlist{$$codetitles[2]}} = ();
- %{$$idlist_titles{$$codetitles[2]}} = ();
- foreach my $key_a (keys %{$idarrays{$$codetitles[2]}}) {
- %{$$idlist{$$codetitles[2]}{$key_a}} = ();
- %{$$idlist_titles{$$codetitles[2]}{$key_a}} = ();
- foreach my $key_b (keys %{$idarrays{$$codetitles[2]}{$key_a}}) {
- my @sorted_b = ();
- my @sorted_b_titles = ();
- &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[2]}{$key_a}{$key_b}},\@sorted_b);
- if (defined($$cat_titles{$$codetitles[2]})) {
- foreach (@sorted_b) {
- push @sorted_b_titles, $$cat_titles{$$codetitles[2]}{$_};
- }
- }
- $$idlist{$$codetitles[2]}{$key_a}{$key_b} = join('","',@sorted_b);
- $$idnums{$$codetitles[2]}{$key_a}{$key_b} = scalar(@sorted_b);
- if (defined($$cat_titles{$$codetitles[2]})) {
- $$idlist_titles{$$codetitles[2]}{$key_a}{$key_b} = join('","',@sorted_b_titles);
- }
- }
- }
- } elsif ($num == 3) {
- %{$$idlist{$$codetitles[3]}} = ();
- foreach my $key_a (keys %{$idarrays{$$codetitles[3]}}) {
- %{$$idlist{$$codetitles[3]}{$key_a}} = ();
- foreach my $key_b (keys %{$idarrays{$$codetitles[3]}{$key_a}}) {
- %{$$idlist{$$codetitles[3]}{$key_a}{$key_b}} = ();
- foreach my $key_c (keys %{$idarrays{$$codetitles[3]}{$key_a}{$key_b}}) {
- my @sorted_c = ();
- my @sorted_c_titles = ();
- &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[3]}{$key_a}{$key_b}{$key_c}},\@sorted_c);
- if (defined($$cat_titles{$$codetitles[3]})) {
- foreach (@sorted_c) {
- push @sorted_c_titles, $$cat_titles{$$codetitles[3]}{$_};
- }
- }
- $$idlist{$$codetitles[3]}{$key_a}{$key_b}{$key_c} = join('","',@sorted_c);
- $$idnums{$$codetitles[3]}{$key_a}{$key_b}{$key_c} = scalar(@sorted_c);
- if (defined($$cat_titles{$$codetitles[3]})) {
- $$idlist_titles{$$codetitles[2]}{$key_a}{$key_b} = join('","',@sorted_c_titles);
- }
- }
- }
- }
- } elsif ($num == 4) {
- %{$$idlist{$$codetitles[4]}} = ();
- foreach my $key_a (keys %{$idarrays{$$codetitles[4]}}) {
- %{$$idlist{$$codetitles[4]}{$key_a}} = ();
- foreach my $key_b (keys %{$idarrays{$$codetitles[4]}{$key_a}}) {
- %{$$idlist{$$codetitles[4]}{$key_a}{$key_b}} = ();
- foreach my $key_c (keys %{$idarrays{$$codetitles[4]}{$key_a}{$key_b}}) {
- %{$$idlist{$$codetitles[4]}{$key_a}{$key_b}{$key_c}} = ();
- foreach my $key_d (keys %{$idarrays{$$codetitles[4]}{$key_a}{$key_b}{$key_c}}) {
- my @sorted_d = ();
- my @sorted_d_titles = ();
- &sort_cats($num,$cat_order,$codetitles,$idarrays{$$codetitles[4]}{$key_a}{$key_b}{$key_c}{$key_d},\@sorted_d);
- if (defined($$cat_titles{$$codetitles[4]})) {
- foreach (@sorted_d) {
- push @sorted_d_titles, $$cat_titles{$$codetitles[4]}{$_};
- }
- }
- $$idlist{$$codetitles[4]}{$key_a}{$key_b}{$key_c}{$key_d} = join('","',@sorted_d);
- $$idnums{$$codetitles[4]}{$key_a}{$key_b}{$key_c}{$key_d} = scalar(@sorted_d);
- }
- }
- }
- }
- }
- }
-}
-
-sub sort_cats {
- my ($num,$cat_order,$codetitles,$idsarrayref,$sorted) = @_;
- my @unsorted = @{$idsarrayref};
- if (defined($$cat_order{$$codetitles[$num]})) {
- foreach my $item (@{$$cat_order{$$codetitles[$num]}}) {
- if (grep/^\Q$item\E$/,@unsorted) {
- push @{$sorted}, $item;
- }
- }
- } else {
- @{$sorted} = sort (@unsorted);
- }
-}
-
-
-sub recurse_list {
- my ($cid,$codetitles,$codes,$num,$idarrays) = @_;
- if ($num == 0) {
- if (!grep/^$$codes{$cid}{$$codetitles[0]}$/,@{$$idarrays{$$codetitles[0]}}) {
- push @{$$idarrays{$$codetitles[0]}}, $$codes{$cid}{$$codetitles[0]};
- }
- } elsif ($num == 1) {
- if (defined($$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}})) {
- if (!grep/^$$codes{$cid}{$$codetitles[1]}$/,@{$$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}}}) {
- push @{$$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}}}, $$codes{$cid}{$$codetitles[1]};
- }
- } else {
- @{$$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}}} = ("$$codes{$cid}{$$codetitles[1]}");
- }
- } elsif ($num == 2) {
- if (defined($$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}})) {
- if (defined($$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}})) {
- if (!grep/^$$codes{$cid}{$$codetitles[2]}$/,@{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}}) {
- push @{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}}, $$codes{$cid}{$$codetitles[2]};
- }
- } else {
- @{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ("$$codes{$cid}{$$codetitles[2]}");
- }
- } else {
- %{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}} = ();
- @{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ("$$codes{$cid}{$$codetitles[2]}");
- }
- } elsif ($num == 3) {
- if (defined($$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}})) {
- if (defined($$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}})) {
- if (defined($$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}})) {
- if (!grep/^$$codes{$cid}{$$codetitles[3]}$/,@{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}}) {
- push @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}}, $$codes{$cid}{$$codetitles[3]};
- }
- } else {
- @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ("$$codes{$cid}{$$codetitles[3]}");
- }
- } else {
- %{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
- @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ("$$codes{$cid}{$$codetitles[3]}");
- }
- } else {
- %{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}} = ();
- %{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
- @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ("$$codes{$cid}{$$codetitles[3]}");
- }
- } elsif ($num == 4) {
- if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}})) {
- if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}})) {
- if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}})) {
- if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}})) {
- if (!grep/^$$codes{$cid}{$$codetitles[4]}$/,@{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}}) {
- push @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}}, $$codes{$cid}{$$codetitles[4]};
- }
- } else {
- @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[4]}");
- }
- } else {
- %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ();
- @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[4]}");
- }
- } else {
- %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
- %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ();
- @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[4]}");
- }
- } else {
- %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}} = ();
- %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
- %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ();
- @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[3]}");
- }
- }
- $num ++;
- if ($num <@{$codetitles}) {
- &recurse_list($cid,$codetitles,$codes,$num,$idarrays);
- }
-}
-
-sub javascript_code_selections {
- my ($formname,$numcats,$cat_titles,$script_tag,$idlist,$idnums,$idlist_titles,$codetitles) = @_;
- my $numtitles = @{$codetitles};
- my @seltitles = ();
- for (my $j=0; $j<$numtitles; $j++) {
- $seltitles[$j] = 'id'.$$codetitles[$j];
- }
- my $seltitle_str = join('","',@seltitles);
- my @longtitles = ();
- for (my $i=0; $i<$numtitles; $i++) {
- if (defined($$cat_titles{$$codetitles[$i]})) {
- $longtitles[$i] = 1;
- } else {
- $longtitles[$i] = 0;
- }
- }
- my $longtitles_str = join('","',@longtitles);
- $$script_tag .= <