#!/usr/bin/env perl use strict; use warnings; =head1 DESCRIPTION emit Gears header files =head1 SYNOPSIS % sample.pl --interface list % sample.pl --impl single_linked_list --interface list % sample.pl -w --interface list =cut use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/; use Pod::Usage qw/pod2usage/; GetOptions( \my %opt, qw/ interface=s impl=s o=s w /) or pod2usage(1); unless ($opt{interface}) { pod2usage(1); } my ($type, $msg); if ($opt{impl}) { $msg = emit_impl_header($opt{interface}, $opt{impl}); $type = $opt{impl}; } else { $msg = emit_interface_header($opt{interface}); $type = $opt{interface}; } $msg .= emit_last($type); unless ($opt{w} || $opt{o}) { print $msg; exit 0; } my $emit_file; if ($opt{o}) { $emit_file = $opt{o}; } else { $emit_file = "$type.h" } open my $fh, '>', $emit_file; print $fh $msg; close $fh; sub emit_interface_header { my $interface_name = shift; return "typedef struct $interface_name {\n"; } sub emit_impl_header { my ($interface_name, $impl_name) = @_; return "typedef struct $impl_name impl $interface_name {\n"; } sub emit_last { my $type = shift; my $msg = " __code next(....);\n"; $msg .= "} $type;\n"; return $msg; }