#!/usr/bin/perl -w
use strict;
use XML::Parser;

die "Usage: gtk2-perl-connect-signals perlprogram gladefile\n"
    unless ($#ARGV == 1);

my ($p, $prog, @handlers);

sub handle_start 
{
    my ($p, $element, %attr) = @_;

    if ($element eq 'signal' && defined($attr{'handler'}))
    {
	if ($prog !~ /\n[\ \t]*sub\s+$attr{'handler'}\W/xs)
	{
	    push @handlers, $attr{'handler'};
	}
    }
}
$p = new XML::Parser(Handlers => {Start => \&handle_start});

open(I, $ARGV[0])
    || die "Unable to open $ARGV[0] for reading\n";
$prog = join('', <I>);
close I;

$p->parsefile($ARGV[1]);

if (!@handlers)
{
    print "No changes\n";
    exit;
}
my ($stubs);

$stubs = join("\n", 
	      map { "sub $_\n{\n\tprint \"called $_: \".join(', ', \@_).\"\\n\";\n}\n" }
	      @handlers);

if ($prog =~ s/(.*\npackage\s+main\s*;\s*?\n)/$1$stubs/xs) {}
elsif ($prog =~ s/(.*\nuse\s+.*?\;\s*?\n)/$1$stubs/xs) {}
elsif ($prog =~ s/(\#\!.*?\n)/$1$stubs/xs) {}
else
{
    $prog =~ s/^/$stubs/xs;
}

rename($ARGV[0], "$ARGV[0].bak")
    || die "Unable to rename $ARGV[0] to $ARGV[0].bak\n";
open(O, ">$ARGV[0]")
    || die "Unable to open $ARGV[0] for writing\n";
print O $prog;
close O;
system ("chmod +x $ARGV[0]"); # system to preserve umask