summaryrefslogtreecommitdiffstats
path: root/files/pkgs.pm
diff options
context:
space:
mode:
Diffstat (limited to 'files/pkgs.pm')
-rw-r--r--files/pkgs.pm295
1 files changed, 0 insertions, 295 deletions
diff --git a/files/pkgs.pm b/files/pkgs.pm
deleted file mode 100644
index ed3da31..0000000
--- a/files/pkgs.pm
+++ /dev/null
@@ -1,295 +0,0 @@
-package pkgs;
-
-
-
-use common;
-use run_program;
-use detect_devices;
-use log;
-
-sub rpmsrate_rate_max() {
- 5; # also defined in perl-URPM
-}
-
-sub rpmsrate_rate_default() {
- detect_devices::need_light_desktop() ? 5 : 4;
-}
-
-sub read_rpmsrate_raw {
- my ($file) = @_;
- my $line_nb = 0;
- my $fatal_error;
- my (%flags, %rates, @need_to_copy);
- my (@l);
- local $_;
- foreach (cat_($file)) {
- $line_nb++;
- /\t/ and die "tabulations not allowed at line $line_nb\n";
- s/#.*//; # comments
-
- my ($indent, $data) = /(\s*)(.*)/;
- next if !$data; # skip empty lines
-
- @l = grep { $_->[0] < length $indent } @l;
-
- my @m = @l ? @{$l[-1][1]} : ();
- my ($t, $flag, @l2);
- while ($data =~
- /^((
- [1-6]
- |
- (?: (?: !\s*)? [0-9A-Z_]+(?:".*?")?)
- (?: \s*\|\|\s* (?: !\s*)? [0-9A-Z_]+(?:".*?")?)*
- )
- (?:\s+|$)
- )(.*)/x) { #@")) {
- ($t, $flag, $data) = ($1,$2,$3);
- while ($flag =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {}
- push @m, $flag;
- push @l2, [ length $indent, [ @m ] ];
- $indent .= $t;
- }
- if ($data) {
- # has packages on same line
- my ($rates, $flags) = partition { /^\d$/ } @m;
- my ($rate) = @$rates or die sprintf qq(missing rate for "%s" at line %d (flags are %s)\n), $data, $line_nb, join('&&', @m);
- foreach my $name (split ' ', $data) {
- if (uc($name) eq $name) {
- log::l("$line_nb: $name is parsed as a package name, not as a flag");
- }
- if (member('INSTALL', @$flags)) {
- push @need_to_copy, $name if !member('NOCOPY', @$flags);
- next; #- do not need to put INSTALL flag for a package.
- }
- if (member('PRINTER', @$flags)) {
- push @need_to_copy, $name;
- }
- my @new_flags = @$flags;
- if (my $previous = $flags{$name}) {
- my @common = intersection($flags, $previous);
- my @diff1 = difference2($flags, \@common);
- my @diff2 = difference2($previous, \@common);
- if (!@diff1 || !@diff2) {
- @new_flags = @common;
- } elsif (@diff1 == 1 && @diff2 == 1) {
- @new_flags = (@common, join('||', $diff1[0], $diff2[0]));
- } else {
- log::l("$line_nb: cannot handle complicate flags for packages appearing twice ($name)");
- $fatal_error++;
- }
- log::l("$line_nb: package $name appearing twice with different rates ($rate != " . $rates{$name} . ")") if $rate != $rates{$name};
- }
- $rates{$name} = $rate;
- $flags{$name} = \@new_flags;
- }
- push @l, @l2;
- } else {
- push @l, [ $l2[0][0], $l2[-1][1] ];
- }
- }
- $fatal_error and die "$fatal_error fatal errors in rpmsrate";
- \%rates, \%flags, \@need_to_copy;
-}
-
-sub read_rpmsrate {
- my ($packages, $rpmsrate_flags_chosen, $file, $match_all_hardware) = @_;
-
- my ($rates, $flags, $need_to_copy) = read_rpmsrate_raw($file);
-
- my ($TYPEs, @probeall);
- if (!$match_all_hardware) {
- $TYPEs = detect_devices::matching_types();
- @probeall = detect_devices::probeall();
- }
-
- foreach (keys %$flags) {
- my @flags = @{$flags->{$_}};
- my $p;
- if ($::isInstall) {
- $p = install::pkgs::packageByName($packages, $_) or next;
- if (my @l = map { /locales-(.*)/ ? qq(LOCALES"$1") : () } $p->requires_nosense) {
- if (@l > 1) {
- log::l("ERROR: package $_ is requiring many locales") if !member($_, qw(lsb libreoffice-langpack-br));
- } else {
- push @flags, @l;
- }
- }
- }
-
- @flags = map {
- my ($user_flags, $known_flags) = partition { /^!?CAT_/ } split('\|\|', $_);
- my $ok = find {
- my $inv = s/^!//;
- return 0 if $::isStandalone && $inv;
- if (my ($p) = /^HW"(.*)"/) {
- $match_all_hardware ? 1 : ($inv xor find { $_->{description} =~ /$p/i } @probeall);
- } elsif (($p) = /^DRIVER"(.*)"/) {
- $match_all_hardware ? 1 : ($inv xor find { $_->{driver} =~ /$p/i } @probeall);
- } elsif (($p) = /^TYPE"(.*)"/) {
- $match_all_hardware ? 1 : ($inv xor $TYPEs->{$p});
- } elsif (($p) = /^HW_CAT"(.*)"/) {
- $match_all_hardware ? 1 : ($inv xor detect_devices::probe_category($p));
- } else { # LOCALES"", SOUND, ...
- $inv xor $rpmsrate_flags_chosen->{$_};
- }
- } @$known_flags;
- $ok ? 'TRUE' : @$user_flags ? join('||', @$user_flags) : 'FALSE';
- } @flags;
-
- @flags = member('FALSE', @flags) ? 'FALSE' : @flags;
- if ($::isInstall) {
- $p->set_rate($rates->{$_});
- $p->set_rflags(@flags);
- } else {
- $flags->{$_} = \@flags;
- }
- }
- push @{$packages->{needToCopy} ||= []}, @$need_to_copy if ref($packages);
- return ($rates, $flags);
-}
-
-
-sub simple_read_rpmsrate {
- my ($o_match_all_hardware, $o_ignore_flags) = @_;
- my ($rates, $flags) = read_rpmsrate({}, {}, $::prefix . '/usr/share/meta-task/rpmsrate-raw', $o_match_all_hardware);
-
- # FIXME: we do not handle !CAT_desktop but we do not care for now:
- if (!$o_match_all_hardware && $o_ignore_flags) {
- while (my ($pkg, $pkg_flags) = each %$flags) {
- my $flags_str = "@$pkg_flags";
- if ($flags_str =~ /TRUE/ && any { $flags_str =~ /[^!]$_/ } @$o_ignore_flags) {
- delete $flags->{$pkg};
- }
- }
- }
-
- grep { member('TRUE', @{$flags->{$_}}) && $rates->{$_} >= 5 } keys %$flags;
-}
-
-sub detect_rpmsrate_hardware_packages {
- my ($o_match_all_hardware, $ignore_flags) = @_;
- grep { !/openoffice|java/ } simple_read_rpmsrate($o_match_all_hardware, $ignore_flags);
-}
-
-sub detect_graphical_drivers {
- my ($do_pkgs, $o_match_all_hardware) = @_;
- require Xconfig::card;
- require Xconfig::proprietary;
-
- my @cards;
- if ($o_match_all_hardware) {
- my $all_cards = Xconfig::card::readCardsDB("$ENV{SHARE_PATH}/ldetect-lst/Cards+");
- @cards = values %$all_cards;
- } else {
- @cards = Xconfig::card::probe();
- }
-
- my @firmware_pkgs = grep { $_ } uniq(map { $_->{FIRMWARE} } @cards);
- my @drivers = grep { $_ } uniq(map { $_->{Driver2} } @cards);
- my @proprietary_pkgs = map { Xconfig::proprietary::pkgs_for_Driver2($_, $do_pkgs) } @drivers;
- return @firmware_pkgs, @proprietary_pkgs;
-}
-
-sub detect_network_drivers {
- my ($do_pkgs, $o_match_all_hardware) = @_;
- require network::connection;
- require network::thirdparty;
-
- my @l;
- foreach my $type (network::connection->get_types) {
- $type->can('get_thirdparty_settings') or next;
- my @network_settings;
- my @all_settings = @{$type->get_thirdparty_settings || []};
- if ($o_match_all_hardware) {
- @network_settings = @all_settings;
- } else {
- my @connections = $type->get_connections(automatic_only => 1, fast_only => 1);
- @network_settings = map { network::thirdparty::find_settings(\@all_settings, $_->get_driver) } @connections;
- }
- foreach my $settings (@network_settings) {
- foreach (@network::thirdparty::thirdparty_types) {
- my @packages = network::thirdparty::get_required_packages($_, $settings);
- push @l, network::thirdparty::get_available_packages($_, $do_pkgs, @packages);
- }
- }
- }
- @l;
-}
-
-sub detect_hardware_packages {
- my ($do_pkgs, $o_match_all_hardware) = @_;
- my @ignore_flags = $::isInstall ? () : (
- if_(!$do_pkgs->is_installed('task-kde4-minimal'), "CAT_KDE"),
- if_(!$do_pkgs->is_installed('task-gnome-minimal'), "CAT_GNOME"),
- );
- (
- ($::isInstall ? () : detect_rpmsrate_hardware_packages($o_match_all_hardware, \@ignore_flags)),
- detect_graphical_drivers($do_pkgs, $o_match_all_hardware),
- detect_network_drivers($do_pkgs, $o_match_all_hardware),
- );
-}
-
-sub detect_unused_hardware_packages {
- my ($do_pkgs) = @_;
- my @all_hardware_packages = detect_hardware_packages($do_pkgs, 'match_all_hardware');
- my @used_hardware_packages = detect_hardware_packages($do_pkgs);
- my @unneeded_hardware_packages = difference2(\@all_hardware_packages, \@used_hardware_packages);
- $do_pkgs->are_installed(@unneeded_hardware_packages);
-}
-
-sub detect_unselected_locale_packages {
- my ($do_pkgs) = @_;
- require lang;
- my $locales_prefix = 'locales-';
- my $locale = lang::read();
- my $selected_locale = $locales_prefix . lang::locale_to_main_locale($locale->{lang});
- my @available_locales = $do_pkgs->are_installed($locales_prefix . '*');
- member($selected_locale, @available_locales) ? difference2(\@available_locales, [ $selected_locale ]) : ();
-}
-
-sub remove_unused_packages {
- my ($in, $do_pkgs, $o_prefix) = @_;
-
- my $wait;
- $wait = $in->wait_message(N("Unused packages removal"), N("Finding unused hardware packages..."));
- my @unused_hardware_packages = detect_unused_hardware_packages($do_pkgs);
- undef $wait;
- $wait = $in->wait_message(N("Unused packages removal"), N("Finding unused localization packages..."));
- my @unselected_locales = detect_unselected_locale_packages($do_pkgs);
- undef $wait;
-
- # Packages to not remove even if they seem unused
- my @wanted_hardware_packages = qw(gnome-bluetooth pulseaudio-module-bluetooth gnome-phone-manager bluedevil kppp ppp wireless-tools wpa_supplicant kernel-firmware-nonfree radeon-firmware ralink-firmware rtlwifi-firmware ipw2100-firmware ipw2200-firmware iwlwifi-3945-ucode iwlwifi-4965-ucode iwlwifi-agn-ucode b43-fwcutter b43-openfwwf atmel-firmware speedtouch-firmware zd1211-firmware isdn4k-utils rfkill x11-driver-input-wacom);
- @unused_hardware_packages = difference2(\@unused_hardware_packages, \@wanted_hardware_packages);
-
- @unused_hardware_packages || @unselected_locales or return;
-
- my $hardware = @unused_hardware_packages;
- my $locales = @unselected_locales;
- $in->ask_from(
- N("Unused packages removal"),
- N("We have detected that some packages are not needed for your system configuration.") . "\n" .
- N("We will remove the following packages, unless you choose otherwise:"),
- [
- if_(@unused_hardware_packages,
- { text => N("Unused hardware support"), val => \$hardware, type => "bool" },
- { label => N("Unused hardware support") . "\n" . join("\n", map { " " . $_ } sort(@unused_hardware_packages)), advanced => 1 },
- ),
- if_(@unselected_locales,
- { text => N("Unused localization"), val => \$locales, type => "bool" },
- { label => N("Unused localization") . "\n" . join("\n", map { " " . $_ } sort(@unselected_locales)), advanced => 1 },
- ),
- ],
- if_($::isWizard, cancel => N("Skip")),
- ) && ($hardware || $locales) or return;
-
- #- we should have some gurpme
- $wait = $in->wait_message(N("Please wait"), N("Removing packages..."));
- run_program::rooted($o_prefix, 'urpme', '--auto',
- if_($hardware, @unused_hardware_packages),
- if_($locales, @unselected_locales),
- );
- #- use script from One to list language files (/usr/share/locale mainly) and remove them?
-}
-
-1;