[29536] | 1 | package Greenstone::Package;
|
---|
| 2 |
|
---|
| 3 | use strict;
|
---|
| 4 | use warnings;
|
---|
| 5 | use utf8;
|
---|
[29551] | 6 | use File::Basename;
|
---|
[29536] | 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
|
---|
[29546] | 55 | my $self = bless({}, 'Greenstone::Config');
|
---|
[29536] | 56 |
|
---|
| 57 | $self->readconf ("global.conf");
|
---|
| 58 | $self->readconf ($distro_conf);
|
---|
[29546] | 59 |
|
---|
[29536] | 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};
|
---|
[29546] | 64 | eval "require $class; 1" or die "Package manager '$self->{config}->{MANAGER}' does not exist or did not compile";
|
---|
[29536] | 65 |
|
---|
| 66 | # Reclassify as our implementation
|
---|
| 67 | bless $self, $class;
|
---|
| 68 |
|
---|
[29546] | 69 | $self->readconf ($package_conf);
|
---|
| 70 |
|
---|
[29536] | 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;
|
---|
[29546] | 78 | $self->add_install;
|
---|
[29536] | 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 |
|
---|
[29551] | 135 | # make sure the destination path exists
|
---|
| 136 | make_path dirname $dst;
|
---|
| 137 |
|
---|
[29536] | 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;
|
---|