diff --git a/kdesrc-build-setup b/kdesrc-build-setup index 0f9af1d..d779695 100755 --- a/kdesrc-build-setup +++ b/kdesrc-build-setup @@ -1,449 +1,475 @@ #!/usr/bin/env perl # Script to create a configuration file for kdesrc-build. # # Copyright © 2011, 2016 Michael Pyne. # Home page: https://kdesrc-build.kde.org/ # # This program is free software; you can redistribute it and/or modify it under # the terms of the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any later # version. # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more # details. # # You should have received a copy of the GNU General Public License along with # this program; if not, write to the Free Software Foundation, Inc., 51 # Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA use strict; use 5.018; use IO::Pipe; use File::Copy; use File::Temp qw/tempfile/; use File::Basename; use Cwd qw(abs_path); our $VERSION = 0.03; # Not user-visible yet. sub clearScreen { require POSIX; my $termios = POSIX::Termios->new(); $termios->getattr(1); # Get STDOUT attributes require Term::Cap; my $terminal = Term::Cap->Tgetent({OSPEED => $termios->getospeed}); # Force the clear characters to be output immediately. # Otherwise it might overlap with other output, like error messages. local $| = 1; print $terminal->Tputs('cl', 0); return 0; } sub runDialogExecutable { my (@args) = @_; # Allow for 2 more file descriptors (on top of the normally allowed 0, 1, # 2) to survive the upcoming exec # See "SYSTEM_FD_MAX" in perldoc:perlvar $^F = 4; my $pipe = new IO::Pipe; my $pid; if ($pid = fork()) { # Parent $pipe->reader(); my $output = <$pipe>; waitpid $pid, 0; my $result = ($? >> 8); $pipe->close(); # dialog uses -1 as an exit code, Perl gets just the standard 8 bits # the rest of UNIX uses... if ($? == -1) { clearScreen(); die "Failed to run dialog(1): $@"; } elsif ($result == 255) { clearScreen(); die "Canceled the dialog"; } return $output || $result; } elsif (defined $pid) { # Child $pipe->writer(); my $outputFd = $pipe->fileno(); print "Using fd $outputFd"; exec ('dialog', '--output-fd', $outputFd, '--backtitle', 'kdesrc-build setup', @args); } else { die "Unable to fork? $!"; } } sub getUserInput { my $prompt = shift; my $default = shift; my @args = qw/--inputbox 8 50/; splice @args, 1, 0, $prompt; push @args, $default if $default; return runDialogExecutable(@args); } sub getMenuOption { my ($prompt, @opts) = @_; @opts = @{$opts[0]} if ref $opts[0] eq 'ARRAY'; my @args = qw/--menu 20 70 18/; splice @args, 1, 0, $prompt; while(my ($k, $v) = splice (@opts, 0, 2)) { push @args, $k, $v; } return runDialogExecutable(@args); } sub showInfo { my $message = shift; my @args = qw/--msgbox 20 62/; splice @args, 1, 0, $message; return runDialogExecutable(@args); } sub getYesNoAnswer { my $prompt = shift; my @args = qw/--yesno 8 55/; splice @args, 1, 0, $prompt; return runDialogExecutable(@args) == 0; } sub getDirectory { my $dir = shift; my @args = qw/--dselect 10 70/; splice @args, 1, 0, $dir; return runDialogExecutable(@args); } sub getListOptions { my ($prompt, $opts, $enabled) = @_; die "\$opts not a hash ref" unless (ref $opts eq 'ARRAY'); die "\$enabled not a hash ref" unless (ref $enabled eq 'HASH'); my @args = qw/--checklist 20 70 18/; splice @args, 1, 0, $prompt; splice @args, 0, 0, '--output-separator', ','; while (my ($k, $v) = splice(@{$opts}, 0, 2)) { push (@args, $k, $v, (exists ${$enabled}{$k} ? 'on' : 'off')); } my $output = runDialogExecutable(@args); # Filter out empty results, remove quotes. my @items = split (/,/, $output); s/^"(.*)"$/$1/ foreach @items; @items = grep { length $_ } @items; return @items; } # The 'dialog(1)' program is required, verify it exists before going # further. # We use the --help option since it doesn't send weird terminal characters to the screen # and it's supported on dialog and Debian's dialog replacement called whiptail. system('dialog', '--help') == 0 or do { my $osError = "$!"; say "Unable to run the dialog(1) program, it is required for this setup script."; if ($? == -1) { say "\tThe program wouldn't even run, due to error: $osError"; } else { say "\tProgram ran, but exited with error: ", $? >> 8; } exit 1; }; showInfo(< "$ENV{HOME}/kde/usr (default)", custom => "Custom location, chosen next screen", ]); if ($installDir eq 'custom') { $installDir = getDirectory('/usr/local/kde'); } else { $installDir = "~/kde/usr"; } +my $sourceDir = getMenuOption('Where do you want the source code to be saved?', + [ + home => "$ENV{HOME}/kde/src (default)", + custom => "Custom location, chosen next screen", + ]); + +if ($sourceDir eq 'custom') { + $sourceDir = getDirectory('/usr/local/kde/src'); +} +else { + $sourceDir = "~/kde/src"; +} + +my $buildDir = getMenuOption('Where do you want temporary build files to be saved? (They might need lots of space)', + [ + home => "$ENV{HOME}/kde/build (default)", + custom => "Custom location, chosen next screen", + ]); + +if ($buildDir eq 'custom') { + $buildDir = getDirectory('/usr/local/kde/build'); +} +else { + $buildDir = "~/kde/build"; +} + my @chosenModules = getListOptions( "Which major module groups do you want to build?", [ frameworks => 'KDE Frameworks 5 - Essential libraries/runtime (required)', workspace => 'KDE Plasma 5 Desktop and workspace', base => 'Assorted useful KF5-based applications', pim => 'Personal Information Management software', ], { frameworks => 1, workspace => 1, base => 1, }, ); my $numCpus = getUserInput( 'How many CPU cores do you wish to use for building?', '4'); my $outputFileName = "$ENV{HOME}/.kdesrc-buildrc"; my $output; # Will be output filehandle. while (-e $outputFileName) { (my $printableName = $outputFileName) =~ s/^$ENV{HOME}/~/; my $outputChoice = getMenuOption( "$printableName already exists, what do you want to do?", [ backup => 'Make a backup, then overwrite with the new configuration', custom => 'Write the new configuration to a different file', cancel => 'Cancel setup', ], ); if ($outputChoice eq 'cancel') { showInfo('Setup canceled'); exit 0; } if ($outputChoice eq 'custom') { $outputFileName = getUserInput('Enter desired configuration file name.'); $outputFileName =~ s/^~/$ENV{HOME}/; } if ($outputChoice eq 'backup') { copy($outputFileName, "$outputFileName~") or do { my $error = "$!"; showInfo(<', $outputFileName) or do { my $error = "$!"; showInfo (<