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

Revision 29546, 4.5 KB (checked in by jts21, 5 years ago)

Arch package now automatically sets the owner of the web directory to the tomcat user. The functionality is also implemented for the other package managers, but not yet tested.

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