1 | package Greenstone::Package;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 | use warnings;
|
---|
5 | use utf8;
|
---|
6 | use File::Basename;
|
---|
7 | use File::Path 'make_path';
|
---|
8 | use File::Copy 'cp';
|
---|
9 | use POSIX 'uname';
|
---|
10 | use Storable 'dclone';
|
---|
11 | use Greenstone::Helpers;
|
---|
12 | use base 'Exporter';
|
---|
13 |
|
---|
14 | use parent 'Greenstone::Config';
|
---|
15 |
|
---|
16 | our $VERSION = 1.00;
|
---|
17 | our @EXPORT = qw(makepkg);
|
---|
18 |
|
---|
19 | =head1 NAME
|
---|
20 |
|
---|
21 | Greenstone::Package
|
---|
22 |
|
---|
23 | =head1 SYNOPSIS
|
---|
24 |
|
---|
25 | use Greenstone::Package;
|
---|
26 | makepkg (
|
---|
27 | package => 'package',
|
---|
28 | distro => 'distro'
|
---|
29 | );
|
---|
30 |
|
---|
31 | =head1 DESCRIPTION
|
---|
32 |
|
---|
33 | This module will generate scripts for building Greenstone packages
|
---|
34 | under various Linux distributions
|
---|
35 |
|
---|
36 | =head2 FUNCTIONS
|
---|
37 |
|
---|
38 | Only the makepkg function is exported.
|
---|
39 | All other functions are internal and should not be used externally.
|
---|
40 |
|
---|
41 | =cut
|
---|
42 |
|
---|
43 | sub makepkg {
|
---|
44 | my %args = @_;
|
---|
45 |
|
---|
46 | # sanity checks
|
---|
47 | die "A package must have a name" unless (exists $args{package});
|
---|
48 | die "A package must have a distro" unless (exists $args{distro});
|
---|
49 |
|
---|
50 | my $package_conf = "packages/$args{package}";
|
---|
51 | -f $package_conf or die "Package '$args{package}' does not exist";
|
---|
52 |
|
---|
53 | my $distro_conf = "distros/$args{distro}";
|
---|
54 | -f $distro_conf or die "Distro '$args{distro}' does not exist";
|
---|
55 |
|
---|
56 | # Classify ourselves as config and load the config
|
---|
57 | my $self = bless({}, 'Greenstone::Config');
|
---|
58 |
|
---|
59 | $self->readconf ("global.conf");
|
---|
60 | $self->readconf ($distro_conf);
|
---|
61 |
|
---|
62 | my $manager_conf = "managers/$self->{config}->{MANAGER}/conf";
|
---|
63 | -f $manager_conf or die "Manager config for '$self->{config}->{MANAGER}' does not exist";
|
---|
64 |
|
---|
65 | $self->readconf ($manager_conf);
|
---|
66 |
|
---|
67 | die "Distro '$args{distro}' is invalid (does not specify a manager)"
|
---|
68 | unless (exists $self->{config}->{MANAGER});
|
---|
69 |
|
---|
70 | my $class = __PACKAGE__ . '::_' . lc $self->{config}->{MANAGER};
|
---|
71 | eval "require $class; 1" or die "Package manager '$self->{config}->{MANAGER}' does not exist or did not compile";
|
---|
72 |
|
---|
73 | # Reclassify as our implementation
|
---|
74 | bless $self, $class;
|
---|
75 |
|
---|
76 | $self->readconf ($package_conf);
|
---|
77 |
|
---|
78 | $self->{package} = $args{package};
|
---|
79 | $self->{distro} = $args{distro};
|
---|
80 | $self->{output} = "build/$args{distro}/$args{package}";
|
---|
81 | make_path $self->{output};
|
---|
82 |
|
---|
83 | $self->add_sources;
|
---|
84 | $self->add_makefile;
|
---|
85 | $self->add_package;
|
---|
86 | }
|
---|
87 |
|
---|
88 | # Copys the source files required for this package,
|
---|
89 | # from the files/ folder
|
---|
90 | # Performs variable substitution on file names,
|
---|
91 | # and file content for plain-text files
|
---|
92 | sub add_sources {
|
---|
93 | my $self = shift;
|
---|
94 | for my $source (@{$self->{config}->{SOURCES}}) {
|
---|
95 | $self->add ("files/$source", "$self->{output}/$source", $self->{config});
|
---|
96 | }
|
---|
97 | }
|
---|
98 |
|
---|
99 | # Generates the Makefile for this package,
|
---|
100 | # by concatenating the files in the segments/ folder
|
---|
101 | sub add_makefile {
|
---|
102 | my $self = shift;
|
---|
103 | push @{$self->{config}->{SOURCES}}, 'Makefile';
|
---|
104 | my $makefile = "$self->{output}/Makefile";
|
---|
105 | print " - $makefile\n";
|
---|
106 | open MAKEFILE, '>', $makefile
|
---|
107 | or die "Failed to open '$makefile' for writing: $!";
|
---|
108 | for my $segment (@{$self->{config}->{MAKEFILE}}) {
|
---|
109 | open IN, '<', "segments/$segment"
|
---|
110 | or die "Failed to open 'segments/$segment' for reading: $!";
|
---|
111 | while (my $line = <IN>) {
|
---|
112 | $self->subst ($line);
|
---|
113 | print MAKEFILE $line;
|
---|
114 | }
|
---|
115 | close IN;
|
---|
116 | print MAKEFILE "\n";
|
---|
117 | }
|
---|
118 | # add a target for packaging
|
---|
119 | my $manager_segment = "segments/$self->{config}->{MANAGER}";
|
---|
120 | open IN, '<', $manager_segment
|
---|
121 | or die "Failed to open '$manager_segment' for reading: $!";
|
---|
122 | while (my $line = <IN>) {
|
---|
123 | $self->subst ($line);
|
---|
124 | print MAKEFILE $line;
|
---|
125 | }
|
---|
126 | close IN;
|
---|
127 | close MAKEFILE;
|
---|
128 | }
|
---|
129 |
|
---|
130 | # Generates the package-manager specific package generation scripts
|
---|
131 | sub add_package {
|
---|
132 | my $self = shift;
|
---|
133 |
|
---|
134 | # Add the (relatively) static files
|
---|
135 | my $static = "managers/$self->{config}->{MANAGER}/files";
|
---|
136 | -d $static and $self->add ($static, $self->{output});
|
---|
137 |
|
---|
138 | if (exists $self->{config}->{SUB_PACKAGES}) {
|
---|
139 | my $packages = [];
|
---|
140 | for my $subpackage (sort @{$self->{config}->{SUB_PACKAGES}}) {
|
---|
141 | my $config = {};
|
---|
142 | for my $key (keys %{$self->{config}}) {
|
---|
143 | if ($key =~ /^${subpackage}_(.*)$/) {
|
---|
144 | # print "setting '$1' to '$key' = '$self->{config}->{$key}'\n";
|
---|
145 | $config->{$1} = $self->{config}->{$key};
|
---|
146 | }
|
---|
147 | }
|
---|
148 | # hashdump $self->{config};
|
---|
149 | push @{$packages}, $config;
|
---|
150 | }
|
---|
151 | $self->add_package_impl ($packages);
|
---|
152 | } else {
|
---|
153 | $self->add_package_impl;
|
---|
154 | }
|
---|
155 | }
|
---|
156 |
|
---|
157 | # Adds a file or a folder to the package's folder
|
---|
158 | sub add {
|
---|
159 | my ($self, $src, $dst) = @_;
|
---|
160 | $self->subst ($dst);
|
---|
161 |
|
---|
162 | # make sure the destination path exists
|
---|
163 | make_path dirname $dst;
|
---|
164 |
|
---|
165 | if (-d $src) {
|
---|
166 | mkdir $dst;
|
---|
167 | opendir my $DIRFH, $src or die "Could not open '$src': $!";
|
---|
168 | while (readdir $DIRFH) {
|
---|
169 | next if ($_ eq '.' or $_ eq '..');
|
---|
170 | $self->add ("$src/$_", "$dst/$_");
|
---|
171 | }
|
---|
172 | closedir $DIRFH;
|
---|
173 | } else {
|
---|
174 | print ' - ', $dst, "\n";
|
---|
175 | if (-B $src) {
|
---|
176 | # copy binary file
|
---|
177 | cp $src, $dst or die "Failed to copy '$src': $!";
|
---|
178 | } else {
|
---|
179 | # copy normal file
|
---|
180 | open IN, '<', $src
|
---|
181 | or die "Failed to open '$src' for reading: $!";
|
---|
182 | open OUT, '>', $dst
|
---|
183 | or die "Failed to open '$dst' for writing: $!";
|
---|
184 | while (my $line = <IN>) {
|
---|
185 | $self->subst ($line);
|
---|
186 | print OUT $line;
|
---|
187 | }
|
---|
188 | my $perms = (stat IN)[2] & 07777;
|
---|
189 | close IN;
|
---|
190 | close OUT;
|
---|
191 | chmod ($perms | 0600, $dst);
|
---|
192 | }
|
---|
193 | }
|
---|
194 | }
|
---|
195 |
|
---|
196 | 1;
|
---|