1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
#!/usr/bin/perl -w
# Copyright (c) 2002 Mattia Barbon.
# Copyright (c) 2002 Audrey 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__\r?\n).*)//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:
|
