--- loncom/interface/loncommon.pm 2013/12/19 08:28:05 1.1075.2.58
+++ loncom/interface/loncommon.pm 2013/12/27 15:50:34 1.1075.2.59
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1075.2.58 2013/12/19 08:28:05 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.59 2013/12/27 15:50:34 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -8688,7 +8688,7 @@ Incoming parameters:
2. user's domain
3. quota name - portfolio, author, or course
(if no quota name provided, defaults to portfolio).
-4. crstype - official, unofficial or community, if quota name is
+4. crstype - official, unofficial, textbook or community, if quota name is
course
Returns:
@@ -8762,7 +8762,8 @@ sub get_user_quota {
if ($quota eq '' || wantarray) {
if ($quotaname eq 'course') {
my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
- if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) {
+ if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
+ ($crstype eq 'community') || ($crstype eq 'textbook')) {
$defquota = $domdefs{$crstype.'quota'};
}
if ($defquota eq '') {
@@ -8910,6 +8911,7 @@ Inputs: 6
4. filename of file for which action is being requested
5. filesize (kB) of file
6. action being taken: copy or upload.
+7. quotatype (in course context -- official, unofficial, community or textbook).
Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
otherwise return null.
@@ -8919,9 +8921,9 @@ Returns: 1 scalar: HTML to display conta
=cut
sub excess_filesize_warning {
- my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
+ my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
my $current_disk_usage = 0;
- my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
+ my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
if ($context eq 'author') {
my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
$current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
@@ -10998,16 +11000,43 @@ sub decompress_form {
}
}
if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
- my @camtasia = ("$topdir/","$topdir/index.html",
+ my @camtasia6 = ("$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 @diffs = &compare_arrays(\@paths,\@camtasia);
+ 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);
if (@diffs == 0) {
- $is_camtasia = 1;
+ $is_camtasia = 6;
+ } else {
+ @diffs = &compare_arrays(\@paths,\@camtasia8);
+ if (@diffs == 0) {
+ $is_camtasia = 8;
+ }
}
}
my $output;
@@ -11019,8 +11048,7 @@ sub decompress_form {
function camtasiaToggle() {
for (var i=0; i'.
''.$lt{'proa'}.'
'.
@@ -11315,6 +11343,7 @@ 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'} = [];
@@ -11333,12 +11362,15 @@ 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") {
+ } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
+ (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
$env{'form.archive_'.$i} = 'display';
$env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
$displayed{'web'} = $i;
} else {
- if ($item eq "$contents[0]/media") {
+ 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))) {
push(@{$env{'form.archive_directory'}},$i);
}
$env{'form.archive_'.$i} = 'dependency';
@@ -13844,7 +13876,7 @@ sub check_clone {
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
my $outcome;
my $linefeed = '
'."\n";
if ($context eq 'auto') {
@@ -13941,7 +13973,8 @@ sub construct_course {
'plc.users.denied',
'hidefromcat',
'checkforpriv',
- 'categories'],
+ 'categories',
+ 'internal.uniquecode'],
$$crsudom,$$crsunum);
}
@@ -14126,6 +14159,25 @@ 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';
}
@@ -14194,6 +14246,60 @@ 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;
+}
+
############################################################
############################################################
@@ -14221,11 +14327,12 @@ sub group_term {
}
sub course_types {
- my @types = ('official','unofficial','community');
+ my @types = ('official','unofficial','community','textbook');
my %typename = (
official => 'Official course',
unofficial => 'Unofficial course',
community => 'Community',
+ textbook => 'Textbook course',
);
return (\@types,\%typename);
}
@@ -14428,7 +14535,7 @@ sub init_user_environment {
undef,\%userenv,\%domdef,\%is_adv);
}
- foreach my $crstype ('official','unofficial','community') {
+ foreach my $crstype ('official','unofficial','community','textbook') {
$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,
'reload','requestcourses',