#!/usr/bin/env perl
#
# contributed by //www.drupal.org/u/jfmacdonald
###############################################

require 5.14.1;

use strict;
use warnings;
use English;

use Getopt::Long;
use IO::File;

my $script = $0;
$script =~ s{ .* [/] ([^\s\/]*) }{$1}x;

my $usage = <<"END_USAGE";

usage: $script [options] file . . .

    Insert tag at the end of each docblock that precede test classes defined
    in the given list of files. A class is deemed to be a test if its name
    matches the pattern *Test and its docblock contains a \@group directive. 
    Each file is modified in place.

    OPTIONS:
        --help                  # display this message
        --dryrun                # don't modify, just print to screen
        --tag <string>          # default is '\@internal'

    NOTES:
        To avoid duplication, docblocks with existing tag <string> are ignored.

    EXAMPLE:
        $script --tag '\@internal' file1.php file2.php

END_USAGE

# Command line options
my $help;
my $dryrun;
my $tag = '@internal';

# Get the command line
GetOptions(
    'help'        => \$help,
    'dryrun'      => \$dryrun,
    'tag=s'       => \$tag
);
my @files = @ARGV;

# Provide usage if need help
if ($help || !@files) {
    print $usage;
    exit;
}

# Set up regular expressions
my $namespace_pattern = qr{ ^namespace \s+ ([^\s;]+) }x;
my $class_pattern = qr{ ^\s* class\s+ (?<class> \w*Test)\b }xm;
my $docstart_pattern = qr{ ^\s* [/][*]{2} }xm;
my $docblock_pattern = qr{
    (?<before>
        ^\s* [/][*]{2} \s*\n
        (?: \s* [*] .* \n)*
        (?: \s* [*] \s* \@group .* \n)
        (?: \s* [*] .* \n)* 
        )?
        (?<after> (?<indent>\s*) [*][/] \s* \n
        $class_pattern )
    }xm;

# Process files
foreach my $file (@files) {

    # only process files
    next if !-e $file;

    # warn if not writable
    if (!-w $file) {
        warn "protected: $file\n";
        next;
    }

    # open file
    my $fh = IO::File->new();
    $fh->open("< $file");

    # buffers
    my $buffer = q();
    my $new_content = q();
    my $namespace = q();
    my $class = q();

    # process file
    while (<$fh>) {
        if ( /$namespace_pattern/) {
            $namespace = $1;
        }
        if (/$docstart_pattern/) {
            $buffer = $_;
            while (<$fh>) {
                $buffer .= $_;
                if (!/^ \s* [*]/x) {
                    if ($buffer !~ /$tag/ && $buffer =~ /$docblock_pattern/) {
                        my $insert = "$+{indent}*\n$+{indent}* $tag\n";
                        $class = $+{class};
                        $buffer =~ s/$docblock_pattern/$+{before}$insert$+{after}/;
                        print "$namespace\\$class\n" if !$dryrun;
                    }
                    $new_content .= $buffer;
                    $buffer = q();
                    last;
                }
            }
        }
        else {
            $new_content .= $_;
        }
    }
    $fh->close();

    if ($dryrun) {
        print "$new_content\n";
    }
    else {
        # write new content to same file
        $fh->open("> $file");
        $fh->print($new_content);
        $fh->close();
    }
}