#!/usr/local/bin/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 docblocks that precede statements matching
    a defined pattern in the given list of files. Each file is modified in place,
    so be sure to have a committed files to the repository (or have other backup)
    before running.

    OPTIONS:
        --help                  # display this message
        --dryrun                # don't modify, just print to screen
        --statement <regexp>    # default is '^\\s* class\\s \\w+Test\\b'
        --tag <string>          # default is '\@internal'

    NOTES:
        To avoid duplication, docblocks with existing tag <string> are ignored.
        Whitespace in statement <regexp> is ignored (but quote on command line).

    EXAMPLE:
        $script --statement '^\\s* private' --tag '\@internal' file1.php file2.php

END_USAGE

# Command line options
my $help;
my $dryrun;
my $regexp = '^\s* class\s+ \w+Test\b';
my $tag = '@internal';

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

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

# Set up regular expressions
my $statement = qr{ $regexp }xm;
my $docstart = qr{ ^\s* [/][*]{2} }xm;
my $docend = qr{ ^\s* [*][/] \s* $}xm;
my $docblock = qr{
    (?<before>
        ^\s* [/][*]{2} \s*\n
        (?: \s* [*] .* \n)* )
        (?<after> (?<indent>\s*) [*][/] \s* \n
        $statement )
    }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;
    }

    # say where we're at
    print "$file\n";

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

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

    # process file
    while (<$fh>) {
        if (/$docstart/) {
            $buffer = $_;
            while (<$fh>) {
                $buffer .= $_;
                if (!/^ \s* [*]/x) {
                    if ($buffer !~ /$tag/ && $buffer =~ /$docblock/) {
                        my $insert = "$+{indent}*\n$+{indent}* $tag\n";
                        $buffer =~ s/$docblock/$+{before}$insert$+{after}/;
                    }
                    $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();
    }
}