###########################################################################
#
# SRCPlug.pm -- source code  plugin
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 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.
#
###########################################################################
# John McPherson Nov 2000
# originally based on TEXTPlug
# filename is currently used for Title ( optionally minus some prefix )

package SRCPlug;

use BasPlug;
use parsargv;

sub BEGIN {
    @ISA = ('BasPlug');
}


sub print_usage {
    print STDERR "\n  usage: plugin SRCPlug [options]\n";
    print STDERR "Try to import C and C++ source code. Adds \"class\"";
    print STDERR " metadata.\n\n";
    print STDERR "  options:\n";
    print STDERR "  -remove_prefix <pattern>   Remove this leading pattern from the filename\n";
    print STDERR "                             (eg -remove_prefix /tmp/XX/src/). The default is to\n";
    print STDERR "                             remove the whole path from the filename.\n";
    print STDERR "\n";
}

sub new {
    my ($class) = @_;
    my $self = new BasPlug ($class, @_);

    if (!parsargv::parse(\@_,
			 q^remove_prefix/(\S+)/^, \$self->{'remove_prefix'})) {
        print STDERR "\nIncorrect options passed to SRCPlug, ";
        print STDERR "check your collect.cfg configuration file\n";
        &print_usage();
        die "\n";
    }
    return bless $self, $class;
}

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

    return q^(?i)\.(o|obj|a|so|dll)$^;
}

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

#    return q^(?i)\.te?xt$^;
    return q^(Makefile.*|README.*|(?i)\.(c|cc|cpp|C|h|hpp|pl|pm|sh))$^;
}

# do plugin specific processing of doc_obj
sub process {
    my $self = shift (@_);
    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
    my $outhandle = $self->{'outhandle'};
    
    print $outhandle "SRCPlug: processing $file\n" 
	if $self->{'verbosity'} > 1;
    
    my $cursection = $doc_obj->get_top_section();

    my $filetype="text";  # Makefiles, READMEs, ...
    if ($file =~ /\.(cc|h|cpp|C)$/) {$filetype="C++";} # assume all .h files...
    elsif ($file =~ /\.c$/)         {$filetype="C";}
    elsif ($file =~ /\.p(l|m)$/)    {$filetype="perl";}
    elsif ($file =~ /\.sh$/)        {$filetype="sh";}

    # modify '<' and '>' for GML... (even though inside <pre> tags!!)
    $$textref =~ s/</&lt;/g;
    $$textref =~ s/>/&gt;/g;
    # try _escape_text($text) from doc.pm....


    # use filename (minus any prefix) as the title.
    my $title;
    if ($self->{'remove_prefix' ne ""}) {
	($title = $file) =~ s/^$self->{'remove_prefix'}//;
    } else {
	($title = $file) =~ s@^.*(/|\\)@@; # remove pathname by default
    }
    $doc_obj->add_utf8_metadata ($cursection, "Title", $title);
    $doc_obj->add_utf8_metadata ($cursection, "filename", $file);

    # class information from .h and .cc and .C and .cpp files
    if ($filetype eq "C++") 
    {
	return process_c_plus_plus($textref,$pluginfo, $base_dir, 
				   $file, $metadata, $doc_obj);
    }
     # default operation...
     # insert preformat tags and add text to document object
    $doc_obj->add_utf8_text($cursection, "<pre>\n$$textref\n</pre>");
    
    return 1;
}


sub process_c_plus_plus {
    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;

    my $topsection = $doc_obj->get_top_section();



    # Get '#include' directives for metadata
    if ($$textref =~ /\#\W?include\b/) {
	my $includes=$$textref;

	# remove commented lines
	$includes =~ s@/\*.*?\*/@@sg; # treat string as single line
	# ? means match smallest instead of longest !!!
	$includes =~ s@//.*$@@mg; # treat string as multiple lines

	# remove non- include lines (well, lines without a '#')
	$includes =~ s/^[^\#]*$//mg;

	# lines don't always start '#include "'.... we have to allow (eg)
	# '#  include ...'
	# '  #include ...'
	while ($includes =~ /\#\W?include/) {
	    $includes =~ s/^.*?include.*?(\"|&lt;)(.*)(\"|&gt;).*$//m;
	    # $1 is now the filename between the "s.
	    my $include=$2;
	    # remove leading pathname
	    $include =~ s@^.*(/|\\)@@;

	    my $incs_done=$doc_obj->get_metadata($section, "includes");
	    foreach my $elem (@$incs_done) {
		if ("$elem" eq "$include") {goto header_done;}
	    }
	    $doc_obj->add_utf8_metadata($topsection, "includes", $include);
	  header_done:
	}
    }




    # Get class declarations (but not forward declarations...) as metadata
    if ($$textref =~ /\bclass\b/ ) {
	my $classnames=$$textref;
	
	# remove commented lines
	$classnames =~ s@/\*.*?\*/@@sg;
	$classnames =~ s@//.*$@@mg;
	while ($classnames =~ /\bclass\b/) {

	    # delete all lines up to the next "class"
	    while ($classnames !~ /^[^\n]*\bclass\b[^\n]*\n/)
	    {$classnames =~ s/.*\n//;}
	    
#	    $classnames =~ s/^([^c][^l])*(.)?$//mg; # delete unneccessary lines

	    # get the line including the next "class" and remove it from
	    # our tmp text.
	    $classnames =~ s/^(.*\bclass\b.*)$//m;

	    # don't index if merely a reference/fwd decl. of another class
	    if ($1 !~ /(friend\Wclass)|(class\W\w+\W?\;)|(\/\/.*class)/) {
		# $1 is still the whole line - eg:
		# "class StaffSystem: public BaseStaffSystem"
		my $wholeline=$1;
		my $classname=$1;
		$classname =~ s/.*class\W(\w+).*/$1/;
		my $classes=$doc_obj->get_metadata($section, "class");
		foreach my $elem (@$classes) {
		    if ("$elem" eq "$classname") {goto class_done;}
		}
		$doc_obj->add_utf8_metadata($topsection, "class", $classname);
	      class_done:
		$doc_obj->add_utf8_metadata($topsection, "classdecl", $wholeline);
	    }
	}
    } # end of "class"




    # insert preformat tags and add text to document object
    $doc_obj->add_utf8_text($topsection, "<pre>\n$$textref\n</pre>");

    return 1;
}

1;

