File: Archrepo.pm

package info (click to toggle)
obs-build 20180831-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 2,396 kB
  • sloc: perl: 10,030; sh: 3,142; ansic: 284; makefile: 151; python: 35
file content (105 lines) | stat: -rw-r--r-- 3,463 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Archrepo;

use strict;
use Build::Arch;

eval { require Archive::Tar; };
if (!defined &Archive::Tar::iter) {
  *Archive::Tar::iter = sub {
    my ($class, $filename) = @_;
    die("Archive::Tar is not available\n") unless defined &Archive::Tar::new;
    Archive::Tar->new();
    my $handle = $class->_get_handle($filename, 1, 'rb') or return undef;
    my @data;
    return sub {
      return shift(@data) if !$handle || @data; 
      my $files = $class->_read_tar($handle, { limit => 1 });
      @data = @$files if (ref($files) || '') eq 'ARRAY';
      undef $handle unless @data;
      return shift @data;
    };
  };
}

sub addpkg {
  my ($res, $data, $options) = @_;
  return unless defined $data->{'version'};
  if ($options->{'addselfprovides'}) {
    my $selfprovides = $data->{'name'};
    $selfprovides .= "=$data->{'version'}" if defined $data->{'version'};
    push @{$data->{'provides'}}, $selfprovides unless @{$data->{'provides'} || []} && $data->{'provides'}->[-1] eq $selfprovides;
  }
  if ($options->{'normalizedeps'}) {
    # our normalized dependencies have spaces around the op
    for my $dep (qw {provides requires conflicts obsoletes suggests}) {
      next unless $data->{$dep};
      s/ ?([<=>]+) ?/ $1 / for @{$data->{$dep}};
    }
  }
  if (defined($data->{'version'})) {
    # split version into evr
    $data->{'epoch'} = $1 if $data->{'version'} =~ s/^(\d+)://s;
    $data->{'release'} = $1 if $data->{'version'} =~ s/-([^-]*)$//s;
  }
  $data->{'location'} = delete($data->{'filename'}) if exists $data->{'filename'};
  if ($options->{'withchecksum'}) {
    for (qw {md5 sha1 sha256}) {
      my $c = delete($data->{"checksum_$_"});
      $data->{'checksum'} = "$_:$c" if $c;
    }     
  } else {
    delete $data->{"checksum_$_"} for qw {md5 sha1 sha256};
  }
  if (ref($res) eq 'CODE') {
    $res->($data);
  } else {
    push @$res, $data;
  }
}

sub parse {
  my ($in, $res, %options) = @_;
  $res ||= [];
  die("Build::Archrepo::parse needs a filename\n") if ref($in);
  die("$in: $!\n") unless -e $in;
  my $repodb = Archive::Tar->iter($in, 1);
  die("$in is not a tar archive\n") unless $repodb;
  my $e;
  my $lastfn = '';
  my $d;
  while ($e = $repodb->()) {
    next unless $e->type() == Archive::Tar::Constant::FILE();
    my $fn = $e->name();
    next unless $fn =~ s/\/(?:depends|desc|files)$//s;
    if ($lastfn ne $fn) {
      addpkg($res, $d, \%options) if $d->{'name'};
      $d = {};
      $lastfn = $fn;
    }
    Build::Arch::parserepodata($d, $e->get_content());
  }
  addpkg($res, $d, \%options) if $d->{'name'};
  return $res;
}

1;