package Iurt::Config; use base qw(Exporter); use RPM4::Header; use Data::Dumper; use MDK::Common; use Iurt::Util qw(plog); use strict; use Sys::Hostname; use File::lockf; our @EXPORT = qw( config_usage config_init get_date get_maint get_date get_prefix get_author_email check_arch check_noarch get_package_prefix get_mandatory_arch get_target_arch %arch_comp ); our %arch_comp = ( 'i586' => { 'i386' => 1, 'i486' => 1, 'i586' => 1 }, 'i686' => { 'i386' => 1, 'i486' => 1, 'i586' => 1, 'i686' => 1 }, 'x86_64' => { 'x86_64' => 1 }, 'ppc' => { 'ppc' => 1 }, 'ppc64' => { 'ppc' => 1, 'ppc64' => 1 }, 'armv5tejl' => { 'armv5tl' => 1 }, 'armv5tel' => { 'armv5tl' => 1 }, 'armv5tl' => { 'armv5tl' => 1 }, 'armv7l' => { 'armv5tl' => 1, 'armv7hl' => 1, 'armv7hnl' => 1 }, ); =head2 config_usage($config_usage, $config) Create an instance of a class at runtime. I<$config_usage> is the configuration help, I<%config> is the current configuration values Return true. =cut sub config_usage { my ($config_usage, $config) = @_; print "\nIurt configuration keywords:\n\n"; $Data::Dumper::Indent = 0; $Data::Dumper::Terse = 1; foreach my $k (sort keys %$config_usage) { print " $k: $config_usage->{$k}{desc}\n\t\tdefault: ", Data::Dumper->Dump([ $config_usage->{$k}{default} ]), ", current: ", Data::Dumper->Dump([ $config->{$k} ]), "\n"; } print "\n\n"; } =head2 config_init($config_usage, $config, $run) Create an instance of a class at runtime. I<$config_usage> is the configuration help, I<%config> is the current configuration values I<%run> is the current running options Return true. =cut sub config_init { my ($config_usage, $config, $run) = @_; foreach my $k (keys %$config_usage) { ref $config_usage->{$k}{default} eq 'CODE' and next; if (defined($run->{config}{$k})) { $config->{$k} = $run->{config}{$k}; } elsif (!defined($config->{$k})) { $config->{$k} = $config_usage->{$k}{default}; } } # warly 20061107 # we need to have all the default initialised before calling functions, so this # cannot be done in the same loop foreach my $k (keys %$config_usage) { ref $config_usage->{$k}{default} eq 'CODE' or next; my $a = $config_usage->{$k}{default}($config, $run); if (defined($run->{config}{$k})) { $config->{$k} = $run->{config}{$k}; } elsif (!defined($config->{$k})) { $config->{$k} = $a; } } } =head2 get_date($shift) Create a string based on the current date and time I<$shift> number of second to shift the date Return date-time and date =cut sub get_date { my ($o_shift) = @_; my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(time() - $o_shift); $year += 1900; my $fulldate = sprintf "%4d%02d%02d%02d%02d%02d", $year, $mon+1, $mday, $hour, $min, $sec; my $daydate = sprintf "%4d%02d%02d", $year, $mon+1, $mday; $fulldate, $daydate; } sub get_prefix { my ($luser) = @_; my $hostname = hostname(); my ($fulldate) = get_date(); my ($host) = $hostname =~ /([^.]*)/; join('.', $fulldate, $luser, $host, $$) . '_'; } sub get_package_prefix { my ($rpm) = @_; my ($prefix1) = $rpm =~ /^(\d{14}\.\w+\.\w+\.\d+)_/; my ($prefix2) = $rpm =~ /^(\@\d+:)/; "$prefix1$prefix2"; } sub get_maint { my ($run, $srpm) = @_; my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.[^.]+$/; $srpm_name ||= $srpm; if ($run->{maint}{$srpm}) { return $run->{maint}{$srpm}, $srpm_name; } my $maint = `GET 'http://maintdb.mageia.org/$srpm_name'`; if ($?) { return 'NOT_FOUND'; } chomp $maint; $run->{maint}{$srpm} = $maint; $maint, $srpm_name; } sub get_author_email { my ($user) = @_; my $authoremail = $user . ' <' . $user . '>'; return $authoremail; } sub check_noarch { my ($rpm) = @_; my $hdr = RPM4::Header->new($rpm); # Stupid rpm doesn't return an empty list so we must check for (none) my ($build_archs) = $hdr->queryformat('%{BUILDARCHS}'); if ($build_archs ne '(none)') { ($build_archs) = $hdr->queryformat('[%{BUILDARCHS} ]'); my @list = split ' ', $build_archs; return 1 if member('noarch', @list); } return 0; } sub check_arch { my ($rpm, $arch) = @_; my $hdr = RPM4::Header->new($rpm); # Stupid rpm doesn't return an empty list so we must check for (none) my ($exclusive_arch) = $hdr->queryformat('%{EXCLUSIVEARCH}'); if ($exclusive_arch ne '(none)') { ($exclusive_arch) = $hdr->queryformat('[%{EXCLUSIVEARCH} ]'); my @list = split ' ', $exclusive_arch; return 0 unless member($arch, @list); } my ($exclude_arch) = $hdr->queryformat('[%{EXCLUDEARCH} ]'); if ($exclude_arch ne '(none)') { ($exclude_arch) = $hdr->queryformat('[%{EXCLUDEARCH} ]'); my @list = split ' ', $exclude_arch; return 0 if member($arch, @list); } return 1; } sub get_mandatory_arch { my ($config, $target) = @_; find { ref($_) eq 'ARRAY' } $config->{mandatory_arch}, (ref($config->{mandatory_arch}) eq 'HASH' ? ($config->{mandatory_arch}{$target}, $config->{mandatory_arch}{default}) : ()), []; } sub get_target_arch { my ($config, $target) = @_; find { ref($_) eq 'ARRAY' } $config->{arch}, (ref($config->{arch}) eq 'HASH' ? ($config->{arch}{$target}, $config->{arch}{default}) : ()), [ keys %{$config->{bot}} ]; } 1;