#! /usr/bin/perl use strict; use lib 'lib'; use Benchmark qw(cmpthese); require Exporter::Easy; use vars; my $file_bms = { new => '', old => '', }; my $simple_bms = { old_simple => <<'EOM', our(@EXPORT) = qw(getservbyname getservbyport getservent getserv); our @ISA = ('Exporter'); EOM new_simple => <<'EOM', use Exporter::Easy( EXPORT => [qw(getservbyname getservbyport getservent getserv)], ); EOM }; my $vars_bms = { old_our_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); our ($s_name, @s_aliases, $s_port, $sx_proto); EOM old_use_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); use vars @EXPORT_OK; EOM old_grep_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); use vars grep /^\$/, @EXPORT_OK; EOM new_vars => <<'EOM', use Exporter::Easy( EXPORT => [qw(getservbyname getservbyport getservent getserv)], OK => [qw( $s_name @s_aliases $s_port $s_proto )], ALL => 'FIELDS', ); EOM }; my $no_vars_bms = { old_no_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); EOM new_no_vars => <<'EOM', use Exporter::Easy( EXPORT => [qw(getservbyname getservbyport getservent getserv)], OK => [qw( $s_name @s_aliases $s_port $s_proto )], ALL => 'FIELDS', VARS => 0, ); EOM }; my @bms = ( $file_bms, $vars_bms, $no_vars_bms, $simple_bms, ); my @comps; foreach my $bm (@bms) { foreach my $want_files ( '', # '_file' ) { my %comp; while (my ($name, $code) = (each %$bm)) { $comp{"$name$want_files"} = make_bm("$name$want_files", $code, $want_files); } push(@comps, \%comp); } } my $time = -2; foreach my $bm (@comps) { cmpthese($time, $bm); } sub make_bm { my ($name, $code, $want_files) = @_; my @files; if ($want_files) { @files = ('lib/Exporter.pm'); if ($name =~ /^new/) { push(@files, 'lib/Exporter/Easy.pm'); } else { } } my @file_code = map { "do '$_';" } @files; my $all_code = join("\n", @file_code, $code); eval $all_code; die "$all_code\n$@" if $@; # print "------------------$name----------------\n$all_code\n\n"; return sub { eval $all_code }; }