[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm londocs.pm

raeburn raeburn at source.lon-capa.org
Tue Jan 31 18:47:15 EST 2012


raeburn		Tue Jan 31 23:47:15 2012 EDT

  Modified files:              
    /loncom/interface	londocs.pm loncommon.pm 
  Log:
  - Work in progress.
  - Upload archive files (.zip, .tar, .tar.gz etc.) into a course, and offer the
    option to extract contents, and decide how extracted items should be deployed.
  - londocs.pm
    - new routines: &decompression_info(), &decompression_phase_one(),
                    &decompression_phase_two().
  - loncomon.pm
    - new routines: &process_decompression(), &get_extracted(), 
                    &recurse_extracted_archive(), &archive_hierarchy(),
                    &archive_row(), &archive_options_form, &archive_javascript(),
                    &process_extracted_files()     
  
  
-------------- next part --------------
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.475 loncom/interface/londocs.pm:1.476
--- loncom/interface/londocs.pm:1.475	Sun Jan 29 19:50:53 2012
+++ loncom/interface/londocs.pm	Tue Jan 31 23:47:15 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Documents
 #
-# $Id: londocs.pm,v 1.475 2012/01/29 19:50:53 raeburn Exp $
+# $Id: londocs.pm,v 1.476 2012/01/31 23:47:15 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1109,6 +1109,23 @@
                     $$upload_output .= &mt('No embedded items identified').'<br />';
                 }
                 $$upload_output = '<div id="uploadfileresult">'.$$upload_output.'</div>';
+            } elsif (&Apache::loncommon::is_archive_file($mimetype)) {
+                $nextphase = 'decompress_uploaded';
+                my $position = scalar(@LONCAPA::map::order)-1;
+                my $noextract = &return_to_editor();
+                my $archiveurl = &HTML::Entities::encode($url,'<>&"');
+                my %archiveitems = (
+                    folderpath => $env{'form.folderpath'},
+                    pagepath   => $env{'form.pagepath'},
+                    cmd        => $nextphase,
+                    newidx     => $newidx,
+                    position   => $position,
+                    phase      => $nextphase,
+                ); 
+                $$upload_output = $showupload.
+                                  &Apache::loncommon::decompress_form($mimetype,
+                                      $archiveurl,'/adm/coursedocs',$noextract,
+                                      \%archiveitems);
             }
         }
     }
@@ -2363,6 +2380,14 @@
                                                          $docuname,$docudom,undef,
                                                          $dir_root).
                    &return_to_editor());
+      } elsif ($env{'form.phase'} eq 'decompress_uploaded') {
+          $uploadphase = 'decompress_phase_one';
+          $r->print(&decompression_phase_one().
+                    &return_to_editor());
+      } elsif ($env{'form.phase'} eq 'decompress_cleanup') {
+          $uploadphase = 'decompress_phase_two';
+          $r->print(&decompression_phase_two().
+                    &return_to_editor());
       }
   }
 
@@ -2933,6 +2958,93 @@
            '</a></p>';
 }
 
+sub decompression_info {
+    my ($destination,$dir_root) = &embedded_destination();
+    my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
+    my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+    my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
+    my $container='sequence';
+    my $hiddenelem;
+    if ($env{'form.pagepath'}) {
+        $container='page';
+        $hiddenelem = '<input type="hidden" name="pagepath" value="'.$env{'form.pagepath'}.'" />'."\n";
+    } else {
+        $hiddenelem = '<input type="hidden" name="folderpath" value="'.$env{'form.folderpath'}.'" />'."\n";
+    }
+    if ($env{'form.newidx'}) {
+        $hiddenelem .= '<input type="hidden" name="newidx" value="'.$env{'form.newidx'}.'" />'."\n";
+    }
+    return ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,
+            $hiddenelem);
+}
+
+sub decompression_phase_one {
+    my ($dir,$file,$warning,$error,$output);
+    my ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,$hiddenelem)=
+        &decompression_info();
+    if ($env{'form.archiveurl'} !~ m{^/uploaded/\Q$docudom/$docuname/docs/\E(?:default|supplemental|\d+).*/([^/]+)$}) {
+        $error = &mt('Archive file "[_1]" not in the expected location.',$env{'form.archiveurl'});
+    } else {
+        my $file = $1;
+        $output = &Apache::loncommon::process_decompression($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem);
+        if ($env{'form.archivedelete'}) {
+            my $map = $env{'form.folder'}.'.'.$container;
+            my ($delwarning,$delresult);
+            my ($errtext,$fatal) = &mapread($docuname,$docudom,$map);
+            if ($fatal) {
+                if ($container eq 'page') {
+                    $delwarning = &mt('An error occurred retrieving the contents of the current page.');
+                } else {
+                    $delwarning = &mt('An error occurred retrieving the contents of the current folder.');
+                }
+                $delwarning .= &mt('As a result the archive file has not been removed.');
+            } else {
+                my $currcmd = $env{'form.cmd'};
+                $env{'form.cmd'} = 'del_'.$env{'form.position'};
+                if (&handle_edit_cmd($docuname,$docudom)) {
+                    ($errtext,$fatal) = &storemap($docuname,$docudom,$map);
+                    if ($fatal) {
+                        if ($container eq 'page') {
+                            $delwarning = &mt('An error occurred updating the contents of the current page.');
+                        } else {
+                            $delwarning = &mt('An error occurred updating the contents of the current folder.');
+                        }
+                    }
+                }
+                $env{'form.cmd'} = $currcmd;
+                $delresult = &mt('Archive file removed after extracting files.');
+            }
+            if ($delwarning) {
+                $output .= '<p class="LC_warning">'.
+                           $delwarning.
+                           '</p>';
+            }
+            if ($delresult) {
+                $output .= '<p class="LC_info">'.
+                           $delresult.
+                           '</p>';
+            }
+        }
+    }
+    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 decompression_phase_two {
+    my ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,$hiddenelem)=
+        &decompression_info();
+    my $output = 
+        &Apache::loncommon::process_extracted_files('coursedocs',$docudom,$docuname,
+                                                    $destination,$dir_root,$hiddenelem);
+    return $output;
+}
+
 sub generate_admin_options {
   my ($help_ref,$env_ref) = @_;
   my %lt=&Apache::lonlocal::texthash(
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1054 loncom/interface/loncommon.pm:1.1055
--- loncom/interface/loncommon.pm:1.1054	Mon Jan 16 18:04:20 2012
+++ loncom/interface/loncommon.pm	Tue Jan 31 23:47:15 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1054 2012/01/16 18:04:20 raeburn Exp $
+# $Id: loncommon.pm,v 1.1055 2012/01/31 23:47:15 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -9735,6 +9735,9 @@
     }
     $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" />
@@ -9771,6 +9774,506 @@
     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$/, at 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, at contents);
+                    my ($newdirlistref,$newlisterror) =
+                        &Apache::lonnet::dirlist($currdir,$docudom,
+                                                 $docuname,1);
+                    my (%is_dir,%changes, at 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 .= ' /> '.$choices{$action}.'</label></span></td>';
+    }
+    $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
+               &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' 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="" /> '."\n".
+                   '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
+    } else {
+        $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
+    }
+    $output .= ' '.$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'".')" />'.
+                    '  <input type="button" value="'.&mt('Include as dependency for a displayed item').'"'.
+                    ' onclick="javascript:checkAll(document.'.$form.",'dependency'".')" />'.
+                    '  <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$/, at 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$/, at 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$/, at 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()


More information about the LON-CAPA-cvs mailing list