#!/usr/bin/perl -w
# $File: //member/autrijus/PAR/myldr/file2c.pl $ $Author: autrijus $
# $Revision: #19 $ $Change: 10967 $ $DateTime: 2004/07/02 09:01:03 $
#
# Copyright (c) 2002 Mattia Barbon.
# Copyright (c) 2002 Autrijus Tang.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use strict;
use FindBin;
use lib "$FindBin::Bin/../lib";
use File::Basename;
use PAR::Filter::PodStrip;

my $give_help = 0;
my $pl_file = shift;
my $c_file = shift;
my $c_var = shift;
my $long_literal = shift;
my $chunk_size = shift;

$give_help ||= ( !defined $pl_file or
                !defined $c_file or
                !defined $c_var );
$pl_file ||= '';
$c_file ||= '';
$give_help ||= !-e $pl_file;
if( $give_help ) {
  print <<EOT;
Usage: $0 file.pl file.c c_variable
EOT

  exit 1;
}

open IN, "< $pl_file" or die "open '$pl_file': $!";
open OUT, "> $c_file" or die "open '$c_file': $!";
binmode IN; binmode OUT;

# read perl file
undef $/;
my $pl_text = <IN>;
close IN;

PAR::Filter::PodStrip->new->apply(\$pl_text)
    if -e $pl_file and $pl_file =~ /\.p[lm]/i;

#  make a c-array

print OUT "const char * name_$c_var = \"" . basename($pl_file) . "\";\n";

if (!$chunk_size) {
    print_chunk($pl_text, '');
    print OUT "#define WRITE_$c_var(i) write(i, $c_var, (size_t)size_$c_var);\n";
}
else {
    my $chunk_count = int(length($pl_text) / $chunk_size) + 1;
    print OUT "unsigned long size_$c_var = " . length($pl_text) . ";\n";

    for (1 .. $chunk_count) {
	print_chunk( substr($pl_text, ($_ - 1) * $chunk_size, $chunk_size), "_$_" );
    }

    print OUT "#define WRITE_$c_var(i)";
    for (1 .. $chunk_count) {
	print OUT " write(i, ${c_var}_$_, (size_t)size_${c_var}_$_);";
    }
    print OUT "\n";
}
close OUT;

sub print_chunk {
    my $text = reverse($_[0]);
    my $suffix = $_[1];

    print OUT "unsigned long size_$c_var$suffix = " . length($text) . ";\n";
    print OUT "const char $c_var$suffix\[" . (length($text) + 1) . "] = ";
    print OUT $long_literal ? '"' : '{';

    my $i;
    for (1 .. length($text)) {
	if ($long_literal) {
	    print OUT sprintf '\%03o', ord(chop($text));
	}
	else {
	    print OUT sprintf "'\\%03o',", ord(chop($text));
	    print OUT "\n" unless $i++ % 16;
	}
    }

    print OUT $long_literal ? "\";\n" : "0\n};\n";
}

sub pod_strip {
    my ($pl_text, $filename) = @_;

    local $^W;

    my $data = '';
    $data = $1 if $pl_text =~ s/((?:^__DATA__$).*)//ms;

    my $line = 1;
    if ($pl_text =~ /^=(?:head\d|pod|begin|item|over|for|back|end)\b/) {
        $pl_text = "\n$pl_text";
        $line--;
    }
    $pl_text =~ s{(
	(.*?\n)
	=(?:head\d|pod|begin|item|over|for|back|end)\b
	.*?\n
	(?:=cut[\t ]*[\r\n]*?|\Z)
	(\r?\n)?
    )}{
	my ($pre, $post) = ($2, $3);
        "$pre#line " . (
	    $line += ( () = ( $1 =~ /\n/g ) )
	) . $post;
    }gsex;
    $pl_text = '#line 1 "' . ($filename) . "\"\n" . $pl_text
        if length $filename;
    $pl_text =~ s/^#line 1 (.*\n)(#!.*\n)/$2#line 2 $1/g;

    return $pl_text . $data;
}

# local variables:
# mode: cperl
# end: