translator.pl

doxygen(一个自动从源代码生成文档的工具)的源代码

            
    open(FOUT, "> $fout") or die "\nError when open > $fout: $!";
    print FOUT $cont;
    close FOUT;
}
##}}}


################################################################
# Body
#
{
    # Set the content of global variables using the environment
    # variables. #{{{
    #
    $docdir = (defined $ENV{'DOXYGEN_DOCDIR'}) 
                ? $ENV{'DOXYGEN_DOCDIR'} : '.';
    
    $docdir =~ s{\\}{/}g;
    $docdir =~ s{/$}{};
    
    $doxygenrootdir = ($docdir eq '.') ? '..' : $docdir;
    $doxygenrootdir =~ s{/doc$}{};

    $srcdir = "$doxygenrootdir/src";

=pod
# Show the environment variables (for debugging only). 
#
foreach (sort keys %ENV) { print STDERR "$_=$ENV{$_}\n"; }
print STDERR "\n\n"; 
=cut
    
    $doxversion = (defined $ENV{'VERSION'}) ? $ENV{'VERSION'} : 'unknown';

    ##}}}
    
    # The translator base class must be present.  Exit otherwise,
    # but be kind to those who already have the documentation
    # generated by this script ready, but who do not have sources. 
    # If no $flangdoc is present, copy the template to it. #{{{
    #
    if (!-f "$srcdir/translator.h") {
        print STDERR "\nThe $0 warning:\n"
                     . "\tThe translator.h not found in $srcdir.\n"
                     . "\tThe $ftranslatortxt will not be "
                     . "generated (you don't need it).\n";

        # $flangdoc is present, copy the template to it.
        #
        if (!-f "$docdir/$flangdoc") {

            # Copy the template document to $flandoc with simplified
            # replacement of the markers inside the template.
            #
            CopyTemplateToLanguageDoc();
            
            # Generate the warning about $flangdoc content.
            #
            print STDERR "\nThe $0 warning:\n"
                . "\tThe $flangdoc not found in the '$docdir' directory.\n"
                . "\tThe $flangtpl template content copied into it.\n"
                . "\tAs the sources are not available, some information\n"
                . "\tcould not be extracted and inserted into $flangdoc.\n";
        }
        
        # Exit as if nothing happened.
        #
        exit 0;
    }
    ##}}}

    # Find all translator_xx.h file names. #{{{
    #
    my @entries = ();  # init

    opendir DIR, $srcdir or confess "opendir error for $srcdir: $!";
    foreach (readdir(DIR)) { if (!/^\./) { push @entries, $_; } }
    closedir DIR;          # ignore names with dot at the beginning

    my @files = sort 
                grep { -f "$srcdir/$_" && m{^translator_..\.h$}i } 
                @entries;
    ##}}}
    
    # Get only the pure virtual methods from the Translator class
    # into a hash structure for later testing present/not present.
    #
    my @expected = GetPureVirtualFrom("$srcdir/translator.h");

    # The details for translators will be collected into the output
    # string. If some details are listed for a translator, the flag
    # will be set to produce possible warning to the list of
    # up-to-date translators.
    #
    my $output = '';
    my %details = ();

    # Remove the argument identifiers from the method prototypes
    # to get only the required form of the prototype. Fill the
    # hash with them. #{{{
    #
    my %required = ();
    
    foreach (@expected) {
        my $prototype = StripArgIdentifiers($_);
        $required{$prototype} = 1;
    }
    ##}}}
    
    # Collect base classes of translators in the hash. CB stands
    # for Class and Base.
    #
    my %cb = ();
    
    # Loop through all translator files.  Extract the implemented
    # virtual methods and compare it with the requirements. Prepare
    # the output.
    #
    foreach (@files) {                               

        # Get the information from the sources.  Remember the base
        # class for each of the classes.  Clear the flag for
        # details for the class. #{{{
        #
        my @info = GetInfoFrom("$srcdir/$_");
        
        my $class = shift @info;
        my $base = shift @info;

        $cb{$class} = $base;
        $details{$class} = 0;
        
        ##}}}
        
        # Set the value of the required methods to 1 (true).  Let
        # this indicate that the method was not defined in the
        # translator class.
        #
        foreach (keys %required) { $required{$_} = 1; }
        
        # Loop through all items and compare the prototypes. Mark
        # the implemented method and collect the old ones.  #{{{
        #
        my @old_methods = ();

        foreach my $implemented (@info) {
            
            # Get only the necessary form of the prototype.
            #
            my $prototype = StripArgIdentifiers($implemented);
            
            # Mark as recognized when the prototype is required.
            # Otherwise, remember it as old method which is
            # implemented, but not required.
            #
            if (defined $required{$prototype}) { 
                $required{$prototype} = 0; 
            }
            else {
                push(@old_methods, $implemented); 
            }
        }
        ##}}}

        # Loop through the list of expected methods and collect 
        # the missing (new) methods.  Do this only when it derives
        # from Translator or TranslatorAdapter classes (i.e. ignore
        # any unusual kind of TranslatorXxxx implementation). #{{{
        #
        my @missing_methods = ();
        
        if ($base =~ m/^Translator(Adapter.*)?$/) {
            foreach my $method (@expected) {
                
                # Get the stripped version of the prototype.
                #
                my $prototype = StripArgIdentifiers($method); 
                
                # If the prototype is stored in the %required
                # table, and if it was not marked as implemented,
                # then it should be.  It is a missing method.
                #
                if (defined $required{$prototype} && $required{$prototype}) { 
                    push(@missing_methods, $method); 
                }
            }
        }
        ##}}}

        # The detailed output will be produced only when it is
        # needed. #{{{
        #
        if (@old_methods || @missing_methods
            || $base !~ m/^Translator(Adapter.*)?$/) {

            $output .= "\n\n\n";
            $output .= $class . " ($base)\n" . '-' x length($class) . "\n";
            
            if ($base !~ m/^Translator(Adapter.*)?$/) {
                $output .= "\nThis is the unusual implementation of the "
                         . "translator.  Its class is derived\n"
                         . "from the $base base class. The usual translator"
                         . "class derives\n"
                         . "or from the Translator class or from some "
                         . "TranslatorAdapter_x_x_x classes.\n"
                         . "Because of that, nothing can be guessed about "
                         . "missing methods.\n";
            }
                
            if (@missing_methods) {
                $output .= "\nMissing methods (should be implemented):\n\n";
                foreach (@missing_methods) { $output .= "  $_\n"; }
            }    

            if (@old_methods) {
                $output .= "\nObsolete methods (should be removed):\n\n";
                foreach (sort @old_methods) { $output .= "  $_\n"; }
            }
                
            # Some details were listed, set the details flag for
            # the class.
            #
            $details{$class} = 1;
        }
        ##}}}
    }

    
    # Generate the textual output file.
    #
    my $fout = "$docdir/$ftranslatortxt";
    
    # Open it first.
    #
    open(FOUT, "> $fout") or die "\nError when open > $fout: $!";

    # List the supported languages. #{{{
    #
    my @all_translators = keys %cb;

    print FOUT "Doxygen supports the following (" . @all_translators
             . ") languages (sorted alphabetically):\n\n";
    
    foreach (sort grep { s/^Translator(\w+)\b.*$/$1/ } @all_translators) {
        print FOUT "  $_\n";
    }
    ##}}}

    # If there are up-to-date translators, list them.  #{{{
    #
    my @list = sort grep { $cb{$_} =~ m/^Translator$/ } keys %cb;    
    
    if (@list) {
        print FOUT "\n" .'-' x 70 . "\n";
        print FOUT "The following translator classes are up-to-date " 
                 . "(sorted alphabetically).\n"
                 . "This means that they derive from the Translator class.  "
                 . "Anyway, there still\n"
                 . "may be some details listed even for "
                 . "the up-to-date translators.\n"
                 . "Please, check the text below if the translator "
                 . "is marked so.\n\n";
        
        foreach (@list) { 
            
            # Print the class name.
            #
            print FOUT "  $_";
            
            # If some details were listed for the translator class,
            # add a notice.
            #
            if ($details{$_}) {
                print FOUT "\t-- see details below in the report"; 
            }
            
            print FOUT "\n"; 
        }
    }
    ##}}}

    # If there are obsolete translators, list them.  #{{{
    #
    @list = sort grep { $cb{$_} =~ m/^TranslatorAdapter_/ } keys %cb;

    if (@list) {
        print FOUT "\n" .'-' x 70 . "\n";
        print FOUT "The following translator classes are obsolete "
                 . "(sorted alphabetically).\n"
                 . "This means that they derive from some of " 
                 . "the adapter classes.\n\n";
        
        foreach (@list) { print FOUT "  $_\t($cb{$_})\n"; }        
    }
    ##}}}

    # If there are other translators, list them. #{{{
    #
    @list = sort 
            grep { $cb{$_} !~ m/^Translator$/ } 
            grep { $cb{$_} !~ m/^TranslatorAdapter_/ } 
            keys %cb;

    if (@list) {
        print FOUT "\n" .'-' x 70 . "\n";
        print FOUT "The following translator classes are somehow different\n"
                 . "(sorted alphabetically).  This means that they "
                 . "do not derive from\n"
                 . "the Translator class, nor from some of the adapter classes.\n\n";
        
        foreach (@list) { print FOUT "  $_\t($cb{$_})\n"; }        
    }
    ##}}}

    # List the methods that are expected to be implemented.  #{{{
    #
    print FOUT "\n\n" .'-' x 70 . "\n";
    print FOUT "Localized translators are expected to implement "
             . "the following methods\n"
             . "(prototypes sorted aplhabetically):\n\n";

    foreach (sort @expected) {
        print FOUT "$_\n";
    }
    ##}}}

    # If there are some details for the translators, show them.  #{{{
    #
    if ($output !~ m/^\s*$/) {
        print FOUT "\n\n" .'=' x 70 . "\n";
        print FOUT "Details related to specific translator classes follow.\n";

        print FOUT $output . "\n";
    }
    ##}}}

    # Close the output file
    #
    close FOUT;

    # Generate the language.doc file.  
    #
    $fout = "$docdir/$flangdoc";
    
    # Open it first for the output.
    #
    open(FOUT, "> $fout") or die "\nError when open > $fout: $!";

    print FOUT GenerateLanguageDoc(\%cb);

    # Close the output file
    #
    close FOUT;

    
    exit 0;
}
# end of body
################################################################