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

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

Working on a more flexible generation system. Only working for pacman so far, so if you want to generate packages you'll need to check out an old revision. The reason behind this change is that I discovered that the greenstone user database really needs to be owned by the tomcat user rather than root (things such as edit mode don't work properly otherwise), and setting file ownership requires .install files, which was not really possible with the existing system. At this point it would certainly have been faster to just write all the scripts by hand, but this way I get to learn perl.

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