--- loncom/interface/loncommon.pm 2008/03/18 23:00:51 1.636.2.3 +++ loncom/interface/loncommon.pm 2008/06/09 22:34:55 1.660 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.636.2.3 2008/03/18 23:00:51 raeburn Exp $ +# $Id: loncommon.pm,v 1.660 2008/06/09 22:34:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -67,6 +67,7 @@ use Apache::loncoursedata(); use Apache::lontexconvert(); use Apache::lonclonecourse(); use LONCAPA qw(:DEFAULT :match); +use DateTime::TimeZone; # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -78,6 +79,76 @@ my $readit; ## Global Variables ## + +# ----------------------------------------------- SSI with retries: +# + +=pod + +=head1 Server Side include with retries: + +=over 4 + +=item * &ssi_with_retries(resource,retries form) + +Performs an ssi with some number of retries. Retries continue either +until the result is ok or until the retry count supplied by the +caller is exhausted. + +Inputs: + +=over 4 + +resource - Identifies the resource to insert. + +retries - Count of the number of retries allowed. + +form - Hash that identifies the rendering options. + +=back + +Returns: + +=over 4 + +content - The content of the response. If retries were exhausted this is empty. + +response - The response from the last attempt (which may or may not have been successful. + +=back + +=back + +=cut + +sub ssi_with_retries { + my ($resource, $retries, %form) = @_; + + + my $ok = 0; # True if we got a good response. + my $content; + my $response; + + # Try to get the ssi done. within the retries count: + + do { + ($content, $response) = &Apache::lonnet::ssi($resource, %form); + $ok = $response->is_success; + if (!$ok) { + &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message); + } + $retries--; + } while (!$ok && ($retries > 0)); + + if (!$ok) { + $content = ''; # On error return an empty content. + } + return ($content, $response); + +} + + + # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; @@ -214,14 +285,14 @@ BEGIN { =over 4 -=item * browser_and_searcher_javascript () +=item * &browser_and_searcher_javascript() XXReturns a string containing javascript with two functions, C and C. Returned string does not contain EscriptE tags. -=item * openbrowser(formname,elementname,only,omit) [javascript] +=item * &openbrowser(formname,elementname,only,omit) [javascript] inputs: formname, elementname, only, omit @@ -234,7 +305,7 @@ with the given extension. Can be a comm Specifying 'omit' will restrict the browser to NOT displaying files with the given extension. Can be a comma separated list. -=item * opensearcher(formname, elementname) [javascript] +=item * &opensearcher(formname,elementname) [javascript] Inputs: formname, elementname @@ -319,7 +390,7 @@ sub storeresurl { unless ($resurl=~/^\/res/) { return 0; } $resurl=~s/\/$//; &Apache::lonnet::put('environment',{'lastresurl' => $resurl}); - &Apache::lonnet::appenv('environment.lastresurl' => $resurl); + &Apache::lonnet::appenv({'environment.lastresurl' => $resurl}); return 1; } @@ -377,6 +448,25 @@ sub selectstudent_link { return ''; } +sub authorbrowser_javascript { + return <<"ENDAUTHORBRW"; + +ENDAUTHORBRW +} + sub coursebrowser_javascript { my ($domainfilter,$sec_element,$formname)=@_; my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); @@ -514,6 +604,12 @@ sub selectcourse_link { '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course').""; } +sub selectauthor_link { + my ($form,$udom)=@_; + return ''. + &mt('Select Author').''; +} + sub check_uncheck_jscript { my $jscript = <<"ENDSCRT"; function checkAll(field) { @@ -539,10 +635,31 @@ ENDSCRT return $jscript; } +sub select_timezone { + my ($name,$selected,$onchange,$includeempty)=@_; + my $output=' menus. The select menus will be linked in that @@ -707,7 +824,7 @@ END =pod -=item * help_open_topic($topic, $text, $stayOnPage, $width, $height) +=item * &help_open_topic($topic,$text,$stayOnPage,$width,$height) Returns a string corresponding to an HTML link to the given help $topic, where $topic corresponds to the name of a .tex file in @@ -761,7 +878,7 @@ sub help_open_topic { # Add the graphic my $title = &mt('Online Help'); - my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif"); + my $helpicon=&lonhttpdurl("/res/adm/pages/help.png"); $template .= <<"ENDTEMPLATE"; (Help: $topic) ENDTEMPLATE @@ -1017,7 +1134,7 @@ ENDTEMPLATE =pod -=item * change_content_javascript(): +=item * &change_content_javascript(): This and the next function allow you to create small sections of an otherwise static HTML page that you can update on the fly with @@ -1072,7 +1189,7 @@ DOMBASED =pod -=item * changable_area($name, $origContent): +=item * &changable_area($name,$origContent): This provides a "changable area" that can be modified on the fly via the Javascript code provided in C. $name is @@ -1096,7 +1213,7 @@ sub changable_area { =pod -=item * viewport_geometry_js { +=item * &viewport_geometry_js Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser. @@ -1143,7 +1260,7 @@ GEOMETRY =pod -=item * viewport_size_js { +=item * &viewport_size_js() Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. @@ -1167,7 +1284,7 @@ DIMS =pod -=item * resize_textarea_js +=item * &resize_textarea_js() emits the needed javascript to resize a textarea to be as big as possible @@ -1176,6 +1293,7 @@ the id of the element to resize, second surrounds everything that comes after the textarea, this routine needs to be attached to the for the onload and onresize events. +=back =cut @@ -1228,8 +1346,6 @@ RESIZE =pod -=back - =head1 Excel and CSV file utility routines =over 4 @@ -1241,7 +1357,7 @@ RESIZE =pod -=item * csv_translate($text) +=item * &csv_translate($text) Translate $text to allow it to be output as a 'comma separated values' format. @@ -1262,7 +1378,7 @@ sub csv_translate { =pod -=item * define_excel_formats +=item * &define_excel_formats() Define some commonly used Excel cell formats. @@ -1318,7 +1434,7 @@ sub define_excel_formats { =pod -=item * create_workbook +=item * &create_workbook() Create an Excel worksheet. If it fails, output message on the request object and return undefs. @@ -1361,7 +1477,7 @@ sub create_workbook { =pod -=item * create_text_file +=item * &create_text_file() Create a file to write to and eventually make available to the user. If file creation fails, outputs an error message on the request object and @@ -1429,7 +1545,7 @@ sub domain_select { =over 4 -=item * multiple_select_form($name,$value,$size,$hash,$order) +=item * &multiple_select_form($name,$value,$size,$hash,$order) Returns a string containing a form to allow a user to select options from a hash option_name => displayed text. @@ -1566,7 +1682,7 @@ sub select_level_form { =pod -=item * select_dom_form($defdom,$name,$includeempty,$showdomdesc) +=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc) Returns a string containing a + '; + my $attrib = join(':',@{$$allfiles{$embed_file}}); + $upload_output .= + "\n\t\t". + ''; + if (exists($$codebase{$embed_file})) { + $upload_output .= + "\n\t\t". + ''; + } + } + $upload_output .= ''.&Apache::loncommon::end_data_table_row(); + $num++; + } + $upload_output .= &Apache::loncommon::end_data_table().'
+ + + '.&mt('(only files for which a location has been provided will be uploaded)').' + '; + return $upload_output; +} + =pod @@ -6841,7 +7092,7 @@ sub get_env_multiple { =over 4 -=item * upfile_store($r) +=item * &upfile_store($r) Store uploaded file, $r should be the HTTP Request object, needs $env{'form.upfile'} @@ -6871,7 +7122,7 @@ sub upfile_store { =pod -=item * load_tmp_file($r) +=item * &load_tmp_file($r) Load uploaded file from tmp, $r should be the HTTP Request object, needs $env{'form.datatoken'}, @@ -6895,7 +7146,7 @@ sub load_tmp_file { =pod -=item * upfile_record_sep() +=item * &upfile_record_sep() Separate uploaded file into records returns array of records, @@ -6917,7 +7168,7 @@ sub upfile_record_sep { =pod -=item * record_sep($record) +=item * &record_sep($record) Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'} @@ -7002,7 +7253,7 @@ sub record_sep { =pod -=item * upfile_select_html() +=item * &upfile_select_html() Return HTML code to select a file from the users machine and specify the file type. @@ -7049,7 +7300,7 @@ sub get_samples { =pod -=item * csv_print_samples($r,$records) +=item * &csv_print_samples($r,$records) Prints a table of sample values from each column uploaded $r is an Apache Request ref, $records is an arrayref from @@ -7085,7 +7336,7 @@ sub csv_print_samples { =pod -=item * csv_print_select_table($r,$records,$d) +=item * &csv_print_select_table($r,$records,$d) Prints a table to create associations between values and table columns. @@ -7131,7 +7382,7 @@ sub csv_print_select_table { =pod -=item * csv_samples_select_table($r,$records,$d) +=item * &csv_samples_select_table($r,$records,$d) Prints a table of sample values from the upload and can make associate samples to internal names. @@ -7181,7 +7432,7 @@ sub csv_samples_select_table { =pod -=item clean_excel_name($name) +=item * &clean_excel_name($name) Returns a replacement for $name which does not contain any illegal characters. @@ -7200,7 +7451,7 @@ sub clean_excel_name { =pod -=item * check_if_partid_hidden($id,$symb,$udom,$uname) +=item * &check_if_partid_hidden($id,$symb,$udom,$uname) Returns either 1 or undef @@ -7241,7 +7492,7 @@ sub check_if_partid_hidden { =over 4 -=item get_cgi_id +=item * &get_cgi_id() Inputs: none @@ -7265,7 +7516,7 @@ sub get_cgi_id { =pod -=item DrawBarGraph +=item * &DrawBarGraph() Facilitates the plotting of data in a (stacked) bar graph. Puts plot definition data into the users environment in order for @@ -7400,7 +7651,7 @@ sub DrawBarGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7409,7 +7660,7 @@ sub DrawBarGraph { =pod -=item DrawXYGraph +=item * &DrawXYGraph() Facilitates the plotting of data in an XY graph. Puts plot definition data into the users environment in order for @@ -7490,7 +7741,7 @@ sub DrawXYGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7499,7 +7750,7 @@ sub DrawXYGraph { =pod -=item DrawXYYGraph +=item * &DrawXYYGraph() Facilitates the plotting of data in an XY graph with two Y axes. Puts plot definition data into the users environment in order for @@ -7592,7 +7843,7 @@ sub DrawXYYGraph { $ValuesHash{$id.'.'.$key} = $value; } # - &Apache::lonnet::appenv(%ValuesHash); + &Apache::lonnet::appenv(\%ValuesHash); return ''; } @@ -7609,7 +7860,7 @@ Bad place for them but what the hell. =over 4 -=item &chartlink +=item * &chartlink() Returns a link to the chart for a specific student. @@ -7648,9 +7899,9 @@ sub chartlink { =over 4 -=item &restore_course_settings +=item * &restore_course_settings() -=item &store_course_settings +=item * &store_course_settings() Restores/Store indicated form parameters from the course environment. Will not overwrite existing values of the form parameters. @@ -7724,7 +7975,7 @@ sub store_settings { 'got error:'.$put_result); } # Make sure these settings stick around in this session, too - &Apache::lonnet::appenv(%AppHash); + &Apache::lonnet::appenv(\%AppHash); return; } @@ -7761,7 +8012,7 @@ sub restore_settings { =over 4 -=item &build_recipient_list +=item * &build_recipient_list() Build recipient lists for three types of e-mail: (a) Error Reports, (b) Package Updates, (c) Help requests, generated by @@ -7774,7 +8025,9 @@ 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 -Returns: comma separated list of addresses to which to send e-mail. +Returns: comma separated list of addresses to which to send e-mail. + +=back =cut @@ -7825,6 +8078,172 @@ sub build_recipient_list { ############################################################ ############################################################ +=pod + +=head1 Course Catalog Routines + +=over 4 + +=item * &gather_categories() + +Converts category definitions - keys of categories hash stored in +coursecategories in configuration.db on the primary library server in a +domain - to an array. Also generates javascript and idx hash used to +generate Domain Coordinator interface for editing Course Categories. + +Inputs: +categories (reference to hash of category definitions). +cats (reference to array of arrays/hashes which encapsulates hierarchy of + categories and subcategories). +idx (reference to hash of counters used in Domain Coordinator interface for + editing Course Categories). +jsarray (reference to array of categories used to create Javascript arrays for + Domain Coordinator interface for editing Course Categories). + +Returns: nothing + +Side effects: populates cats, idx and jsarray. + +=cut + +sub gather_categories { + my ($categories,$cats,$idx,$jsarray) = @_; + my %counters; + my $num = 0; + foreach my $item (keys(%{$categories})) { + my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item); + if ($container eq '' && $depth == 0) { + $cats->[$depth][$categories->{$item}] = $cat; + } else { + $cats->[$depth]{$container}[$categories->{$item}] = $cat; + } + my ($escitem,$tail) = split(/:/,$item,2); + if ($counters{$tail} eq '') { + $counters{$tail} = $num; + $num ++; + } + if (ref($idx) eq 'HASH') { + $idx->{$item} = $counters{$tail}; + } + if (ref($jsarray) eq 'ARRAY') { + push(@{$jsarray->[$counters{$tail}]},$item); + } + } + return; +} + +=pod + +=item * &extract_categories() + +Used to generate breadcrumb trails for course categories. + +Inputs: +categories (reference to hash of category definitions). +cats (reference to array of arrays/hashes which encapsulates hierarchy of + categories and subcategories). +trails (reference to array of breacrumb trails for each category). +allitems (reference to hash - key is category key + (format: escaped(name):escaped(parent category):depth in hierarchy). +idx (reference to hash of counters used in Domain Coordinator interface for + editing Course Categories). +jsarray (reference to array of categories used to create Javascript arrays for + Domain Coordinator interface for editing Course Categories). + +Returns: nothing + +Side effects: populates trails and allitems hash references. + +=cut + +sub extract_categories { + my ($categories,$cats,$trails,$allitems,$idx,$jsarray) = @_; + if (ref($categories) eq 'HASH') { + &gather_categories($categories,$cats,$idx,$jsarray); + if (ref($cats->[0]) eq 'ARRAY') { + for (my $i=0; $i<@{$cats->[0]}; $i++) { + my $name = $cats->[0][$i]; + my $item = &escape($name).'::0'; + my $trailstr; + if ($name eq 'instcode') { + $trailstr = &mt('Official courses (with institutional codes)'); + } else { + $trailstr = $name; + } + if ($allitems->{$item} eq '') { + push(@{$trails},$trailstr); + $allitems->{$item} = scalar(@{$trails})-1; + } + my @parents = ($name); + if (ref($cats->[1]{$name}) eq 'ARRAY') { + for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) { + my $category = $cats->[1]{$name}[$j]; + &recurse_categories($cats,2,$category,$trails,$allitems,\@parents); + } + } + } + } + } + return; +} + +=pod + +=item *&recurse_categories() + +Recursively used to generate breadcrumb trails for course categories. + +Inputs: +cats (reference to array of arrays/hashes which encapsulates hierarchy of + categories and subcategories). +depth (current depth in hierarchy of categories and sub-categories - 0 indexed). +category (current course category, for which breadcrumb trail is being generated). +trails (reference to array of breacrumb trails for each category). +allitems (reference to hash - key is category key + (format: escaped(name):escaped(parent category):depth in hierarchy). +parents (array containing containers directories for current category, + back to top level). + +Returns: nothing + +Side effects: populates trails and allitems hash references + +=back + +=cut + +sub recurse_categories { + my ($cats,$depth,$category,$trails,$allitems,$parents) = @_; + my $shallower = $depth - 1; + if (ref($cats->[$depth]{$category}) eq 'ARRAY') { + 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(' -> ',(@{$parents},$category)); + if ($allitems->{$item} eq '') { + push(@{$trails},$trailstr); + $allitems->{$item} = scalar(@{$trails})-1; + } + my $deeper = $depth+1; + push(@{$parents},$category); + &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents); + pop(@{$parents}); + } + } else { + my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; + my $trailstr = join(' -> ',(@{$parents},$category)); + if ($allitems->{$item} eq '') { + push(@{$trails},$trailstr); + $allitems->{$item} = scalar(@{$trails})-1; + } + } + return; +} + +############################################################ +############################################################ + + sub commit_customrole { my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_; my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url. @@ -7866,7 +8285,7 @@ sub commit_standardrole { $output = &mt('Assigning').' '.$three.' in '.$url. ($start?', '.&mt('starting').' '.localtime($start):''). ($end?', '.&mt('ending').' '.localtime($end):'').': '; - my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start); + my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context); if ($context eq 'auto') { $output .= $result.$linefeed; } else { @@ -7901,7 +8320,7 @@ sub commit_studentrole { } $oldsecurl = $uurl; $expire_role_result = - &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now); + &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context); if ($env{'request.course.sec'} ne '') { if ($expire_role_result eq 'refused') { my @roles = ('st'); @@ -7924,7 +8343,7 @@ sub commit_studentrole { } } if (($expire_role_result eq 'ok') || ($secchange == 0)) { - $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid); + $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context); if ($modify_section_result =~ /^ok/) { if ($secchange == 1) { if ($sec eq '') { @@ -8087,7 +8506,7 @@ sub construct_course { $outcome .= $clonemsg.$linefeed; my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); # Copy all files - &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid); + &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); # Restore URL $cenv{'url'}=$oldcenv{'url'}; # Restore title @@ -8134,7 +8553,6 @@ sub construct_course { } else { $cenv{'internal.courseowner'} = $args->{'curruser'}; } - my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner. if ($args->{'crssections'}) { $cenv{'internal.sectionnums'} = '';