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