]> git.netwichtig.de Git - user/henk/code/inspircd.git/blob - make/common.pm
Update copyright headers.
[user/henk/code/inspircd.git] / make / common.pm
1 #
2 # InspIRCd -- Internet Relay Chat Daemon
3 #
4 #   Copyright (C) 2014-2017, 2019-2021 Sadie Powell <sadie@witchery.services>
5 #
6 # This file is part of InspIRCd.  InspIRCd is free software: you can
7 # redistribute it and/or modify it under the terms of the GNU General Public
8 # License as published by the Free Software Foundation, version 2.
9 #
10 # This program is distributed in the hope that it will be useful, but WITHOUT
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 # FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
13 # details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
17 #
18
19
20 package make::common;
21
22 use v5.10.0;
23 use strict;
24 use warnings FATAL => qw(all);
25
26 use Exporter              qw(import);
27 use File::Path            qw(mkpath);
28 use File::Spec::Functions qw(rel2abs);
29
30 use make::console;
31
32 our @EXPORT = qw(create_directory
33                  execute
34                  get_cpu_count
35                  get_version
36                  read_config_file
37                  write_config_file);
38
39 sub create_directory($$) {
40         my ($location, $permissions) = @_;
41         return eval {
42                 mkpath($location, 0, $permissions);
43                 return 1;
44         } // 0;
45 }
46
47 sub execute(@) {
48         say console_format "<|BOLD \$|> @_";
49         return system @_;
50 }
51
52 sub get_version {
53         state %version;
54         return %version if %version;
55
56         # Attempt to retrieve version information from src/version.sh
57         chomp(my $vf = `sh src/version.sh 2>/dev/null`);
58         if ($vf =~ /^InspIRCd-([0-9]+)\.([0-9]+)\.([0-9]+)(?:-(\w+))?$/) {
59                 %version = ( MAJOR => $1, MINOR => $2, PATCH => $3, LABEL => $4 );
60         }
61
62         # Attempt to retrieve missing version information from Git
63         chomp(my $gr = `git describe --tags 2>/dev/null`);
64         if ($gr =~ /^v([0-9]+)\.([0-9]+)\.([0-9]+)(?:[a-z]+\d+)?(?:-\d+-g(\w+))?$/) {
65                 $version{MAJOR} //= $1;
66                 $version{MINOR} //= $2;
67                 $version{PATCH} //= $3;
68                 $version{LABEL} = $4 if defined $4;
69         }
70
71         # If the user has specified a distribution label then we use it in
72         # place of the label from src/version.sh or Git.
73         $version{REAL_LABEL} = $version{LABEL};
74         $version{LABEL} = shift // $version{LABEL};
75
76         # If any of these fields are missing then the user has deleted the
77         # version file and is not running from Git. Fill in the fields with
78         # dummy data so we don't get into trouble with undef values later.
79         $version{MAJOR} //= '0';
80         $version{MINOR} //= '0';
81         $version{PATCH} //= '0';
82
83         # If there is no label then the user is using a stable release which
84         # does not have a label attached.
85         if (defined $version{LABEL}) {
86                 $version{FULL} = "$version{MAJOR}.$version{MINOR}.$version{PATCH}-$version{LABEL}"
87         } else {
88                 $version{LABEL} = 'release';
89                 $version{FULL} = "$version{MAJOR}.$version{MINOR}.$version{PATCH}"
90         }
91
92         return %version;
93 }
94
95 sub get_cpu_count {
96         my $count = 1;
97         if ($^O =~ /bsd/) {
98                 $count = `sysctl -n hw.ncpu 2>/dev/null` || 1;
99         } elsif ($^O eq 'darwin') {
100                 $count = `sysctl -n hw.activecpu 2>/dev/null` || 1;
101         } elsif ($^O eq 'linux') {
102                 $count = `getconf _NPROCESSORS_ONLN 2>/dev/null` || 1;
103         } elsif ($^O eq 'solaris') {
104                 $count = `psrinfo -p 2>/dev/null` || 1;
105         }
106         chomp($count);
107         return $count;
108 }
109
110 sub read_config_file($) {
111         my $path = shift;
112         my %config;
113         open(my $fh, $path) or return %config;
114         while (my $line = <$fh>) {
115                 next if $line =~ /^\s*($|\#)/;
116                 my ($key, $value) = ($line =~ /^(\S+)(?:\s(.*))?$/);
117                 $config{$key} = $value;
118         }
119         close $fh;
120         return %config;
121 }
122
123 sub write_config_file($%) {
124         my $path = shift;
125         my %config = @_;
126         open(my $fh, '>', $path) or print_error "unable to write to $path: $!";
127         while (my ($key, $value) = each %config) {
128                 $value //= '';
129                 say $fh "$key $value";
130         }
131         close $fh;
132 }
133
134 1;