App-CPANtoRPM
view release on metacpan or search on metacpan
lib/App/CPANtoRPM.pm view on Meta::CPAN
'_optimize' => '$RPM_OPT_FLAGS',
'_buildroot' => '$RPM_BUILD_ROOT',
},
1 => {
'_optimize' => '%{optimize}',
'_buildroot' => '%{buildroot}',
}
);
our ($OUTPUT,@OUTPUT,%package,$MAN);
$package{'VERSION'} = $VERSION;
my $old_locale = setlocale(LC_TIME);
setlocale(LC_TIME, "C");
$package{'date'} = POSIX::strftime("%a %b %d %Y",localtime());
setlocale(LC_TIME, $old_locale);
###############################################################################
###############################################################################
lib/App/CPANtoRPM.pm view on Meta::CPAN
sub _multiple_methods {
my($self,$test,@method) = @_;
my($testfunc,@args) = @$test;
$self->_log_indent(+1);
my(@print);
METHOD:
foreach my $method (@method) {
my($type,@tmp) = @$method;
@OUTPUT = ();
if ($type eq 'ignore') {
next METHOD;
} elsif ($type eq 'module') {
my ($module,$vers,$import_list,$eval_string);
if (ref($tmp[1])) {
($module,$import_list,$eval_string) = @tmp;
$vers = '';
lib/App/CPANtoRPM.pm view on Meta::CPAN
my $err = $self->_load_module($module,$vers,@$import_list);
if ($err) {
$self->_log_indent(+1);
push(@print,
$self->_log_message('INFO',"Failed to load module: $module"));
$self->_log_indent(-1);
next METHOD;
}
push(@OUTPUT,eval "$eval_string");
} elsif ($type eq 'system' ||
$type eq 'system-null') {
my($bin,$command,@args) = @tmp;
my $exe = $self->_find_exe($bin);
if (! $exe) {
push(@print,
$self->_log_message('INFO',"System command not found: $command"));
next METHOD;
lib/App/CPANtoRPM.pm view on Meta::CPAN
if (system($cmd) != 0) {
$self->_log_indent(+1);
push(@print,
$self->_log_message('INFO',"Failed system command: $cmd"));
$self->_log_indent(-1);
next METHOD;
}
if ($type eq 'system-null') {
@OUTPUT = ();
} else {
my $in = new IO::File;
$in->open("$TMPDIR/cmd.out");
my @out = <$in>;
$in->close();
chomp(@out);
@OUTPUT = @out;
}
} elsif ($type eq 'function') {
my($coderef,@args) = @$method;
my @out = &$coderef(@args);
chomp(@out);
@OUTPUT = @out;
}
if (&$testfunc(@args)) {
$self->_log_indent(-1);
return 1;
}
}
if (@print) {
$self->_log_message('NONE',@print);
lib/App/CPANtoRPM.pm view on Meta::CPAN
$self->_log_message('ERR',"Options file not readable: $file");
}
my $succ;
if ($file =~ /\.(yml|yaml)$/i) {
$succ = $self->_multiple_methods
( [ sub { 1; } ],
[ 'module', 'YAML::XS', [],
"my \@tmp = YAML::XS::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
[ 'module', 'YAML::Tiny', [],
"my \@tmp = YAML::Tiny::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
[ 'module', 'YAML', [],
"my \@tmp = YAML::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
[ 'module', 'YAML::Syck', [],
"my \@tmp = YAML::Syck::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
);
} elsif ($file =~ /\.json$/i) {
$succ = $self->_multiple_methods
( [ sub { 1; } ],
[ 'module', 'JSON::XS', ['decode_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = decode_json(\$json_text);" ],
[ 'module', 'JSON', ['from_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = from_json(\$json_text);" ],
[ 'module', 'JSON::PP', ['decode_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = decode_json(\$json_text);" ],
[ 'module', 'JSON::DWIW', ['from_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = from_json(\$json_text);" ],
);
} else {
$self->_log_message('ERR',"Options file must be YAML or JSON: $file");
}
if (! $succ) {
$self->_log_message('ERR',"Unable to read options file: $file");
}
return () if (! exists $OUTPUT->{$$self{'package'}});
my @opts;
foreach my $line (@{ $OUTPUT->{$$self{'package'}} }) {
if ($line =~ /^(.+?)(?:\s+|=)(.+?)\s*$/) {
push(@opts,$1,$2);
} else {
push(@opts,$line);
}
}
return @opts;
}
lib/App/CPANtoRPM.pm view on Meta::CPAN
# }
#
sub _get_filelist {
my($self,$dir) = @_;
$self->_log_message('INFO',"Listing package files");
my $succ = $self->_multiple_methods
( [ sub { 1; } ],
[ 'module','File::Find',['find'],
qq< find(sub { push(\@OUTPUT,\$File::Find::name) if (-f) },"$dir"); >
],
[ 'system','find',
"{find} '$dir' -type f" ]
);
my %files;
foreach my $file (@OUTPUT) {
$file =~ s,^$dir/,,;
next if (! $file);
$files{lc($file)}{$file} = 1;
}
return %files;
}
# This looks at the filelist determines which are pod files, which are
lib/App/CPANtoRPM.pm view on Meta::CPAN
my @tmp = keys %$filehash;
if (@tmp != 1) {
my $tmp = $tmp[0];
$self->_log_message
('WARN',
"Multiple '$tmp' files exist (with different cases).",
"This is not supported, so they will be ignored.");
return;
}
my $file = "$package{DIR}/$tmp[0]";
$OUTPUT = '';
$self->_log_message('INFO',"Reading META file: $tmp[0]");
my $succ;
if ($type eq 'json') {
$succ = $self->_multiple_methods
( [ sub { 1; } ],
[ 'module', 'Parse::CPAN::Meta', '1.41', [],
"\$OUTPUT = Parse::CPAN::Meta->load_file('$file')" ],
[ 'module', 'JSON', ['from_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = from_json(\$json_text);" ],
[ 'module', 'JSON::XS', ['decode_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = decode_json(\$json_text);" ],
[ 'module', 'JSON::PP', ['decode_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = decode_json(\$json_text);" ],
[ 'module', 'JSON::DWIW', ['from_json'],
"my \$fh; " .
"open \$fh,'<:utf8','$file'; " .
"my \$json_text = do { local \$/; <\$fh> }; " .
"\$OUTPUT = from_json(\$json_text);" ],
);
} else {
$succ = $self->_multiple_methods
( [ sub { 1; } ],
# [ 'module', 'Parse::CPAN::Meta', [],
# "\$OUTPUT = Parse::CPAN::Meta::LoadFile('$file')" ],
# [ 'module', 'CPAN::Meta::YAML', [],
# "my \$fh; " .
# "open \$fh,'<:utf8','$file'; " .
# "my \$yaml_text = do { local \$/; <\$fh> }; " .
# "my \$tmp = CPAN::Meta::YAML->read_string(\$yaml_text);" .
# "\$OUTPUT = \$tmp->[0]" ],
[ 'module', 'YAML', [],
"my \@tmp = YAML::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
[ 'module', 'YAML::Syck', [],
"my \@tmp = YAML::Syck::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
[ 'module', 'YAML::XS', [],
"my \@tmp = YAML::XS::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
[ 'module', 'YAML::Tiny', [],
"my \@tmp = YAML::Tiny::LoadFile('$file'); " .
"\$OUTPUT = \$tmp[0]" ],
);
}
if (! $succ) {
$self->_log_message('WARN',"Unable to read META file: $tmp[0]");
return;
}
if (! $OUTPUT) {
$self->_log_message('ERR',"META file empty or corrupt: $tmp[0]");
return;
}
# Now get the meta information:
foreach my $f (qw(name version keywords abstract description author provides)) {
$self->_get_meta_field($f,"m_$f");
}
# License information is stored in multiple places:
# license => VALUE
# license => [ VALUE, VALUE, ... ]
# resources => license => [ VALUE, VALUE, ... ]
# license_uri => VALUE
if (! $package{'m_license'}) {
my $lic = '';
if ($OUTPUT->{'license'}) {
my @lic;
if (ref($OUTPUT->{'license'})) {
@lic = @{ $OUTPUT->{'license'} };
} else {
@lic = ($OUTPUT->{'license'});
}
foreach my $l (@lic) {
if ($l =~ /^perl$/i ||
$l =~ /^perl_5$/i) {
$l="GPL+ or Artistic";
} elsif ($l =~ /^apache$/i) {
$l="Apache Software License";
} elsif ($l =~ /^artistic$/i) {
$l="Artistic";
lib/App/CPANtoRPM.pm view on Meta::CPAN
$l="Unknown license: $l";
$self->_log_message
('WARN',
"Unknown license: $l",
'Check to make sure this package is distributable.');
}
}
$lic = join(', ',@lic);
} elsif ($OUTPUT->{'resources'} &&
$OUTPUT->{'resources'}->{'license'}) {
$lic = join(' ',@{ $OUTPUT->{'resources'}->{'license'} });
} elsif ($OUTPUT->{'license_uri'}) {
$lic = $OUTPUT->{'license_uri'};
}
$package{'m_license'} = $lic if ($lic);
}
# Requires can come from an old-style META.yml file:
# requires => FEATURE => VERSION
# build_requires => FEATURE => VERSION
# configure_requires => FEATURE => VERSION
lib/App/CPANtoRPM.pm view on Meta::CPAN
# LEVEL => LEVEL = configure, build, test, runtime
# KEY => KEY = requires, recommends
# FEATURE => VERSION
#
# If we find prereqs in multiple files, we'll merge them
# (but we'll use the VERSION from the first file they're
# found in so we'll assume that we're examining the most
# accurate file first).
my %requires;
if ($OUTPUT->{'prereqs'}) {
my %lev = ( 'configure' => [ 'build' ],
'build' => [ 'build' ],
'test' => [ 'test' ],
'runtime' => [ 'build', 'runtime' ],
);
foreach my $lev (keys %lev) {
foreach my $t (@{ $lev{$lev} }) {
my @key = ('requires');
push(@key,'recommends')
if ( ($t eq 'build' && $$self{'build_rec'}) ||
($t eq 'test' && $$self{'test_rec'}) ||
($t eq 'runtime' && $$self{'runtime_rec'}) );
foreach my $key (@key) {
if ($OUTPUT->{'prereqs'}->{$lev} &&
$OUTPUT->{'prereqs'}->{$lev}->{$key}) {
foreach my $f (keys %{ $OUTPUT->{'prereqs'}->{$lev}->{$key} }) {
my $v = $OUTPUT->{'prereqs'}->{$lev}->{$key}->{$f};
$requires{$t}{$f} = $v;
}
}
}
}
}
} else {
# Requires
my %lev = ( 'configure_requires' => [ 'build' ],
'build_rquires' => [ 'build' ],
'requires' => [ 'build', 'runtime' ],
);
foreach my $lev (keys %lev) {
if ($OUTPUT->{$lev}) {
foreach my $f (keys %{ $OUTPUT->{$lev} }) {
my $v = $OUTPUT->{$lev}->{$f};
foreach my $t (@{ $lev{$lev} }) {
$requires{$t}{$f} = $v;
}
}
}
}
# Recommends
%lev = ( 'recommends' => [ 'build', 'runtime' ],
);
foreach my $lev (keys %lev) {
if ($OUTPUT->{$lev}) {
foreach my $f (keys %{ $OUTPUT->{$lev} }) {
my $v = $OUTPUT->{$lev}->{$f};
foreach my $t (@{ $lev{$lev} }) {
if ( ($t eq 'build' && $$self{'build_rec'}) ||
($t eq 'test' && $$self{'test_rec'}) ||
($t eq 'runtime' && $$self{'runtime_rec'}) ) {
$requires{$t}{$f} = $v;
}
}
}
}
lib/App/CPANtoRPM.pm view on Meta::CPAN
} else {
$package{'requires'} = \%requires;
}
}
sub _get_meta_field {
my($self,$meta_field,$pack_field) = @_;
return if ($package{$pack_field} ||
! exists $OUTPUT->{$meta_field});
$package{$pack_field} = $OUTPUT->{$meta_field};
# Strings containing newlines in the META.* files cause problems,
# so change them to spaces.
$package{$pack_field} =~ tr{\n}{ } if (! ref($OUTPUT->{$meta_field}));
}
# This will get the NAME, SUMMARY, and DESCRIPTION sections of a POD
# file. It will return () if it is not a valid POD file.
#
# This will use the following perl modules:
# Pod::Parser
# Pod::Simple::TextContent
#
sub _get_meta_pod {
lib/App/CPANtoRPM.pm view on Meta::CPAN
$package =~ m,^(.*/)?(.*)$,;
my $dir = $2;
if ($dir eq '.' || $dir eq '..') {
$self->_log_message('INFO',"Diretory name not specified. Assuming '.'");
my $succ = $self->_multiple_methods( [ sub { 1; } ],
['system','pwd',
"cd '$$self{file_path}'; {pwd}"],
);
if (! $succ || ! @OUTPUT) {
$self->_log_message('ERR',
"Unable to determine package directory: $package");
}
$package = $OUTPUT[0];
$package =~ m,^(.*/)?(.*)$,;
$dir = $2;
}
my ($dist,$vers);
if ($dir =~ /^(.+)\-(.+)$/) {
($dist,$vers) = ($1,$2);
} else {
$self->_log_message('ERR','Invalid directory name: $dir');
}
( run in 0.371 second using v1.01-cache-2.11-cpan-4e96b696675 )