source: main/trunk/package-kits/linux/perllib/Greenstone/Package.pm@ 29595

Last change on this file since 29595 was 29595, checked in by Jeremy Symon, 9 years ago

Modifying package generation to use sub-packages in order to avoid compiling the same source multiple times. Currently works for Pacman. Needs testing (and fixing) for other package managers.

File size: 5.3 KB
Line 
1package Greenstone::Package;
2
3use strict;
4use warnings;
5use utf8;
6use File::Basename;
7use File::Path 'make_path';
8use File::Copy 'cp';
9use POSIX 'uname';
10use Storable 'dclone';
11use Greenstone::Helpers;
12use base 'Exporter';
13
14use parent 'Greenstone::Config';
15
16our $VERSION = 1.00;
17our @EXPORT = qw(makepkg);
18
19=head1 NAME
20
21Greenstone::Package
22
23=head1 SYNOPSIS
24
25use Greenstone::Package;
26makepkg (
27 package => 'package',
28 distro => 'distro'
29);
30
31=head1 DESCRIPTION
32
33This module will generate scripts for building Greenstone packages
34under various Linux distributions
35
36=head2 FUNCTIONS
37
38Only the makepkg function is exported.
39All other functions are internal and should not be used externally.
40
41=cut
42
43sub 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
89sub 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
98sub 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
128sub 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
154sub 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
1921;
Note: See TracBrowser for help on using the repository browser.