view release on metacpan or  search on metacpan

lib/C/Utility.pm  view on Meta::CPAN

package C::Utility;
use warnings;
use strict;
use File::Spec;
use Carp;
use File::Versions 'make_backup';
use File::Slurper qw/read_text write_text/;
use C::Tokenize qw/$comment_re $include $reserved_re/;
use Text::LineNumber;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT_OK = qw/
		       add_lines
		       brute_force_line
		       c_string
		       c_to_h_name
		       ch_files
		       convert_to_c_string
		       convert_to_c_string_pc
		       escape_string
		       hash_to_c_file
		       line_directive
		       linein 
		       lineout
		       print_bottom_h_wrapper
		       print_top_h_wrapper
		       read_includes
		       remove_quotes
		       stamp_file
		       valid_c_variable
		   /;

our %EXPORT_TAGS = (
    'all' => \@EXPORT_OK,
);

our $VERSION = '0.012';

sub convert_to_c_string
{
    my ($text) = @_;
    if (length ($text) == 0) {
        return "\"\"";
    }
    # Convert backslashes to double backslashes.
    $text =~ s/\\/\\\\/g;
    # Escape double quotes
    $text = escape_string ($text);
    # If there was a backslash before a quote, as in \", the first
    # regex above converted it to \\", and then escape_string
    # converted that to \\\".
    $text =~ s/\\\\"/\\"/g;
    # Remove backslashes from before the @ symbol.
    $text =~ s/\\\@/@/g;
    # Turn each line into a string
    $text =~ s/(.*)\n/"$1\\n"\n/gm;
    # Catch a final line without any \n at its end.
    if ($text !~ /\\n\"$/) {
	$text =~ s/(.+)$/"$1"/g;
    }
    return $text;
}

sub c_string
{
    goto & convert_to_c_string;
}

sub ch_files
{
    my ($c_file_name) = @_;
    if ($c_file_name !~ /\.c/) {
       die "$c_file_name is not a C file name";
    }
    my $h_file_name = $c_file_name;
    $h_file_name =~ s/\.c$/\.h/;
    if (-f $c_file_name) {
	make_backup ($c_file_name);
    }
    if (-f $h_file_name) {
	make_backup ($h_file_name);
    }
    return $h_file_name;
}

sub convert_to_c_string_pc
{
    my ($text) = @_;
    $text =~ s/%/%%/g;
    return convert_to_c_string ($text);
}

sub escape_string
{
    my ($text) = @_;
    $text =~ s/\"/\\\"/g;
    return $text;
}

sub c_to_h_name
{
    my ($c_file_name) = @_;
    if ($c_file_name !~ /\.c/) {
	die "$c_file_name is not a C file name";
    }
    my $h_file_name = $c_file_name;
    $h_file_name =~ s/\.c$/\.h/;
    return $h_file_name;
}

sub valid_c_variable
{
    my ($variable_name) = @_;
    if ($variable_name !~ /^[A-Za-z_][A-Za-z_0-9]+$/ ||
	$variable_name =~ /^(?:$reserved_re)$/) {
	return;
    }
    return 1;
}

# Wrapper name
# BKB 2009-10-05 14:09:41

sub wrapper_name
{
    my ($string) = @_;
    $string =~ s/[.-]/_/g;
    if (! valid_c_variable ($string)) {
        croak "Bad string for wrapper '$string'";
    }
    my $wrapper_name = uc $string;
    return $wrapper_name;
}

sub print_top_h_wrapper
{
    my ($fh, $file_name) = @_;
    
    my $wrapper_name = wrapper_name ($file_name);
    my $wrapper = <<EOF;
#ifndef $wrapper_name