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 | $self->{config}->{ARCH} = (uname)[4];
|
---|
62 |
|
---|
63 | die "Distro '$args{distro}' is invalid (does not specify a manager)"
|
---|
64 | unless (exists $self->{config}->{MANAGER});
|
---|
65 |
|
---|
66 | my $class = __PACKAGE__ . '::_' . lc $self->{config}->{MANAGER};
|
---|
67 | eval "require $class; 1" or die "Package manager '$self->{config}->{MANAGER}' does not exist or did not compile";
|
---|
68 |
|
---|
69 | # Reclassify as our implementation
|
---|
70 | bless $self, $class;
|
---|
71 |
|
---|
72 | $self->readconf ($package_conf);
|
---|
73 |
|
---|
74 | $self->{package} = $args{package};
|
---|
75 | $self->{distro} = $args{distro};
|
---|
76 | $self->{output} = "build/$args{distro}/$args{package}";
|
---|
77 | make_path $self->{output};
|
---|
78 |
|
---|
79 | $self->add_sources;
|
---|
80 | $self->add_makefile;
|
---|
81 | $self->add_install;
|
---|
82 | $self->add_package;
|
---|
83 | }
|
---|
84 |
|
---|
85 | # Copys the source files required for this package,
|
---|
86 | # from the files/ folder
|
---|
87 | # Performs variable substitution on file names,
|
---|
88 | # and file content for plain-text files
|
---|
89 | sub add_sources {
|
---|
90 | my $self = shift;
|
---|
91 | for my $source (@{$self->{config}->{SOURCES}}) {
|
---|
92 | $self->add ("files/$source", "$self->{output}/$source", $self->{config});
|
---|
93 | }
|
---|
94 | }
|
---|
95 |
|
---|
96 | # Generates the Makefile for this package,
|
---|
97 | # by concatenating the files in the segments/ folder
|
---|
98 | sub add_makefile {
|
---|
99 | my $self = shift;
|
---|
100 | push @{$self->{config}->{SOURCES}}, 'Makefile';
|
---|
101 | my $makefile = "$self->{output}/Makefile";
|
---|
102 | print " - $makefile\n";
|
---|
103 | open MAKEFILE, '>', $makefile
|
---|
104 | or die "Failed to open '$makefile' for writing: $!";
|
---|
105 | for my $segment (@{$self->{config}->{MAKEFILE}}) {
|
---|
106 | open IN, '<', "segments/$segment"
|
---|
107 | or die "Failed to open 'segments/$segment' for reading: $!";
|
---|
108 | while (my $line = <IN>) {
|
---|
109 | $self->subst ($line);
|
---|
110 | print MAKEFILE $line;
|
---|
111 | }
|
---|
112 | close IN;
|
---|
113 | print MAKEFILE "\n";
|
---|
114 | }
|
---|
115 | # add a target for packaging
|
---|
116 | my $manager_segment = "segments/$self->{config}->{MANAGER}";
|
---|
117 | open IN, '<', $manager_segment
|
---|
118 | or die "Failed to open '$manager_segment' for reading: $!";
|
---|
119 | while (my $line = <IN>) {
|
---|
120 | $self->subst ($line);
|
---|
121 | print MAKEFILE $line;
|
---|
122 | }
|
---|
123 | close IN;
|
---|
124 | close MAKEFILE;
|
---|
125 | }
|
---|
126 |
|
---|
127 | # Generates the package-manager specific package generation scripts
|
---|
128 | sub add_package {
|
---|
129 | my $self = shift;
|
---|
130 |
|
---|
131 | # Add the (relatively) static files
|
---|
132 | $self->add ("managers/$self->{config}->{MANAGER}", $self->{output});
|
---|
133 |
|
---|
134 | if (exists $self->{config}->{SUB_PACKAGES}) {
|
---|
135 | my $packages = [];
|
---|
136 | for my $subpackage (sort @{$self->{config}->{SUB_PACKAGES}}) {
|
---|
137 | my $config = {};
|
---|
138 | for my $key (keys %{$self->{config}}) {
|
---|
139 | if ($key =~ /^${subpackage}_(.*)$/) {
|
---|
140 | # print "setting '$1' to '$key' = '$self->{config}->{$key}'\n";
|
---|
141 | $config->{$1} = $self->{config}->{$key};
|
---|
142 | }
|
---|
143 | }
|
---|
144 | # hashdump $self->{config};
|
---|
145 | push @{$packages}, $config;
|
---|
146 | }
|
---|
147 | $self->add_package_impl ($packages);
|
---|
148 | } else {
|
---|
149 | $self->add_package_impl;
|
---|
150 | }
|
---|
151 | }
|
---|
152 |
|
---|
153 | # Adds a file or a folder to the package's folder
|
---|
154 | sub add {
|
---|
155 | my ($self, $src, $dst) = @_;
|
---|
156 | $self->subst ($dst);
|
---|
157 |
|
---|
158 | # make sure the destination path exists
|
---|
159 | make_path dirname $dst;
|
---|
160 |
|
---|
161 | if (-d $src) {
|
---|
162 | mkdir $dst;
|
---|
163 | opendir my $DIRFH, $src or die "Could not open '$src': $!";
|
---|
164 | while (readdir $DIRFH) {
|
---|
165 | next if ($_ eq '.' or $_ eq '..');
|
---|
166 | $self->add ("$src/$_", "$dst/$_");
|
---|
167 | }
|
---|
168 | closedir $DIRFH;
|
---|
169 | } else {
|
---|
170 | print ' - ', $dst, "\n";
|
---|
171 | if (-B $src) {
|
---|
172 | # copy binary file
|
---|
173 | cp $src, $dst or die "Failed to copy '$src': $!";
|
---|
174 | } else {
|
---|
175 | # copy normal file
|
---|
176 | open IN, '<', $src
|
---|
177 | or die "Failed to open '$src' for reading: $!";
|
---|
178 | open OUT, '>', $dst
|
---|
179 | or die "Failed to open '$dst' for writing: $!";
|
---|
180 | while (my $line = <IN>) {
|
---|
181 | $self->subst ($line);
|
---|
182 | print OUT $line;
|
---|
183 | }
|
---|
184 | my $perms = (stat IN)[2] & 07777;
|
---|
185 | close IN;
|
---|
186 | close OUT;
|
---|
187 | chmod ($perms | 0600, $dst);
|
---|
188 | }
|
---|
189 | }
|
---|
190 | }
|
---|
191 |
|
---|
192 | 1;
|
---|