BuildContext.pm 33 KB
Newer Older
1
package ksb::BuildContext 0.35;
2

3
4
# Class: BuildContext
#
5
6
7
# This contains the information needed about the build context, e.g.  list of
# modules, what phases each module is in, the various options, etc.

8
use 5.014;
9
use warnings;
10
no if $] >= 5.018, 'warnings', 'experimental::smartmatch';
11
12
13
14
15
16

use Carp 'confess';
use File::Basename; # dirname
use IO::File;
use POSIX qw(strftime);
use Errno qw(:POSIX);
17
use JSON::PP;
18

19
20
21
22
23
# We derive from ksb::Module so that BuildContext acts like the 'global'
# ksb::Module, with some extra functionality.
# TODO: Derive from OptionsBase directly and remove getOption override
use parent qw(ksb::Module);

24
use ksb::BuildException;
25
26
27
28
use ksb::Debug;
use ksb::Util;
use ksb::PhaseList;
use ksb::Module;
29
use ksb::Module::BranchGroupResolver;
30
use ksb::Updater::KDEProjectMetadata 0.20;
31
use ksb::Version qw(scriptVersion);
32
use ksb::StatusView;
33
use ksb::KDEProjectsReader 0.50;
34

35
use File::Temp qw(tempfile);
36
use File::Spec; # rel2abs
37
38
39
40
41
42
43
44
45
46

my @DefaultPhases = qw/update build install/;
my @rcfiles = ("./kdesrc-buildrc", "$ENV{HOME}/.kdesrc-buildrc");
my $LOCKFILE_NAME = '.kdesrc-lock';

# The # will be replaced by the directory the rc File is stored in.
my $PERSISTENT_FILE_NAME = '#/.kdesrc-build-data';

my $SCRIPT_VERSION = scriptVersion();

47
48
49
# Should be used for internal state that shouldn't be exposed as a hidden
# cmdline option, or has other cmdline switches (e.g. debug/verbose handling).
my %internalGlobalOptions = (
50
51
52
53
54
55
    "async"                => 1,
    "build-system-only"    => "",
    "build-when-unchanged" => 1, # Safe default
    "checkout-only"        => "",
    "colorful-output"      => 1, # Use color by default.
    "debug-level"          => ksb::Debug::INFO,
56
    "filter-out-phases"    => '',
57
    "git-desired-protocol" => 'git', # protocol to use for git *push* URLs (fetch requires https)
58
    "git-repository-base"  => {}, # Base path template for use multiple times.
59
    "ignore-modules"       => '', # See also: use-modules, kde-projects
60
    "include-dependencies" => 0,  # Recursively include kde-projects module deps?
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
    "manual-build"         => "",
    "manual-update"        => "",
    "niceness"             => "10",
    "no-svn"               => "",  # TODO: Rename to no-src
    "prefix"               => "", # Override installation prefix.
    "pretend"              => "",
    "reconfigure"          => "",
    "refresh-build"        => "",
    "repository"           => '',     # module's git repo
    "revision"             => '', # Only useful for Subversion modules at cmdline
    "set-env"              => { }, # Hash of environment vars to set
    "ssh-identity-file"    => '', # If set, is passed to ssh-add.
    "use-modules"          => "",
);

# Holds boolean flags that could be altered from cmdline.
77
78
# These must be completely disjoint from the options provided in
# ksb::Application to GetOptionsFromArray!
79
our %defaultGlobalFlags = (
80
81
82
83
84
    "delete-my-patches"          => 0, # Should only be set from cmdline
    "delete-my-settings"         => 0, # Should only be set from cmdline
    "disable-agent-check"        => 0, # If true we don't check on ssh-agent
    "disable-snapshots"          => 1, # 2016-07-31 Temp. disabled until kde.org fixed to supply snapshots
    "ignore-kde-structure"       => 0, # Whether to use kde dir structure like extragear/network
85
    "use-invent-structure"       => 0, # Whether to use kde dir structure based on repository paths on invent.kde.org
86
    "include-dependencies"       => 0, # 2019-08-31 Made negatable from cmdline (NB: false here but true in rcfile)
87
88
89
90
91
92
93
94
95
    "install-after-build"        => 1,
    "install-environment-driver" => 1, # Setup ~/.config/kde-env-*.sh for login scripts
    "install-session-driver"     => 0, # Above, + ~/.xsession
    "purge-old-logs"             => 1,
    "run-tests"                  => 0,  # 1 = make test, upload = make Experimental
    "stop-on-failure"            => 0,
    "use-clean-install"          => 0,
    "use-idle-io-priority"       => 0,
    "use-stable-kde"             => 0,
96
97
98
99
100
101
102
103
);

# Holds other cmdline-accessible options that aren't simply binary flags.
our %defaultGlobalOptions = (
    "binpath"              => '',
    "branch"               => "",
    "branch-group"         => "", # Overrides branch, uses JSON data.
    "build-dir"            => "build",
104
    "cmake-generator"      => "",
105
    "cmake-options"        => "",
106
    "cmake-toolchain"      => "",
107
108
109
110
111
112
    "configure-flags"      => "",
    "custom-build-command" => '',
    "cxxflags"             => "-pipe",
    "dest-dir"             => '${MODULE}', # single quotes used on purpose!
    "do-not-compile"       => "",
    "http-proxy"           => '', # Proxy server to use for HTTP.
113
114
115
116
117
118
119
    "kdedir"               => "$ENV{HOME}/kde",
    "kde-languages"        => "",
    "libpath"              => "",
    "log-dir"              => "log",
    "make-install-prefix"  => "",  # Some people need sudo
    "make-options"         => "",
    "module-base-path"     => "",  # Used for tags and branches
120
121
122
    "ninja-options"        => "",
    "num-cores"            => 4,   # Used only in rc-file but documented
    "num-cores-low-mem"    => 2,   # Used only in rc-file but documented
123
124
125
    "override-build-system"=> "",
    "override-url"         => "",
    "persistent-data-file" => "",
126
    "qtdir"                => "",
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
    "remove-after-install" => "none", # { none, builddir, all }
    "source-dir"           => "$ENV{HOME}/kdesrc",
    "svn-server"           => "svn://anonsvn.kde.org/home/kde",
    "tag"                  => "",
);

sub new
{
    my ($class, @args) = @_;

    # It is very important to use the ksb::Module:: syntax instead of ksb::Module->,
    # otherwise you can't pass $class and have it used as the classname.
    my $self = ksb::Module::new($class, undef, 'global');
    my %newOpts = (
        modules => [],
        context => $self, # Fix link to buildContext (i.e. $self)
        build_options => {
144
145
146
147
148
            global => {
                %internalGlobalOptions,
                %defaultGlobalFlags,
                %defaultGlobalOptions,
            },
149
150
151
152
153
            # Module options are stored under here as well, keyed by module->name()
        },
        # This one replaces ksb::Module::{phases}
        phases  => ksb::PhaseList->new(@DefaultPhases),
        errors  => {
154
155
            # A map from module *names* (as in modules[] above) to the
            # phase name at which they failed.
156
157
158
159
160
161
162
163
164
165
        },
        logPaths=> {
            # Holds a hash table of log path bases as expanded by
            # getSubdirPath (e.g. [source-dir]/log) to the actual log dir
            # *this run*, with the date and unique id added. You must still
            # add the module name to use.
        },
        rcFiles => [@rcfiles],
        rcFile  => undef,
        env     => { },
166
        persistent_options => { }, # These are kept across multiple script runs
167
        ignore_list => [ ], # List of KDE project paths to ignore completely
168
169
        kde_projects_metadata     => undef, # Enumeration of kde-projects
        logical_module_resolver   => undef, # For branch-group option
170
        status_view => ksb::StatusView->new(),
171
        projects_db => undef, # See getProjectDataReader
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
    );

    # Merge all new options into our self-hash.
    @{$self}{keys %newOpts} = values %newOpts;
    $self->{options} = $self->{build_options}{global};

    assert_isa($self, 'ksb::Module');
    assert_isa($self, 'ksb::BuildContext');

    return $self;
}

# Gets the ksb::PhaseList for this context, and optionally sets it first to
# the ksb::PhaseList passed in.
sub phases
{
    my ($self, $phases) = @_;

    if ($phases) {
        confess("Invalid type, expected PhaseList")
            unless $phases->isa('ksb::PhaseList');
        $self->{phases} = $phases;
    }
    return $self->{phases};
}

sub addModule
{
    my ($self, $module) = @_;
    Carp::confess("No module to push") unless $module;

203
    my $path;
204
205
206
    if (list_has($self->{modules}, $module)) {
        debug("Skipping duplicate module ", $module->name());
    }
Michael Pyne's avatar
Michael Pyne committed
207
208
209
    # TODO: Shouldn't this support all modules, not just 'proj' modules?
    elsif ($module->scmType() eq 'proj' &&
           ($path = $module->fullProjectPath()) &&
210
        # See if the name matches any given in the ignore list.
211
           any(sub { $path =~ /(^|\/)$_($|\/)/ }, $self->{ignore_list}))
212
213
214
215
    {
        debug("Skipping ignored module $module");
    }
    else {
Michael Pyne's avatar
Michael Pyne committed
216
        debug("Adding $module to module list");
217
218
219
220
        push @{$self->{modules}}, $module;
    }
}

221
# Returns a listref of the modules to build
222
223
224
225
226
227
sub moduleList
{
    my $self = shift;
    return $self->{modules};
}

228
# Adds a list of modules to ignore processing on completely.
229
# Parameters should simply be a list of KDE project paths to ignore,
230
231
# e.g. 'extragear/utils/kdesrc-build'. Partial paths are acceptable, matches
# are determined by comparing the path provided to the suffix of the full path
232
# of modules being compared.  See KDEProjectsReader::_projectPathMatchesWildcardSearch
233
234
235
#
# Existing items on the ignore list are not removed.
sub addToIgnoreList
236
237
{
    my $self = shift;
238
    push @{$self->{ignore_list}}, @_;
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
}

sub setupOperatingEnvironment
{
    my $self = shift;
    # Set the process priority
    POSIX::nice(int $self->getOption('niceness'));

    # Set the IO priority if available.
    if ($self->getOption('use-idle-io-priority')) {
        # -p $$ is our PID, -c3 is idle priority
        # 0 return value means success
        if (safe_system('ionice', '-c3', '-p', $$) != 0) {
            warning (" b[y[*] Unable to lower I/O priority, continuing...");
        }
    }

    # Get ready for logged output.
    ksb::Debug::setLogFile($self->getLogDirFor($self) . '/build-log');

    # Propagate HTTP proxy through environment unless overridden.
    if ((my $proxy = $self->getOption('http-proxy')) &&
        !defined $ENV{'http_proxy'})
    {
        $self->queueEnvironmentVariable('http_proxy', $proxy);
    }
}

# Clears the list of environment variables to set for log_command runs.
sub resetEnvironment
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    $self->{env} = { };
}

# Adds an environment variable and value to the list of environment
# variables to apply for the next subprocess execution.
#
# Note that these changes are /not/ reflected in the current environment,
# so if you are doing something that requires that kind of update you
# should do that yourself (but remember to have some way to restore the old
# value if necessary).
#
# In order to keep compatibility with the old 'setenv' sub, no action is
# taken if the value is not equivalent to boolean true.
sub queueEnvironmentVariable
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    my ($key, $value) = @_;

    return unless $value;

    debug ("\tQueueing g[$key] to be set to y[$value]");
    $self->{env}->{$key} = $value;
}

# Applies all changes queued by queueEnvironmentVariable to the actual
# environment irretrievably. Use this before exec()'ing another child, for
# instance.
sub commitEnvironmentChanges
{
    my $self = assert_isa(shift, 'ksb::BuildContext');

    while (my ($key, $value) = each %{$self->{env}}) {
        $ENV{$key} = $value;
        debug ("\tSetting environment variable g[$key] to g[b[$value]");
    }
}

# Adds the given library paths to the path already given in an environment
# variable. In addition, detected "system paths" are stripped to ensure
# that we don't inadvertently re-add a system path to be promoted over the
# custom code we're compiling (for instance, when a system Qt is used and
# installed to /usr).
#
# If the environment variable to be modified has already been queued using
# queueEnvironmentVariable, then that (queued) value will be modified and
# will take effect with the next forked subprocess.
#
# Otherwise, the current environment variable value will be used, and then
# queued. Either way the current environment will be unmodified afterward.
#
# First parameter is the name of the environment variable to modify
Yuri Chornoivan's avatar
Yuri Chornoivan committed
322
# All remaining parameters are prepended to the current environment path, in
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
# the order given. (i.e. param1, param2, param3 ->
# param1:param2:param3:existing)
sub prependEnvironmentValue
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    my ($envName, @items) = @_;
    my @curPaths = split(':', $self->{env}->{$envName} // $ENV{$envName} // '');

    # Filter out entries to add that are already in the environment from
    # the system.
    for my $path (grep { list_has(\@curPaths, $_) } (@items) ) {
        debug ("\tNot prepending y[$path] to y[$envName] as it appears " .
              "to already be defined in y[$envName].");
    }

    @items = grep { not list_has(\@curPaths, $_); } (@items);

    my $envValue = join(':', @items, @curPaths);

    $envValue =~ s/^:*//;
    $envValue =~ s/:*$//; # Remove leading/trailing colons
    $envValue =~ s/:+/:/; # Remove duplicate colons

    $self->queueEnvironmentVariable($envName, $envValue);
}

# Tries to take the lock for our current base directory, which currently is
# what passes for preventing people from accidentally running kdesrc-build
# multiple times at once.  The lock is based on the base directory instead
# of being global to allow for motivated and/or brave users to properly
# configure kdesrc-build to run simultaneously with different
# configurations.
#
# Return value is a boolean success flag.
sub takeLock
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    my $baseDir = $self->baseConfigDirectory();
    my $lockfile = "$baseDir/$LOCKFILE_NAME";

    $! = 0; # Force reset to non-error status
    sysopen LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL;
    my $errorCode = $!; # Save for later testing.

    if ($errorCode == EEXIST)
    {
        # Path already exists, read the PID and see if it belongs to a
        # running process.
        open (my $pidFile, "<", $lockfile) or do
        {
            # Lockfile is there but we can't open it?!?  Maybe a race
            # condition but I have to give up somewhere.
            warning (" WARNING: Can't open or create lockfile r[$lockfile]");
            return 1;
        };

        my $pid = <$pidFile>;
        close $pidFile;

        if ($pid)
        {
            # Recent kdesrc-build; we wrote a PID in there.
            chomp $pid;

            # See if something's running with this PID.
            if (kill(0, $pid) == 1)
            {
                # Something *is* running, likely kdesrc-build.  Don't use error,
                # it'll scan for $!
                print ksb::Debug::colorize(" r[*y[*r[*] kdesrc-build appears to be running.  Do you want to:\n");
                print ksb::Debug::colorize("  (b[Q])uit, (b[P])roceed anyways?: ");

395
                my $choice = <STDIN> // '';
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
                chomp $choice;

                if (lc $choice ne 'p')
                {
                    say ksb::Debug::colorize(" y[*] kdesrc-build run canceled.");
                    return 0;
                }

                # We still can't grab the lockfile, let's just hope things
                # work out.
                note (" y[*] kdesrc-build run in progress by user request.");
                return 1;
            }

            # If we get here, then the program isn't running (or at least not
            # as the current user), so allow the flow of execution to fall
            # through below and unlink the lockfile.
        } # pid

        # No pid found, optimistically assume the user isn't running
        # twice.
        warning (" y[WARNING]: stale kdesrc-build lockfile found, deleting.");
        unlink $lockfile;

        sysopen (LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL) or do {
            error (" r[*] Still unable to lock $lockfile, proceeding anyways...");
            return 1;
        };

        # Hope the sysopen worked... fall-through
    }
    elsif ($errorCode == ENOTTY)
    {
        # Stupid bugs... normally sysopen will return ENOTTY, not sure who's to blame between
        # glibc and Perl but I know that setting PERLIO=:stdio in the environment "fixes" things.
        ; # pass
    }
    elsif ($errorCode != 0) # Some other error occurred.
    {
        warning (" r[*]: Error $errorCode while creating lock file (is $baseDir available?)");
        warning (" r[*]: Continuing the script for now...");

        # Even if we fail it's generally better to allow the script to proceed
        # without being a jerk about things, especially as more non-CLI-skilled
        # users start using kdesrc-build to build KDE.
        return 1;
    }

    say LOCKFILE "$$";
    close LOCKFILE;

    return 1;
}

# Releases the lock obtained by takeLock.
sub closeLock
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    my $baseDir = $self->baseConfigDirectory();
    my $lockFile = "$baseDir/$LOCKFILE_NAME";

    unlink ($lockFile) or warning(" y[*] Failed to close lock: $!");
}

# This subroutine accepts a Module parameter, and returns the log directory
# for it. You can also pass a BuildContext (including this one) to get the
# default log directory.
#
# As part of setting up what path to use for the log directory, the
# 'latest' symlink will also be setup to point to the returned log
# directory.
sub getLogDirFor
{
    my ($self, $module) = @_;

    my $baseLogPath = $module->getSubdirPath('log-dir');
    my $logDir;

    if (!exists $self->{logPaths}{$baseLogPath}) {
        # No log dir made for this base, do so now.
        my $id = '01';
        my $date = strftime "%F", localtime; # ISO 8601 date
        $id++ while -e "$baseLogPath/$date-$id";
        $self->{logPaths}{$baseLogPath} = "$baseLogPath/$date-$id";
    }

    $logDir = $self->{logPaths}{$baseLogPath};
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
    super_mkdir($logDir);

    # global logs go to basedir directly
    $logDir .= "/$module" unless $module->isa('ksb::BuildContext');

    return $logDir;
}

# Constructs the appropriate full path to a log file based on the given
# basename (including extensions). Use this instead of getLogDirFor when you
# actually intend to create a log, as this function will also adjust the
# 'latest' symlink properly.
sub getLogPathFor
{
    my ($self, $module, $path) = @_;
498

499
500
    my $baseLogPath = $module->getSubdirPath('log-dir');
    my $logDir = $self->getLogDirFor($module);
501

502
503
    # We create this here to avoid needless empty module directories everywhere
    super_mkdir($logDir);
504

505
506
    # Add a symlink to the latest run for this module. 'latest' itself is
    # a directory under the base log directory that holds symlinks mapping
Yuri Chornoivan's avatar
Yuri Chornoivan committed
507
    # each module name to the specific log directory most recently used.
508
509
510
511
512
513
514
515
516
517
518

    my $latestPath = "$baseLogPath/latest";

    # Handle stuff like playground/utils or KDE/kdelibs
    my ($moduleName, $modulePath) = fileparse($module->name());
    $latestPath .= "/$modulePath" if $module->name() =~ m(/);

    super_mkdir($latestPath);

    my $symlink = "$latestPath/$moduleName";

519
    if (-l $symlink and readlink($symlink) ne $logDir)
520
521
    {
        unlink($symlink);
522
        symlink($logDir, $symlink);
523
524
525
526
    }
    elsif(not -e $symlink)
    {
        # Create symlink initially if we've never done it before.
527
        symlink($logDir, $symlink);
528
529
    }

530
    return "$logDir/$path";
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
}

# Returns rc file in use. Call loadRcFile first.
sub rcFile
{
    my $self = shift;
    return $self->{rcFile};
}

# Forces the rc file to be read from to be that given by the first
# parameter.
sub setRcFile
{
    my ($self, $file) = @_;
    $self->{rcFiles} = [$file];
    $self->{rcFile} = undef;
}

# Returns an open filehandle to the user's chosen rc file.  Use setRcFile
# to choose a file to load before calling this function, otherwise
# loadRcFile will search the default search path.  After this function is
# called, rcFile() can be used to determine which file was loaded.
#
# If unable to find or open the rc file an exception is raised. Empty rc
# files are supported however.
sub loadRcFile
{
    my $self = shift;
    my @rcFiles = @{$self->{rcFiles}};
    my $fh;

    for my $file (@rcFiles)
    {
        if (open ($fh, '<', "$file"))
        {
            $self->{rcFile} = File::Spec->rel2abs($file);
            return $fh;
        }
    }

    # No rc found, check if we can use default.
    if (scalar @rcFiles == 1)
    {
        # This can only happen if the user uses --rc-file, so if we fail to
        # load the file, we need to fail to load at all.
        my $failedFile = $rcFiles[0];

        error (<<EOM);
Unable to open config file $failedFile

Script stopping here since you specified --rc-file on the command line to
load $failedFile manually.  If you wish to run the script with no configuration
file, leave the --rc-file option out of the command line.

If you want to force an empty rc file, use --rc-file /dev/null

EOM
        croak_runtime("Missing $failedFile");
    }

Michael Pyne's avatar
Michael Pyne committed
591
592
593
594
595
596
597
598
599
600
601
602
    # If no configuration but no --rc-file option was used, warn the user
    # and fail, as there are too many possible modes of using kdesrc-build
    # for kdesrc-buildrc-sample to be appropriate.

    error (<<EOM);
b[No configuration file is present.]

kdesrc-build requires a configuration file to select which KDE software modules
to build, what options to build them with, the path to install to, etc.

kdesrc-build looks for its configuration in the file `kdesrc-buildrc' in
whatever directory kdesrc-build is run from.
603

Michael Pyne's avatar
Michael Pyne committed
604
605
If no such file exists, kdesrc-build tries to use `~/.kdesrc-buildrc' (note the
leading `.')
606

Michael Pyne's avatar
Michael Pyne committed
607
608
609
A sample configuration suitable for KDE 4 software is included at the file
`kdesrc-buildrc-sample' which can be copied to the correct location and then
edited.
610

Michael Pyne's avatar
Michael Pyne committed
611
612
613
614
615
616
617
618
619
620
621
622
623
KDE Frameworks 5 users can use the `kdesrc-buildrc-kf5-sample' file which can
be copied to the correct location and then edited.

In either case b[once the configuration file is setup to your liking], you
should run:
b[kdesrc-build --metadata-only]

to download needed information about the KDE source repositories and then:
b[kdesrc-build --pretend]

to preview what kdesrc-build will do.
EOM
    croak_runtime("No configuration available");
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
}

# Returns the base directory that holds the configuration file. This is
# typically used as the directory base for other necessary kdesrc-build
# execution files, such as the persistent data store and lock file.
#
# The RC file must have been found and loaded first, obviously.
sub baseConfigDirectory
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    my $rcfile = $self->rcFile() or
        croak_internal("Call to baseConfigDirectory before loadRcFile");

    return dirname($rcfile);
}

sub modulesInPhase
{
    my ($self, $phase) = @_;
    my @list = grep { list_has([$_->phases()->phases()], $phase) } (@{$self->moduleList()});
    return @list;
}

# Searches for a module with a name that matches the provided parameter,
# and returns its ksb::Module object. Returns undef if no match was found.
# As a special-case, returns the BuildContext itself if the name passed is
# 'global', since the BuildContext also is a (in the "is-a" OOP sense)
# ksb::Module, specifically the 'global' one.
sub lookupModule
{
    my ($self, $moduleName) = @_;

    return $self if $moduleName eq 'global';

    my @options = grep { $_->name() eq $moduleName } (@{$self->moduleList()});
    return undef unless @options;

    if (scalar @options > 1) {
        croak_internal("Detected 2 or more $moduleName ksb::Module objects");
    }

    return $options[0];
}

sub markModulePhaseFailed
{
    my ($self, $phase, $module) = @_;
    assert_isa($module, 'ksb::Module');

673
    $self->{errors}->{$module->name()} = $phase;
674
675
676
677
678
679
680
681
}

# Returns a list (i.e. not a reference to, but a real list) of Modules that failed to
# complete the given phase.
sub failedModulesInPhase
{
    my ($self, $phase) = @_;

682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
    my @failures = grep {
        ($self->{errors}->{$_->name()} // '') eq $phase
    } (@{$self->moduleList()});

    return @failures;
}

# Returns a list of modules that had a failure of some sort, in the order the modules
# are listed in our current module list.
sub listFailedModules
{
    my $self = shift;
    my @modules = @{$self->moduleList()};

    # grepping for failures instead of returning error list directly maintains ordering
    @modules = grep {
        exists $self->{errors}->{$_->name()}
    } (@modules);

    return @modules;
702
703
}

704
705
706
# OVERRIDE: Our immediate parent class Module overrides this, but we actually
# want the OptionsBase version to be used instead, until we break the recursive
# use of Module's own getOption calls on our getOption.
707
708
sub getOption
{
709
    &ksb::OptionsBase::getOption;
710
711
}

712
# OVERRIDE: Overrides OptionsBase::setOption to handle some global-only options.
713
714
715
716
sub setOption
{
    my ($self, %options) = @_;

717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
    # Special-case handling
    my $repoOption = 'git-repository-base';
    if (exists $options{$repoOption}) {
        my $value = $options{$repoOption};
        my ($repo, $url) = ($value =~ /^([a-zA-Z0-9_-]+)\s+(.+)$/);

        # This will be a hash reference instead of a scalar
        $value = $self->getOption($repoOption) || { };

        if (!$repo || !$url) {
            die ksb::BuildException::Config->new($repoOption,
                "Invalid git-repository-base setting: $value");
        }

        $value->{$repo} = $url;
        delete $options{$repoOption};
    }

735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
    # Actually set options.
    $self->SUPER::setOption(%options);

    # Automatically respond to various global option changes.
    while (my ($key, $value) = each %options) {
        my $normalizedKey = $key;
        $normalizedKey =~ s/^#//; # Remove sticky key modifier.
        given ($normalizedKey) {
            when ('colorful-output') { ksb::Debug::setColorfulOutput($value); }
            when ('debug-level')     { ksb::Debug::setDebugLevel($value); }
            when ('pretend')         { ksb::Debug::setPretending($value); }
        }
    }
}

#
# Persistent option handling
#

# Returns the name of the file to use for persistent data.
# Supports expanding '#' at the beginning of the filename to the directory
# containing the rc-file in use, but only for the default name at this
# point.
sub persistentOptionFileName
{
    my $self = shift;
    my $filename = $self->getOption('persistent-data-file');

    if (!$filename) {
        $filename = $PERSISTENT_FILE_NAME;
        my $dir = $self->baseConfigDirectory();
        $filename =~ s/^#/$dir/;
    }
    else {
        # Tilde-expand
        $filename =~ s/^~\//$ENV{HOME}\//;
    }

    return $filename;
}

# Reads in all persistent options from the file where they are kept
# (.kdesrc-build-data) for use in the program.
#
# The directory used is the same directory that contains the rc file in use.
sub loadPersistentOptions
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    my $fh = IO::File->new($self->persistentOptionFileName(), '<');

    return unless $fh;

787
788
    # $persistent_data should be a JSON object which we can store directly as a
    # hash.
789
790
791
792
793
794
795
796
    my $persistent_data;
    {
        local $/ = undef; # Read in whole file with <> operator.
        $persistent_data = <$fh>;
    }

    my $persistent_options;

797
798
799
800
801
802
803
804
805
806
807
808
809
810
    eval { $persistent_options = decode_json($persistent_data); };
    if ($@) {
        # Apparently wasn't JSON, try falling back to old format for compat.
        # Previously, this was a Perl code which, when evaluated would give
        # us a hash called persistent_options which we can then merge into our
        # persistent options.
        # TODO: Remove compat code after 2018-06-30
        eval $persistent_data; # Runs Perl code read from file
        if ($@)
        {
            # Failed.
            error ("Failed to read persistent module data: r[b[$@]");
            return;
        }
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
    }

    # We need to keep persistent data with the context instead of with the
    # applicable modules since otherwise we might forget to write out
    # persistent data for modules we didn't build in this run. So, we just
    # store it all.
    # Layout of this data:
    #  $self->persistent_options = {
    #    'module-name' => {
    #      option => value,
    #      # foreach option/value pair
    #    },
    #    # foreach module
    #  }
    $persistent_options = {} if ref $persistent_options ne 'HASH';
    $self->{persistent_options} = $persistent_options;
}

# Writes out the persistent options to the file .kdesrc-build-data.
#
# The directory used is the same directory that contains the rc file in use.
sub storePersistentOptions
{
    my $self = assert_isa(shift, 'ksb::BuildContext');
    return if pretending();

    my $fh = IO::File->new($self->persistentOptionFileName(), '>');
838
    my $json = JSON::PP->new->ascii->pretty;
839
840
841
842
843
844
845

    if (!$fh)
    {
        error ("Unable to save persistent module data: b[r[$!]");
        return;
    }

846
847
    my $encodedJSON = $json->encode($self->{persistent_options});
    print $fh $encodedJSON;
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
    undef $fh; # Closes the file
}

# Returns the value of a "persistent" option (normally read in as part of
# startup), or undef if there is no value stored.
#
# First parameter is the module name to get the option for, or 'global' if
# not for a module.
#     Note that unlike setOption/getOption, no inheritance is done at this
#     point so if an option is present globally but not for a module you
#     must check both if that's what you want.
# Second parameter is the name of the value to retrieve (i.e. the key)
sub getPersistentOption
{
    my ($self, $moduleName, $key) = @_;
    my $persistent_opts = $self->{persistent_options};

    # We must check at each level of indirection to avoid
    # "autovivification"
    return unless exists $persistent_opts->{$moduleName};
    return unless exists $persistent_opts->{$moduleName}{$key};

    return $persistent_opts->{$moduleName}{$key};
}

# Clears a persistent option if set (for a given module and option-name).
#
# First parameter is the module name to get the option for, or 'global' for
# the global options.
# Second parameter is the name of the value to clear.
# No return value.
sub unsetPersistentOption
{
    my ($self, $moduleName, $key) = @_;
    my $persistent_opts = $self->{persistent_options};

    if (exists $persistent_opts->{$moduleName} &&
        exists $persistent_opts->{$moduleName}->{$key})
    {
        delete $persistent_opts->{$moduleName}->{$key};
    }
}

# Sets a "persistent" option which will be read in for a module when
# kdesrc-build starts up and written back out at (normal) program exit.
#
# First parameter is the module name to set the option for, or 'global'.
# Second parameter is the name of the value to set (i.e. key)
# Third parameter is the value to store, which must be a scalar.
sub setPersistentOption
{
    my ($self, $moduleName, $key, $value) = @_;
    my $persistent_opts = $self->{persistent_options};

    # Initialize empty hash ref if nothing defined for this module.
    $persistent_opts->{$moduleName} //= { };

    $persistent_opts->{$moduleName}{$key} = $value;
}

908
909
910
911
912
913
914
915
916
917
918
# Returns the ksb::Module (which has a 'metadata' scm type) that is used for
# kde-project metadata, so that other modules that need it can call into it if
# necessary.
#
# Also may return undef if the metadata is unavailable or has not yet
# been set by setKDEProjectsMetadataModule (this method does not
# automatically create the needed module).
sub getKDEProjectsMetadataModule
{
    my $self = shift;

919
920
921
    # Initialize if not set
    $self->{kde_projects_metadata} //=
        ksb::ModuleSet::KDEProjects::getProjectMetadataModule($self);
922

923
    return $self->{kde_projects_metadata};
924
925
}

926
# Returns a KDEProjectsReader module, which has already read in the database and
927
928
929
930
931
932
933
934
# is ready to be queried. Note that exceptions can be thrown in the process
# of downloading and parsing the database information, so be ready for that.
sub getProjectDataReader
{
    my $self = shift;

    return $self->{projects_db} if $self->{projects_db};

935
    my $projectDatabaseModule = $self->getKDEProjectsMetadataModule() or
936
937
        croak_runtime("kde-projects repository information could not be downloaded: $!");

938
    $self->{projects_db} = ksb::KDEProjectsReader->new($projectDatabaseModule);
939
940
941
    return $self->{projects_db};
}

942
# Returns the effective branch group to use for modules. You should not call
943
944
# this unless KDE project metadata is available (see
# setKDEProjectsMetadataModule and moduleBranchGroupResolver).
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
sub effectiveBranchGroup
{
    my $self = shift;
    my $branchGroup = $self->getOption('branch-group', 'module') // '';

    if (!$branchGroup) {
        $branchGroup = $self->getOption('use-stable-kde')
            ? 'latest-qt4'
            : ($self->hasOption('use-stable-kde') # Could also be false if unset
                ? 'kf5-qt5'      # Really set to false
                : 'latest-qt4'); # Unset / this is default branch group if no option set
    }

    return $branchGroup;
}

961
962
963
# Returns a ksb::Module::BranchGroupResolver which can be used to efficiently
# determine a git branch to use for a given kde-projects module (when the
# branch-group option is in use), as specified at
964
# https://community.kde.org/Infrastructure/Project_Metadata.
965
966
967
968
969
sub moduleBranchGroupResolver
{
    my $self = shift;

    if (!$self->{logical_module_resolver}) {
970
        my $metadataModule = $self->getKDEProjectsMetadataModule();
971
972
973
974
975
976
977
978
979
980
981
982

        croak_internal("Tried to use branch-group, but needed data wasn't loaded!")
            unless $metadataModule;

        my $resolver = ksb::Module::BranchGroupResolver->new(
            $metadataModule->scm()->logicalModuleGroups());
        $self->{logical_module_resolver} = $resolver;
    }

    return $self->{logical_module_resolver};
}

983
984
985
986
987
988
sub statusViewer
{
    my $self = shift;
    return $self->{status_view};
}

989
1;