--- loncom/interface/loncommon.pm 2011/08/03 18:25:11 1.1016 +++ loncom/interface/loncommon.pm 2012/01/31 23:47:15 1.1055 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1016 2011/08/03 18:25:11 raeburn Exp $ +# $Id: loncommon.pm,v 1.1055 2012/01/31 23:47:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -154,6 +154,8 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %latex_language; # For choosing hyphenation in +my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; my %scprtag; my %fe; my %fd; my %fm; @@ -186,11 +188,15 @@ BEGIN { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line)); + my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; } + if ($latex) { + $latex_language_bykey{$key} = $latex; + $latex_language{$two} = $latex; + } } close($fh); } @@ -632,6 +638,51 @@ ENDJS } +sub javascript_array_indexof { + return < +// >> 0; + if (len === 0) { + return -1; + } + var n = 0; + if (arguments.length > 0) { + n = Number(arguments[1]); + if (n !== n) { // shortcut for verifying if it's NaN + n = 0; + } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { + n = (n > 0 || -1) * Math.floor(Math.abs(n)); + } + } + if (n >= len) { + return -1; + } + var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0); + for (; k < len; k++) { + if (k in t && t[k] === searchElement) { + return k; + } + } + return -1; + } +} + +// ]]> + + +ENDJS + +} + sub userbrowser_javascript { my $id_functions = &javascript_index_functions(); return <<"ENDUSERBRW"; @@ -802,6 +853,9 @@ sub selectcourse_link { } elsif ($selecttype eq 'Course/Community') { $linktext = &mt('Select Course/Community'); $type = ''; + } elsif ($selecttype eq 'Select') { + $linktext = &mt('Select'); + $type = ''; } return '' ." '; + $addOther = ''.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).' '; } $out = '' # Start cheatsheet .$addOther .'' - .&Apache::loncommon::help_open_topic('Greek_Symbols',&mt('Greek Symbols'), - undef,undef,600) + .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600) .' ' - .&Apache::loncommon::help_open_topic('Other_Symbols',&mt('Other Symbols'), - undef,undef,600) + .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600) .''; unless ($not_author) { $out .= ' ' - .&Apache::loncommon::help_open_topic('Authoring_Output_Tags',&mt('Output Tags'), - undef,undef,600) + .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600) .''; } $out .= ''; # End cheatsheet @@ -3182,11 +3233,29 @@ sub languagedescription { ($supported_language{$code}?' ('.&mt('interface available').')':''); } +=pod + +=item * &plainlanguagedescription + +Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)') +and the language character encoding (e.g. ISO) separated by a ' - ' string. + +=cut + sub plainlanguagedescription { my $code=shift; return $language{$code}; } +=pod + +=item * &supportedlanguagecode + +Returns the supported language code (e.g. sptutf maps to pt) given a language +code. + +=cut + sub supportedlanguagecode { my $code=shift; return $supported_language{$code}; @@ -3194,6 +3263,35 @@ sub supportedlanguagecode { =pod +=item * &latexlanguage() + +Given a language key code returns the correspondnig language to use +to select the correct hyphenation on LaTeX printouts. This is undef if there +is no supported hyphenation for the language code. + +=cut + +sub latexlanguage { + my $code = shift; + return $latex_language{$code}; +} + +=pod + +=item * &latexhyphenation() + +Same as above but what's supplied is the language as it might be stored +in the metadata. + +=cut + +sub latexhyphenation { + my $key = shift; + return $latex_language_bykey{$key}; +} + +=pod + =item * ©rightids() returns list of all copyrights @@ -4398,7 +4496,7 @@ sub get_legacy_domconf { close($fh); } } - if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { + if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') { $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif"; } return %legacyhash; @@ -4484,27 +4582,39 @@ sub designparm { =item * &authorspace() -Inputs: ./. +Inputs: $url (usually will be undef). -Returns: Path to the Construction Space of the current user's - accessed author space - The author space will be that of the current user - when accessing the own author space - and that of the co-author/assistent co-author - when accessing the co-author's/assistent co-author's - space +Returns: Path to Construction Space containing the resource or + directory being viewed (or for which action is being taken). + If $url is provided, and begins /priv// + the path will be that portion of the $context argument. + Otherwise the path will be for the author space of the current + user when the current role is author, or for that of the + co-author/assistant co-author space when the current role + is co-author or assistant co-author. =cut sub authorspace { + my ($url) = @_; + if ($url ne '') { + if ($url =~ m{^(/priv/$match_domain/$match_username/)}) { + return $1; + } + } my $caname = ''; - if ($env{'request.role'} =~ /^ca|^aa/) { - (undef,$caname) = + my $cadom = ''; + if ($env{'request.role'} =~ /^(?:ca|aa)/) { + ($cadom,$caname) = ($env{'request.role'}=~/($match_domain)\/($match_username)$/); - } else { + } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) { $caname = $env{'user.name'}; + $cadom = $env{'user.domain'}; + } + if (($caname ne '') && ($cadom ne '')) { + return "/priv/$cadom/$caname/"; } - return '/priv/'.$caname.'/'; + return; } ############################################## @@ -4532,7 +4642,9 @@ sub head_subbox { =item * &CSTR_pageheader() -Inputs: ./. +Input: (optional) filename from which breadcrumb trail is built. + In most cases no input as needed, as $env{'request.filename'} + is appropriate for use in building the breadcrumb trail. Returns: HTML div with CSTR path and recent box To be included on Construction Space pages @@ -4540,12 +4652,19 @@ Returns: HTML div with CSTR path and rec =cut sub CSTR_pageheader { - # this is for resources; directories have customtitle, and crumbs - # and select recent are created in lonpubdir.pm - my ($uname,$thisdisfn)= - ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); - my $formaction='/priv/'.$uname.'/'.$thisdisfn; - $formaction=~s/\/+/\//g; + my ($trailfile) = @_; + if ($trailfile eq '') { + $trailfile = $env{'request.filename'}; + } + +# this is for resources; directories have customtitle, and crumbs +# and select recent are created in lonpubdir.pm + + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + my ($udom,$uname,$thisdisfn)= + ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$}); + my $formaction = "/priv/$udom/$uname/$thisdisfn"; + $formaction =~ s{/+}{/}g; my $parentpath = ''; my $lastitem = ''; @@ -4562,7 +4681,7 @@ sub CSTR_pageheader { .''.&mt('Construction Space:').' ' .'
' #FIXME lonpubdir: target="_parent" - .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv',undef,undef); + .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef); if ($lastitem) { $output .= @@ -4914,7 +5033,6 @@ body { a:focus, a:focus img { color: red; - background: yellow; } form, .inline { @@ -5009,35 +5127,36 @@ div.LC_confirm_box .LC_success img { } .LC_discussion { - background: $tabbg; + background: $data_table_dark; border: 1px solid black; margin: 2px; } -.LC_disc_action_links_bar { - background: $tabbg; - border: none; - margin: 4px; -} - .LC_disc_action_left { + background: $sidebg; text-align: left; + padding: 4px; + margin: 2px; } .LC_disc_action_right { + background: $sidebg; text-align: right; + padding: 4px; + margin: 2px; } .LC_disc_new_item { background: white; border: 2px solid red; - margin: 2px; + margin: 4px; + padding: 4px; } .LC_disc_old_item { background: white; - border: 1px solid black; - margin: 2px; + margin: 4px; + padding: 4px; } table.LC_pastsubmission { @@ -5159,7 +5278,7 @@ td.LC_table_cell_checkbox { vertical-align: middle; } -li.LC_menubuttons_inline_text img,a { +li.LC_menubuttons_inline_text img { cursor:pointer; text-decoration: none; } @@ -5455,6 +5574,11 @@ span.LC_current_location { background: $pgbg; } +span.LC_current_nav_location { + font-weight:bold; + background: $sidebg; +} + span.LC_parm_menu_item { font-size: larger; } @@ -6009,7 +6133,6 @@ div.LC_createcourse { display:none; } -a:hover, ol.LC_primary_menu a:hover, ol#LC_MenuBreadcrumbs a:hover, ol#LC_PathBreadcrumbs a:hover, @@ -6180,7 +6303,7 @@ ul.LC_TabContent { background: $sidebg; border-bottom: solid 1px $lg_border_color; list-style:none; - margin: 0 -10px; + margin: -1px -10px 0 -10px; padding: 0; } @@ -6203,7 +6326,7 @@ ul.LC_TabContent li { padding: 0 16px 0 10px; background-color:$tabbg; border-bottom:solid 1px $lg_border_color; - border-right: solid 1px $font; + border-left: solid 1px $font; } ul.LC_TabContent .right { @@ -6243,6 +6366,12 @@ ul.LC_TabContent li.active a { background:#FFFFFF; outline: none; } + +ul.LC_TabContent li.goback { + float: left; + border-left: none; +} + #maincoursedoc { clear:both; } @@ -6302,11 +6431,10 @@ ul.LC_TabContentBigger li.active b { ul.LC_CourseBreadcrumbs { background: $sidebg; - line-height: 32px; + height: 2em; padding-left: 10px; - margin: 0 0 10px 0; + margin: 0; list-style-position: inside; - } ol#LC_MenuBreadcrumbs, @@ -6348,6 +6476,11 @@ ol#LC_PathBreadcrumbs li a { padding: 0 10px 10px 10px; } +.LC_DocsBox { + border: solid 1px $lg_border_color; + padding: 0 0 10px 10px; +} + .LC_AboutMe_Image { float:left; margin-right:10px; @@ -6488,6 +6621,10 @@ a#LC_content_toolbar_changefolder_toggle background-image:url(/res/adm/pages/open-all-folders.gif); } +a#LC_content_toolbar_edittoplevel { + background-image:url(/res/adm/pages/edittoplevel.gif); +} + ul#LC_toolbar li a:hover { background-position: bottom center; } @@ -6556,6 +6693,53 @@ ul.LC_funclist li { display: none; } +.LCmodal-overlay { + position:fixed; + top:0; + right:0; + bottom:0; + left:0; + height:100%; + width:100%; + margin:0; + padding:0; + background:#999; + opacity:.75; + filter: alpha(opacity=75); + -moz-opacity: 0.75; + z-index:101; +} + +* html .LCmodal-overlay { + position: absolute; + height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px'); +} + +.LCmodal-window { + position:fixed; + top:50%; + left:50%; + margin:0; + padding:0; + z-index:102; + } + +* html .LCmodal-window { + position:absolute; +} + +.LCclose-window { + position:absolute; + width:32px; + height:32px; + right:8px; + top:8px; + background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top; + text-indent:-99999px; + overflow:hidden; + cursor:pointer; +} + END } @@ -6614,8 +6798,24 @@ sub headtag { && !$args->{'only_body'} && !$args->{'frameset'}) { $result .= &help_menu_js(); + $result.=&modal_window(); + $result.=&togglebox_script(); + $result.=&wishlist_window(); + $result.=&LCprogressbarUpdate_script(); + } else { + if ($args->{'add_modal'}) { + $result.=&modal_window(); + } + if ($args->{'add_wishlist'}) { + $result.=&wishlist_window(); + } + if ($args->{'add_togglebox'}) { + $result.=&togglebox_script(); + } + if ($args->{'add_progressbar'}) { + $result.=&LCprogressbarUpdate_script(); + } } - if (ref($args->{'redirect'})) { my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}}; $url = &Apache::lonenc::check_encrypt($url); @@ -6740,32 +6940,12 @@ $args - additional optional args support sub start_page { my ($title,$head_extra,$args) = @_; #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); -#SD -#I don't see why we copy certain elements of %$args to %head_args -#head args is passed to headtag() and this routine only reads those -#keys that are needed. There doesn't happen any writes or any processing -#of other keys. -#proposal: just pass $args to headtag instead of \%head_args and delete -#marked lines -#<- MARK - my %head_args; - foreach my $arg ('redirect','force_register','domain','function', - 'bgcolor','frameset','no_nav_bar','only_body', - 'no_auto_mt_title') { - if (defined($args->{$arg})) { - $head_args{$arg} = $args->{$arg}; - } - } -#MARK -> $env{'internal.start_page'}++; my $result; if (! exists($args->{'skip_phases'}{'head'}) ) { - $result .= - &xml_begin() . &headtag($title,$head_extra,\%head_args); -#replace prev line by -# &xml_begin() . &headtag($title, $head_extra, $args); + $result .= &xml_begin() . &headtag($title, $head_extra, $args); } if (! exists($args->{'skip_phases'}{'body'}) ) { @@ -6831,7 +7011,6 @@ sub end_page { } $result .= &Apache::lonxml::xmlend($target,$parser); } - if ($args->{'frameset'}) { $result .= ''; } else { @@ -6850,6 +7029,281 @@ sub end_page { return $result; } +sub wishlist_window { + return(<<'ENDWISHLIST'); + +ENDWISHLIST +} + +sub modal_window { + return(<<'ENDMODAL'); + +ENDMODAL +} + +sub modal_link { + my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_; + unless ($width) { $width=480; } + unless ($height) { $height=400; } + unless ($scrolling) { $scrolling='yes'; } + return ''. + $linktext.''; +} + +sub modal_adhoc_script { + my ($funcname,$width,$height,$content)=@_; + return (< +// + +ENDADHOC +} + +sub modal_adhoc_inner { + my ($funcname,$width,$height,$content)=@_; + my $innerwidth=$width-20; + $content=&js_ready( + &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). + &start_scrollbox($width.'px',$innerwidth.'px',$height.'px'). + $content. + &end_scrollbox(). + &end_page() + ); + return &modal_adhoc_script($funcname,$width,$height,$content); +} + +sub modal_adhoc_window { + my ($funcname,$width,$height,$content,$linktext)=@_; + return &modal_adhoc_inner($funcname,$width,$height,$content). + "".$linktext.""; +} + +sub modal_adhoc_launch { + my ($funcname,$width,$height,$content)=@_; + return &modal_adhoc_inner($funcname,$width,$height,$content).(< +// + +ENDLAUNCH +} + +sub modal_adhoc_close { + return (< +// + +ENDCLOSE +} + +sub togglebox_script { + return(< +// + +ENDTOGGLE +} + +sub start_togglebox { + my ($id,$heading,$headerbg,$hidetext,$showtext)=@_; + unless ($heading) { $heading=''; } else { $heading.=' '; } + unless ($showtext) { $showtext=&mt('show'); } + unless ($hidetext) { $hidetext=&mt('hide'); } + unless ($headerbg) { $headerbg='#FFFFFF'; } + return &start_data_table(). + &start_data_table_header_row(). + ''.$heading. + '['.$showtext.']'. + &end_data_table_header_row(). + ''; +} + +sub end_togglebox { + return ''.&end_data_table(); +} + +sub LCprogressbar_script { + my ($id)=@_; + return(< +// + +ENDPROGRESS +} + +sub LCprogressbarUpdate_script { + return(< +.ui-progressbar { position:relative; } +.pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; } + + +ENDPROGRESSUPDATE +} + +my $LClastpercent; +my $LCidcnt; +my $LCcurrentid; + +sub LCprogressbar { + my ($r)=(@_); + $LClastpercent=0; + $LCidcnt++; + $LCcurrentid=$$.'_'.$LCidcnt; + my $starting=&mt('Starting'); + my $content=(< +
+ $starting +
+

+ENDPROGBAR + &r_print($r,$content.&LCprogressbar_script($LCcurrentid)); +} + +sub LCprogressbarUpdate { + my ($r,$val,$text)=@_; + unless ($val) { + if ($LClastpercent) { + $val=$LClastpercent; + } else { + $val=0; + } + } + if ($val<0) { $val=0; } + if ($val>100) { $val=0; } + $LClastpercent=$val; + unless ($text) { $text=$val.'%'; } + $text=&js_ready($text); + &r_print($r,< +// + +ENDUPDATE +} + +sub LCprogressbarClose { + my ($r)=@_; + $LClastpercent=0; + &r_print($r,< +// + +ENDCLOSE +} + +sub r_print { + my ($r,$to_print)=@_; + if ($r) { + $r->print($to_print); + $r->rflush(); + } else { + print($to_print); + } +} + sub html_encode { my ($result) = @_; @@ -6857,6 +7311,7 @@ sub html_encode { return $result; } + sub js_ready { my ($result) = @_; @@ -6895,15 +7350,20 @@ sub validate_page { sub start_scrollbox { - my ($outerwidth,$width,$height)=@_; + my ($outerwidth,$width,$height,$id)=@_; unless ($outerwidth) { $outerwidth='520px'; } unless ($width) { $width='500px'; } unless ($height) { $height='200px'; } - return "
"; + my ($table_id,$div_id); + if ($id ne '') { + $table_id = " id='table_$id'"; + $div_id = " id='div_$id'"; + } + return "
"; } sub end_scrollbox { - return '
'; + return '
'; } sub simple_error_page { @@ -6933,10 +7393,14 @@ sub simple_error_page { } sub start_data_table { - my ($add_class) = @_; + my ($add_class,$id) = @_; my $css_class = (join(' ','LC_data_table',$add_class)); + my $table_id; + if (defined($id)) { + $table_id = ' id="'.$id.'"'; + } &start_data_table_count(); - return ''."\n"; + return '
'."\n"; } sub end_data_table { @@ -7063,7 +7527,7 @@ sub get_users_function { $function='admin'; } if (($env{'request.role'}=~/^(au|ca|aa)/) || - ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { + ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) { $function='author'; } return $function; @@ -8178,7 +8642,8 @@ sub get_standard_codeitems { =item * sorted_slots() -Sorts an array of slot names in order of slot start time (earliest first). +Sorts an array of slot names in order of an optional sort key, +default sort is by slot start time (earliest first). Inputs: @@ -8188,15 +8653,16 @@ slotsarr - Reference to array of unsort slots - Reference to hash of hash, where outer hash keys are slot names. +sortkey - Name of key in inner hash to be sorted on (e.g., starttime). + =back Returns: =over 4 -sorted - An array of slot names sorted by the start time of the slot. - -=back +sorted - An array of slot names sorted by a specified sort key + (default sort key is start time of the slot). =back @@ -8204,13 +8670,16 @@ sorted - An array of slot names sorted sub sorted_slots { - my ($slotsarr,$slots) = @_; + my ($slotsarr,$slots,$sortkey) = @_; + if ($sortkey eq '') { + $sortkey = 'starttime'; + } my @sorted; if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) { @sorted = sort { if (ref($slots->{$a}) && ref($slots->{$b})) { - return $slots->{$a}{'starttime'} <=> $slots->{$b}{'starttime'} + return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey} } if (ref($slots->{$a})) { return -1;} if (ref($slots->{$b})) { return 1;} @@ -8220,6 +8689,131 @@ sub sorted_slots { return @sorted; } +=pod + +=item * get_future_slots() + +Inputs: + +=over 4 + +cnum - course number + +cdom - course domain + +now - current UNIX time + +symb - optional symb + +=back + +Returns: + +=over 4 + +sorted_reservable - ref to array of student_schedulable slots currently + reservable, ordered by end date of reservation period. + +reservable_now - ref to hash of student_schedulable slots currently + reservable. + + Keys in inner hash are: + (a) symb: either blank or symb to which slot use is restricted. + (b) endreserve: end date of reservation period. + +sorted_future - ref to array of student_schedulable slots reservable in + the future, ordered by start date of reservation period. + +future_reservable - ref to hash of student_schedulable slots reservable + in the future. + + Keys in inner hash are: + (a) symb: either blank or symb to which slot use is restricted. + (b) startreserve: start date of reservation period. + +=back + +=cut + +sub get_future_slots { + my ($cnum,$cdom,$now,$symb) = @_; + my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future); + my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom); + foreach my $slot (keys(%slots)) { + next unless($slots{$slot}->{'type'} eq 'schedulable_student'); + if ($symb) { + next if (($slots{$slot}->{'symb'} ne '') && + ($slots{$slot}->{'symb'} ne $symb)); + } + if (($slots{$slot}->{'starttime'} > $now) && + ($slots{$slot}->{'endtime'} > $now)) { + if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) { + my $userallowed = 0; + if ($slots{$slot}->{'allowedsections'}) { + my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'}); + if (!defined($env{'request.role.sec'}) + && grep(/^No section assigned$/,@allowed_sec)) { + $userallowed=1; + } else { + if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) { + $userallowed=1; + } + } + unless ($userallowed) { + if (defined($env{'request.course.groups'})) { + my @groups = split(/:/,$env{'request.course.groups'}); + foreach my $group (@groups) { + if (grep(/^\Q$group\E$/,@allowed_sec)) { + $userallowed=1; + last; + } + } + } + } + } + if ($slots{$slot}->{'allowedusers'}) { + my @allowed_users = split(',',$slots{$slot}->{'allowedusers'}); + my $user = $env{'user.name'}.':'.$env{'user.domain'}; + if (grep(/^\Q$user\E$/,@allowed_users)) { + $userallowed = 1; + } + } + next unless($userallowed); + } + my $startreserve = $slots{$slot}->{'startreserve'}; + my $endreserve = $slots{$slot}->{'endreserve'}; + my $symb = $slots{$slot}->{'symb'}; + if (($startreserve < $now) && + (!$endreserve || $endreserve > $now)) { + my $lastres = $endreserve; + if (!$lastres) { + $lastres = $slots{$slot}->{'starttime'}; + } + $reservable_now{$slot} = { + symb => $symb, + endreserve => $lastres + }; + } elsif (($startreserve > $now) && + (!$endreserve || $endreserve > $startreserve)) { + $future_reservable{$slot} = { + symb => $symb, + startreserve => $startreserve + }; + } + } + } + my @unsorted_reservable = keys(%reservable_now); + if (@unsorted_reservable > 0) { + @sorted_reservable = + &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve'); + } + my @unsorted_future = keys(%future_reservable); + if (@unsorted_future > 0) { + @sorted_future = + &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve'); + } + return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable); +} =pod @@ -8387,8 +8981,8 @@ sub ask_for_embedded_content { $getpropath = 1; } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || ($actionurl eq '/adm/imsimport')) { - ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$}); - $url = '/home/'.$uname.'/public_html/'; + my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$}); + $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/"; $toplevel = $url; if ($rest ne '') { $url .= $rest; @@ -8438,10 +9032,13 @@ sub ask_for_embedded_content { foreach my $path (keys(%subdependencies)) { my %currsubfile; if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { - my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath); - foreach my $line (@subdir_list) { - my ($file_name,$rest) = split(/\&/,$line,2); - $currsubfile{$file_name} = 1; + my ($sublistref,$listerror) = + &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath); + if (ref($sublistref) eq 'ARRAY') { + foreach my $line (@{$sublistref}) { + my ($file_name,$rest) = split(/\&/,$line,2); + $currsubfile{$file_name} = 1; + } } } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) { if (opendir(my $dir,$url.'/'.$path)) { @@ -8464,10 +9061,13 @@ sub ask_for_embedded_content { } my %currfile; if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { - my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath); - foreach my $line (@dir_list) { - my ($file_name,$rest) = split(/\&/,$line,2); - $currfile{$file_name} = 1; + my ($dirlistref,$listerror) = + &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath); + if (ref($dirlistref) eq 'ARRAY') { + foreach my $line (@{$dirlistref}) { + my ($file_name,$rest) = split(/\&/,$line,2); + $currfile{$file_name} = 1; + } } } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) { if (opendir(my $dir,$url)) { @@ -8746,12 +9346,12 @@ sub upload_embedded { my $fullpath = $dir_root.$dirpath.'/'.$path; my $dest = $fullpath.$fname; my $url = $url_root.$dirpath.'/'.$path.$fname; - my @parts=split(/\//,$fullpath); + my @parts=split(/\//,"$dirpath/$path"); my $count; my $filepath = $dir_root; - for ($count=4;$count<=$#parts;$count++) { - $filepath .= "/$parts[$count]"; - if ((-e $filepath)!=1) { + foreach my $subdir (@parts) { + $filepath .= "/$subdir"; + if (!-e $filepath) { mkdir($filepath,0770); } } @@ -8870,8 +9470,7 @@ sub modify_html_refs { } elsif ($context eq 'coursedoc') { $container = $env{'form.primaryurl'}; } else { - $container = $env{'form.filename'}; - $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2}; + $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'}; } my (%allfiles,%codebase,$output,$content); my @changes = &get_env_multiple('form.namechange'); @@ -8987,8 +9586,8 @@ sub check_for_upload { } $filesize = $filesize/1000; #express in k (1024?) my $getpropath = 1; - my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname, - $getpropath); + my ($dirlistref,$listerror) = + &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath); my $found_file = 0; my $locked_file = 0; my @lockers; @@ -8996,48 +9595,50 @@ sub check_for_upload { if ($env{'request.course.id'}) { $navmap = Apache::lonnavmaps::navmap->new(); } - foreach my $line (@dir_list) { - my ($file_name,$rest)=split(/\&/,$line,2); - if ($file_name eq $fname){ - $file_name = $path.$file_name; - if ($group ne '') { - $file_name = $group.$file_name; - } - $found_file = 1; - if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') { - foreach my $lock (@lockers) { - if (ref($lock) eq 'ARRAY') { - my ($symb,$crsid) = @{$lock}; - if ($crsid eq $env{'request.course.id'}) { - if (ref($navmap)) { - my $res = $navmap->getBySymb($symb); - foreach my $part (@{$res->parts()}) { - my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part); - unless (($slot_status == $res->RESERVED) || - ($slot_status == $res->RESERVED_LOCATION)) { - $locked_file = 1; + if (ref($dirlistref) eq 'ARRAY') { + foreach my $line (@{$dirlistref}) { + my ($file_name,$rest)=split(/\&/,$line,2); + if ($file_name eq $fname){ + $file_name = $path.$file_name; + if ($group ne '') { + $file_name = $group.$file_name; + } + $found_file = 1; + if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') { + foreach my $lock (@lockers) { + if (ref($lock) eq 'ARRAY') { + my ($symb,$crsid) = @{$lock}; + if ($crsid eq $env{'request.course.id'}) { + if (ref($navmap)) { + my $res = $navmap->getBySymb($symb); + foreach my $part (@{$res->parts()}) { + my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part); + unless (($slot_status == $res->RESERVED) || + ($slot_status == $res->RESERVED_LOCATION)) { + $locked_file = 1; + } } + } else { + $locked_file = 1; } } else { $locked_file = 1; } - } else { - $locked_file = 1; } - } - } - } else { - my @info = split(/\&/,$rest); - my $currsize = $info[6]/1000; - if ($currsize < $filesize) { - my $extra = $filesize - $currsize; - if (($current_disk_usage + $extra) > $disk_quota) { - 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); - return ('will_exceed_quota',$msg); + } + } else { + my @info = split(/\&/,$rest); + my $currsize = $info[6]/1000; + if ($currsize < $filesize) { + my $extra = $filesize - $currsize; + if (($current_disk_usage + $extra) > $disk_quota) { + 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); + return ('will_exceed_quota',$msg); + } } } } @@ -9107,6 +9708,572 @@ sub check_for_traversal { return $cleanpath; } +sub is_archive_file { + my ($mimetype) = @_; + if (($mimetype eq 'application/octet-stream') || + ($mimetype eq 'application/x-stuffit') || + ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) { + return 1; + } + return; +} + +sub decompress_form { + my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements) = @_; + my %lt = &Apache::lonlocal::texthash ( + this => 'This file is an archive file.', + youm => 'You may wish to extract its contents.', + camt => 'Extraction of contents is recommended for Camtasia zip files.', + perm => 'Permanently remove archive file after extraction of contents?', + extr => 'Extract contents', + yes => 'Yes', + no => 'No', + ); + my $output = '

'.$lt{'this'}.' '.$lt{'youm'}.'
'; + if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) { + $output .= $lt{'camt'}; + } + $output .= '

'; + $output .= <<"START"; +

+$lt{'this'} $lt{'youm'} +

+
+ + +START + if (ref($hiddenelements) eq 'HASH') { + foreach my $hidden (sort(keys(%{$hiddenelements}))) { + $output .= ''."\n"; + } + } + $output .= <<"END"; +$lt{'perm'}  +   +
+ + +$noextract +
+END + return $output; +} + +sub decompress_uploaded_file { + my ($file,$dir) = @_; + &Apache::lonnet::appenv({'cgi.file' => $file}); + &Apache::lonnet::appenv({'cgi.dir' => $dir}); + my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl'); + my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$}); + my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'}; + &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1); + my $decompressed = $env{'cgi.decompressed'}; + &Apache::lonnet::delenv('cgi.file'); + &Apache::lonnet::delenv('cgi.dir'); + &Apache::lonnet::delenv('cgi.decompressed'); + return ($decompressed,$result); +} + +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)$/) { + $error = &mt('File name not a supported archive file type.'). + '
'.&mt('File name should end with one of: [_1].', + '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz'); + } else { + my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom); + if ($docuhome eq 'no_host') { + $error = &mt('Could not determine home server for course.'); + } else { + my @ids=&Apache::lonnet::current_machine_ids(); + my $currdir = "$dir_root/$destination"; + my ($currdirlistref,$currlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1); + if (grep(/^\Q$docuhome\E$/,@ids)) { + $dir = &LONCAPA::propath($docudom,$docuname). + "$dir_root/$destination"; + } else { + $dir = $Apache::lonnet::perlvar{'lonDocRoot'}. + "$dir_root/$docudom/$docuname/$destination"; + unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') { + $error = &mt('Archive file not found.'); + } + } + if ($dir eq '') { + $error = &mt('Directory containing archive file unavailable.'); + } elsif (!$error) { + my ($decompressed,$display) = &decompress_uploaded_file($file,$dir); + if ($decompressed eq 'ok') { + $output = &mt('Files extracted successfully from archive.').'
'; + my ($warning,$result,@contents); + my ($newdirlistref,$newlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom, + $docuname,1); + my (%is_dir,%changes,@newitems); + my $dirptr = 16384; + if (ref($currdirlistref) eq 'ARRAY') { + my @curritems; + foreach my $dir_line (@{$currdirlistref}) { + my ($item,$rest)=split(/\&/,$dir_line,2); + unless ($item =~ /\.+$/) { + push(@curritems,$item); + } + } + if (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,4); + unless ($item =~ /^\.+$/) { + if ($dirptr&$testdir) { + $is_dir{$item} = 1; + } + push(@newitems,$item); + } + } + my @diffs = &compare_arrays(\@curritems,\@newitems); + if (@diffs > 0) { + foreach my $item (@diffs) { + $changes{$item} = 1; + } + } + } + } elsif (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); + unless ($item =~ /\.+$/) { + push(@newitems,$item); + if ($dirptr&$testdir) { + $is_dir{$item} = 1; + } + $changes{$item} = 1; + } + } + } + if (keys(%changes) > 0) { + foreach my $item (sort(@newitems)) { + if ($changes{$item}) { + push(@contents,$item); + } + } + } + if (@contents > 0) { + my (%children,%parent); + my $wantform = 1; + my ($count,$datatable) = &get_extracted($docudom,$docuname, + $currdir,\%is_dir, + \%children,\%parent, + \@contents,$wantform); + if ($datatable ne '') { + $output .= &archive_options_form('decompressed',$datatable, + $count,$hiddenelem); + my $startcount = 3; + $output .= &archive_javascript($startcount,$count, + %children); + } + } else { + $warning = &mt('No new items extracted from archive file.'); + } + } else { + $output = $display; + $error = &mt('An error occurred during extraction from the archive file.'); + } + } + } + } + if ($error) { + $output .= '

'.&mt('Not extracted.').'
'. + $error.'

'."\n"; + } + if ($warning) { + $output .= '

'.$warning.'

'."\n"; + } + return $output; +} + +sub get_extracted { + my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$wantform) = @_; + my $count = 0; + my $lastcontainer = 0; + my $depth = 0; + my $datatable; + return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') && + (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY')); + foreach my $item (@{$contents}) { + $count ++; + &archive_hierarchy($depth,$count,$parent,$children); + if ($wantform) { + $datatable .= &archive_row($is_dir->{$item},$item, + $currdir,$depth,$count); + } + if ($is_dir->{$item}) { + $depth ++; + $lastcontainer = $count; + $parent->{$depth} = $lastcontainer; + $datatable .= + &recurse_extracted_archive("$currdir/$item",$docudom,$docuname, + \$depth,\$count,\$lastcontainer, + $children,$parent,$wantform); + $depth --; + $lastcontainer = $parent->{$depth}; + } + } + return ($count,$datatable); +} + +sub recurse_extracted_archive { + my ($currdir,$docudom,$docuname,$depth,$count,$lastcontainer, + $children,$parent,$wantform) = @_; + my $result=''; + unless ((ref($depth)) && (ref($count)) && (ref($lastcontainer)) && + (ref($children) eq 'HASH') && (ref($parent) eq 'HASH')) { + return $result; + } + my $dirptr = 16384; + my ($newdirlistref,$newlisterror) = + &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1); + if (ref($newdirlistref) eq 'ARRAY') { + foreach my $dir_line (@{$newdirlistref}) { + my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); + unless ($item =~ /^\.+$/) { + $$count ++; + &archive_hierarchy($$depth,$$count,$parent,$children); + my $is_dir; + if ($dirptr&$testdir) { + $is_dir = 1; + } + if ($wantform) { + $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count); + } + if ($is_dir) { + $$depth ++; + $$lastcontainer = $$count; + $parent->{$$depth} = $$lastcontainer; + $result .= + &recurse_extracted_archive("$currdir/$item",$docudom, + $docuname,$depth,$count, + $lastcontainer,$children, + $parent,$wantform); + $$depth --; + $$lastcontainer = $parent->{$$depth}; + } + } + } + } + return $result; +} + +sub archive_hierarchy { + my ($depth,$count,$parent,$children) =@_; + if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) { + if (exists($parent->{$depth})) { + $children->{$parent->{$depth}} .= $count.':'; + } + } + return; +} + +sub archive_row { + my ($is_dir,$item,$currdir,$depth,$count) = @_; + my ($name) = ($item =~ m{([^/]+)$}); + my %choices = &Apache::lonlocal::texthash ( + 'display' => 'Add as File', + 'dependency' => 'Include as dependency', + 'discard' => 'Discard', + ); + if ($is_dir) { + $choices{'display'} = &mt('Add as Folder'); + } + my $output = &start_data_table_row()."\n"; + foreach my $action ('display','dependency','discard') { + $output .= ''; + } + $output .= ''."\n". + &end_data_table_row(); + return $output; +} + +sub archive_options_form { + my ($form,$output,$count,$hiddenelem) = @_; + return ''."\n". + ''."\n". + '

'. + &mt('How should each item be incorporated in the course?'). + '

'. + '
'. + ''.&mt('Content actions for all').''. + ''. + '  '. + '  '. + '
'. + &start_data_table()."\n". + $output."\n". + &end_data_table()."\n". + ''. + $hiddenelem. + '
'. + ''; +} + +sub archive_javascript { + my ($startcount,$numitems,%children) = @_; + my $scripttag = < +// 0) { + var startelement = $startcount + (count-1) * 5; + for (var j=1; j<4; j++) { + var item = startelement + j; + if (form.elements[item].type == 'radio') { + if (form.elements[item].checked) { + containerCheck(form,count,j); + break; + } + } + } + } +} + +numitems = $numitems +var parents = new Array(numitems) +for (var i=0; i $b } (keys(%children))) { + my @contents = split(/:/,$children{$container}); + for (my $i=0; $i<@contents; $i ++) { + $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n"; + } + } + + $scripttag .= < 0) { + var item = $startcount + ((count-1) * 5) + offset; + form.elements[item].checked = true; + if(Object.prototype.toString.call(parents[count]) === '[object Array]') { + if (parents[count].length > 0) { + for (var j=0; j + +END + return $scripttag; +} + +sub process_extracted_files { + my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; + my $numitems = $env{'form.archive_count'}; + return unless ($numitems); + my @ids=&Apache::lonnet::current_machine_ids(); + my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, + %folders,%containers,%mapinner); + my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom); + if (grep(/^\Q$docuhome\E$/,@ids)) { + $prefix = &LONCAPA::propath($docudom,$docuname); + $pathtocheck = "$dir_root/$destination"; + $dir = $dir_root; + $ishome = 1; + } else { + $prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; + $pathtocheck = "$dir_root/$docudom/$docuname/$destination"; + $dir = "$dir_root/$docudom/$docuname"; + } + my $currdir = "$dir_root/$destination"; + (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); + if ($env{'form.folderpath'}) { + my @items = split('&',$env{'form.folderpath'}); + $folders{'0'} = $items[-2]; + $containers{'0'}='sequence'; + } elsif ($env{'form.pagepath'}) { + my @items = split('&',$env{'form.pagepath'}); + $folders{'0'} = $items[-2]; + $containers{'0'}='page'; + } + my @archdirs = &get_env_multiple('form.archive_directory'); + if ($numitems) { + for (my $i=1; $i<=$numitems; $i++) { + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) { + my $item = $1; + $toplevelitems{$item} = $i; + if (grep(/^\Q$i\E$/,@archdirs)) { + $is_dir{$item} = 1; + } + } + } + } + my ($output,%children,%parent); + if (keys(%toplevelitems) > 0) { + my @contents = sort(keys(%toplevelitems)); + my ($count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir, + \%children,\%parent,\@contents); + } + my (@above,%hierarchy,%referrer,%orphaned,%todelete); + foreach my $depth (sort { $a <=> $b } keys(%parent)) { + push(@above,$parent{$depth}); + foreach my $item (split(/:/,$children{$parent{$depth}})) { + $hierarchy{$item} = \@above; + } + } + if ($numitems) { + for (my $i=1; $i<=$numitems; $i++) { + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ /^\Q$pathtocheck\E/) { + if ($env{'form.archive_'.$i} eq 'discard') { + if ($prefix ne '' && $path ne '') { + if (-e $prefix.$path) { + $todelete{$prefix.$path} = 1; + } + } + } elsif ($env{'form.archive_'.$i} eq 'display') { + my ($title,$url,$outer); + ($title) = ($path =~ m{/([^/]+)$}); + $outer = 0; + if (ref($hierarchy{$i}) eq 'ARRAY') { + if (@{$hierarchy{$i}} > 0) { + foreach my $item (reverse(@{$hierarchy{$i}})) { + if ($env{'form.archive_'.$item} eq 'display') { + $outer = $item; + last; + } + } + } + } + my ($errtext,$fatal) = + &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname. + '/'.$folders{$outer}.'.'. + $containers{$outer}); + next if ($fatal); + if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) { + if ($context eq 'coursedocs') { + $mapinner{$i} = time; + $folders{$i} = 'default_'.$mapinner{$i}; + $containers{$i} = 'sequence'; + my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. + $folders{$i}.'.'.$containers{$i}; + my $newidx = &LONCAPA::map::getresidx(); + $LONCAPA::map::resources[$newidx]= + $title.':'.$url.':false:normal:res'; + push(@LONCAPA::map::order,$newidx); + my ($outtext,$errtext) = + &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. + $docuname.'/'.$folders{$outer}. + '.'.$containers{$outer},1); + } + } else { + if ($context eq 'coursedocs') { + my $newidx=&LONCAPA::map::getresidx(); + my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. + $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. + $title; + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); + } + if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); + } + if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { + system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title"); + } + $LONCAPA::map::resources[$newidx]= + $title.':'.$url.':false:normal:res'; + push(@LONCAPA::map::order, $newidx); + my ($outtext,$errtext)= + &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. + $docuname.'/'.$folders{$outer}. + '.'.$containers{$outer},1); + } + } + } elsif ($env{'form.archive_'.$i} eq 'dependency') { + if (ref($hierarchy{$i}) eq 'ARRAY') { + foreach my $item (reverse(@{$hierarchy{$i}})) { + if ($env{'form.archive_'.$item} eq 'display') { + $referrer{$i} = $item; + last; + #FIXME identify as dependency in db file + #FIXME need to move item to referrer location + #FIXME need to setup httprefs so access allowed + } elsif ($env{'form.archive_'.$item} eq 'discard') { + $orphaned{$i} = $item; + last; + } + } + } + } + } else { + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
'; + } + } + if (keys(%todelete)) { + foreach my $key (keys(%todelete)) { + unlink($key); + unless ($ishome) { + #FIXME Need to notify homeserver to delete files. + } + } + } + } else { + $warning = &mt('No items found in archive.'); + } + if ($error) { + $output .= '

'.&mt('Not extracted.').'
'. + $error.'

'."\n"; + } + if ($warning) { + $output .= '

'.$warning.'

'."\n"; + } + return $output; +} + =pod =item * &get_turnedin_filepath()
'. + '&').'" />'.(' ' x 2); + for (my $i=0; $i<$depth; $i++) { + $output .= ('' x2)."\n"; + } + if ($is_dir) { + $output .= ' '."\n". + ''."\n"; + } else { + $output .= ''."\n"; + } + $output .= ' '.$name.'