###########################################################################
#
# solrbuildproc.pm -- perl wrapper for building index with Solr
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 2026 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

package solrbuildproc;

# This document processor outputs a document for solr to process

# Rather then use the XML structure developed for mgppbuilder/mgppbuildproc
# whose use was then extended to Lucene, Solr has its own XML syntax:
#
#  http://wiki.apache.org/solr/UpdateXmlMessages
#
# Using this means we don't need to write SolrWrapper.jar, as had to be
# done for Lucene, translating the XML syntax piped to it into appropriate
# calls to the Lucene API


use lucenebuildproc;
use ghtml;
use strict;
no strict 'refs'; # allow filehandles to be variables and viceversa


use IncrementalBuildUtils;

sub BEGIN {
    @solrbuildproc::ISA = ('lucenebuildproc');
}


sub new {
    my $class = shift @_;
    my $self = new lucenebuildproc (@_);

    $self->{'actualfacetfields'} = {};
    $self->{'facetfieldnamemap'} = {};
    return bless $self, $class;
}

sub set_text_index {
    my $self = shift (@_);
    my ($text_index) = @_;
    $self->{'text_index'} = $text_index;
}

# set_sortfields done in lucenebuildproc

sub set_facetfields {
    my $self = shift (@_);
 
    my ($facetfields) = @_;
    $self->{'facetfields'} = ();
    # lets just go through and check for text, allfields, metadata which are only valid for indexes, not for facetfields
    foreach my $s (@$facetfields) {
	if ($s !~ /^(text|allfields|metadata)$/) {
	    push (@{$self->{'facetfields'}}, $s);
	}
    }
}


# UNUSED now by default.
# Georgy overrode the mgppbuildproc::create_shortname() method in commit 32441 to create the method below, to override the inherited
# behaviour so that create_shortname() worked appropriately for his use cases involving multiple analyzers.
# As a result, create_shortname() for solr no longer did a lookup into the %mgppbuildproc::static_indexfield_map for registered shortnames.
# For the rest, this method is a copy mgppbuildproc::create_shortname().
# But we want the original mgppbuildproc::create_shortname() behaviour restored, as it does the lookups into %static_indexfield_map that's necessary for us.
# So we've renamed this function to create_shortname_multi_solr_analyzer below so it won't get called as default beahviour any more.
# Rename to create_shortname() when requiring Georgy's behaviour.
sub create_shortname_multi_solr_analyzer {
    my $self = shift(@_);

    my ($realname) = @_;
    my @realnamelist = split(",", $realname);
    map {$_=~ s/^[a-zA-Z]+\.//;} @realnamelist; #remove namespaces
    my ($singlename) = $realnamelist[0];

    # try our predefined static mapping
    my $name;
    # we can't use the quick map, so join all fields back together (without namespaces), and try sets of two characters.
    $realname = join ("", @realnamelist);
    #try the first two chars
    my $shortname;
    if ($realname =~ /^[^\w]*(\w)[^\w]*(\w)/) {
        $shortname = "$1$2";
    } else {
        # there aren't two letdig's in the field - try arbitrary combinations
        $realname = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
        $shortname = "AB";
    }
    $shortname =~ tr/a-z/A-Z/;

    #if already used, take the first and third letdigs and so on
    my $count = 1;
    while (defined $self->{'indexfieldmap'}->{$shortname}) {
        if ($realname =~ /^[^\w]*(\w)([^\w]*\w){$count}[^\w]*(\w)/) {
            $shortname = "$1$3";
            $count++;
            $shortname =~ tr/a-z/A-Z/;

        }
        else {
            #remove up to and incl the first letdig
            $realname =~ s/^[^\w]*\w//;
            $count = 0;
        }
    }

    return $shortname ;
}


#----
# this is the actual hard lifting method
# file param is not used by solr
sub textedit {
    my $self = shift (@_);
    my ($doc_obj,$file,$edit_mode) = @_;
    # currently mode can be either delete or add
    

    # "update" for $edit_mode near identical to "add" as we use Solr in its
    # default mode of replacing an existing document if the new document
    # has the same doc id.  Main area of difference between "add" and "update"
    # is that we do not update our 'stats' for number of documents or number
    # of bytes processed.  The latter is inaccurate, but considered better
    # than allowing the value to steadily climb.

    my $solrhandle = $self->{'output_handle'};
    my $outhandle = $self->{'outhandle'};

    # only output this document if it is one to be indexed
    return if ($doc_obj->get_doc_type() ne "indexed_doc");

    my $text_index = $self->{'text_index'};

    # this is another document
    if ($edit_mode eq "add") {
	$self->{'num_docs'} += 1;
    }
    elsif ($edit_mode eq "delete") {
	$self->{'num_docs'} -= 1;
    }

    # get the parameters for the output
    # split on : just in case there is subcoll and lang stuff
    my ($fields) = split (/:/, $self->{'index'});
   # print STDERR "fields = $fields\n";
    my $levels = $self->{'levels'};
    #print STDERR "specified level = ". join (',', keys %{$levels})."\n";
    my $doc_level_index = $levels->{'document'};
    my $sec_level_index = $levels->{'section'};
    if ($doc_level_index && $sec_level_index) {
        print STDERR "ERROR: both section and document levels were defined for index $self->{'index'} Not indexing\n";
        return;
    }
    if (!$doc_level_index && !$sec_level_index) {
        print STDERR "ERROR: neither section or document levels were defined for index $self->{'index'} Not indexing\n";
        return;
    }
    my $gs2_docOID = $doc_obj->get_OID();

    my $start_doc;
    my $end_doc;

    my $gathered_text = ""; # we output this at the end of each doc/section
    if ($doc_level_index) {
        if ($edit_mode eq "add") {
            $start_doc  = "  <add>\n";
            $start_doc .= "    <doc>\n";
            $start_doc .= "      <field name=\"docOID\">$gs2_docOID</field>\n";
            
            $end_doc    = "    </doc>\n";
            $end_doc   .= "  </add>\n"; 
        }
        else {
            $start_doc  = "  <delete>\n";
            $start_doc .= "    <id>$gs2_docOID</id>\n";
            
            $end_doc    = "  </delete>\n"; 
            
            # for delete mode, we need to specify just the docOID to delete and we're done
            # what about updating num bytes???
            my $text = $start_doc;
            $text .= $end_doc;
            print $solrhandle $text;
            return;
        }
    }

    # add/update/ delete sections


    my $doc_section = 0; # just for this document

    # if we are doing a doc level index, output the container <doc>
    my $text = ($doc_level_index) ? $start_doc : "";

    # get the text for this document
    my $section = $doc_obj->get_top_section();

    while (defined $section)
    {
	# update a few statistics
	$doc_section++;
	$self->{'num_sections'}++;

	my $sec_gs2_id = $self->{'num_sections'};
	my $sec_gs2_docOID = $gs2_docOID;
	$sec_gs2_docOID .= ".$section" if ($section ne "");
	
	my $start_sec;
	my $end_sec;

        if ($edit_mode eq "delete") {
            # we must be section level otherwise we would have returned already
            $start_sec  = "  <delete>\n";
	    $start_sec .= "    <id>$sec_gs2_docOID</id>\n";
            
	    $end_sec    = "  </delete>\n"; 

	    # for delete mode, should specify only this section's docOID to delete, then move on to the next section
            $self->{'num_bytes'} -= $doc_obj->get_text_length ($section);
	    my $text = $start_sec;
	    $text .= $end_sec;
	    print $solrhandle $text;
	    $section = $doc_obj->get_next_section($section);
	    next;
        }

        if ($sec_level_index) {
	    $start_sec  = "  <add>\n";
	    $start_sec .= "    <doc>\n";
	    $start_sec .= "      <field name=\"docOID\">$sec_gs2_docOID</field>\n";
	
	    $end_sec    = "    </doc>\n";
	    $end_sec   .= "  </add>\n"; 
	}

	# add in start section tag if indexing at the section level
	$text .= $start_sec; 

        # TODO - should we count the bytes here if we are not indexing text
        $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
        if ($text_index) {
            my $section_text = $doc_obj->get_text($section);
            &ghtml::htmlsafe($section_text);
            $gathered_text .= $section_text;
        }
	# has the user added a 'metadata' index?
	my $all_metadata_specified = 0;
	# which fields have already been indexed? (same as fields, but in a map)
	my $specified_fields = {};

	# do we have an allfields index??
	my $allfields_index = 0;
		
	foreach my $field (split (/;/, $fields)) {
	    
	    # only deal with this field if it doesn't start with top or
	    # this is the first section
            # ie topTitle should only be indexed for the first section
	    my $real_field = $field;
	    next if (($real_field =~ s/^top//) && ($doc_section != 1));
	    
	    # process this later
	    if ($real_field eq "metadata") {
                $all_metadata_specified = 1;
                next; 
	    }
	    #individual metadata and or text specified - could be a comma separated list
            
	    $specified_fields->{$real_field} = 1;
	    my $shortname="";
	    my $new_field = 0; # have we found a new field name?
            # we shouldn't ever get a new field here? we have preprocessed fields to make sure we have shortnames
	    if (defined $self->{'indexfieldmap'}->{$real_field}) {
		$shortname = $self->{'indexfieldmap'}->{$real_field};
	    }
	    else {
                print STDERR "new field!!!!!!!!!!!!!!!! $real_field\n";
		$shortname = $self->get_or_create_shortname($real_field) ."_m";
                $self->{'indexfieldmap'}->{$real_field} = $shortname;
                $self->{'indexfieldmap'}->{$shortname} = 1;
		$new_field = 1;
	    }

	    my @metadata_list = (); # put any metadata values in here
	    my $section_text = ""; # put the text in here
	    foreach my $submeta (split /,/, $real_field) {
		if ($submeta eq "text") {
		    # no point in indexing text more than once
		    if ($section_text eq "") {
			$section_text = $doc_obj->get_text($section);
                        &ghtml::htmlsafe($section_text);
                    }
		}
		else {
                    # need to allow for ex.dc.Title to stay
                    $submeta =~ s/^ex\.([^.]+)$/$1/; #strip off ex. iff it's the only metadata set prefix (will leave ex.dc.* intact)
		    # its a metadata element
		    my @section_metadata = @{$doc_obj->get_metadata ($section, $submeta)};
		    if ($section ne $doc_obj->get_top_section() && defined ($self->{'sections_index_document_metadata'})) {
			if ($self->{'sections_index_document_metadata'} eq "always" || ( scalar(@section_metadata) == 0 && $self->{'sections_index_document_metadata'} eq "unless_section_metadata_exists")) {
			    push (@section_metadata, @{$doc_obj->get_metadata ($doc_obj->get_top_section(), $submeta)});
			}
		    }
		    push (@metadata_list, @section_metadata);
		}
	    } # for each field in this one index
	    
	    # now we add the text and/or metadata into new_text
	    if ($section_text ne "" || scalar(@metadata_list)) {
                # record that we have found something for this field
                $self->{'allindexfields'}->{$real_field} = 1;
		my $new_text = "";
		
		if ($section_text ne "") {
			
			# Remove any leading or trailing white space
			$section_text =~ s/\s+$//;
			$section_text =~ s/^\s+//;
                        # add the tag
                        $new_text .= "<field name=\"$shortname\" >$section_text</field>\n";
			
		}
		
		foreach my $item (@metadata_list) {
		    &ghtml::htmlsafe($item);

                    # Remove any leading or trailing white space
                    $item =~ s/\s+$//;
                    $item =~ s/^\s+//;
                    
                    # add the tag
                    $new_text .= "<field name=\"$shortname\" >$item</field>\n";
		
		} # end for loop processing @metadata_list
		
		# filter the text
		$new_text = $self->filter_text ($field, $new_text);

                $self->{'num_processed_bytes'} += length ($new_text);
                $text .= "$new_text";
	    
            } # foreach item
        } # foreach field
    
    

   	if ($all_metadata_specified) {
	    
	    my $new_text = "";
	    my $shortname = "";
	    my $metadata = $doc_obj->get_all_metadata ($section);
	    foreach my $pair (@$metadata) {
		my ($mfield, $mvalue) = (@$pair);

		# no value
		next unless defined $mvalue && $mvalue ne "";

		# we have already indexed this
		next if defined ($specified_fields->{$mfield});

		# check fields here, maybe others dont want - change to use dontindex!!
		next if ($mfield eq "Identifier" || $mfield eq "classifytype" || $mfield eq "assocfilepath");
		next if ($mfield =~ /^gsdl/);
		
		&ghtml::htmlsafe($mvalue);
		
		if (defined $self->{'indexfieldmap'}->{$mfield}) {
		    $shortname = $self->{'indexfieldmap'}->{$mfield};
		}
		else {
                    # if we have discovered new meta here, we use XX_m so its
                    # covered by default rules in schema
		    $shortname = $self->get_or_create_shortname($mfield) . "_m";
		    $self->{'indexfieldmap'}->{$mfield} = $shortname;
		    $self->{'indexfieldmap'}->{$shortname} = 1;
                    # record what extra fields we found
                    print STDERR "adding $mfield into extra meta, shortname=$shortname\n";
                    $self->{'extraindexfields'}->{$mfield} = 1;
		}
                $self->{'allindexfields'}->{$mfield} = 1;
		$new_text .= "<field name=\"$shortname\">$mvalue</field>\n";

		if (!defined $self->{'indexfields'}->{$mfield}) {
		    $self->{'indexfields'}->{$mfield} = 1;
		}				    
	    
	    }
	    # filter the text
	    $new_text = $self->filter_text ("metadata", $new_text);
	    
	    if ($edit_mode eq "add") {
		$self->{'num_processed_bytes'} += length ($new_text);
		$text .= "$new_text";
	    }
	}

	    
	# only add sort and facet fields for this section if we are doing section level indexing or this is the top section
	if ($sec_level_index || $doc_section == 1 ) {
	# add sort fields if there are any
        foreach my $sfield (@{$self->{'sortfields'}}) {
	    # ignore special field rank/none
	    next if $sfield eq "rank" || $sfield eq "none";
	    my $sf_shortname = $self->get_or_create_sortfield_shortname($sfield);
	    my @metadata_list = (); # put any metadata values in here
	    foreach my $submeta (split /,/, $sfield) {
		$submeta =~ s/^ex\.([^.]+)$/$1/; #strip off ex. iff it's the only metadata set prefix (will leave ex.dc.* intact)
	    
		my @section_metadata = @{$doc_obj->get_metadata ($section, $submeta)};
		    if ($section ne $doc_obj->get_top_section() && defined ($self->{'sections_sort_on_document_metadata'})) {
			if ($self->{'sections_sort_on_document_metadata'} eq "always" || ( scalar(@section_metadata) == 0 && $self->{'sections_sort_on_document_metadata'} eq "unless_section_metadata_exists")) {
			    push (@section_metadata, @{$doc_obj->get_metadata ($doc_obj->get_top_section(), $submeta)});
			}
		    }
		push (@metadata_list, @section_metadata);
	    }
	     my $new_text = "";
	    foreach my $item (@metadata_list) {
	     	&ghtml::htmlsafe($item);
	    	$new_text .= "$item ";
	    }
	    if ($new_text =~ /\S/) {
	     	$new_text = "<field name=\"$sf_shortname\">$new_text</field>\n";
	     	# filter the text???
	     	$text .= "$new_text"; # add it to the main text block
	     	#print "#### new_text: $new_text\n";

	     	$self->{'actualsortfields'}->{$sfield} = 1;
	    }
	   # print "#### TEXT: $text\n";
	    

	} # end foreach sort field

	# add facet fields if there are any
	foreach my $sfield (@{$self->{'facetfields'}}) {
	    my $sf_shortname = $self->get_or_create_facetfield_shortname($sfield);
	    my @metadata_list = (); # put any metadata values in here
	    foreach my $submeta (split /,/, $sfield) {
		$submeta =~ s/^ex\.([^.]+)$/$1/; #strip off ex. iff it's the only metadata set prefix (will leave ex.dc.* intact)
	    
		my @section_metadata = @{$doc_obj->get_metadata ($section, $submeta)};
		    if ($section ne $doc_obj->get_top_section() && defined ($self->{'sections_sort_on_document_metadata'})) {
			if ($self->{'sections_sort_on_document_metadata'} eq "always" || ( scalar(@section_metadata) == 0 && $self->{'sections_sort_on_document_metadata'} eq "unless_section_metadata_exists")) {
			    push (@section_metadata, @{$doc_obj->get_metadata ($doc_obj->get_top_section(), $submeta)});
			}
		    }
		push (@metadata_list, @section_metadata);
	    }
	    my $found_facet_value = 0;
	    foreach my $item (@metadata_list) {
		&ghtml::htmlsafe($item);
		if ($item =~ /\S/) {
		    $item = "<field name=\"$sf_shortname\">$item</field>\n";
		    # filter the text???
		    $text .= "$item"; # add it to the main text block
		    $found_facet_value = 1;
		    #print "#### new_text: $item\n";
		}
	    }
	    if($found_facet_value) {
	    	$self->{'actualfacetfields'}->{$sfield} = 1;
	    }
	    
	} # foreach facet field
	} # end of if sec indexing or top level section (for sort and facets)

        # if we have a text index, and section level index, add it in now
        if ($sec_level_index && $text_index) {
            $text .= "<field name=\"TX\">$gathered_text</field>\n";
            $gathered_text=""; # clear the stored text
        }
	# add in end tag if at top-level doc root, or indexing at the section level
	$text .= $end_sec; # will be empty for doc level # if ($sec_tag_name ne "");

        $section = $doc_obj->get_next_section($section);
        
    }# while defined section

    
    # only output the entire text as one field if working with doc level
    if ($doc_level_index && $text_index) {
        $text .= "<field name=\"TX\">$gathered_text</field>\n";
    }
    $text .= $end_doc if ($doc_level_index); #sec_tag_name eq "");

##    $text .= "<commit/>\n";
    
    # Uncomment this if you want to output a file containing the content sent to solr - for debug purposes

    #open(TEXTOUT, '>>:utf8', "text.out");
    #print TEXTOUT "$text";
    #close TEXTOUT;

    print $solrhandle $text;

}




sub textreindex
{
    my $self = shift (@_);
    my ($doc_obj,$file) = @_;

    # the update command does not exist in solrbuildproc
    # reindexing consists of deleting and then adding the same file
    $self->textedit($doc_obj,$file,"delete");
    $self->textedit($doc_obj,$file,"add");
}

sub get_or_create_facetfield_shortname {
    my $self = shift(@_);

    my ($realname) = @_;
    
    if (defined $self->{'facetfieldnamemap'}->{$realname}) {
	return $self->{'facetfieldnamemap'}->{$realname};
    }

    # get the shortname made for this index field

    my $shortname = $self->get_or_create_shortname($realname);
    $shortname = "fc".$shortname;

    $self->{'facetfieldnamemap'}->{$realname} = $shortname;
    $self->{'facetfieldnamemap'}->{$shortname} = 1;
    return $shortname;
}
  


1;