--- loncom/interface/loncommon.pm 2014/04/23 10:33:52 1.1075.2.70 +++ loncom/interface/loncommon.pm 2013/05/03 21:57:13 1.1126 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.70 2014/04/23 10:33:52 raeburn Exp $ +# $Id: loncommon.pm,v 1.1126 2013/05/03 21:57:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -69,14 +69,12 @@ use Apache::lontexconvert(); use Apache::lonclonecourse(); use Apache::lonuserutils(); use Apache::lonuserstate(); -use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; use DateTime::Locale::Catalog; +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; -use Crypt::DES; -use DynaLoader; # for Crypt::DES version # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -161,6 +159,7 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %supported_codes; my %latex_language; # For choosing hyphenation in my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; @@ -195,14 +194,15 @@ BEGIN { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); + my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; + $supported_codes{$key} = $code; } if ($latex) { $latex_language_bykey{$key} = $latex; - $latex_language{$two} = $latex; + $latex_language{$code} = $latex; } } close($fh); @@ -666,7 +666,7 @@ if (!Array.prototype.indexOf) { var n = 0; if (arguments.length > 0) { n = Number(arguments[1]); - if (n !== n) { // shortcut for verifying if it's NaN + if (n !== n) { // shortcut for verifying if it is NaN n = 0; } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { n = (n > 0 || -1) * Math.floor(Math.abs(n)); @@ -902,12 +902,12 @@ sub check_uncheck_jscript { function checkAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { - if (!field[i].disabled) { + if (!field[i].disabled) { field[i].checked = true; } } } else { - if (!field.disabled) { + if (!field.disabled) { field.checked = true; } } @@ -1017,6 +1017,33 @@ sub select_language { =pod + +=item * &list_languages() + +Returns an array reference that is suitable for use in language prompters. +Each array element is itself a two element array. The first element +is the language code. The second element a descsriptiuon of the +language itself. This is suitable for use in e.g. +&Apache::edit::select_arg (once dereferenced that is). + +=cut + +sub list_languages { + my @lang_choices; + + foreach my $id (&languageids()) { + my $code = &supportedlanguagecode($id); + if ($code) { + my $selector = $supported_codes{$id}; + my $description = &plainlanguagedescription($id); + push (@lang_choices, [$selector, $description]); + } + } + return \@lang_choices; +} + +=pod + =item * &linked_select_forms(...) linked_select_forms returns a string containing a block @@ -1237,11 +1264,7 @@ sub help_open_topic { $topic=~s/\W/\_/g; if (!$stayOnPage) { - if ($env{'browser.mobile'}) { - $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; - } else { - $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; - } + $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');"; } elsif ($stayOnPage eq 'popup') { $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; } else { @@ -1355,40 +1378,32 @@ sub help_open_menu { sub top_nav_help { my ($text) = @_; $text = &mt($text); - my $stay_on_page; - unless ($env{'environment.remote'} eq 'on') { - $stay_on_page = 1; - } - my ($link,$banner_link); - unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) { - $link = ($stay_on_page) ? "javascript:helpMenu('display')" - : "javascript:helpMenu('open')"; - $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); - } + my $stay_on_page = 1; + + my $link = ($stay_on_page) ? "javascript:helpMenu('display')" + : "javascript:helpMenu('open')"; + my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page); + my $title = &mt('Get help'); - if ($link) { - return <<"END"; + + return <<"END"; $banner_link -$text + $text END - } else { - return ' '.$text.' '; - } } sub help_menu_js { - my ($httphost) = @_; + my ($text) = @_; my $stayOnPage = 1; my $width = 620; my $height = 600; my $helptopic=&general_help(); - my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp'; + my $details_link = '/adm/help/'.$helptopic.'.hlp'; my $nothing=&Apache::lonhtmlcommon::javascript_nothing(); my $start_page = &Apache::loncommon::start_page('Help Menu', undef, {'frameset' => 1, 'js_ready' => 1, - 'use_absolute' => $httphost, 'add_entries' => { 'border' => '0', 'rows' => "110,*",},}); @@ -1420,10 +1435,9 @@ function helpMenu(target) { return; } function writeHelp(caller) { - caller.document.writeln('$start_page\\n\\n'); - caller.document.writeln('\\n$end_page'); - caller.document.close(); - caller.focus(); + caller.document.writeln('$start_page\\n\\n\\n$end_page') + caller.document.close() + caller.focus() } // END LON-CAPA Internal --> // ]]> @@ -1735,6 +1749,8 @@ RESIZE =head1 Excel and CSV file utility routines +=over 4 + =cut ############################################################### @@ -1742,8 +1758,6 @@ RESIZE =pod -=over 4 - =item * &csv_translate($text) Translate $text to allow it to be output as a 'comma separated values' @@ -2192,7 +2206,7 @@ The optional $onchange argument specifie The optional $incdoms is a reference to an array of domains which will be the only available options. -The optional $excdoms is a reference to an array of domains which will be excluded from the available options. +The optional $excdoms is a reference to an array of domains which will be excluded from the available options. =cut @@ -2210,7 +2224,7 @@ sub select_dom_form { } if ($includeempty) { @domains=('',@domains); } if (ref($excdoms) eq 'ARRAY') { - map { $exclude{$_} = 1; } @{$excdoms}; + map { $exclude{$_} = 1; } @{$excdoms}; } my $selectdomain = "'."\n"; @@ -10320,46 +10052,6 @@ sub ask_for_embedded_content { return ($output,$counter,$numpathchg); } -=pod - -=item * clean_path($name) - -Performs clean-up of directories, subdirectories and filename in an -embedded object, referenced in an HTML file which is being uploaded -to a course or portfolio, where -"Upload embedded images/multimedia files if HTML file" checkbox was -checked. - -Clean-up is similar to replacements in lonnet::clean_filename() -except each / between sub-directory and next level is preserved. - -=cut - -sub clean_path { - my ($embed_file) = @_; - $embed_file =~s{^/+}{}; - my @contents; - if ($embed_file =~ m{/}) { - @contents = split(/\//,$embed_file); - } else { - @contents = ($embed_file); - } - my $lastidx = scalar(@contents)-1; - for (my $i=0; $i<=$lastidx; $i++) { - $contents[$i]=~s{\\}{/}g; - $contents[$i]=~s/\s+/\_/g; - $contents[$i]=~s{[^/\w\.\-]}{}g; - if ($i == $lastidx) { - $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g; - } - } - if ($lastidx > 0) { - return join('/',@contents); - } else { - return $contents[0]; - } -} - sub embedded_file_element { my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_; return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') && @@ -10484,8 +10176,7 @@ sub upload_embedded { # Check if extension is valid if (($fname =~ /\.(\w+)$/) && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { - $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1) - .' '.&mt('Rename the file with a different extension and re-upload.').'
'; + $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'
'; next; } elsif (($fname =~ /\.(\w+)$/) && (!defined(&Apache::loncommon::fileembstyle($1)))) { @@ -10684,7 +10375,7 @@ sub modify_html_refs { } my (%allfiles,%codebase,$output,$content); my @changes = &get_env_multiple('form.namechange'); - unless ((@changes > 0) || ($context eq 'syllabus')) { + unless ((@changes > 0) || ($context eq 'syllabus')) { if (wantarray) { return ('',0,0); } else { @@ -10749,7 +10440,6 @@ sub modify_html_refs { my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi); $count += $numchg; $allfiles{$newname} = $allfiles{$ref}; - delete($allfiles{$ref}); } if ($env{'form.embedded_codebase_'.$i} ne '') { $codebase = &unescape($env{'form.embedded_codebase_'.$i}); @@ -10819,7 +10509,7 @@ sub modify_html_refs { } } if ($rewrites) { - my $saveresult; + my $saveresult; my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); if ($url eq $container) { my ($fname) = ($container =~ m{/([^/]+)$}); @@ -10925,11 +10615,11 @@ sub check_for_upload { if ($currsize < $filesize) { my $extra = $filesize - $currsize; if (($current_disk_usage + $extra) > $disk_quota) { - my $msg = '

'. + my $msg = ''. &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', - ''.$fname.'',$filesize,$currsize).'

'. - '

'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', - $disk_quota,$current_disk_usage).'

'; + ''.$fname.'',$filesize,$currsize).''. + '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', + $disk_quota,$current_disk_usage); return ('will_exceed_quota',$msg); } } @@ -10938,21 +10628,21 @@ sub check_for_upload { } } if (($current_disk_usage + $filesize) > $disk_quota){ - my $msg = '

'. - &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.'',$filesize).'

'. - '

'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'

'; + my $msg = ''. + &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.'',$filesize).''. + '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage); return ('will_exceed_quota',$msg); } elsif ($found_file) { if ($locked_file) { - my $msg = '

'; + my $msg = ''; $msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].',''.$fname.'',''.$port_path.$env{'form.currentpath'}.''); - $msg .= '

'; + $msg .= '
'; $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.',''.$fname.''); return ('file_locked',$msg); } else { - my $msg = '

'; + my $msg = ''; $msg .= &mt(' A file by that name: [_1] was found in [_2].',''.$fname.'',$port_path.$env{'form.currentpath'}); - $msg .= '

'; + $msg .= ''; return ('existingfile',$msg); } } @@ -11043,43 +10733,16 @@ sub decompress_form { } } if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) { - my @camtasia6 = ("$topdir/","$topdir/index.html", + my @camtasia = ("$topdir/","$topdir/index.html", "$topdir/media/", "$topdir/media/$topdir.mp4", "$topdir/media/FirstFrame.png", "$topdir/media/player.swf", "$topdir/media/swfobject.js", "$topdir/media/expressInstall.swf"); - my @camtasia8 = ("$topdir/","$topdir/$topdir.html", - "$topdir/$topdir.mp4", - "$topdir/$topdir\_config.xml", - "$topdir/$topdir\_controller.swf", - "$topdir/$topdir\_embed.css", - "$topdir/$topdir\_First_Frame.png", - "$topdir/$topdir\_player.html", - "$topdir/$topdir\_Thumbnails.png", - "$topdir/playerProductInstall.swf", - "$topdir/scripts/", - "$topdir/scripts/config_xml.js", - "$topdir/scripts/handlebars.js", - "$topdir/scripts/jquery-1.7.1.min.js", - "$topdir/scripts/jquery-ui-1.8.15.custom.min.js", - "$topdir/scripts/modernizr.js", - "$topdir/scripts/player-min.js", - "$topdir/scripts/swfobject.js", - "$topdir/skins/", - "$topdir/skins/configuration_express.xml", - "$topdir/skins/express_show/", - "$topdir/skins/express_show/player-min.css", - "$topdir/skins/express_show/spritesheet.png"); - my @diffs = &compare_arrays(\@paths,\@camtasia6); + my @diffs = &compare_arrays(\@paths,\@camtasia); if (@diffs == 0) { - $is_camtasia = 6; - } else { - @diffs = &compare_arrays(\@paths,\@camtasia8); - if (@diffs == 0) { - $is_camtasia = 8; - } + $is_camtasia = 1; } } my $output; @@ -11091,7 +10754,8 @@ sub decompress_form { function camtasiaToggle() { for (var i=0; i'. ''.$lt{'proa'}.' 
'. @@ -11276,7 +10940,7 @@ sub decompress_uploaded_file { sub process_decompression { my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; my ($dir,$error,$warning,$output); - if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { + if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) { $error = &mt('Filename not a supported archive file type.'). '
'.&mt('Filename should end with one of: [_1].', '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz'); @@ -11386,7 +11050,6 @@ sub process_decompression { \%titles,\%children); } if ($env{'form.autoextract_camtasia'}) { - my $version = $env{'form.autoextract_camtasia'}; my %displayed; my $total = 1; $env{'form.archive_directory'} = []; @@ -11405,15 +11068,12 @@ sub process_decompression { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'}; $displayed{'folder'} = $i; - } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) || - (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) { + } elsif ($item eq "$contents[0]/index.html") { $env{'form.archive_'.$i} = 'display'; $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'}; $displayed{'web'} = $i; } else { - if ((($item eq "$contents[0]/media") && ($version == 6)) || - ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") || - ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) { + if ($item eq "$contents[0]/media") { push(@{$env{'form.archive_directory'}},$i); } $env{'form.archive_'.$i} = 'dependency'; @@ -11858,7 +11518,7 @@ sub process_extracted_files { $folders{'0'} = $items[-2]; if ($env{'form.folderpath'} =~ /\:1$/) { $containers{'0'}='page'; - } else { + } else { $containers{'0'}='sequence'; } } @@ -11978,7 +11638,7 @@ sub process_extracted_files { } } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; } } for (my $i=1; $i<=$numitems; $i++) { @@ -12000,7 +11660,7 @@ sub process_extracted_files { } if ($itemidx eq '') { $itemidx = 0; - } + } if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { if ($mapinner{$referrer{$i}}) { $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; @@ -12047,12 +11707,12 @@ sub process_extracted_files { $showpath = "$relpath/$title"; } else { $showpath = "/$title"; - } + } $result .= '
  • '.&mt('[_1] included as a dependency',$showpath).'
  • '."\n"; - } + } unless ($ishome) { my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; + $fetch =~ s/^\Q$prefix$dir\E//; $prompttofetch{$fetch} = 1; } } @@ -12062,7 +11722,7 @@ sub process_extracted_files { $path,$env{'form.archive_content_'.$referrer{$i}}).'
    '; } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; } } if (keys(%todelete)) { @@ -12140,7 +11800,7 @@ sub cleanup_empty_dirs { =pod -=item * &get_folder_hierarchy() +=item &get_folder_hierarchy() Provides hierarchy of names of folders/sub-folders containing the current item, @@ -12168,7 +11828,7 @@ sub get_folder_hierarchy { my @pcs = split(/,/,$pcslist); foreach my $pc (@pcs) { if ($pc == 1) { - push(@pathitems,&mt('Main Content')); + push(@pathitems,&mt('Main Course Documents')); } else { my $res = $navmap->getByMapPc($pc); if (ref($res)) { @@ -12183,7 +11843,7 @@ sub get_folder_hierarchy { } if ($showitem) { if ($mapres->{ID} eq '0.0') { - push(@pathitems,&mt('Main Content')); + push(@pathitems,&mt('Main Course Documents')); } else { my $maptitle = $mapres->compTitle(); $maptitle =~ s/\W+/_/g; @@ -12250,9 +11910,6 @@ sub get_turnedin_filepath { my $title = $res->compTitle(); $title =~ s/\W+/_/g; if ($title ne '') { - if (($pc > 1) && (length($title) > 12)) { - $title = substr($title,0,12); - } push(@pathitems,$title); } } @@ -12261,9 +11918,6 @@ sub get_turnedin_filepath { my $maptitle = $mapres->compTitle(); $maptitle =~ s/\W+/_/g; if ($maptitle ne '') { - if (length($maptitle) > 12) { - $maptitle = substr($maptitle,0,12); - } push(@pathitems,$maptitle); } unless ($env{'request.state'} eq 'construct') { @@ -12304,9 +11958,6 @@ sub get_turnedin_filepath { $restitle = time; } } - if (length($restitle) > 12) { - $restitle = substr($restitle,0,12); - } push(@pathitems,$restitle); $path .= join('/',@pathitems); } @@ -13244,22 +12895,18 @@ sub restore_settings { =item * &build_recipient_list() -Build recipient lists for following types of e-mail: +Build recipient lists for five types of e-mail: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors -(d) Help requests, (e) Course requests needing approval, (f) loncapa -module change checking, student/employee ID conflict checks, as -generated by lonerrorhandler.pm, CHECKRPMS, loncron, -lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively. +(d) Help requests, (e) Course requests needing approval, generated by +lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and +loncoursequeueadmin.pm respectively. Inputs: -defmail (scalar - email address of default recipient), -mailing type (scalar: errormail, packagesmail, helpdeskmail, -requestsmail, updatesmail, or idconflictsmail). - +defmail (scalar - email address of default recipient), +mailing type (scalar - errormail, packagesmail, or helpdeskmail), defdom (domain for which to retrieve configuration settings), - -origmail (scalar - email address of recipient from loncapa.conf, -i.e., predates configuration by DC via domainprefs.pm +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. @@ -13453,7 +13100,7 @@ sub extract_categories { =pod -=item * &recurse_categories() +=item *&recurse_categories() Recursively used to generate breadcrumb trails for course categories. @@ -13524,7 +13171,7 @@ sub recurse_categories { =pod -=item * &assign_categories_table() +=item *&assign_categories_table() Create a datatable for display of hierarchical categories in a domain, with checkboxes to allow a course to be categorized. @@ -13601,7 +13248,7 @@ sub assign_categories_table { =pod -=item * &assign_category_rows() +=item *&assign_category_rows() Create a datatable row for display of nested categories in a domain, with checkboxes to allow a course to be categorized,called recursively. @@ -13635,7 +13282,7 @@ sub assign_category_rows { if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { my $numchildren = @{$cats->[$depth]{$parent}}; my $css_class = $itemcount%2?' class="LC_odd_row"':''; - $text .= ''; + $text .= '
    '; for (my $j=0; $j<$numchildren; $j++) { $name = $cats->[$depth]{$parent}[$j]; $item = &escape($name).':'.&escape($parent).':'.$depth; @@ -13667,12 +13314,6 @@ sub assign_category_rows { return $text; } -=pod - -=back - -=cut - ############################################################ ############################################################ @@ -13803,7 +13444,7 @@ sub commit_studentrole { } } } else { - if ($secchange) { + if ($secchange) { $$logmsg .= &mt('Error when attempting section change for [_1] from old section "[_2]" to new section: "[_3]" in course [_4] -error:',$uname,$oldsec,$sec,$cid).' '.$modify_section_result.$linefeed; } else { $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed; @@ -13925,7 +13566,7 @@ sub check_clone { } sub construct_course { - my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; + my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_; my $outcome; my $linefeed = '
    '."\n"; if ($context eq 'auto') { @@ -14022,12 +13663,8 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); - if ($args->{'textbook'}) { - $cenv{'internal.textbook'} = $args->{'textbook'}; - } } # @@ -14211,25 +13848,6 @@ sub construct_course { } } -# -# generate and store uniquecode (available to course requester), if course should have one. -# - if ($args->{'uniquecode'}) { - my ($code,$error) = &make_unique_code($$crsudom,$$crsunum); - if ($code) { - $cenv{'internal.uniquecode'} = $code; - my %crsinfo = - &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.'); - if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') { - $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code; - my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime'); - } - if (ref($coderef)) { - $$coderef = $code; - } - } - } - if ($args->{'disresdis'}) { $cenv{'pch.roles.denied'}='st'; } @@ -14298,60 +13916,6 @@ sub construct_course { return (1,$outcome); } -sub make_unique_code { - my ($cdom,$cnum) = @_; - # get lock on uniquecodes db - my $lockhash = { - $cnum."\0".'uniquecodes' => $env{'user.name'}. - ':'.$env{'user.domain'}, - }; - my $tries = 0; - my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); - my ($code,$error); - - while (($gotlock ne 'ok') && ($tries<3)) { - $tries ++; - sleep 1; - $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom); - } - if ($gotlock eq 'ok') { - my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom); - my $gotcode; - my $attempts = 0; - while ((!$gotcode) && ($attempts < 100)) { - $code = &generate_code(); - if (!exists($currcodes{$code})) { - $gotcode = 1; - unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') { - $error = 'nostore'; - } - } - $attempts ++; - } - my @del_lock = ($cnum."\0".'uniquecodes'); - my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom); - } else { - $error = 'nolock'; - } - return ($code,$error); -} - -sub generate_code { - my $code; - my @letts = qw(B C D G H J K M N P Q R S T V W X Z); - for (my $i=0; $i<6; $i++) { - my $lettnum = int (rand 2); - my $item = ''; - if ($lettnum) { - $item = $letts[int( rand(18) )]; - } else { - $item = 1+int( rand(8) ); - } - $code .= $item; - } - return $code; -} - ############################################################ ############################################################ @@ -14379,12 +13943,11 @@ sub group_term { } sub course_types { - my @types = ('official','unofficial','community','textbook'); + my @types = ('official','unofficial','community'); my %typename = ( official => 'Official course', unofficial => 'Unofficial course', community => 'Community', - textbook => 'Textbook course', ); return (\@types,\%typename); } @@ -14517,7 +14080,7 @@ sub init_user_environment { # ------------------------------------ Check browser type and MathML capability my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, - $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r); + $clientunicode,$clientos) = &decode_user_agent($r); # ------------------------------------------------------------- Get environment @@ -14548,8 +14111,6 @@ sub init_user_environment { "browser.mathml" => $clientmathml, "browser.unicode" => $clientunicode, "browser.os" => $clientos, - "browser.mobile" => $clientmobile, - "browser.info" => $clientinfo, "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'}, "request.course.fn" => '', "request.course.uri" => '', @@ -14569,12 +14130,6 @@ sub init_user_environment { $env{'browser.interface'}=$form->{'interface'}; } - if ($form->{'iptoken'}) { - my $lonhost = $r->dir_config('lonHostID'); - $initial_env{"user.noloadbalance"} = $lonhost; - $env{'user.noloadbalance'} = $lonhost; - } - my %is_adv = ( is_adv => $env{'user.adv'} ); my %domdef; unless ($domain eq 'public') { @@ -14587,7 +14142,7 @@ sub init_user_environment { undef,\%userenv,\%domdef,\%is_adv); } - foreach my $crstype ('official','unofficial','community','textbook') { + foreach my $crstype ('official','unofficial','community') { $userenv{'canrequest.'.$crstype} = &Apache::lonnet::usertools_access($username,$domain,$crstype, 'reload','requestcourses', @@ -14601,7 +14156,7 @@ sub init_user_environment { my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], $domain,$username); my $reqstatus = $reqauthor{'author_status'}; - if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { if (ref($reqauthor{'author'}) eq 'HASH') { $userenv{'requestauthorqueued'} = $reqstatus.':'. $reqauthor{'author'}{'timestamp'}; @@ -14692,535 +14247,6 @@ sub clean_symb { return ($symb,$enc); } -############################################################ -############################################################ - -=pod - -=head1 Routines for building display used to search for courses - - -=over 4 - -=item * &build_filters() - -Create markup for a table used to set filters to use when selecting -courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm -and quotacheck.pl - - -Inputs: - -filterlist - anonymous array of fields to include as potential filters - -crstype - course type - -roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used - to pop-open a course selector (will contain "extra element"). - -multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1 - -filter - anonymous hash of criteria and their values - -action - form action - -numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number) - -caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm) - -cloneruname - username of owner of new course who wants to clone - -clonerudom - domain of owner of new course who wants to clone - -typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community) - -codetitlesref - reference to array of titles of components in institutional codes (official courses) - -codedom - domain - -formname - value of form element named "form". - -fixeddom - domain, if fixed. - -prevphase - value to assign to form element named "phase" when going back to the previous screen - -cnameelement - name of form element in form on opener page which will receive title of selected course - -cnumelement - name of form element in form on opener page which will receive courseID of selected course - -cdomelement - name of form element in form on opener page which will receive domain of selected course - -setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file - -clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course - -clonewarning - warning message about missing information for intended course owner when DC creates a course - - -Returns: $output - HTML for display of search criteria, and hidden form elements. - - -Side Effects: None - -=cut - -# ---------------------------------------------- search for courses based on last activity etc. - -sub build_filters { - my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action, - $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement, - $codetitlesref,$codedom,$formname,$fixeddom,$prevphase, - $cnameelement,$cnumelement,$cdomelement,$setroles, - $clonetext,$clonewarning) = @_; - my ($list,$jscript); - my $onchange = 'javascript:updateFilters(this)'; - my ($domainselectform,$sincefilterform,$createdfilterform, - $ownerdomselectform,$persondomselectform,$instcodeform, - $typeselectform,$instcodetitle); - if ($formname eq '') { - $formname = $caller; - } - foreach my $item (@{$filterlist}) { - unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') || - ($item eq 'sincefilter') || ($item eq 'createdfilter')) { - if ($item eq 'domainfilter') { - $filter->{$item} = &LONCAPA::clean_domain($filter->{$item}); - } elsif ($item eq 'coursefilter') { - $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item}); - } elsif ($item eq 'ownerfilter') { - $filter->{$item} = &LONCAPA::clean_username($filter->{$item}); - } elsif ($item eq 'ownerdomfilter') { - $filter->{'ownerdomfilter'} = - &LONCAPA::clean_domain($filter->{$item}); - $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'}, - 'ownerdomfilter',1); - } elsif ($item eq 'personfilter') { - $filter->{$item} = &LONCAPA::clean_username($filter->{$item}); - } elsif ($item eq 'persondomfilter') { - $persondomselectform = &select_dom_form($filter->{'persondomfilter'}, - 'persondomfilter',1); - } else { - $filter->{$item} =~ s/\W//g; - } - if (!$filter->{$item}) { - $filter->{$item} = ''; - } - } - if ($item eq 'domainfilter') { - my $allow_blank = 1; - if ($formname eq 'portform') { - $allow_blank=0; - } elsif ($formname eq 'studentform') { - $allow_blank=0; - } - if ($fixeddom) { - $domainselectform = ''. - &Apache::lonnet::domain($codedom,'description'); - } else { - $domainselectform = &select_dom_form($filter->{$item}, - 'domainfilter', - $allow_blank,'',$onchange); - } - } else { - $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"'); - } - } - - # last course activity filter and selection - $sincefilterform = &timebased_select_form('sincefilter',$filter); - - # course created filter and selection - if (exists($filter->{'createdfilter'})) { - $createdfilterform = &timebased_select_form('createdfilter',$filter); - } - - my %lt = &Apache::lonlocal::texthash( - 'cac' => "$crstype Activity", - 'ccr' => "$crstype Created", - 'cde' => "$crstype Title", - 'cdo' => "$crstype Domain", - 'ins' => 'Institutional Code', - 'inc' => 'Institutional Categorization', - 'cow' => "$crstype Owner/Co-owner", - 'cop' => "$crstype Personnel Includes", - 'cog' => 'Type', - ); - - if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) { - my $typeval = 'Course'; - if ($crstype eq 'Community') { - $typeval = 'Community'; - } - $typeselectform = ''; - } else { - $typeselectform = '"; - } - - my ($cloneableonlyform,$cloneabletitle); - if (exists($filter->{'cloneableonly'})) { - my $cloneableon = ''; - my $cloneableoff = ' checked="checked"'; - if ($filter->{'cloneableonly'}) { - $cloneableon = $cloneableoff; - $cloneableoff = ''; - } - $cloneableonlyform = ''.(' 'x3).''; - if ($formname eq 'ccrs') { - $cloneabletitle = &mt('Cloneable for').' '.$cloneruname.':'.$clonerudom; - } else { - $cloneabletitle = &mt('Cloneable by you'); - } - } - my $officialjs; - if ($crstype eq 'Course') { - if (exists($filter->{'instcodefilter'})) { -# if (($fixeddom) || ($formname eq 'requestcrs') || -# ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) { - if ($codedom) { - $officialjs = 1; - ($instcodeform,$jscript,$$numtitlesref) = - &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker', - $officialjs,$codetitlesref); - if ($jscript) { - $jscript = ''."\n"; - } - } - if ($instcodeform eq '') { - $instcodeform = - ''; - $instcodetitle = $lt{'ins'}; - } else { - $instcodetitle = $lt{'inc'}; - } - if ($fixeddom) { - $instcodetitle .= '
    ('.$codedom.')'; - } - } - } - my $output = qq| - - -|; - if ($formname eq 'modifycourse') { - $output .= ''."\n". - ''."\n"; - } elsif ($formname ne 'quotacheck') { - my $name_input; - if ($cnameelement ne '') { - $name_input = ''; - } - $output .= qq| - - -$name_input -$roleelement -$multelement -$typeelement -|; - if ($formname eq 'portform') { - $output .= ''."\n"; - } - } - if ($fixeddom) { - $output .= ''."\n"; - } - $output .= "
    \n".&Apache::lonhtmlcommon::start_pick_box(); - if ($sincefilterform) { - $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'}) - .$sincefilterform - .&Apache::lonhtmlcommon::row_closure(); - } - if ($createdfilterform) { - $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'}) - .$createdfilterform - .&Apache::lonhtmlcommon::row_closure(); - } - if ($domainselectform) { - $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'}) - .$domainselectform - .&Apache::lonhtmlcommon::row_closure(); - } - if ($typeselectform) { - if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) { - $output .= $typeselectform; - } else { - $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'}) - .$typeselectform - .&Apache::lonhtmlcommon::row_closure(); - } - } - if ($instcodeform) { - $output .= &Apache::lonhtmlcommon::row_title($instcodetitle) - .$instcodeform - .&Apache::lonhtmlcommon::row_closure(); - } - if (exists($filter->{'ownerfilter'})) { - $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}). - '
    '.&mt('Username').'
    '. - '
    '.&mt('Domain').'
    '. - $ownerdomselectform.'
    '. - &Apache::lonhtmlcommon::row_closure(); - } - if (exists($filter->{'personfilter'})) { - $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}). - '
    '.&mt('Username').'
    '. - '
    '.&mt('Domain').'
    '. - $persondomselectform.'
    '. - &Apache::lonhtmlcommon::row_closure(); - } - if (exists($filter->{'coursefilter'})) { - $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID')) - .'' - .&Apache::lonhtmlcommon::row_closure(); - } - if ($cloneableonlyform) { - $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle). - $cloneableonlyform.&Apache::lonhtmlcommon::row_closure(); - } - if (exists($filter->{'descriptfilter'})) { - $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'}) - .'' - .&Apache::lonhtmlcommon::row_closure(1); - } - $output .= &Apache::lonhtmlcommon::end_pick_box().'

    '.$clonetext."\n". - ''."\n". - '

    '."\n".''."\n".'
    '."\n"; - return $jscript.$clonewarning.$output; -} - -=pod - -=item * &timebased_select_form() - -Create markup for a dropdown list used to select a time-based -filter e.g., Course Activity, Course Created, when searching for courses -or communities - -Inputs: - -item - name of form element (sincefilter or createdfilter) - -filter - anonymous hash of criteria and their values - -Returns: HTML for a select box contained a blank, then six time selections, - with value set in incoming form variables currently selected. - -Side Effects: None - -=cut - -sub timebased_select_form { - my ($item,$filter) = @_; - if (ref($filter) eq 'HASH') { - $filter->{$item} =~ s/[^\d-]//g; - if (!$filter->{$item}) { $filter->{$item}=-1; } - return &select_form( - $filter->{$item}, - $item, - { '-1' => '', - '86400' => &mt('today'), - '604800' => &mt('last week'), - '2592000' => &mt('last month'), - '7776000' => &mt('last three months'), - '15552000' => &mt('last six months'), - '31104000' => &mt('last year'), - 'select_form_order' => - ['-1','86400','604800','2592000','7776000', - '15552000','31104000']}); - } -} - -=pod - -=item * &js_changer() - -Create script tag containing Javascript used to submit course search form -when course type or domain is changed, and also to hide 'Searching ...' on -page load completion for page showing search result. - -Inputs: None - -Returns: markup containing updateFilters() and hideSearching() javascript functions. - -Side Effects: None - -=cut - -sub js_changer { - return < -// - - -ENDJS -} - -=pod - -=item * &search_courses() - -Process selected filters form course search form and pass to lonnet::courseiddump -to retrieve a hash for which keys are courseIDs which match the selected filters. - -Inputs: - -dom - domain being searched - -type - course type ('Course' or 'Community' or '.' if any). - -filter - anonymous hash of criteria and their values - -numtitles - for institutional codes - number of categories - -cloneruname - optional username of new course owner - -clonerudom - optional domain of new course owner - -domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, - (used when DC is using course creation form) - -codetitles - reference to array of titles of components in institutional codes (official courses). - - -Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type. - - -Side Effects: None - -=cut - - -sub search_courses { - my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_; - my (%courses,%showcourses,$cloner); - if (($filter->{'ownerfilter'} ne '') || - ($filter->{'ownerdomfilter'} ne '')) { - $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'. - $filter->{'ownerdomfilter'}; - } - foreach my $item ('descriptfilter','coursefilter','combownerfilter') { - if (!$filter->{$item}) { - $filter->{$item}='.'; - } - } - my $now = time; - my $timefilter = - ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'}); - my ($createdbefore,$createdafter); - if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) { - $createdbefore = $now; - $createdafter = $now-$filter->{'createdfilter'}; - } - my ($instcodefilter,$regexpok); - if ($numtitles) { - if ($env{'form.official'} eq 'on') { - $instcodefilter = - &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles); - $regexpok = 1; - } elsif ($env{'form.official'} eq 'off') { - $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles); - unless ($instcodefilter eq '') { - $regexpok = -1; - } - } - } else { - $instcodefilter = $filter->{'instcodefilter'}; - } - if ($instcodefilter eq '') { $instcodefilter = '.'; } - if ($type eq '') { $type = '.'; } - - if (($clonerudom ne '') && ($cloneruname ne '')) { - $cloner = $cloneruname.':'.$clonerudom; - } - %courses = &Apache::lonnet::courseiddump($dom, - $filter->{'descriptfilter'}, - $timefilter, - $instcodefilter, - $filter->{'combownerfilter'}, - $filter->{'coursefilter'}, - undef,undef,$type,$regexpok,undef,undef, - undef,undef,$cloner,$env{'form.cc_clone'}, - $filter->{'cloneableonly'}, - $createdbefore,$createdafter,undef, - $domcloner); - if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) { - my $ccrole; - if ($type eq 'Community') { - $ccrole = 'co'; - } else { - $ccrole = 'cc'; - } - my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'}, - $filter->{'persondomfilter'}, - 'userroles',undef, - [$ccrole,'in','ad','ep','ta','cr'], - $dom); - foreach my $role (keys(%rolehash)) { - my ($cnum,$cdom,$courserole) = split(':',$role); - my $cid = $cdom.'_'.$cnum; - if (exists($courses{$cid})) { - if (ref($courses{$cid}) eq 'HASH') { - if (ref($courses{$cid}{roles}) eq 'ARRAY') { - if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) { - push (@{$courses{$cid}{roles}},$courserole); - } - } else { - $courses{$cid}{roles} = [$courserole]; - } - $showcourses{$cid} = $courses{$cid}; - } - } - } - %courses = %showcourses; - } - return %courses; -} - - -=pod - -=back - -=cut - - sub build_release_hashes { my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_; return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') && @@ -15337,30 +14363,6 @@ sub parse_supplemental_title { return $title; } -sub recurse_supplemental { - my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_; - if ($suppmap) { - my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); - if ($fatal) { - $errors ++; - } else { - if ($#LONCAPA::map::resources > 0) { - foreach my $res (@LONCAPA::map::resources) { - my ($title,$src,$ext,$type,$status)=split(/\:/,$res); - if (($src ne '') && ($status eq 'res')) { - if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { - ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors); - } else { - $numfiles ++; - } - } - } - } - } - } - return ($numfiles,$errors); -} - sub symb_to_docspath { my ($symb) = @_; return unless ($symb); @@ -15390,7 +14392,7 @@ sub symb_to_docspath { my $thistitle = $res->title(); $path .= '&'. &Apache::lonhtmlcommon::entity_encode($thisurl).'&'. - &escape($thistitle). + &Apache::lonhtmlcommon::entity_encode($thistitle). ':'.$res->randompick(). ':'.$res->randomout(). ':'.$res->encrypted(). @@ -15402,11 +14404,11 @@ sub symb_to_docspath { $path =~ s/^\&//; my $maptitle = $mapresobj->title(); if ($mapurl eq 'default') { - $maptitle = 'Main Content'; + $maptitle = 'Main Course Documents'; } $path .= (($path ne '')? '&' : ''). &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &escape($maptitle). + &Apache::lonhtmlcommon::entity_encode($maptitle). ':'.$mapresobj->randompick(). ':'.$mapresobj->randomout(). ':'.$mapresobj->encrypted(). @@ -15416,14 +14418,14 @@ sub symb_to_docspath { my $maptitle = &Apache::lonnet::gettitle($mapurl); my $ispage = (($type eq 'page')? 1 : ''); if ($mapurl eq 'default') { - $maptitle = 'Main Content'; + $maptitle = 'Main Course Documents'; } $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'. - &escape($maptitle).':::::'.$ispage; + &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage; } unless ($mapurl eq 'default') { $path = 'default&'. - &escape('Main Content'). + &Apache::lonhtmlcommon::entity_encode('Main Course Documents'). ':::::&'.$path; } return $path; @@ -15436,15 +14438,15 @@ sub captcha_display { if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { - $error = 'captcha'; + $error = 'captcha'; } } elsif ($captcha eq 'recaptcha') { $output = &create_recaptcha($pubkey); unless ($output) { - $error = 'recaptcha'; + $error = 'recaptcha'; } } - return ($output,$error,$captcha); + return ($output,$error); } sub captcha_response { @@ -15520,9 +14522,8 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". &mt('Type in the letters/numbers shown below').' '. - ''. - '
    '. - 'captcha'; + '
    '. + ''; last; } } @@ -15563,15 +14564,11 @@ sub check_captcha { sub create_recaptcha { my ($pubkey) = @_; - my $use_ssl; - if ($ENV{'SERVER_PORT'} == 443) { - $use_ssl = 1; - } my $captcha = Captcha::reCAPTCHA->new; return $captcha->get_options_setter({theme => 'white'})."\n". - $captcha->get_html($pubkey,undef,$use_ssl). + $captcha->get_html($pubkey). &mt('If either word is hard to read, [_1] will replace them.', - 'reCAPTCHA refresh'). + 'reCAPTCHA refresh'). '

    '; } @@ -15592,82 +14589,11 @@ sub check_recaptcha { return $captcha_chk; } -sub emailusername_info { - my @fields = ('firstname','lastname','institution','web','location','officialemail'); - my %titles = &Apache::lonlocal::texthash ( - lastname => 'Last Name', - firstname => 'First Name', - institution => 'School/college/university', - location => "School's city, state/province, country", - web => "School's web address", - officialemail => 'E-mail address at institution (if different)', - ); - return (\@fields,\%titles); -} +=pod -sub cleanup_html { - my ($incoming) = @_; - my $outgoing; - if ($incoming ne '') { - $outgoing = $incoming; - $outgoing =~ s/;/;/g; - $outgoing =~ s/\#/#/g; - $outgoing =~ s/\&/&/g; - $outgoing =~ s//>/g; - $outgoing =~ s/\(/(/g; - $outgoing =~ s/\)/)/g; - $outgoing =~ s/"/"/g; - $outgoing =~ s/'/'/g; - $outgoing =~ s/\$/$/g; - $outgoing =~ s{/}{/}g; - $outgoing =~ s/=/=/g; - $outgoing =~ s/\\/\/g - } - return $outgoing; -} +=back -# Use: -# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); -# -################################################## -# password associated functions # -################################################## -sub des_keys { - # Make a new key for DES encryption. - # Each key has two parts which are returned separately. - # Please note: Each key must be passed through the &hex function - # before it is output to the web browser. The hex versions cannot - # be used to decrypt. - my @hexstr=('0','1','2','3','4','5','6','7', - '8','9','a','b','c','d','e','f'); - my $lkey=''; - for (0..7) { - $lkey.=$hexstr[rand(15)]; - } - my $ukey=''; - for (0..7) { - $ukey.=$hexstr[rand(15)]; - } - return ($lkey,$ukey); -} - -sub des_decrypt { - my ($key,$cyphertext) = @_; - my $keybin=pack("H16",$key); - my $cypher; - if ($Crypt::DES::VERSION>=2.03) { - $cypher=new Crypt::DES $keybin; - } else { - $cypher=new DES $keybin; - } - my $plaintext= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); - $plaintext.= - $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); - $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); - return $plaintext; -} +=cut 1; __END__;