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

Revision 29551, 4.6 KB (checked in by jts21, 5 years ago)

I lied. (Ubuntu packages wouldn't generate from a clean build folder. Changed 'add' method to make it create any necessary folders). Ubuntu works.

Line 
1package Greenstone::Package;
2
3use strict;
4use warnings;
5use utf8;
6use File::Basename;
7use File::Path 'make_path';
8use File::Copy 'cp';
9use Greenstone::Helpers;
10use base 'Exporter';
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');
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
86sub 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
95sub 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
125sub 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
131sub 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
1691;
Note: See TracBrowser for help on using the browser.