--- loncom/interface/loncommon.pm	2012/01/09 19:56:28	1.1052
+++ 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.1052 2012/01/09 19:56:28 www Exp $
+# $Id: loncommon.pm,v 1.1055 2012/01/31 23:47:15 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -9708,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 = '<p>'.$lt{'this'}.' '.$lt{'youm'}.'<br />';
+    if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
+        $output .= $lt{'camt'};
+    }
+    $output .= '</p>';
+    $output .= <<"START";
+<p>
+$lt{'this'} $lt{'youm'}
+</p>
+<div id="uploadfileresult">
+  <form name="uploaded_decompress" action="$action" method="post">
+  <input type="hidden" name="archiveurl" value="$archiveurl" />
+START
+    if (ref($hiddenelements) eq 'HASH') {
+        foreach my $hidden (sort(keys(%{$hiddenelements}))) {
+            $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
+        }
+    }
+    $output .= <<"END";
+<span class="LC_nobreak">$lt{'perm'}&nbsp;
+<label><input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}</label>&nbsp;&nbsp;
+<label><input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label></span><br />
+<input type="submit" name="decompress" value="$lt{'extr'}" />
+</form>
+$noextract
+</div>
+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.').
+                 '<br />'.&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.').'<br />';
+                    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 .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
+                   $error.'</p>'."\n";
+    }
+    if ($warning) {
+        $output .= '<p class="LC_warning">'.$warning.'</p>'."\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 .= '<td><span class="LC_nobreak">'.
+                   '<label><input type="radio" name="archive_'.$count.
+                   '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
+        my $text = $choices{$action};
+        if ($is_dir) {
+            $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
+            if ($action eq 'display') {
+                $text = &mt('Add as Folder');
+            }
+        }
+        $output .= ' />&nbsp;'.$choices{$action}.'</label></span></td>';
+    }
+    $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
+               &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
+    for (my $i=0; $i<$depth; $i++) {
+        $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
+    }
+    if ($is_dir) {
+        $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
+                   '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
+    } else {
+        $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
+    }
+    $output .= '&nbsp;'.$name.'</td>'."\n".
+               &end_data_table_row();
+    return $output;
+}
+
+sub archive_options_form {
+    my ($form,$output,$count,$hiddenelem) = @_;
+    return '<form name="'.$form.'" method="post" action="">'."\n".
+           '<input type="hidden" name="phase" value="decompress_cleanup" />'."\n".
+                    '<p>'.
+                    &mt('How should each item be incorporated in the course?').
+                    '</p>'.
+                    '<div class="LC_columnSection"><fieldset>'.
+                    '<legend>'.&mt('Content actions for all').'</legend>'.
+                    '<input type="button" value="'.&mt('Display in Contents').'" '.
+                    'onclick="javascript:checkAll(document.'.$form.",'display'".')" />'.
+                    '&nbsp;&nbsp;<input type="button" value="'.&mt('Include as dependency for a displayed item').'"'.
+                    ' onclick="javascript:checkAll(document.'.$form.",'dependency'".')" />'.
+                    '&nbsp;&nbsp;<input type="button" value="'.&mt('Discard').'"'.
+                    ' onclick="javascript:checkAll(document.'.$form.",'discard'".')" />'.
+                     '</fieldset></div>'.
+           &start_data_table()."\n".
+           $output."\n".
+           &end_data_table()."\n".
+           '<input type="hidden" name="archive_count" value="'.$count.'" />'.
+           $hiddenelem.
+           '<br /><input type="submit" name="archive_submit" value="'.&mt('Save').'" />'.
+           '</form>';
+}
+
+sub archive_javascript {
+    my ($startcount,$numitems,%children) = @_;
+    my $scripttag = <<START;
+<script type="text/javascript">
+// <![CDATA[
+
+function checkAll(form,prefix) {
+    var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
+    for (var i=0; i < form.elements.length; i++) {
+        var id = form.elements[i].id;
+        if ((id != '') && (id != undefined)) {
+            if (idstr.test(id)) {
+                if (form.elements[i].type == 'radio') {
+                    form.elements[i].checked = true;
+                }
+            }
+        }
+    }
+}
+
+function propagateCheck(form,count) {
+    if (count > 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<numitems; i++) {
+    parents[i] = new Array
+}
+
+START
+
+    foreach my $container (sort { $a <=> $b } (keys(%children))) {
+        my @contents = split(/:/,$children{$container});
+        for (my $i=0; $i<@contents; $i ++) {
+            $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
+        }
+    }
+
+    $scripttag .= <<END;
+
+function containerCheck(form,count,offset) {
+    if (count > 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<parents[count].length; j++) {
+                    containerCheck(form,parents[count][j],offset)
+                }
+            }
+        }
+    }
+}
+// ]]>
+</script>
+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).'<br />'; 
+            }
+        }
+        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 .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
+                   $error.'</p>'."\n";
+    }
+    if ($warning) {
+        $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
+    }
+    return $output;
+}
+
 =pod
 
 =item * &get_turnedin_filepath()