Perl script to find destructors of all classes in a C++ directory and to report their visibility

destructors_reporter.pl

#!/usr/bin/perl
use File::Find;
use strict;

# Perl script to find destructors of all classes in a C++ directory, 
# and to report their visibility.
# Usage: run the script without argument in the source root directory.
# The script will find all .cpp, .h and .mm files in the file hierarchy.
# For each class or struct found, it displays 4 fields separated with tabulations:
# - the class name (can be an inner class)
# - the optional base classes, separated with commas
# - the destructor status: can be 'none', 'public', 'protected', 'private' or 'deleted'
# - the file name where the class is declared
# The output, when redirected to a file, can then be opened on a spreadsheet software.

my(@Strings);
find({ wanted => \&patchAFile, no_chdir => 1 }, '.');

sub patchAFile
{
	return unless -f;
	return unless(/\.(cpp|mm|h)$/);
	local $/;
	my $file = $_;
	open IN, $file;
	eval { 
		$_ = ReplaceProblematicSequences(<IN>);
		s/\$\d+ //og; # We don't need the special sequences
		s/\benum\s+class\b/enum/og; # avoid "enum class" that looks like a class
		FindClasses($_, "", $file);
	}; warn "$file: $@" if $@;
}

sub ReplaceProblematicSequences
{
	local $_ = shift;
	$_ .= "\n" unless (substr($_, -1) eq "\n");
	@Strings = ();
	my ($lastPos, $result);
	while(m!(#|//|/\*|'|"|R".*?\()!sog)
	{
		my $s = $1;
		my $pos1 = pos($_) - length($s);
		if($s eq '#')
			{ m/([^\n]*\\\s*\n)*[^\n]\s*\n/og; }
		elsif($s eq '//')
			{ m/.*?\n/og; }
		elsif($s eq '/*')
			{ m/.*?\*\//og; }
		elsif($s eq '"')
			{ m/("|[^\n]*?\\\\"|[^\n]*?[^\\]")/og; }
		elsif($s eq "'")
			{ m/([^\n]*?\\\\'|[^\n]*?[^\\]')/og; }
		elsif($s =~ m/^R"(.*)\(/)
		{ 
			my $delimiter = $1;
			m/.*\)$delimiter"/g; 
		}
		else
			{ die }
		my $pos2 = pos;
		$pos2-- if(substr($_, $pos2-1, 1) eq "\n");
		die "$pos1 $pos2" unless($pos2 > $pos1);
		
		push @Strings, substr($_, $pos1, $pos2-$pos1);
		$result .= substr($_, $lastPos, $pos1-$lastPos) . "\$$#Strings ";
		$lastPos = $pos2;
	}
	$result .= substr($_, $lastPos);
	return $result;
}

sub FindClasses
{
	local $_ = shift;
	my ($outer, $file) = @_;;
	while(/\b(class|struct)\s+(\w+)\s*(:[\w,\s]+)?(\{(?:[^{}]++|(?4))*\})\s*;/sog)
	{
		my($classKey, $className, $baseClasses, $body) = ($1, $2, $3, $4);
		$body = substr($body, 1, -1);
		FindClasses($body, $className.'::', $file); # Recursively find inner classes
		my $destructor = "none";
		$baseClasses =~ s/(public|protected|private|:|\s+)//sog;
		$body =~ s/(\{(?:[^{}]++|(?1))*\})/;/sog; # Remove blocks
		$body =~ s/::/__/og;
		$body =~ s/\b(private|protected|public)\s*:/\1;/og;
		my $privacy = $classKey eq "struct" ? "public" : "private";
		my @instructions = split(/;/, $body);
		for my $instr(@instructions)
		{
			local $_ = $instr;
			s/\b(virtual|override|const|volatile)\b//og; # Remove useless keywords
			s/\s+/ /sog; # Remove unnecessary white space...
			s/^ *//; 
			s/ *$//;
			s/ (\W)/\1/sog;
			s/(\W) /\1/sog;
			s/:.*//;
			if(/^(private|protected|public)$/)
				{ $privacy = $1; }
			if(/^\~$className\(\)(=(delete|default))?/)
			{
				$destructor = $privacy;
				$destructor = "deleted" if($2 eq "delete");
			}
		}
		print "$outer$className\t$baseClasses\t$destructor\t$file\n"; 
	}
}