Skip to content

Commit 0bd6906

Browse files
alivraghialivraghi
authored
Merge pull request #7 from alivraghi/1.09
1.09 Sun Jul 26 04:47:10 2009
2 parents faf8975 + 137a313 commit 0bd6906

File tree

7 files changed

+147
-1187
lines changed

7 files changed

+147
-1187
lines changed

‎Changes

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,9 @@
11
Revision history for Perl extension PerlCryptLib
22
================================================
33

4+
1.09 Sun Jul 26 04:47:10 2009
5+
- Cryptlib header's translation has been reviewd
6+
47
1.08 Sat Mar 14 08:55:13 2009
58
- Fixed missing lines from cryptFinalizeComponents() in .pm
69

‎GenPerl.pl

Lines changed: 83 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,13 @@
3636

3737
use File::stat;
3838
use File::Basename;
39+
use Data::Dumper;
40+
#use Tie::IxHash;
3941

42+
my $C = "C\t";
43+
my $PERL = "PERL\t";
44+
45+
my $DEBUG = grep /^--debug$/, @ARGV; # print debug info on STDERR
4046
my $inFileName = shift @ARGV || 'cryptlib.h'; # default filename is "cryptlib.h"
4147
my %DEFINED = ( 1, 1, # ifdef 1 is to be included
4248
"USE_VENDOR_ALGOS", 0 ); # set to 1 to include #IFDEF USE_VENDOR_ALGOS
@@ -56,6 +62,21 @@
5662
print "Transforming \"$Infile\" into \"$Outfile\"\n";
5763
my $Default = select(OUTFILE);
5864

65+
print STDERR qq[
66+
${C}#include <stdio.h>
67+
${C}#include <stdlib.h>
68+
${C}#include "$Infile"
69+
${C}int main(void) {
70+
] if $DEBUG;
71+
72+
print STDERR qq[
73+
${PERL}#!/usr/bin/perl -W
74+
${PERL}use strict;
75+
${PERL}use warnings;
76+
${PERL}require "$Outfile";
77+
] if $DEBUG;
78+
79+
5980

6081
# Ignore all input lines before (and including) $Startline
6182
while (<INFILE>) {
@@ -163,7 +184,8 @@
163184

164185
# constant definitions
165186
#s/^\s*#define\s+(\w+)\s+(\w+|[+\-0-9]+|&H[0-9a-fA-F]+)/ Public Const $1 As Long = $2/;
166-
s/^\s*#define\s+(\w+)\s+(\w+|[+\-0-9]+|&H[0-9a-fA-F]+)/\tsub $1 { $2 }/;
187+
#s/^\s*#define\s+(\w+)\s+(\w+|[+\-0-9]+|&H[0-9a-fA-F]+)/\tsub $1 { $2 }/;
188+
s/^\s*#define\s+(\w+)\s+\(?\s*(\w+|[+\-0-9]+|&H[0-9a-fA-F]+)\s*\)?\s*/\tsub $1 { $2 }\n/;
167189

168190
# typedef struct
169191
if (s!^(\s*)typedef\s+struct\s*{([^}]*)}\s*(\w+)\s*;!&typelist(split(/;/,$2))!e) {
@@ -207,9 +229,18 @@
207229
}
208230
print PERLFooter();
209231

232+
print STDERR qq[
233+
${C}return 0;
234+
${C}}
235+
] if $DEBUG;
236+
237+
print STDERR qq[
238+
${PERL}exit(0);
239+
] if $DEBUG;
240+
210241
select($Default);
211242

212-
exit;
243+
exit 0;
213244

214245
# subroutine definitions follow:
215246

@@ -278,10 +309,14 @@ sub enums {
278309
if (m/(\w+)\s*=\s*(\d+).*$/) {
279310
# new value is being set, $index must be updated
280311
$_S .= " sub $1 { $2 }\n";
312+
print STDERR qq{${C}printf("$1: \%d\\n", $1);\n} if $DEBUG;
313+
print STDERR qq{${PERL}print "$1: ", \&$1(), "\\n";\n} if $DEBUG;
281314
eval($Index = $2+1);
282315
}
283316
else {
284317
$_S .= " sub $_ { ".$Index++." }\n";
318+
print STDERR qq{${C}printf("$_: \%d\\n", $_);\n} if $DEBUG;
319+
print STDERR qq{${PERL}print "$_: ", \&$_(), "\\n";\n} if $DEBUG;
285320
}
286321
}
287322
return $_S;
@@ -292,34 +327,58 @@ sub enumt {
292327
my $LINES = "";
293328
my $parval;
294329
my $lastValue = 0;
295-
foreach $parval (@_) {
296-
my ($val, $rem, $name, $value);
297-
$parval =~ s/^\s*(.*?)\s*$/$1/;
298-
($val, $rem) = split('#', $parval, 2);
299-
$val = '' unless $val;
300-
$val =~ s/^\s*(.*?)\s*$/$1/;
330+
#tie my %values, 'Tie::IxHash', ();
331+
my %values = ();
332+
my @lines = @_;
333+
foreach my $parval1 (@lines) {
334+
#my ($val, $rem, $name, $value);
335+
my ($val1, $rem) = split('#', $parval1, 2);
301336
$rem = '' unless $rem;
302337
$rem =~ s/^\s*(.*?)\s*$/$1/;
303-
if ( $val ne '' ) {
304-
($name, $value) = split('=', $val, 2);
305-
$name = '' unless $name;
306-
$name =~ s/^\s*(.*?)[\s\,]*$/$1/;
307-
$value = '' unless $value;
308-
$value =~ s/^\s*(.*?)[\s\,]*$/$1/;
309-
if ( $value eq '' || $value =~ /^\d/ ) {
310-
$value = $lastValue unless $value;
338+
$LINES .= ($rem ? "\t# $rem" : '') . "\n";
339+
$val1 = '' unless $val1;
340+
$val1 =~ s/^\s*(.*?)\s*$/$1/;
341+
next unless $val1;
342+
foreach $parval (split(',',$val1)) {
343+
last unless defined($parval);
344+
my ($val, $name, $value);
345+
($val = $parval) =~ s/^\s*(.*?)\s*$/$1/;
346+
#$val = '' unless $val;
347+
#$val =~ s/^\s*(.*?)\s*$/$1/;
348+
if ( $val ne '' ) {
349+
($name, $value) = split('=', $val, 2);
350+
$name = '' unless $name;
351+
$name =~ s/^\s*(.*?)[\s\,]*$/$1/;
352+
$value = '' unless $value;
353+
$value =~ s/^\s*(.*?)[\s\,]*$/$1/;
354+
if ( $value eq '' || $value =~ /^\d/ ) {
355+
$value = $lastValue unless $value;
356+
#$lastValue = $value + 1;
357+
} else {
358+
#$rem .= ' ==> ' . $value;
359+
#$lastValue =
360+
$value = eval( join(' ', map { exists($values{$_}) ? $values{$_} : $_ } split(/\s+/,$value)) );
361+
}
311362
$lastValue = $value + 1;
312363
}
313-
}
314-
if ( $name ) {
315-
foreach my $curname (split(',', $name)) {
316-
$curname =~ s/^\s*(.*?)\s*$/$1/;
317-
$LINES .= ($curname ? "\tsub $curname { $value }" : '') . ($rem ? "\t# $rem" : '') . "\n";
364+
if ( $name ) {
365+
#$lastValue = $value;
366+
foreach my $curname (split(',', $name)) {
367+
$curname =~ s/^\s*(.*?)\s*$/$1/;
368+
$values{$curname} = $value;
369+
#$LINES .= ($curname ? "\tsub $curname { $value }" : '') . ($rem ? "\t# $rem" : '') . "\n";
370+
$LINES .= ($curname ? "\tsub $curname { $value }" : '') . "\n";
371+
#++$lastValue;
372+
#print STDERR "$curname = $value\n";
373+
print STDERR qq{${C}printf("$curname: \%d\\n", $curname);\n} if $DEBUG;
374+
print STDERR qq{${PERL}print "$curname: ", \&${curname}(), "\\n";\n} if $DEBUG;
375+
}
376+
} else {
377+
#$LINES .= ($rem ? "\t# $rem" : '') . "\n";
318378
}
319-
} else {
320-
$LINES .= ($rem ? "\t# $rem" : '') . "\n";
321-
}
379+
}
322380
}
381+
#print STDERR Dumper(\%values);
323382
return $LINES;
324383
}
325384
# handle the lines of a "typedef struct { ... } structname"

‎Makefile.PL

Lines changed: 54 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -3,31 +3,30 @@ use ExtUtils::MakeMaker;
33
use Data::Dumper;
44
use File::Find;
55

6-
my @search_in = (
7-
'/usr/local/include'
8-
,'/usr/lib/gcc-lib'
9-
,'/usr/include'
10-
);
11-
push @search_in, $ENV{HOME} if defined($ENV{HOME});
6+
my @search_in = ( '/usr/local/include', '/usr/lib/gcc-lib', '/usr/include' );
7+
push @search_in, $ENV{HOME} if defined( $ENV{HOME} );
128

13-
my $CRYPT_LIB_HEADER = 'cryptlib.h';
9+
my $CRYPT_LIB_HEADER = 'cryptlib.h';
1410
my $PERL_CRYPT_LIB_HEADER = $ENV{PERL_CRYPT_LIB_HEADER};
1511

1612
unless ( defined $PERL_CRYPT_LIB_HEADER ) {
1713
print "Looking for '$CRYPT_LIB_HEADER', in:\n";
1814
print "\t- $_\n" foreach @search_in;
1915
print "Please wait... ";
20-
my @found = qx{find @search_in -type f -iname '$CRYPT_LIB_HEADER' 2>/dev/null};
16+
my @found =
17+
qx{find @search_in -type f -iname '$CRYPT_LIB_HEADER' 2>/dev/null};
2118
if ( scalar(@found) == 0 ) {
22-
print "NOT FOUND", "\n";
19+
print "NOT FOUND", "\n";
2320
print "$0 ABORTED!", "\n";
2421
print "\n";
25-
print "You need CryptLib source code distribution in order to build PerlCryptLib.", "\n";
22+
print
23+
"You need CryptLib source code distribution in order to build PerlCryptLib.",
24+
"\n";
2625
exit 1;
2726
}
28-
print "DONE", "\n";
27+
print "DONE", "\n";
2928
print "Found(ed):", "\n";
30-
my %found = ();
29+
my %found = ();
3130
my $recent = 0;
3231
foreach my $h (@found) {
3332
chomp $h;
@@ -39,6 +38,7 @@ unless ( defined $PERL_CRYPT_LIB_HEADER ) {
3938
print "\t", "(Ver. ", $1, ")";
4039
print "\n";
4140
}
41+
4242
# if ( scalar(@found) > 1 ) {
4343
# print "$0 ABORTED!", "\n";
4444
# print "\n";
@@ -56,60 +56,63 @@ unless ( defined $PERL_CRYPT_LIB_HEADER ) {
5656
}
5757

5858
print "Writing 'PerlCryptLib.ph', please wait... ";
59-
print qx{perl ./GenPerl.pl $PERL_CRYPT_LIB_HEADER ./PerlCryptLib.ph 1>/dev/null};
59+
print
60+
qx{perl ./GenPerl.pl $PERL_CRYPT_LIB_HEADER ./PerlCryptLib.ph 1>/dev/null};
6061
if ( $? != 0 ) {
6162
print "ERROR $?", "\n";
6263
exit 1;
6364
}
6465
print "OK", "\n";
6566

6667
WriteMakefile(
67-
'NAME' => 'PerlCryptLib'
68-
,'DISTNAME' => 'PerlCryptLib'
69-
,'VERSION_FROM' => 'PerlCryptLib.pm'
70-
,'PREREQ_PM' => { }
71-
,'PM' => {
72-
'PerlCryptLib.pm' => '$(INST_LIBDIR)/PerlCryptLib.pm'
73-
,'PerlCryptLib.ph' => '$(INST_LIBDIR)/PerlCryptLib.ph'
74-
}
75-
,(
76-
$] >= 5.005 ?
77-
(
78-
ABSTRACT => 'PerlCryptLib - Perl interface to Peter Guttman\'s cryptlib API'
79-
,AUTHOR => 'Alvaro Livraghi <perlcryptlib@gmail.com>'
80-
) :
81-
()
82-
),
83-
,'LIBS' => [ join(" ", map { "-L$_" } split ":", $ENV{LD_LIBRARY_PATH}) . ' -lresolv -lpthread -lcl' ]
84-
,'DEFINE' => "-DCRYPTLIB_H=\\\"$PERL_CRYPT_LIB_HEADER\\\""
85-
,'INC' => '-I.'
86-
,'clean' => {
87-
FILE => '*.ph .*_h'
88-
}
89-
,'realclean' => {
90-
FILES => '*.ph .*_h *.inc'
91-
}
68+
'NAME' => 'PerlCryptLib',
69+
'DISTNAME' => 'PerlCryptLib',
70+
'VERSION_FROM' => 'PerlCryptLib.pm',
71+
'PREREQ_PM' => {},
72+
'PM' => {
73+
'PerlCryptLib.pm' => '$(INST_LIBDIR)/PerlCryptLib.pm',
74+
'PerlCryptLib.ph' => '$(INST_LIBDIR)/PerlCryptLib.ph'
75+
},
76+
(
77+
$] >= 5.005
78+
? (
79+
ABSTRACT =>
80+
'PerlCryptLib - Perl interface to Peter Guttman\'s cryptlib API',
81+
AUTHOR => 'Alvaro Livraghi <perlcryptlib@gmail.com>'
82+
)
83+
: ()
84+
),
85+
,
86+
'LIBS' => [
87+
join( " ", map { "-L$_" } split ":", $ENV{LD_LIBRARY_PATH} )
88+
. ' -lresolv -lpthread -lcl'
89+
],
90+
'DEFINE' => "-DCRYPTLIB_H=\\\"$PERL_CRYPT_LIB_HEADER\\\"",
91+
'INC' => '-I.',
92+
'clean' => { FILE => '*.ph .*_h __debug*' },
93+
'realclean' => { FILES => '*.ph .*_h __debug* *.inc' }
9294
);
9395

94-
if (eval {require ExtUtils::Constant; 1}) {
96+
if ( eval { require ExtUtils::Constant; 1 } ) {
9597

9698
my @names = ();
97-
ExtUtils::Constant::WriteConstants (
98-
NAME => 'PerlCryptLib'
99-
,NAMES => \@names
100-
,DEFAULT_TYPE => 'IV'
101-
,C_FILE => 'const-c.inc'
102-
,XS_FILE => 'const-xs.inc'
103-
);
104-
print join("\n", @names), "\n";
99+
ExtUtils::Constant::WriteConstants(
100+
NAME => 'PerlCryptLib',
101+
NAMES => \@names,
102+
DEFAULT_TYPE => 'IV',
103+
C_FILE => 'const-c.inc',
104+
XS_FILE => 'const-xs.inc'
105+
);
106+
print join( "\n", @names ), "\n";
105107

106-
} else {
108+
}
109+
else {
107110

108111
use File::Copy;
109112
use File::Spec;
110-
foreach my $file ('const-c.inc', 'const-xs.inc') {
111-
my $fallback = File::Spec->catfile('fallback', $file);
112-
copy ($fallback, $file) or die "Can't copy $fallback to $file: $!";
113+
foreach my $file ( 'const-c.inc', 'const-xs.inc' ) {
114+
my $fallback = File::Spec->catfile( 'fallback', $file );
115+
copy( $fallback, $file ) or die "Can't copy $fallback to $file: $!";
113116
}
114117

115118
}

0 commit comments

Comments
 (0)