[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml verify_domconfiguser.piml loncom loncapa_apache.conf lontrans.pm loncom/auth lonacc.pm loncom/html/res/adm/pages shorturls.png loncom/interface lonblockingmenu.pm loncommon.pm loncourserespicker.pm londocs.pm lontiny.pm
raeburn
raeburn at source.lon-capa.org
Fri Jan 12 08:34:58 EST 2018
raeburn Fri Jan 12 13:34:58 2018 EDT
Added files:
/loncom/interface lontiny.pm
/loncom/html/res/adm/pages shorturls.png
Modified files:
/doc/loncapafiles verify_domconfiguser.piml
/loncom/interface londocs.pm loncommon.pm loncourserespicker.pm
lonblockingmenu.pm
/loncom/auth lonacc.pm
/loncom lontrans.pm loncapa_apache.conf
/doc/loncapafiles loncapafiles.lpml
Log:
- Bug 6400 Tiny URL for deep-linking.
Requires Short::URL and String::CRC32 modules from CPAN. Dependency on
perl-Short-URL needs to be added to LONCAPA-prerequisites.
-------------- next part --------------
Index: doc/loncapafiles/verify_domconfiguser.piml
diff -u doc/loncapafiles/verify_domconfiguser.piml:1.20 doc/loncapafiles/verify_domconfiguser.piml:1.21
--- doc/loncapafiles/verify_domconfiguser.piml:1.20 Sun Feb 22 17:21:51 2015
+++ doc/loncapafiles/verify_domconfiguser.piml Wed Mar 4 13:36:46 2015
@@ -3,7 +3,7 @@
<!-- verify_domconfiguser.piml -->
<!-- Stuart Raeburn -->
-<!-- $Id: verify_domconfiguser.piml,v 1.20 2015/02/22 17:21:51 raeburn Exp $ -->
+<!-- $Id: verify_domconfiguser.piml,v 1.21 2015/03/04 13:36:46 raeburn Exp $ -->
<!--
@@ -183,7 +183,7 @@
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
my $configpass = '';
my @letts = qw( a b c d e f g h i j k l m n o p q r s t u v w x y z );
- for (my $i=0; $i>8; $i++) {
+ for (my $i=0; $i<8; $i++) {
my $lettnum = int (rand 2);
my $item = '';
if ($lettnum) {
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.650 loncom/interface/londocs.pm:1.651
--- loncom/interface/londocs.pm:1.650 Fri Jan 12 01:54:56 2018
+++ loncom/interface/londocs.pm Fri Jan 12 13:33:37 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.650 2018/01/12 01:54:56 raeburn Exp $
+# $Id: londocs.pm,v 1.651 2018/01/12 13:33:37 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -46,6 +46,7 @@
use Apache::lonhomework();
use Apache::lonpublisher();
use Apache::lonparmset();
+use Apache::loncourserespicker();
use HTML::Entities;
use HTML::TokeParser;
use GDBM_File;
@@ -4812,6 +4813,48 @@
$r->print(&endContentScreen());
}
+sub short_urls {
+ my ($r,$canedit) = @_;
+ my $crstype = &Apache::loncommon::course_type();
+ my $formname = 'shortenurl';
+ $r->print(&Apache::loncommon::start_page('Display/Set Shortened URLs'));
+ $r->print(&Apache::lonhtmlcommon::breadcrumbs('Shortened URLs'));
+ $r->print(&startContentScreen('tools'));
+ my ($navmap,$errormsg) =
+ &Apache::loncourserespicker::get_navmap_object($crstype,'shorturls');
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my (%maps,%resources,%titles);
+ if (!ref($navmap)) {
+ $r->print($errormsg.
+ &endContentScreen());
+ return '';
+ } else {
+ $r->print('<h4 class="LC_info">'.&mt('Tiny URLs for deep-linking into course').'</h4>'."\n".
+ $r->rflush();
+ my $readonly;
+ if ($canedit) {
+ my ($numnew,$errors) = &Apache::loncommon::make_short_symbs($cdom,$cnum,$navmap);
+ if ($numnew) {
+ $r->print('<p class="LC_info">'.&mt('Created [quant,_1,URL]',$numnew).'</p>');
+ }
+ if ((ref($errors) eq 'ARRAY') && (@{$errors} > 0)) {
+ $r->print(&mt('The following errors occurred when processing your request to create shortened URLs:').'<br /><ul>');
+ foreach my $error (@{$errors}) {
+ $r->print('<li>'.$error.'</li>');
+ }
+ $r->print('</ul><br />');
+ }
+ } else {
+ $readonly = 1;
+ }
+ my %currtiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
+ $r->print(&Apache::loncourserespicker::create_picker($navmap,'shorturls',$formname,$crstype,undef,
+ undef,undef,undef,undef,undef,\%currtiny,$readonly));
+ }
+ $r->print(&endContentScreen());
+}
+
sub contentverifyform {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
@@ -5347,6 +5390,9 @@
} elsif ($allowed && $env{'form.listsymbs'}) {
&init_breadcrumbs('listsymbs','List Content IDs');
&list_symbs($r);
+ } elsif ($allowed && $env{'form.shorturls'}) {
+ &init_breadcrumbs('shorturls','Set/Display Shortened URLs','Docs_Short_URLs');
+ &short_urls($r,$canedit);
} elsif ($allowed && $env{'form.docslog'}) {
&init_breadcrumbs('docslog','Show Log');
my $folder = $env{'form.folder'};
@@ -6936,6 +6982,7 @@
'vc' => 'Verify Content',
'cv' => 'Check/Set Resource Versions',
'ls' => 'List Resource Identifiers',
+ 'ct' => 'Display/Set Shortened URLs for Deep-linking',
'imse' => 'Export contents to IMS Archive',
'dcd' => "Copy $crstype Content to Authoring Space",
);
@@ -6986,6 +7033,13 @@
icon => 'symbs.png',
linktitle => "List the unique identifier used for each resource instance in your $lc_crstype"
},
+ { linktext => $lt{'ct'},
+ url => "javascript:injectData(document.courseverify,'dummy','shorturls','$lt{'ct'}')",
+ permission => 'F',
+ help => 'Docs_Short_URLs',
+ icon => 'shorturls.png',
+ linktitle => "Set shortened URLs for a resource or folder in your $lc_crstype for use in deep-linking"
+ },
]
});
if ($canedit) {
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1308 loncom/interface/loncommon.pm:1.1309
--- loncom/interface/loncommon.pm:1.1308 Wed Jan 3 04:20:54 2018
+++ loncom/interface/loncommon.pm Fri Jan 12 13:33:38 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1308 2018/01/03 04:20:54 raeburn Exp $
+# $Id: loncommon.pm,v 1.1309 2018/01/12 13:33:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -86,6 +86,8 @@
use MIME::Types;
use File::Copy();
use File::Path();
+use String::CRC32();
+use Short::URL();
# ---------------------------------------------- Designs
use vars qw(%defaultdesign);
@@ -17850,6 +17852,142 @@
return $plaintext;
}
+sub make_short_symbs {
+ my ($cdom,$cnum,$navmap) = @_;
+ return unless (ref($navmap));
+ my ($numnew, at errors);
+ my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
+ if (@toshorten) {
+ my (%maps,%resources,%titles);
+ &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
+ 'shorturls',$cdom,$cnum);
+ my %tocreate;
+ if (keys(%resources)) {
+ foreach my $item (sort {$a <=> $b} (@toshorten)) {
+ my $symb = $resources{$item};
+ if ($symb) {
+ $tocreate{$cnum.'&'.$symb} = 1;
+ }
+ }
+ }
+ if (keys(%tocreate)) {
+ my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
+ my $su = Short::URL->new(no_vowels => 1);
+ my $init = '';
+ my (%newunique,%addcourse,%courseonly,%failed);
+ # get lock on tiny db
+ my $now = time;
+ my $lockhash = {
+ "lock\0$now" => $env{'user.name'}.
+ ':'.$env{'user.domain'},
+ };
+ my $tries = 0;
+ my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
+ my ($code,$error);
+ while (($gotlock ne 'ok') && ($tries<3)) {
+ $tries ++;
+ sleep 1;
+ $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+ }
+ if ($gotlock eq 'ok') {
+ $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
+ \%addcourse,\%courseonly,\%failed);
+ if (keys(%failed)) {
+ my $numfailed = scalar(keys(%failed));
+ push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
+ }
+ if (keys(%newunique)) {
+ my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
+ if ($putres eq 'ok') {
+ $numnew = scalar(keys(%newunique));
+ my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
+ unless ($newputres eq 'ok') {
+ push(@errors,&mt('error: could not store course look-up of short URLs'));
+ }
+ } else {
+ push(@errors,&mt('error: could not store unique six character URLs'));
+ }
+ }
+ my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
+ unless ($dellockres eq 'ok') {
+ push(@errors,&mt('error: could not release lockfile'));
+ }
+ } else {
+ push(@errors,&mt('error: could not obtain lockfile'));
+ }
+ if (keys(%courseonly)) {
+ my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
+ if ($result ne 'ok') {
+ push(@errors,&mt('error: could not update course look-up of short URLs'));
+ }
+ }
+ }
+ }
+ return ($numnew,\@errors);
+}
+
+sub shorten_symbs {
+ my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
+ return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
+ (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
+ (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
+ my (%possibles,%collisions);
+ foreach my $key (keys(%{$tocreate})) {
+ my $num = String::CRC32::crc32($key);
+ my $tiny = $su->encode($num,$init);
+ if ($tiny) {
+ $possibles{$tiny} = $key;
+ }
+ }
+ if (!$init) {
+ $init = 1;
+ } else {
+ $init ++;
+ }
+ if (keys(%possibles)) {
+ my @posstiny = keys(%possibles);
+ my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+ my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
+ if (keys(%currtiny)) {
+ foreach my $key (keys(%currtiny)) {
+ next if ($currtiny{$key} eq '');
+ if ($currtiny{$key} eq $possibles{$key}) {
+ my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
+ unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
+ $courseonly->{$tsymb} = $key;
+ }
+ } else {
+ $collisions{$possibles{$key}} = 1;
+ }
+ delete($possibles{$key});
+ }
+ }
+ foreach my $key (keys(%possibles)) {
+ $newunique->{$key} = $possibles{$key};
+ my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
+ unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
+ $addcourse->{$tsymb} = $key;
+ }
+ }
+ }
+ if (keys(%collisions)) {
+ if ($init <5) {
+ if (!$init) {
+ $init = 1;
+ } else {
+ $init ++;
+ }
+ $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
+ $newunique,$addcourse,$courseonly,$failed);
+ } else {
+ foreach my $key (keys(%collisions)) {
+ $failed->{$key} = 1;
+ }
+ }
+ }
+ return $init;
+}
+
1;
__END__;
Index: loncom/interface/loncourserespicker.pm
diff -u loncom/interface/loncourserespicker.pm:1.14 loncom/interface/loncourserespicker.pm:1.15
--- loncom/interface/loncourserespicker.pm:1.14 Sun Oct 16 21:49:51 2016
+++ loncom/interface/loncourserespicker.pm Fri Jan 12 13:33:38 2018
@@ -1,6 +1,6 @@
# The LearningOnline Network
#
-# $Id: loncourserespicker.pm,v 1.14 2016/10/16 21:49:51 raeburn Exp $
+# $Id: loncourserespicker.pm,v 1.15 2018/01/12 13:33:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,6 +39,7 @@
(a) exported to an IMS Content Package
(b) subject to access blocking for the duriation of an exam/quiz.
(c) dumped to an Authoring Space
+(d) receive shortened URLs to be used when deep-linking into a course
=head1 DESCRIPTION
@@ -80,7 +81,8 @@
(encapsulates information about resources in the course).
- $context -- Context in which course resource selection is being made.
- Currently imsexport and examblock are supported.
+ Currently imsexport, examblock, dumpdocs, and shorturls
+ are supported.
- $formname -- Name of the form in the window from which the pop-up
used to select course items was launched.
@@ -106,10 +108,13 @@
- $uploadedfiles -- Reference to hash: keys are paths to files in
/home/httpd/lonUsers/$cdom/$1/$2/$3/$cnum/userfiles.
-
+
+ - $tiny -- Reference to hash: keys are symbs of course items for which
+ shortened URLs have already been created.
+
- $readonly -- if true, no "check all" or "uncheck all" buttons will
be displayed, and checkboxes will be disabled, if this
- is for an exam block.
+ is for an exam block or for shortened URL creation.
Output: $output is the HTML mark-up for display/selection of content
@@ -211,9 +216,14 @@
sub create_picker {
my ($navmap,$context,$formname,$crstype,$blockedmaps,$blockedresources,$block,$preamble,
- $numhome,$uploadedfiles,$readonly) = @_;
+ $numhome,$uploadedfiles,$tiny,$readonly) = @_;
return unless (ref($navmap));
- my ($it,$output,$numdisc,%maps,%resources,%discussiontime,%currmaps,%currresources,%files);
+ my ($it,$output,$numdisc,%maps,%resources,%discussiontime,%currmaps,%currresources,%files,
+ %shorturls,$chkname);
+ $chkname = 'archive';
+ if ($context eq 'shorturls') {
+ $chkname = 'addtiny';
+ }
$it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
if (ref($blockedmaps) eq 'HASH') {
%currmaps = %{$blockedmaps};
@@ -222,6 +232,8 @@
%currresources = %{$blockedresources};
} elsif (ref($uploadedfiles) eq 'HASH') {
%files = %{$uploadedfiles};
+ } elsif (ref($tiny) eq 'HASH') {
+ %shorturls = %{$tiny};
}
my @checked_maps;
my $curRes;
@@ -256,7 +268,11 @@
&mt('Choose the uploaded course items and templated pages/problems to be copied to Authoring Space.').
'</span><br /><br />';
$startcount = 3 + $numhome;
- $onsubmit = ' onsubmit="return checkUnique(document.'.$formname.',document.'.$formname.'.archive);"';
+ $onsubmit = ' onsubmit="return checkUnique(document.'.$formname.',document.'.$formname.'.'.$chkname.');"';
+ } elsif ($context eq 'shorturls') {
+ $info = '<span class="LC_fontsize_medium">'.
+ &mt('Choose the resource(s) and/or folder(s) from Main Content for which shortened URL(s) are needed.').
+ '</span><br /><br />';
} elsif ($context eq 'imsexport') {
$info = &mt('Choose which items you wish to export from your '.$crstype.'.');
$startcount = 5;
@@ -265,9 +281,9 @@
$togglebuttons = '<br />';
} else {
$togglebuttons = '<input type="button" value="'.&mt('check all').'" '.
- 'onclick="javascript:checkAll(document.'.$formname.'.archive)" />'.
+ 'onclick="javascript:checkAll(document.'.$formname.'.'.$chkname.')" />'.
' <input type="button" value="'.&mt('uncheck all').'"'.
- ' onclick="javascript:uncheckAll(document.'.$formname.'.archive)" />';
+ ' onclick="javascript:uncheckAll(document.'.$formname.'.'.$chkname.')" />';
}
$display = '<form name="'.$formname.'" action="" method="post"'.$onsubmit.'>'."\n";
if ($context eq 'imsexport') {
@@ -290,7 +306,7 @@
'</fieldset>';
}
$display .= '</div>';
- } elsif ($context eq 'examblock') {
+ } elsif (($context eq 'examblock') || ($context eq 'shorturls')) {
$display .= $info.$togglebuttons;
} elsif ($context eq 'dumpdocs') {
$display .= $preamble.
@@ -311,9 +327,12 @@
$display .= '<th>'.&mt('Access blocked?').'</th>';
} elsif ($context eq 'dumpdocs') {
$display .= '<th>'.&mt('Copy?').'</th>'.
- '<th>'.&mt("Title in $crstype").
+ '<th>'.&mt("Title in $crstype").'</th>'.
'<th>'.&mt('Internal Identifier').'</th>'.
'<th>'.&mt('Save as ...').'</th>';
+ } elsif ($context eq 'shorturls') {
+ $display .= '<th colspan="2">'.&mt('Tiny URL').'</th>'.
+ '<th>'.&mt("Title in $crstype").'</th>';
}
$display .= &Apache::loncommon::end_data_table_header_row();
while ($curRes = $it->next()) {
@@ -339,35 +358,49 @@
}
}
$count ++;
- my $currelem;
+ my ($currelem,$mapurl,$is_map);
if ($context eq 'imsexport') {
$currelem = $count+$boards+$startcount;
} else {
$currelem = $count+$startcount;
}
- $display .= &Apache::loncommon::start_data_table_row().
- '<td>'."\n".
- '<input type="checkbox" name="archive" value="'.$count.'" ';
+ $display .= &Apache::loncommon::start_data_table_row()."\n";
if (($curRes->is_sequence()) || ($curRes->is_page())) {
$lastcontainer = $currelem;
- $display .= 'onclick="javascript:checkFolder(document.'.$formname.','."'$currelem'".')" ';
- my $mapurl = (&Apache::lonnet::decode_symb($symb))[2];
- if ($currmaps{$mapurl}) {
- $display .= 'checked="checked"';
- push(@checked_maps,$currelem);
+ $mapurl = (&Apache::lonnet::decode_symb($symb))[2];
+ $is_map = 1;
+ }
+ if ($context eq 'shorturls') {
+ if ($shorturls{$symb}) {
+ $display .= '<td> </td><td align="right"><b>'."/tiny/$cdom/$shorturls{$symb}".'</b></td>'."\n";
+ } else {
+ $display .= '<td align="left"><label><input type="checkbox" name="'.$chkname.'" '.
+ 'value="'.$count.'"'.$disabled.' />'.&mt('Add').'</label></td>'.
+ '<td> </td>'."\n";
}
} else {
- if ($curRes->is_problem()) {
- $numprobs ++;
- }
- $display .= 'onclick="javascript:checkResource(document.'.$formname.','."'$currelem'".')" ';
- if ($currresources{$symb}) {
- $display .= 'checked="checked"';
+ $display .= '<td><input type="checkbox" name="'.$chkname.'" value="'.$count.'" ';
+ if ($is_map) {
+ $display .= 'onclick="javascript:checkFolder(document.'.$formname.','."'$currelem'".')" ';
+ if ($currmaps{$mapurl}) {
+ $display .= 'checked="checked"';
+ push(@checked_maps,$currelem);
+ }
+ } else {
+ if ($curRes->is_problem()) {
+ $numprobs ++;
+ }
+ $display .= 'onclick="javascript:checkResource(document.'.$formname.','."'$currelem'".')" ';
+ if ($currresources{$symb}) {
+ $display .= 'checked="checked"';
+ }
}
+ $display .= $disabled.' />'."\n";
}
- $display .= $disabled.' />'."\n";
if ($context eq 'dumpdocs') {
$display .= '</td><td valign="top">';
+ } elsif ($context eq 'shorturls') {
+ $display .= '<td valign="top">';
}
for (my $i=0; $i<$depth; $i++) {
$display .= "$whitespace\n";
@@ -476,12 +509,19 @@
'<input type="submit" name="dumpcourse" value="'.&mt("Copy $crstype Content").'" />'.
'</div>';
$numcount = $count + $startcount;
+ } elsif ($context eq 'shorturls') {
+ unless ($readonly) {
+ $display .=
+ '<p>'.
+ '<input type="submit" name="shorturls" value="'.
+ &mt('Create Tiny URL(s)').'" /></p>';
+ }
}
$display .= '</form>';
my $scripttag =
&respicker_javascript($startcount,$numcount,$context,$formname,\%children,
- \%hierarchy,\@checked_maps,$numhome);
- if ($context eq 'dumpdocs') {
+ \%hierarchy,\@checked_maps,$numhome,$chkname);
+ if (($context eq 'dumpdocs') || ($context eq 'shorturls')) {
return $scripttag.$display;
}
my ($title,$crumbs,$args);
@@ -498,8 +538,8 @@
$output .= &Apache::lonhtmlcommon::breadcrumbs('IMS Export').
&Apache::londocs::startContentScreen('tools');
} elsif ($context eq 'dumpdocs') {
- $output .= &Apache::lonhtmlcommon::breadcrumbs('Copying to Authoring Space').
- &Apache::londocs::startContentScreen('tools');
+ $output .= &Apache::lonhtmlcommon::breadcrumbs('Copying to Authoring Space').
+ &Apache::londocs::startContentScreen('tools');
}
$output .= $display;
if ($context eq 'examblock') {
@@ -512,21 +552,8 @@
sub respicker_javascript {
my ($startcount,$numitems,$context,$formname,$children,$hierarchy,
- $checked_maps,$numhome) = @_;
- return unless ((ref($children) eq 'HASH') && (ref($hierarchy) eq 'HASH')
- && (ref($checked_maps) eq 'ARRAY'));
- my ($elem,$nested,$nameforelem);
- if ($context eq 'dumpdocs') {
- $elem='((parseInt(item)-'.$startcount.')*2)+'.$startcount;
- $nested='((parseInt(nesting[item][i])-'.$startcount.')*2)+'.$startcount;
- $nameforelem=$elem+1;
- } else {
- $elem='parseInt(item)';
- $nested='parseInt(nesting[item][i])';
- }
- my $scripttag = <<"START";
-<script type="text/javascript">
-// <![CDATA[
+ $checked_maps,$numhome,$chkname) = @_;
+ my $check_uncheck = <<"FIRST";
function checkAll(field) {
if (field.length > 0) {
for (i = 0; i < field.length; i++) {
@@ -546,6 +573,31 @@
field.checked = false;
}
}
+FIRST
+ if ($context eq 'shorturls') {
+ return <<"END";
+<script type="text/javascript">
+// <![CDATA[
+$check_uncheck
+// ]]>
+</script>
+END
+ }
+ return unless ((ref($children) eq 'HASH') && (ref($hierarchy) eq 'HASH')
+ && (ref($checked_maps) eq 'ARRAY'));
+ my ($elem,$nested,$nameforelem);
+ if ($context eq 'dumpdocs') {
+ $elem='((parseInt(item)-'.$startcount.')*2)+'.$startcount;
+ $nested='((parseInt(nesting[item][i])-'.$startcount.')*2)+'.$startcount;
+ $nameforelem=$elem+1;
+ } else {
+ $elem='parseInt(item)';
+ $nested='parseInt(nesting[item][i])';
+ }
+ my $scripttag = <<"START";
+<script type="text/javascript">
+// <![CDATA[
+$check_uncheck
function checkFolder(form,item) {
var elem = $elem;
@@ -699,8 +751,8 @@
function writeToOpener(maps,resources) {
var checkedmaps = '';
var checkedresources = '';
- for (var i=0; i<document.$formname.archive.length; i++) {
- if (document.$formname.archive[i].checked) {
+ for (var i=0; i<document.$formname.${chkname}.length; i++) {
+ if (document.$formname.${chkname}[i].checked) {
var isResource = 1;
var include = 1;
var elemnum = i+1+$startcount;
@@ -721,9 +773,9 @@
}
if (include == 1) {
if (isResource == 1) {
- checkedresources += document.$formname.archive[i].value+',';
+ checkedresources += document.$formname.${chkname}[i].value+',';
} else {
- checkedmaps += document.$formname.archive[i].value+',';
+ checkedmaps += document.$formname.${chkname}[i].value+',';
}
}
}
@@ -757,7 +809,9 @@
undef,{'only_body' => 1,}).
'<h2>'.&mt('Resource Display Failed').'</h2>';
} elsif ($context eq 'dumpdocs') {
- $outcome = '<h2>'.&mt('Copying to Authoring Space unavailable');
+ $outcome = '<h2>'.&mt('Copying to Authoring Space unavailable').'</h2>';
+ } elsif ($context eq 'shorturls') {
+ $outcome = '<h2>'.&mt('Display/Setting of shortened URLs unavailable').'</h2>';
}
$outcome .= '<div class="LC_error">';
if ($crstype eq 'Community') {
@@ -766,7 +820,7 @@
$outcome .= &mt('Unable to retrieve information about course contents');
}
$outcome .= '</div>';
- if (($context eq 'imsexport') || ($context eq 'dumpdocs')) {
+ if (($context eq 'imsexport') || ($context eq 'dumpdocs') || ($context eq 'shorturls') ) {
$outcome .= '<a href="/adm/coursedocs">';
if ($crstype eq 'Community') {
$outcome .= &mt('Return to Community Editor');
@@ -816,10 +870,14 @@
}
}
$count ++;
- if (($curRes->is_sequence()) || ($curRes->is_page())) {
- $map_url->{$count} = (&Apache::lonnet::decode_symb($symb))[2];
- } else {
+ if ($context eq 'shorturls') {
$resource_symb->{$count} = $ressymb;
+ } else {
+ if (($curRes->is_sequence()) || ($curRes->is_page())) {
+ $map_url->{$count} = (&Apache::lonnet::decode_symb($symb))[2];
+ } else {
+ $resource_symb->{$count} = $ressymb;
+ }
}
$titleref->{$count} = $curRes->title();
}
Index: loncom/interface/lonblockingmenu.pm
diff -u loncom/interface/lonblockingmenu.pm:1.25 loncom/interface/lonblockingmenu.pm:1.26
--- loncom/interface/lonblockingmenu.pm:1.25 Mon Jun 26 01:56:58 2017
+++ loncom/interface/lonblockingmenu.pm Fri Jan 12 13:33:38 2018
@@ -2,7 +2,7 @@
# Routines for configuring blocking of access to collaborative functions,
# and specific resources during an exam
#
-# $Id: lonblockingmenu.pm,v 1.25 2017/06/26 01:56:58 raeburn Exp $
+# $Id: lonblockingmenu.pm,v 1.26 2018/01/12 13:33:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -527,7 +527,7 @@
$r->print(&Apache::loncourserespicker::create_picker($navmap,
'examblock','resourceblocks',$crstype,
\%blockedmaps,\%blockedresources,
- $env{'form.block'},'','',undef,$readonly));
+ $env{'form.block'},'','',undef,undef,$readonly));
} else {
$r->print($errormsg);
}
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.168 loncom/auth/lonacc.pm:1.169
--- loncom/auth/lonacc.pm:1.168 Thu Dec 21 22:06:44 2017
+++ loncom/auth/lonacc.pm Fri Jan 12 13:33:46 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Cookie Based Access Handler
#
-# $Id: lonacc.pm,v 1.168 2017/12/21 22:06:44 raeburn Exp $
+# $Id: lonacc.pm,v 1.169 2018/01/12 13:33:46 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -584,7 +584,9 @@
$env{'form.origurl'} = $r->uri;
}
}
-
+ if ($requrl=~m{^/+tiny/+$match_domain/+\w+$}) {
+ return OK;
+ }
# ---------------------------------------------------------------- Check access
my $now = time;
if ($requrl !~ m{^/(?:adm|public|prtspool)/}
Index: loncom/lontrans.pm
diff -u loncom/lontrans.pm:1.17 loncom/lontrans.pm:1.18
--- loncom/lontrans.pm:1.17 Thu Nov 30 15:14:58 2017
+++ loncom/lontrans.pm Fri Jan 12 13:34:08 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# URL translation for User Files
#
-# $Id: lontrans.pm,v 1.17 2017/11/30 15:14:58 raeburn Exp $
+# $Id: lontrans.pm,v 1.18 2018/01/12 13:34:08 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -29,8 +29,8 @@
package Apache::lontrans;
use strict;
-use Apache::Constants qw(:common :remotehost REDIRECT);
-use Apache::lonnet();
+use Apache::Constants qw(:common :remotehost REDIRECT :http);
+use Apache::lonnet;
use Apache::File();
use LONCAPA qw(:DEFAULT :match);
@@ -46,6 +46,8 @@
if ($realuri =~ m{^uploaded/$match_domain/$match_courseid/(default|supplemental)(|_\d+)\.(?:sequence|page)___\d+___.+$}) {
my ($map,$resid,$url) = split(/___/,$realuri);
$realuri = &Apache::lonnet::clutter($url).'?symb='.$realuri;
+ } elsif ($realuri =~ m{^tiny/$match_domain/\w+$}) {
+ $realuri = '/'.$realuri;
} elsif ($realuri =~ m{($match_domain)/($match_courseid)$}) {
$realuri = '/adm/navmaps';
} else {
@@ -65,6 +67,64 @@
return REDIRECT;
}
}
+ } elsif ($r->uri =~ m{^/+tiny/+($match_domain)/+(\w+)$}) {
+ my ($cdom,$key) = ($1,$2);
+ if (&Apache::lonnet::domain($cdom) ne '') {
+ my %user;
+ my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
+ if ($handle ne '') {
+ my $lonidsdir=$r->dir_config('lonIDsDir');
+ &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
+ if ($env{'request.course.id'}) {
+ my $tinyurl;
+ my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
+ if (defined($cached)) {
+ $tinyurl = $result;
+ } else {
+ my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+ my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
+ if ($currtiny{$key} ne '') {
+ $tinyurl = $currtiny{$key};
+ &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
+ }
+ }
+ if ($tinyurl ne '') {
+ my ($cnum,$symb) = split(/\&/,$tinyurl);
+ if (($cnum =~ /^$match_courseid$/) &&
+ (&Apache::lonnet::homeserver($cnum,$cdom) ne 'no_host')) {
+ if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+ my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
+ if (&Apache::lonnet::is_on_map($url)) {
+ my $realuri;
+ if ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
+ (!$env{'request.role.adv'})) {
+ $env{'user.error.msg'}=$r->uri.':bre:1:1:Access to resource denied';
+ return HTTP_NOT_ACCEPTABLE;
+ }
+ if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
+ (!$env{'request.role.adv'})) {
+ $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url)).
+ '?symb='.&Apache::lonenc::encrypted($symb);
+ } else {
+ $realuri = &Apache::lonnet::clutter($url).'?symb='.$symb;
+ }
+ my $host = $r->headers_in->get('Host');
+ if ($host) {
+ my $protocol = 'http';
+ if ($r->get_server_port == 443) {
+ $protocol = 'https';
+ }
+ my $location = $protocol.'://'.$host.$realuri;
+ $r->headers_out->set(Location => $location);
+ return REDIRECT;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
} elsif ($r->uri=~m{^/raw/}) {
my $host = $r->headers_in->get('Host');
if ($host) {
@@ -93,7 +153,7 @@
'/userfiles/'.(join('/', at ufile)));
}
return OK;
- } else {
+ } else {
return DECLINED;
}
}
@@ -150,9 +210,3 @@
1;
__END__
-
-
-
-
-
-
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.261 loncom/loncapa_apache.conf:1.262
--- loncom/loncapa_apache.conf:1.261 Sat Dec 9 01:37:09 2017
+++ loncom/loncapa_apache.conf Fri Jan 12 13:34:08 2018
@@ -2,7 +2,7 @@
## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
##
-# $Id: loncapa_apache.conf,v 1.261 2017/12/09 01:37:09 raeburn Exp $
+# $Id: loncapa_apache.conf,v 1.262 2018/01/12 13:34:08 raeburn Exp $
#
# LON-CAPA Section (extensions to httpd.conf daemon configuration)
@@ -1565,7 +1565,16 @@
PerlHandler Apache::spellcheck
</LocationMatch>
-
+<LocationMatch "^/tiny/[\w.]+/\w+$">
+AuthType LONCAPA
+Require valid-user
+PerlAuthzHandler Apache::lonacc
+SetHandler perl-script
+PerlHandler Apache::lontiny
+ErrorDocument 403 /adm/login
+ErrorDocument 406 /adm/roles
+ErrorDocument 500 /adm/errorhandler
+</LocationMatch>
# ------------------------------------------------- Backdoor Adm Tests/Programs
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.962 doc/loncapafiles/loncapafiles.lpml:1.963
--- doc/loncapafiles/loncapafiles.lpml:1.962 Mon Dec 18 23:14:13 2017
+++ doc/loncapafiles/loncapafiles.lpml Fri Jan 12 13:34:57 2018
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.962 2017/12/18 23:14:13 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.963 2018/01/12 13:34:57 raeburn Exp $ -->
<!--
@@ -6864,6 +6864,17 @@
</dependencies>
</file>
<file>
+<source>loncom/interface/lontiny.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/lontiny.pm</target>
+<categoryname>handler</categoryname>
+<description>
+Extract domain, courseID, and symb from a shortened URL and and switch role
+to a role in designated course. If the user has multiple active roles in a
+course, and one is a Coordinator role, that role will be selected, otherwise
+a list of available roles will be displayed for the user to select one.
+</description>
+</file>
+<file>
<source>loncom/interface/lonsource.pm</source>
<target dist='default'>home/httpd/lib/perl/Apache/lonsource.pm</target>
<categoryname>handler</categoryname>
@@ -8319,6 +8330,7 @@
selfenrl-queue.png;
selfenrl-queue-22x22.png;
sequence.png;
+shorturls.png;
simple.png;
simpprob.png;
start-here.png;
Index: loncom/interface/lontiny.pm
+++ loncom/interface/lontiny.pm
# The LearningOnline Network with CAPA
# Extract domain, courseID, and symb from a shortened URL,
# and switch role to a role in designated course.
#
# $Id: lontiny.pm,v 1.1 2018/01/12 13:33:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::lontiny;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonroles;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
sub handler {
my $r = shift;
my %user;
my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
if ($handle ne '') {
if ($r->uri =~ m{^/tiny/($match_domain)/(\w+)$}) {
my ($cdom,$key) = ($1,$2);
if (&Apache::lonnet::domain($cdom) ne '') {
my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
my $tinyurl;
my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
if (defined($cached)) {
$tinyurl = $result;
} else {
my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
if ($currtiny{$key} ne '') {
$tinyurl = $currtiny{$key};
&Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
}
}
if ($tinyurl) {
my ($cnum,$symb) = split(/\&/,$tinyurl);
if ($cnum =~ /^$match_courseid$/) {
my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
if ($chome ne 'no_host') {
my %crsenv = &Apache::lonnet::coursedescription("$cdom/$cnum");
my @possroles = ('in','ta','ep','st','cr','ad');
if ($crsenv{'type'} eq 'Community') {
unshift(@possroles,'co');
} else {
unshift(@possroles,'cc');
}
my %roleshash = &Apache::lonnet::get_my_roles($env{'user.uname'},
$env{'user.domain'},
'userroles',undef,
\@possroles,[$cdom],1);
my (%possroles,$hassection);
if (keys(%roleshash)) {
foreach my $entry (keys(%roleshash)) {
if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
$possroles{$1} = $2;
if ($2 ne '') {
$hassection = 1;
}
}
}
}
my @allposs = keys(%possroles);
if (@allposs == 0) {
&show_roles($r,\%crsenv,\%possroles)
} elsif (@allposs == 1) {
my $newrole = "$allposs[0]./$cdom/$cnum";
$newrole = "$allposs[0]./$cdom/$cnum";
if ($possroles{$allposs[0]} ne '') {
$newrole .= "/$possroles{$allposs[0]}";
}
my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
'&destinationurl='.&HTML::Entities::encode($r->uri);
&do_redirect($r,$destination);
} elsif (keys(%possroles) > 1) {
if (grep(/^(cc|co)$/, at allposs)) {
my $newrole;
if (exists($possroles{'cc'})) {
$newrole = 'cc';
} else {
$newrole = 'co';
}
$newrole .= "./$cdom/$cnum";
my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
'&destinationurl='.&HTML::Entities::encode($r->uri);
&do_redirect($r,$destination);
} else {
my $hascustom;
if (grep(/^cr\//, at allposs)) {
$hascustom = 1;
}
&show_roles($r,\%crsenv,\%possroles,$hassection,$hascustom);
}
}
return OK;
}
}
}
}
}
&generic_error($r);
return OK;
} else {
return FORBIDDEN;
}
}
sub do_redirect {
my ($r,$destination) = @_;
my $windowinfo = Apache::lonhtmlcommon::scripttag('self.name="loncapaclient";');
my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
&Apache::lonhtmlcommon::scripttag('self.name="loncapaclient";').
'<h1>'.&mt('Welcome').'</h1>'.
'<p>'.&mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>').'</p><p>'.
'<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
&Apache::loncommon::end_page());
return;
}
sub show_roles {
my ($r,$crsenv,$possroles,$hassection,$hascustom) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
if (ref($crsenv) eq 'HASH') {
$crsdesc = $crsenv->{'description'};
$crstype = $crsenv->{'type'};
$cdom = $crsenv->{'domain'};
$cnum = $crsenv->{'num'};
}
if ($crstype eq '') {
$crstype = 'Course';
}
my $lc_crstype = lc($crstype);
if ($crsdesc ne '') {
$header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
'<i>'.$crsdesc.'</i>');
}
if (ref($possroles) eq 'HASH') {
if (keys(%{$possroles}) > 0) {
$args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
$title = 'Choose a role'; #Do not localize.
if ($crstype eq 'Community') {
$preamble = &mt('You have the following active roles in this community:');
} else {
$preamble = &mt('You have the following active roles in this course:');
}
$datatable = '<form name="" action="/adm/roles">'.
'<input type="hidden" name="newrole" value="" />'.
'<input type="hidden" name="selectrole" value="1" />'.
'<input type="hidden" name="destinationurl" value="'.$r->uri.'" />'.
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
'<th></th><th>'.&mt('User role').'</th>';
if ($hassection) {
$datatable .= '<th>'.&mt('Section').'</th>';
}
if ($hascustom) {
$datatable .= '<th>'.&mt('Information').'</th>';
}
$datatable .= &Apache::loncommon::end_data_table_header_row();
my @available = sort(keys(%{$possroles}));
foreach my $role ('ad','in','ta','ep','st','cr') {
foreach my $key (@available) {
if ($key =~ m{^$role($|/)}) {
my $trolecode = "$key./$cdom/$cnum";
my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
my $sec = $possroles->{$key};
if ($sec ne '') {
$trolecode .= '/'.$sec;
}
my $buttonname=$trolecode;
$buttonname=~s/\W//g;
$datatable .= &Apache::loncommon::start_data_table_row().
'<td><input name="'.$buttonname.'" type="button" value="'.
&mt('Select').'" onclick="javascript:enterrole(this.form,'.
"'$trolecode','$buttonname'".');" /></td>';
if ($key =~ /^cr\//) {
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
$datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
if ($hassection) {
$datatable .= '<td>'.$sec.'</td>';
}
$datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
&mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
'</td>';
} else {
if ($hassection) {
$datatable .= '<td>'.$rolename.'</td>';
if ($hascustom) {
$datatable .= '<td colspan="2">'.$sec.'</td>';
} else {
$datatable .= '<td>'.$sec.'</td>';
}
} elsif ($hascustom) {
$datatable .= '<td colspan="2">'.$rolename.'</td>';
} else {
$datatable .= '<td>'.$rolename.'</td>';
}
}
$datatable .= &Apache::loncommon::end_data_table_row();
}
}
}
$datatable .= &Apache::loncommon::end_data_table().
'</form>';
my $standby = &mt('Role selected. Please stand by.');
$js = <<"ENDJS";
<script type="text/javascript">
// <![CDATA[
active=true;
function enterrole (thisform,rolecode,buttonname) {
if (active) {
active=false;
document.title='$standby';
window.status='$standby';
thisform.newrole.value=rolecode;
thisform.submit();
} else {
alert('$standby');
}
}
// ]]>
</script>
ENDJS
} else {
$title = 'No active role';
$preamble = &mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.");
$args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
}
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$r->print(&Apache::loncommon::start_page($title,$js,$args).
'<h3>'.$header.'</h3>'.
'<div>'.$preamble.'</div>'.
$datatable.
&Apache::loncommon::end_page());
return;
}
sub generic_error {
my ($r) = @_;
my $linktext;
if ($env{'user.adv'}) {
$linktext = &mt('Continue to your roles page');
} else {
$linktext = &mt('Continue to your courses page');
}
my $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
my $msg = &mt('The page you requested does not exist.');
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
$r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
'<div class="LC_error">'.$msg.'</div>'.
'<p>'.$continuelink.'</p>'.
&Apache::loncommon::end_page());
return;
}
1;
More information about the LON-CAPA-cvs
mailing list