#!/usr/bin/perl -w

# $Id: pod_merge.PL,v 1.5 2002/12/13 01:35:27 m_ilya Exp $

use 5.006;

use strict;

use File::Find;
use File::Spec;

use lib qw(lib);
use HTTP::WebTest::SelfTest;

my ($sourcedir, $in_file, $out_file) = @ARGV;

my $plugin_dir = File::Spec->catdir($sourcedir, qw(HTTP WebTest Plugin));

# get list of plugins
my @plugins = (File::Spec->catfile($sourcedir, qw(HTTP WebTest ReportPlugin.pm)));
find({ no_chdir => 1,
       wanted   => sub {
	   return unless -f and /\.pm$/;
	   push @plugins, $_;
       } },
    $plugin_dir);
# this is not a plugin but we need its TEST PARAMETERS section anyway
push @plugins, File::Spec->catfile($sourcedir, qw(HTTP WebTest.pm.in));

my $merged_data = <<WARNING;
# WARNING: This file is autogenerated from following files:
#
WARNING

for my $file (sort $in_file, @plugins) {
    $merged_data .= <<WARNING;
#            $file
WARNING
}

$merged_data .= <<WARNING;
#
# Do not modify this file but edit those files. All changes in this
# file will be lost.


WARNING

$merged_data .= read_file($in_file);

# strip CVS ID mark - it caused some minor pain for me
$merged_data =~ s/\n# \$Id.*//;

# find all TEST PARAMETERS sections
my %sections = ();
$sections{params} = '';
for my $plugin (@plugins) {
    my $core_params = file_scan($plugin, 'params');
    my $opt_params  = mark_non_core(file_scan($plugin, 'opt_params'));
    $sections{params} .= $core_params;
    $sections{params} .= $opt_params;
}

# sort content of sections
my @sections = map "=head2$_",
               grep /\S/,
               split '=head2', $sections{params};
s/\s*$/\n\n/ for @sections;
@sections = map $_->[1],
            sort { $a->[0] cmp $b->[0] }
            map { my($name) = $_ =~ /=head2\s+([a-z_]+)/; [ $name => $_ ] }
            @sections;
$sections{params} = join '', @sections;

# replace sections in out file
for my $type (qw(params)) {
    my $regex = section_replace_re($type);
    $merged_data =~ s/$regex/$sections{$type}/xs;
}

write_file($out_file, $merged_data);

# retrieves section of specified type from file
sub file_scan {
    my $file = shift;
    my $type = shift;

    my $data = read_file($file);

    my $regex = section_copy_re($type);
    my $section = join '', $data =~ /$regex/g;

    my($package) = $data =~ /package \s+ ( \w+ (?: :: \w+)* )/gx;

    return wantarray ? ($section, $package) : $section;
}

# returns regexps which gets content between =for pod_merge copy
# and =cut
sub section_copy_re {
    my $type = shift;
    my $regex = qr/\n
                   =for\ pod_merge\ copy\ \Q$type\E
                   (.*?) # content of the section
                   \n =cut  # find the end of section
                  /sx;

    return $regex;
}

# returns regexp which can be used to replace everthing between =for
# pod_merge replace and =cut
sub section_replace_re {
    my $type = shift;
    my $regex = qr/(?<= \n)
                   =for\ pod_merge\ replace\ \Q$type\E
                   (?: .*?)  # content of the section
                   (?= \n =cut) # find the end of section
                  /sx;

    return $regex;
}

# adds NON-CORE PARAMETER line to parameter definition
sub mark_non_core {
    my $sec = shift;
    my $package = shift;
    $sec =~ s/(?<= \n)
              (=head2 \s+ \w+ \s*? \n)
             /$1\nI<NON-CORE PARAMETER> from L<$package>\n/gsx;
    return $sec;
}