view release on metacpan or  search on metacpan

lib/Package/Builder.pm  view on Meta::CPAN

    '^\/initrd$', '^\/lost+found$', '^\/root$',     '^\/selinux$',
    '^\/sys$',    '^\/usr$',        '\/usr\/sbin$', '\/usr\/bin$'
);

our @config_pattern = (
    "config", "conf",, "etc",
    "initrd", "\.conf", "\.properties", "\.cnf",
    "\.ini",  "\.xml"
);
our @doc_pattern =
  ( "doc", "\.txt", "README", "LICENCE", "LICENSE", "TODO", "\.html", "\.tex" );

my %dirAlias = (
    "/usr/sbin"    => "%{_sbindir}",
    "/usr/bin"     => "%{_bindir}",
    "/usr/lib"     => "%{_libdir}",
    "/usr/libexec" => "%{_libexecdir}",
    "/usr/share"   => "%{_datadir}",
    "/var"         => "%{_var}"
);

our $macrosFile = $ENV{'HOME'} . "/.rpmmacros";

our $topdir          = getParameterFromConfig( "_topdir", "/usr/src/redhat" );
our $specDir         = $topdir . "/SPECS";
our $srcDir          = $topdir . "/SOURCES";
our $archiveRootPath = "/tmp/myrpm";

=head1 FUNCTIONS

=head2 extractArchive

=cut
sub extractArchive {
	my $archive = shift;
	my $root_dir = shift;
	my $uid = shift;
	my $gid = shift;

    # Create temporary dir
    my $snap_dir = "$archiveRootPath/$$";
    my $tmp_dir  = "$snap_dir/$root_dir";
    eval { mkpath($tmp_dir) };
    if ($@) {
        print STDERR "\n * Couldn't create $tmp_dir: $@";
	return undef;
    }
    my $cwdir = getcwd;
    chdir $tmp_dir;

    my $compressed_archive = ( $archive =~ /.+?\.(?:tar\.gz|tgz)$/i );
    my $arch_obj = Archive::Tar->new( $archive, $compressed_archive );
    $arch_obj->extract();

    if ( defined $uid && defined $gid ) {
    #change uid if necessary
    $uid = getUserId($uid);
    $gid = getGroupId($gid);
    find(
        sub {
            chown $uid, $gid, $_;
        },
        $tmp_dir
    );
    }
    chdir $cwdir;

    return $snap_dir;
}
=head2 isReservedDir

=cut
sub isReservedDir {
    my $dir = shift;
    foreach my $rdir (@reserved_dirs) {
        return 1 if ( $dir =~ /$rdir/ );
    }
    return 0;
}

=head2 isDocFile

=cut
sub isDocFile {
    my $file = shift;
    foreach my $dpat (@doc_pattern) {
        return 1 if ( $file =~ /$dpat/ );
    }
    return 0;
}

=head2 isConfigFile

=cut
sub isConfigFile {
    my $file = shift;
    foreach my $cpat (@config_pattern) {
        return 1 if ( $file =~ /$cpat/ );
    }
    return 0;
}

=head2 substituteAliasDir

=cut
sub substituteAliasDir {
    my $path = shift;

    #my $not_found=1;
    foreach my $subpath ( keys %dirAlias ) {

        #break unless ($not_found);
        if ( $path =~ /^$subpath/ ) {
            my $alias = $dirAlias{$subpath};
            $path =~ s/^$subpath/$alias/;
            return $path;
        }
    }
    return $path;
}