Index: main/trunk/greenstone2/perllib/cgiactions/docextractaction.pm
===================================================================
--- main/trunk/greenstone2/perllib/cgiactions/docextractaction.pm	(revision 28249)
+++ main/trunk/greenstone2/perllib/cgiactions/docextractaction.pm	(revision 28251)
@@ -46,5 +46,6 @@
 	"extract-archives-doc" => { # where param can be ONE of: index (default), import, archives, live
 	    'compulsory-args' => [ "d", "json-sections" ],
-	    'optional-args'   => [ "json-metadata", "newd" ],
+	    'optional-args'   => [ "json-metadata", "newd", 
+				   "keep-parent-metadata", "keep-parent-content" ],
 #	    'optional-args'   => [ "where" ],
 	    'help-string' => [
@@ -96,5 +97,5 @@
 
     if ($new_depth > $old_depth) {
-	# child subsection
+	# first child subsection
 	$new_secnum = "$old_secnum.1";
     }
@@ -108,8 +109,6 @@
     else {
 	# back up to parent section => lopp off tail
-###	print STDERR "**### back up to parent section, $old_secnum = $old_secnum\n";
-
-	$new_secnum = $old_secnum;
-	$new_secnum =~ s/\.\d+$//;
+#	$new_secnum = $old_secnum;
+#	$new_secnum =~ s/\.\d+$//;
     }
 
@@ -125,38 +124,38 @@
 	my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_;
 
+	my $curr_sec_num = $parser->{'parameters'}->{'curr_section_num'} || undef;
+
 	my $sec_num_hash = $parser->{'parameters'}->{'sec_num_hash'};
-	my $curr_sec_num = $parser->{'parameters'}->{'curr_section_num'} || undef;
+	my $parent_sec_num_hash = $parser->{'parameters'}->{'parent_sec_num_hash'};
+	
+	my $keep_parent_metadata = $parser->{'parameters'}->{'keep_parent_metadata'};
+	my $keep_parent_content  = $parser->{'parameters'}->{'keep_parent_content'};
 
 	my $mode = $parser->{'parameters'}->{'mode'};
 
-	my $depth = $parser->{'parameters'}->{'curr_section_depth'};
-
+	my $prev_depth = $parser->{'parameters'}->{'curr_section_depth'};
 	my $live_depth = scalar(@$contextArray);
 
-#	print STDERR "closing secdtion tag, mode: $mode, curr sec num = $curr_sec_num, live depth = $live_depth\n";
+	if ($live_depth < $prev_depth) {
+	    # In a closing-sections poping off situation:
+	    #   </Section>
+	    # </Section>
+
+	    # => Back up to parent section => lopp off tail
+
+	    $curr_sec_num =~ s/\.\d+$//;
+	    $parser->{'parameters'}->{'curr_section_depth'} = $live_depth;
+	    $parser->{'parameters'}->{'curr_section_num'}   = $curr_sec_num;
+	}
+
 
 	if ($live_depth == 1) {
 	    # root sectin tag, which must always exist
-#	    print STDERR "*** root, tagname = $tagname, attrHash = $attrHash ", 
-#	      " '_content' = ", join(",",@{$attrHash->{'_content'}}), "\n";
 	    return [$tagname => $attrHash];
 	}
-	elsif (defined $sec_num_hash->{$curr_sec_num}) {
-###	    print STDERR "*** got a match on $curr_sec_num, mode = $mode\n";
-
-	    if ($mode eq "extract") {
-		# keep it
-		return [$tagname => $attrHash];
-	    }
-	    else {
-		# remove
-		return undef;
-	    }
-	}
-	else {
-	    # not in our list
-	    if ($mode eq "extract") {
-		# remove
-		return undef;
+	elsif ($mode eq "delete") {
+	    if (defined $sec_num_hash->{$curr_sec_num}) {
+		# remove it
+		return undef
 	    }
 	    else {
@@ -165,4 +164,57 @@
 	    }
 	}
+	else {
+	    # mode is extract
+
+	    if (defined $sec_num_hash->{$curr_sec_num}) {
+		# keep it
+##		print STDERR "**** Asked to keep: sec num = $curr_sec_num\n";
+
+		return [$tagname => $attrHash];
+	    }
+	    elsif (defined $parent_sec_num_hash->{$curr_sec_num}) {
+		# want this element, but cut down to just the child <Section>
+		
+		my $section_child = undef;
+
+##		print STDERR "**** Parent match: sec num = $curr_sec_num\n";
+
+		my $filtered_elems = [];
+		
+		foreach my $elem ( @{$attrHash->{'_content'}}) {
+		    if (ref $elem eq "ARRAY") {
+			my $child_tagname = $elem->[0];
+##			print STDERR "***## elem name $child_tagname\n";
+
+			
+			if ($child_tagname eq "Description") {
+			    if ($keep_parent_metadata) {
+				push(@$filtered_elems,$elem);
+			    }
+			}
+			elsif ($child_tagname eq "Content") {
+			    if ($keep_parent_content) {
+				push(@$filtered_elems,$elem);
+			    }
+			}
+			else {
+			    push(@$filtered_elems,$elem);
+			}
+		    }
+		    else {
+			push(@$filtered_elems,$elem);
+		    }
+		}
+
+		$attrHash->{'_content'} = $filtered_elems;
+
+		return [$tagname => $attrHash];
+
+	    }
+	    else {
+		# not in our list => remove it
+		return undef;
+	    }
+	}
 }
 
@@ -171,5 +223,6 @@
 {
 	my $self = shift @_;
-	my ($gsdl_cgi, $doc_xml_filename, $newdoc_xml_filename, $sec_num_hash, $mode) = @_;
+	my ($gsdl_cgi, $doc_xml_filename, $newdoc_xml_filename, 
+	    $sec_num_hash, $parent_sec_num_hash, $mode) = @_;
 	
 	my @start_rules = ('Section' => \&dxml_start_section);
@@ -219,5 +272,9 @@
 			binmode($MOUT,":utf8");
 
-			my $options = {sec_num_hash => $sec_num_hash, mode => $mode };
+			my $options = { sec_num_hash         => $sec_num_hash, 
+					parent_sec_num_hash  => $parent_sec_num_hash,
+					keep_parent_metadata => $self->{'keep-parent-metadata'},
+					keep_parent_content  => $self->{'keep-parent-content'},
+				        mode => $mode };
 
 			$parser->filter($xml_in, $MOUT, $options);
@@ -231,6 +288,6 @@
 {
     my $self = shift @_;
-
-    my ($json_sections_array,$mode) = @_;
+    
+    my ($json_sections_array) = @_;
 
     my $sec_num_hash = {};
@@ -241,15 +298,4 @@
 	# Need to do the same here, so things can be matched up
 	$sec_num_hash->{".$sn"} = 1; 
-
-###	print STDERR "** storeing .$sn\n";
-
-	if ($mode eq "with-parents") {
-	    my $sn_copy = $sn; # needs to be a copy, otherwise chaning version stored in json_sections
-	    while ($sn_copy =~ s/\.\d+$//) {
-		$sec_num_hash->{".$sn_copy"} = 1; # See '.' comment above
-
-####		print STDERR "** ***** parent storeing .$sn_copy\n";
-	    }
-	}
     }
 
@@ -258,4 +304,40 @@
 
 
+sub parent_sections_as_hash
+{
+    my $self = shift @_;
+
+    my ($json_sections_array) = @_;
+
+    my $sec_num_hash = {};
+
+    foreach my $sn ( @$json_sections_array ) {
+
+	# needs to make a copy, otherwise version stored in json_sections gets changed
+	my $sn_copy = $sn; 
+	while ($sn_copy =~ s/\.\d+$//) {
+	    # our XML parser curr_sec_num puts '.' at the root
+	    # Need to do the same here, so things can be matched up
+
+	    $sec_num_hash->{".$sn_copy"} = 1; 
+	}
+    }
+
+    return $sec_num_hash;
+}
+
+sub parse_flag
+{
+    	my $self = shift @_;
+
+	my ($arg_name) = @_;
+
+	my $flag = $self->{$arg_name} || 0;
+
+	$flag =~ s/^true/1/i;
+	$flag =~ s/^false/0/i;
+
+	return $flag;
+}
 
 sub _extract_archives_doc
@@ -278,4 +360,7 @@
 	my $new_docid = $self->{'newd'} || "HASH" . localtime(time);
 
+	$self->{'keep-parent-metadata'} = $self->parse_flag("keep-parent-metadata");
+	$self->{'keep-parent-content'}  = $self->parse_flag("keep-parent-content");
+
 	my $json_sections_str = $self->{'json-sections'};
 	my $json_sections_array = decode_json($json_sections_str);
@@ -293,7 +378,8 @@
 #	my $doc_filename = $doc_rec->{'doc-file'}->[0];	
 
-	my $extract_sec_num_hash = $self->sections_as_hash($json_sections_array,"with-parents");
-
-	my $extract_status = $self->remove_from_doc_xml($gsdl_cgi, $doc_filename ,$newdoc_filename, $extract_sec_num_hash, "extract");
+	my $sec_num_hash = $self->sections_as_hash($json_sections_array);
+	my $parent_sec_num_hash = $self->parent_sections_as_hash($json_sections_array);
+
+	my $extract_status = $self->remove_from_doc_xml($gsdl_cgi, $doc_filename ,$newdoc_filename, $sec_num_hash, $parent_sec_num_hash, "extract");
 	
 	if ($extract_status == 0) 
@@ -301,5 +387,5 @@
 	    my $delete_sec_num_hash = $self->sections_as_hash($json_sections_array,"no-parents");
 
-	    my $delete_status = $self->remove_from_doc_xml($gsdl_cgi, $doc_filename ,$doc_filename, $delete_sec_num_hash, "delete");
+	    my $delete_status = $self->remove_from_doc_xml($gsdl_cgi, $doc_filename ,$doc_filename, $sec_num_hash, undef, "delete");
 
 	    if ($delete_status == 0) {
