Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Bower components Debian packages RPM packages NuGet packages

beebox / crossover   deb

Repository URL to install this package:

Version: 18.5.0-1 

/ opt / cxoffice / lib / perl / CXDebian.pm

# (c) Copyright 2008, 2010, 2014. CodeWeavers, Inc.
package CXDebian;
use warnings;
use strict;

use CXLog;
use CXUtils;


#####
#
# Static functions
#
#####

sub compute_package_name($)
{
    my ($name)=@_;

    # Debian packages only allow a precisely defined
    # set of characters in the package name.
    $name =~ tr/A-Z/a-z/;
    $name =~ s/[^a-z0-9+.-]/+/g;
    return $name;
}


#####
#
# The CXDebian class
#
#####

sub new($$)
{
    my ($class, $buildroot)=@_;
    my $self={ buildroot => $buildroot,
               renames => 0
             };
    bless $self, $class;

    my %tools=("dh_builddeb"       => "debhelper",
               "dpkg-buildpackage" => "dpkg-dev",
               "fakeroot"          => "fakeroot");

    my @missing;
    while (my ($tool, $package)=each %tools)
    {
        $self->{$tool}=CXUtils::cxwhich($ENV{PATH}, $tool);
        push @missing, $package if (!defined $self->{$tool});
    }
    if (@missing)
    {
        cxerr("You need to install some Debian development packages: " . join(", ", @missing) . " or equivalent\n");
        return undef;
    }

    if (!cxmkpath("$self->{buildroot}/debian", 0700))
    {
        cxerr("unable to create the '$self->{buildroot}/debian' directory: $@\n");
        return undef;
    }

    return $self;
}

sub add_file($$)
{
    my ($self, $src_root, $src)=@_;

    my $dst=$self->map_file($src_root, $src);
    if (!defined $dst)
    {
        cxlog("  $src -> <undef>\n");
        return 1;
    }
    cxlog("  $src -> $dst\n");

    my $full_src="$src_root/$src";
    my $src_base=cxbasename($src);
    my $dst_base=cxbasename($dst);
    if ($src =~ / / or $dst =~ / / or $dst_base ne $src_base)
    {
        if (!defined $self->{staged}->{$dst})
        {
            # Put the file in a staging directory because dh_install cannot
            # handle spaces or renaming.
            if (!defined $self->{stagingdir})
            {
                $self->{stagingdir}="$self->{buildroot}/staging";
                if (!mkdir $self->{stagingdir})
                {
                    cxerr("unable to create the '$self->{stagingdir}' directory: $!\n");
                    return 0;
                }
                push @{$self->{install}}, "$self->{stagingdir}/* /\n";
            }

            require File::Copy;
            my $staging="$self->{stagingdir}$dst";
            my $stagingdir=cxdirname($staging);
            if (!cxmkpath($stagingdir))
            {
                cxerr("unable to create the '$stagingdir' directory: $@\n");
                return 0;
            }
            if (!link("$full_src", $staging) and
                !File::Copy::copy("$full_src", $staging))
            {
                cxerr("unable to link/copy '$full_src' to '$staging': $!\n");
                return 0;
            }
            $self->{staged}->{$dst}=$full_src;
        }
        elsif ($self->{staged}->{$dst} ne $full_src)
        {
            cxerr("cannot ship both '$self->{staged}->{$dst}' and '$full_src' as '$dst'\n");
            return 0;
        }
    }
    else
    {
        $dst=cxdirname($dst);
        push @{$self->{install}}, "$full_src $dst\n";
    }
    return 1;
}

sub add_tree($$)
{
    my ($self, $src_root)=@_;
    cxlog("Debian::add_tree($src_root)\n");

    my @dirs=("");
    while (@dirs)
    {
        my $dir=shift @dirs;
        cxlog("$dir\n");

        my $dh;
        if (!opendir($dh, "$src_root/$dir"))
        {
            cxerr("unable to open the '$src_root/$dir' directory: $!\n");
            return 0;
        }
        foreach my $dentry (readdir $dh)
        {
            next if ($dentry =~ /^\.\.?$/);
            my $src="$dir$dentry";

            if (!-l "$src_root/$src" and -d _)
            {
                my $mode=(stat(_))[2] & 07777;
                my $dst=$self->map_directory($src_root, $src);
                if (!defined $dst)
                {
                    cxlog("  $src -> <undef>\n");
                    next;
                }
                cxlog("  $src -> $dst\n");
                if ($dst)
                {
                    push @{$self->{install}}, "$src_root/$src/* $dst\n";
                }
                else
                {
                    push @dirs, "$src/";
                }
            }
            elsif (!$self->add_file($src_root, $src))
            {
                return 0;
            }
        }
        closedir($dh);
    }
    return 1;
}

sub build($;@)
{
    my $self=shift @_;

    if (open(my $fh, ">", "$self->{buildroot}/debian/install"))
    {
        print $fh @{$self->{install}};
        close($fh);
    }
    else
    {
        cxerr("unable to open '$self->{buildroot}/debian/install' for writing: $!\n");
        return 0;
    }

    my $cmd=join(" ", shquote_string($self->{fakeroot}),
                 shquote_string("$self->{buildroot}/debian/build"),
                 shquote_string($self->{buildroot}), @_, "2>&1");
    my $output=cxbackquote($cmd);
    if ($?)
    {
        print STDERR $output;
        cxwarn("unable to build the Debian package\n");
        if ($self->{buildroot} =~ / /)
        {
            cxwarn("this is most likely because the path contains a space: '$self->{buildroot}'\n");
        }
        return 1;
    }
    return 0;
}

return 1;