#!/usr/bin/env perl

use strict;
use warnings;
use File::Basename;

my $source_data = q|
#include <stdio.h>

#include "%CLASS_AS_PREFIX%.h"

struct s_%CLASS%
{
    /* insert fields here */
};

%CLASS% *
%CLASS_AS_PREFIX%_new (void)
{
    %CLASS% *instance = (%CLASS% *) malloc (sizeof (%CLASS%));

    /* initialize other fields */

    return (instance);
}

void
%CLASS_AS_PREFIX%_destroy (void *ptr)
{
    %CLASS% *instance = (%CLASS% *) ptr;

    /* free other fields */

    free (instance);
}
|;

my $include_data = q|
#ifndef __%CLASS_AS_PREFIX_UPPER%_H__
#define __%CLASS_AS_PREFIX_UPPER%_H__

typedef struct s_%CLASS% %CLASS%;

%CLASS% * %CLASS_AS_PREFIX%_new (void);
void %CLASS_AS_PREFIX%_destroy (void *ptr);

#endif
|;

exit (main(@ARGV));

sub main
{
    my @argv = @_;

    if (!defined ($argv[0]))
    {
        print "usage: " . basename ($0) . " <class>\n";

        return (1);
    }

    my $class = $argv[0];

    my $class_prefix = get_class_prefix ($class);

    if (!-d "include" || !-d "src")
    {
        print "Error: This must be ran from a directory containing \"include\" and \"src\".\n";

        return (2);
    }

    my $include_file = "include/" . $class_prefix . ".h";
    my $src_file = "src/" . $class_prefix . ".c";

    if (-f $include_file || -f $src_file)
    {
        print "Error: Cannot overwrite existing files.\n";

        return (3);
    }

    open (FILE, "> $include_file") || die "$include_file: $^E";

    print FILE get_include ($class);

    close (FILE);

    open (FILE, "> $src_file") || die "$src_file: $^E";

    print FILE get_source ($class);

    close (FILE);

    return (0);
}

sub get_source($)
{
    my ($class) = @_;

    return (update_string_for_class ($class, $source_data));
}

sub get_include($)
{
    my ($class) = @_;

    return (update_string_for_class ($class, $include_data));
}

sub update_string_for_class ($$)
{
    my ($class, $data) = @_;

    my $class_as_prefix = &get_class_prefix ($class);

    my $class_as_prefix_upper = uc ($class_as_prefix);

    $data =~ s/%CLASS%/$class/g;
    $data =~ s/%CLASS_AS_PREFIX%/$class_as_prefix/g;
    $data =~ s/%CLASS_AS_PREFIX_UPPER%/$class_as_prefix_upper/g;

    return ($data);
}

sub get_class_prefix ($)
{
    my ($class) = @_;

    #(my $class_as_prefix = $class) =~ s/([A-Z]*)([A-Z])([^A-Z])/lc ($1) . "_" . lc ($2) . $3/eg;
    (my $class_as_prefix = $class) =~ s/([A-Z]*)([A-Z])([^A-Z])/\L$1_$2\E$3/g;

    $class_as_prefix =~ s/^_+//g;

    return ($class_as_prefix);
}
