The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;
use Module::Metadata ();
use Perl::Tidy       ();
use File::Spec       ();
use FindBin qw{ $Bin };

# check if perltidyrc file exists
my $perltidyrc = File::Spec->catfile( $Bin, 'perltidyrc' );
die "cannot find perltidy configuration file: $perltidyrc\n"
  unless -e $perltidyrc;

my $filename     = "$Bin/../wx-scintilla/src/scintilla/include/Scintilla.iface";
my $constants_pm = "$Bin/../lib/Wx/Scintilla/Constant.pm";
my $scintilla_pm = "$Bin/../lib/Wx/Scintilla.pm";

# Find the version from Scintilla.pm
my $scintilla = Module::Metadata->new_from_file($scintilla_pm);
my $version   = $scintilla->version('Wx::Scintilla');
unless ($version) {
    die "Failed to find Wx::Scintilla \$VERSION";
}

# Parse the iface file
print "Parsing $filename\n";
open my $fh, $filename or die "Cannot open $filename\n";
my $source      = '';
my $doc_comment = undef;
my $pod         = '';
my @constants   = ();
while ( my $line = <$fh> ) {
    if ( $line =~ /^\s*$/ ) {

        # Empty line separator
        $doc_comment = undef;
        $source .= "\n";
    }
    elsif ( $line =~ /^##/ ) {

        # ignore pure comments
    }
    elsif ( $line =~ /^(get|fun)/ ) {

        # Ignore documentation comment for functions
        $doc_comment = undef;
    }
    elsif ( $line =~ /^(#.+?)$/ ) {

        # Store documentation comments
        $doc_comment .= "$1\n";

    }
    elsif ( $line =~ /^\s*enu\s+(\w+)\s*=\s*(\w+)\s*$/ ) {

        # Enumeration
        $doc_comment = "# $1 enumeration\n";

    }
    elsif ( $line =~ /^\s*val\s+(\w+)\s*=(.+?)\s*$/ ) {
        if ( defined $doc_comment ) {
            if ( $doc_comment =~ /#\s+(Lexical state(s)? for (?:.+))$/ ) {
                $pod .= "\n=head2 $1\n\n";
            }
            elsif ( $doc_comment =~ /#\s(\S+\s(?:enumeration))/ ) {
                $pod .= "\n=head2 $1\n\n";
            }
            else {
                my $pod_comment = $doc_comment;
                $pod_comment =~ s/\s*#\s+//g;
                $pod .= "\n$pod_comment\n";
            }

            $source .= $doc_comment if defined $doc_comment;
            $doc_comment = undef;
        }
        $source .= "\t$1 => $2,\n";
        push @constants, $1;
        $pod .= sprintf( "\t%-30s (%s)\n", $1, $2 );
    }
}
close $fh;

my $exported_constants = join "\n", map { "    $_" } @constants;
$source = <<"CODE" . $source;
package Wx::Scintilla::Constant;

##
## Warning: This file is autogenerated from Scintilla.iface
## PLEASE DO NOT EDIT
##

use 5.008;
use strict;
use warnings;

require Exporter;
our \$VERSION = '$version';
our \@ISA     = 'Exporter';
our \@EXPORT  = qw(
$exported_constants
);

use constant {
CODE

$source .= <<"POD";
};

1;

__END__

=pod

=head1 NAME

Wx::Scintilla::Constant - A list of Wx::Scintilla constants

=head1 DESCRIPTION

This is a list of auto-generated constants from Scintilla.iface.

=head1 CONSTANTS

$pod

=head1 AUTHOR

Ahmad M. Zawawi <ahmad.zawawi\@gmail.com>

=head1 COPYRIGHT

Copyright 2011 Ahmad M. Zawawi.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=cut
POD

print "Perl tidy output in memory\n";
my $output = '';
Perl::Tidy::perltidy(
    source      => \$source,
    destination => \$output,
    argv        => "--profile=$perltidyrc",
);

print "Writing to $constants_pm\n";
open my $constants_fh, '>', $constants_pm
  or die "Cannot open $constants_pm\n";
binmode $constants_fh;
print $constants_fh $output;
close $constants_fh;