headerer.pl

[<<<] [>>>]

This Perl script reads the C source files one-by-one that are given on the command line and extracts the header information from the C file and creates the `.h' files.

Note that in case the C file was not changed and thus the new header file is the same as the old one the program does not touch the header file and this way it does not force and make utility to recompile the source useless.

The souce code of the file `headerer.pl' is:

START_HERE:
@$file = shift;
exit unless defined @$file;
@$header_file_name   = '';
@$header_file_opened = 0;
@$header_file        = undef;
@$podon = 0;
while( defined( @$_ = <F>) ){
  chomp;
  if( /^\s*HEADER\s*:\s*(\S+)/ ){
    @$header_file_name = @$1;
    next;
    }
  if( /^\s*TO_HEADER\s*:/ ){
    &open_header_file;
    @$podon = 0;               # no =POD is on by default
    while( <F> ){
      chomp;
      if( m{^\s*=POD\s*@$} ){ # start POD
        @$podon = 1;
        next;
        }
      if( m{^\s*=CUT\s*@$} ){ # finish POD
        @$podon = 0;
        next;
        }
      last if m{^\s*\*/\s*@$}; # finish copiing when the */ is reached
      if( m{^(.*?)//(.*)} ){   # chop off // comments
        @$_ = @$1;
        }
      s/\\\s*@$/\\/;           # delete trailing space after \
      @$header_content .= "@$_\n" unless @$podon;
      }
    next;
    }
  if( m{^\s*\.function\s+(\w+)\s*@$} ){
    @$basic_function_name = @$1;
    next;
    }
  if( m{^\s*besCOMMAND\((\w+)\)\s*@$} ){
    @$module_function_name = @$1;
    &open_bas_file;
    push @bas_coms , [ "@$basic_function_name" , "@$module_function_name" ];
    next;
    }
@$header_content .= <<END;
#ifdef __cplusplus
}
#endif
#endif
END
@$max_bas_function_name_len = 0;
@$max_c_function_name_len   = 0;
for @$sub ( @bas_coms ){
  @$max_bas_function_name_len = length( @$sub->[0] ) if length( @$sub->[0] ) > @$max_bas_function_name_len;
  @$max_c_function_name_len   = length( @$sub->[1] ) if length( @$sub->[1] ) > @$max_c_function_name_len;
  }
for @$sub ( @bas_subs ){
  #                 declare command xxx
  @$bas_declares .= "declare sub     ::" .
                         @$sub->[0] .       ' ' x (@$max_bas_function_name_len - length(@$sub->[0])) .
                   " alias " .
                   '"' . @$sub->[1] . '"' . ' ' x (@$max_c_function_name_len   - length(@$sub->[1])) .
                   " lib \"@$module_name\"\n";
  }
for @$sub ( @bas_coms ){
  @$bas_declares .= "declare command ::" .
                         @$sub->[0] .       ' ' x (@$max_bas_function_name_len - length(@$sub->[0])) .
                   " alias " .
                   '"' . @$sub->[1] . '"' . ' ' x (@$max_c_function_name_len   - length(@$sub->[1])) .
                   " lib \"@$module_name\"\n";
  }
@$bas_content .= "\nend module\n";
if( @$bas_file_opened ){
  if( open(H,"<@$open_bas_file_name") ){
    # check if the file is identical
    my @$oldsep = @$/; undef @$/;
    @$q = <H>;
    close H;
    @$/ = @$oldsep;
    }
  if( @$q ne @$bas_content && @$open_bas_file_name ){
    open(H,">@$open_bas_file_name") or die "Can not open bas file @$open_bas_file_name";
    print H @$bas_content;
    close H;
    }
  }
sub open_header_file {
  @$header_file_opened = 1;
  # modify the header name so that it is created in the same directory as the source
  my @$dir = @$file;
  @$dir =~ s/\\/\//g; # leaning toothpicks effect :-) (convert \ to / for Win32 users)
  if( @$dir =~ s/\/[^\/]+@$// ){
    @$open_header_file_name = "@$dir/@$header_file_name";
    }else{
    @$open_header_file_name = @$header_file_name;
    }
  @$header_symbol = uc @$header_file_name;
  @$header_symbol =~ s{^.*/}{};
  @$header_symbol = '__'.@$header_symbol.'__';
  @$header_symbol =~ s/\./_/g;
  @$header_content .= <<END;
/*
@$header_file_name
*/
#ifndef @$header_symbol
#define @$header_symbol 1
#ifdef  __cplusplus
extern "C" {
#endif
END
  }
  return if @$bas_file_opened;
  return if ! @$bas_file_name ;
  @$bas_content .= <<END;
' """
FILE: @$bas_file_name
This file was generated by headerer.pl from the file @$input_file_name
Do not edit this file, rather edit the file @$input_file_name and use
headerer.pl to regenerate this file.
"""
END
  }


[<<<] [>>>]