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

Revision 29536, 4.5 KB (checked in by jts21, 6 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.

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 browser.