src/test/regress/gpsourcify.pl

#!/usr/bin/env perl
#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing,
# software distributed under the License is distributed on an
# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, either express or implied.  See the License for the
# specific language governing permissions and limitations
# under the License.
#
#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing,
# software distributed under the License is distributed on an
# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, either express or implied.  See the License for the
# specific language governing permissions and limitations
# under the License.
#
use Pod::Usage;
use Getopt::Long;
use strict;
use warnings;
use POSIX;
use File::Spec;
use Env;
use Data::Dumper;

=head1 NAME

B<gpsourcify.pl> - GreenPlum reverse string substitution 

=head1 SYNOPSIS

B<gpsourcify.pl> filename

Options:

    -help            brief help message
    -man             full documentation
    -token_file      (optional) file with list of tokens and 
                     replacement values (gptokencheck by default)
    -dlsuffix        if flag is set, replace DLSUFFIX (false by default)

=head1 OPTIONS

=over 8

=item B<-help>

    Print a brief help message and exits.

=item B<-man>
    
    Prints the manual page and exits.

=item B<-token_file> (optional: gptokencheck by default)

    File which contains a list of token/value pairs.  If a filename is
    not specified, gpsourcify looks for gptokencheck.out under
    $PWD/results. 

=item B<-dlsuffix> (false by default)

    Because the DLSUFFIX is so small (".so" on unix), there is the
    potential for erroneous replacement.  Only replace if -dlsuffix is
    specified.  Do not replace by default, or if -nodlsuffix is specified.

=back

=head1 DESCRIPTION

gpsourcify reads a pg_regress ".out" file as input and rewrites it to
stdout, replacing certain local or environmental values with portable
tokens.  The output is a candidate for a pg_regress ".source" file.
gpsourcify is the complement to the gpstringsubs and pg_regress
"convert_sourcefiles_in" functions.  

=head1 CAVEATS/LIMITATIONS

In general, gpsourcify always replaces the longest string values
first, so you don't have to worry about some type of string
replacement collision.  However, if abs_srcdir and abs_builddir are
identical values (like on unix), gpsourcify uses the heuristic that
source directory references are less common, and usually followed by
"/data".  This may not do what you want.

=head1 AUTHORS

Apache HAWQ

Address bug reports and comments to: dev@hawq.incubator.apache.org

=cut

    my $glob_id = "";

my $glob_token_file;
my $glob_dlsuffix;

BEGIN {
    my $man  = 0;
    my $help = 0;
    my $tokenf = '';
    my $dlsuf = ''; # negatable, ie -dlsuffix or -nodlsuffix

    GetOptions(
               'help|?' => \$help, man => \$man,
               'dlsuffix!' => \$dlsuf,
               'token_file:s' => \$tokenf
               )
        or pod2usage(2);


    pod2usage(-msg => $glob_id, -exitstatus => 1) if $help;
    pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $man;

    $glob_dlsuffix = $dlsuf;
    $glob_token_file = length($tokenf) ? $tokenf : "results/gptokencheck.out";

    unless (-f $glob_token_file)
    {
		if (length($tokenf))
		{
			warn("ERROR: Cannot find specified token file: $glob_token_file");
		}
		else
		{
			warn("ERROR: Need to run test gptokencheck to generate token file:\n\n\tmake installcheck-good TT=gptokencheck\n\n");
		}

        $glob_id = "ERROR - invalid file: $glob_token_file\n";
        pod2usage(-msg => $glob_id, -exitstatus => 1, -verbose => 0);
    }
#    print "loading...\n";                                                     
}


sub LoadTokens
{
    my $fil = shift;

    return undef
        unless (defined($fil) && (-f $fil));

    my $ini = `grep 'is_transformed_to' $fil`;

    $ini =~ s/^\-\-\s+//gm;

#    print $ini;

    my @foo = split(/\n/, $ini);

    my $bigh = {};

    for my $kv (@foo)
    {
        my @baz = split(/\s*\#is\_transformed\_to\#\s*/, $kv, 2);
        
        if (2 == scalar(@baz))
        {
            $bigh->{$baz[0]} = quotemeta($baz[1]);
        }

    }

#    print Data::Dumper->Dump([$bigh]);

    return $bigh;
}


if (1)
{
    my $bigh = LoadTokens($glob_token_file);
    exit(0) unless (defined($bigh));

    # make an array of the token names (keys), sorted descending by
    # the length of of the replacement value.
    my @sortlen;
    @sortlen = 
        sort {length($bigh->{$b}) <=> length($bigh->{$a})} keys %{$bigh};

    my $src_eq_build = 0;
        
    if (exists($bigh->{abs_srcdir})
        && exists($bigh->{abs_builddir}))
    {
        # see if build directory and source directory are the same...
        $src_eq_build = ($bigh->{abs_srcdir} eq $bigh->{abs_builddir});

    }

#    print Data::Dumper->Dump(\@sortlen);

    while (<>)
    {
        my $ini = $_;

        for my $kk (@sortlen)
        {
            my $vv = $bigh->{$kk};
            my $k2 = '@' . $kk . '@';

            if ($kk =~ m/^(perl_osname|gpuname_p|gpisainfo|number_of_segs)$/i)
            {
                # these tokens are for gpexclude, not general test output
                next;
            }

            if ($kk =~ m/DLSUFFIX/ && !$glob_dlsuffix)
            {
                # ignore if -nodlsuffix
                next;
            }

            if (($kk =~ m/abs_srcdir/) && $src_eq_build)
            {
                my $v2 = $vv . "/data";
                my $k3 = $k2 . "/data";
                # replace the srcdir only if followed by "/data"
                $ini =~ s/$v2/$k3/g;  
				# or "include/catalog"
                my $v3 = $vv . "/../../include/catalog";
                my $k4 = $k2 . "/../../include/catalog";
                $ini =~ s/$v3/$k4/g;  
            }
            elsif (($kk =~ m/abs_builddir/) && $src_eq_build)
            {
				my $regex1 =
					"/data" . "|" .
					"/../../include/catalog";

                # replace buildir if not followed by "/data" 
				# or "include/catalog"
                # (negative look-ahead)
                $ini =~ 
					s/$vv(?!($regex1))/$k2/g;
            }
            else
            {
                $ini =~ s/$vv/$k2/g;
            }

        }

        print $ini;

    }
   
    exit(0);
}