2 # InspIRCd -- Internet Relay Chat Daemon
4 # Copyright (C) 2016 Peter Powell <petpow@saberuk.com>
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.
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
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/>.
20 package make::directive;
28 use warnings FATAL => qw(all);
30 use File::Basename qw(basename);
31 use Exporter qw(import);
36 use constant DIRECTIVE_ERROR_PIPE => $ENV{INSPIRCD_VERBOSE} ? '' : '2>/dev/null';
38 our @EXPORT = qw(get_directive
41 sub get_directive($$;$)
43 my ($file, $property, $default) = @_;
44 open(MODULE, $file) or return $default;
48 if ($_ =~ /^\/\* \$(\S+): (.+) \*\/$/ || $_ =~ /^\/\/\/ \$(\S+): (.+)/) {
49 next unless $1 eq $property;
50 $value .= ' ' . execute_functions($file, $1, $2);
55 # Strip all extraneous whitespace.
56 $value =~ s/^\s+|\s+$//g;
57 return $value || $default;
60 sub execute_functions($$$) {
61 my ($file, $name, $line) = @_;
63 # NOTE: we have to use 'our' instead of 'my' here because of a Perl bug.
64 for (our @parameters = (); $line =~ /([a-z_]+)\((?:\s*"([^"]*)(?{push @parameters, $2})"\s*)*\)/; undef @parameters) {
65 my $sub = make::directive->can("__function_$1");
66 print_error "unknown $name directive '$1' in $file!" unless $sub;
68 # Call the subroutine and replace the function.
69 my $result = $sub->($file, @parameters);
70 if (defined $result) {
71 $line = $` . $result . $';
75 # If the subroutine returns undef then it is a sign that we should
76 # disregard the rest of the line and stop processing it.
84 my ($file, @message) = @_;
87 # If we have package details then suggest to the user that they check
88 # that they have the packages installed.=
89 my $dependencies = get_directive($file, 'PackageInfo');
90 if (defined $dependencies) {
91 my @packages = sort grep { /^\S+$/ } split /\s/, $dependencies;
92 push @message, 'You should make sure you have the following packages installed:';
94 push @message, " * $_";
97 push @message, 'You should make sure that you have all of the required dependencies';
98 push @message, 'for this module installed.';
102 # If we have author information then tell the user to report the bug
103 # to them. Otherwise, assume it is a bundled module and tell the user
104 # to report it to the InspIRCd issue tracker.
105 my $author = get_directive($file, 'ModAuthor');
106 if (defined $author) {
107 push @message, 'If you believe this error to be a bug then you can try to contact the';
108 push @message, 'author of this module:';
109 my $author_mail = get_directive($file, 'ModAuthorMail');
110 if (defined $author_mail) {
111 push @message, " * $author <$author_mail>";
113 push @message, " * $author";
116 push @message, 'If you believe this error to be a bug then you can file a bug report';
117 push @message, 'at https://github.com/inspircd/inspircd/issues';
121 push @message, 'If you would like help with fixing this problem then visit our IRC';
122 push @message, 'channel at irc.inspircd.org #InspIRCd for support.';
125 print_error @message;
128 sub __function_error {
129 my ($file, @messages) = @_;
130 __error $file, @messages;
133 sub __function_execute {
134 my ($file, $command, $environment, $defaults) = @_;
136 # Try to execute the command...
137 chomp(my $result = `$command ${\DIRECTIVE_ERROR_PIPE}`);
139 print_format "Execution of `<|GREEN $command|>` succeeded: <|BOLD $result|>\n";
143 # If looking up with pkg-config fails then check the environment...
144 if (defined $environment && $environment ne '') {
145 $environment = sprintf('INSPIRCD_%s', uc $environment);
146 if (defined $ENV{$environment}) {
147 print_format "Execution of `<|GREEN $command|>` failed; using the environment: <|BOLD $ENV{$environment}|>\n";
148 return $ENV{$environment};
152 # If all else fails then look for the defaults..
153 if (defined $defaults) {
154 print_format "Execution of `<|GREEN $command|>` failed; using the defaults: <|BOLD $defaults|>\n";
158 # Executing the command failed and we don't have any defaults so give up.
159 __error $file, "`<|GREEN $command|>` exited with a non-zero exit code!";
162 sub __function_find_compiler_flags {
163 my ($file, $name, $defaults) = @_;
165 # Try to look up the compiler flags with pkg-config...
166 chomp(my $flags = `pkg-config --cflags $name ${\DIRECTIVE_ERROR_PIPE}`);
168 print_format "Found the compiler flags for <|GREEN ${\basename $file, '.cpp'}|> using pkg-config: <|BOLD $flags|>\n";
172 # If looking up with pkg-config fails then check the environment...
173 my $key = sprintf('INSPIRCD_CXXFLAGS_%s', uc $name);
174 if (defined $ENV{$key}) {
175 print_format "Found the compiler flags for <|GREEN ${\basename $file, '.cpp'}|> using the environment: <|BOLD $ENV{$key}|>\n";
179 # If all else fails then look for the defaults..
180 if (defined $defaults) {
181 print_format "Found the compiler flags for <|GREEN ${\basename $file, '.cpp'}|> using the defaults: <|BOLD $defaults|>\n";
185 # We can't find it via pkg-config, via the environment, or via the defaults so give up.
186 __error $file, "unable to find the compiler flags for <|GREEN ${\basename $file, '.cpp'}|>!";
189 sub __function_find_linker_flags {
190 my ($file, $name, $defaults) = @_;
192 # Try to look up the linker flags with pkg-config...
193 chomp(my $flags = `pkg-config --libs $name ${\DIRECTIVE_ERROR_PIPE}`);
195 print_format "Found the linker flags for <|GREEN ${\basename $file, '.cpp'}|> using pkg-config: <|BOLD $flags|>\n";
199 # If looking up with pkg-config fails then check the environment...
200 my $key = sprintf('INSPIRCD_LDFLAGS_%s', uc $name);
201 if (defined $ENV{$key}) {
202 print_format "Found the linker flags for <|GREEN ${\basename $file, '.cpp'}|> using the environment: <|BOLD $ENV{$key}|>\n";
206 # If all else fails then look for the defaults..
207 if (defined $defaults) {
208 print_format "Found the linker flags for <|GREEN ${\basename $file, '.cpp'}|> using the defaults: <|BOLD $defaults|>\n";
212 # We can't find it via pkg-config, via the environment, or via the defaults so give up.
213 __error $file, "unable to find the linker flags for <|GREEN ${\basename $file, '.cpp'}|>!";
216 sub __function_require_system {
217 my ($file, $name, $minimum, $maximum) = @_;
218 my ($system, $version);
220 # Linux is special and can be compared by distribution names.
221 if ($^O eq 'linux' && $name ne 'linux') {
222 chomp($system = lc `lsb_release --id --short 2>/dev/null`);
223 chomp($version = lc `lsb_release --release --short 2>/dev/null`);
226 # Gather information on the system if we don't have it already.
227 chomp($system ||= lc `uname -s 2>/dev/null`);
228 chomp($version ||= lc `uname -r 2>/dev/null`);
230 # We only care about the important bit of the version number so trim the rest.
231 $version =~ s/^(\d+\.\d+).+/$1/;
233 # Check whether the current system is suitable.
234 return undef if $name ne $system;
235 return undef if defined $minimum && $version < $minimum;
236 return undef if defined $maximum && $version > $maximum;
238 # Requirement directives don't change anything directly.
242 sub __function_require_version {
243 my ($file, $name, $minimum, $maximum) = @_;
245 # If pkg-config isn't installed then we can't do anything here.
246 if (system "pkg-config --exists $name ${\DIRECTIVE_ERROR_PIPE}") {
247 print_warning "unable to look up the version of $name using pkg-config!";
251 # Check with pkg-config whether we have the required version.
252 return undef if defined $minimum && system "pkg-config --atleast-version $minimum $name";
253 return undef if defined $maximum && system "pkg-config --max-version $maximum $name";
255 # Requirement directives don't change anything directly.
259 sub __function_warning {
260 my ($file, @messages) = @_;
261 print_warning @messages;