]> git.deb.at Git - deb/packages.git/blob - lib/Packages/SrcPage.pm
Merge commit 'origin/master' into debian-master
[deb/packages.git] / lib / Packages / SrcPage.pm
1 package Packages::SrcPage;
2
3 use strict;
4 use warnings;
5
6 use Data::Dumper;
7 use Locale::gettext;
8 use Deb::Versions;
9 use Packages::CGI;
10 use Packages::Page qw( :all );
11
12 our @ISA = qw( Packages::Page );
13
14 #FIXME: change parameters so that we can use the version from Packages::Page
15 sub merge_data {
16     my ($self, $pkg, $suite, $archive, $data) = @_;
17
18     my %data = split /\00/o, $data;
19     $data{package} = $pkg;
20     $data{suite} = $suite;
21     $data{archive} = $archive;
22
23     return $self->merge_package( \%data );
24 }
25
26 our @DEP_FIELDS = qw( build-depends build-depends-indep
27                       build-conflicts build-conflicts-indep);
28 sub merge_package {
29     my ($self, $data) = @_;
30
31     ($data->{package} && $data->{suite} && $data->{archive}) || return;
32     $self->{package} ||= $data->{package};
33     ($self->{package} eq $data->{package}) || return;
34     debug( "merge package $data->{package}/$data->{version} into $self (".($self->{version}||'').")", 2 ) if DEBUG;
35
36     if (!$self->{version}
37         || (version_cmp( $data->{version}, $self->{version} ) > 0)) {
38         debug( "added package is newer, replacing old information" ) if DEBUG;
39
40         $self->{data} = $data;
41
42         my @uploaders;
43         if ($data->{maintainer} ||= '') {
44             push @uploaders, [ split_name_mail( $data->{maintainer} ) ];
45         }
46         if ($data->{uploaders}) {
47             my @up_tmp = split( /\s*,\s*/,
48                                 $data->{uploaders} );
49             foreach my $up (@up_tmp) {
50                 if ($up ne $data->{maintainer}) { # weed out duplicates
51                     push @uploaders, [ split_name_mail( $up ) ];
52                 }
53             }
54         }
55         $self->{uploaders} = \@uploaders;
56
57         if ($data->{files}) {
58             my @files = split /\01/so, $data->{files};
59             $self->{files} = \@files;
60         }
61
62         foreach (@DEP_FIELDS) {
63             $self->normalize_dependencies( $_, $data );
64         }
65
66         $self->{version} = $data->{version};
67     }
68 }
69
70 #FIXME: should be mergable with the Packages::Page version
71 sub normalize_dependencies {
72     my ($self, $dep_field, $data) = @_;
73
74     my ($deps_norm, $deps) = parse_deps( $data->{$dep_field}||'' );
75     $self->{dep_fields}{$dep_field} =
76         [ $deps_norm, $deps ];
77 }
78
79 sub get_src {
80     my ($self, $field) = @_;
81     
82     return $self->{$field} if exists $self->{$field};
83     return $self->{data}{$field};
84 }
85
86 sub get_architectures {
87     die "NOT SUPPORTED";
88 }
89
90 sub get_arch_field {
91     my ($self, $field) = @_;
92
93     return $self->{data}{$field};
94 }
95
96 sub get_versions {
97     my ($self) = @_;
98
99     return [ $self->{version} ];
100 }
101
102 sub get_version_string {
103     my ($self) = @_;
104
105     my $versions = $self->get_versions;
106
107     return ($self->{version}, $versions);
108 }
109
110 sub get_dep_field {
111     my ($self, $dep_field) = @_;
112
113     my @deps;
114     foreach my $dep (@{$self->{dep_fields}{$dep_field}[1]}) {
115         my @or_deps;
116         foreach my $or_dep ( @$dep ) {
117             my $p_name = $or_dep->[0];
118             my $p_version = $or_dep->[1] ? "$or_dep->[1] $or_dep->[2]" : undef;
119             my $arch_neg;
120             my $arch_str = '';
121             if ($or_dep->[3] && @{$or_dep->[3]}) {
122                 # as either all or no archs have to be prepended with
123                 # exlamation marks, use the first and delete the others
124                 if ($or_dep->[3][0] =~ /^!/) {
125                     $arch_neg = 1;
126                     foreach (@{$or_dep->[3]}) {
127                         $_ =~ s/^!//go;
128                     }
129                 }
130                 $arch_str = join(" ",sort(@{$or_dep->[3]}));
131             }
132
133             push @or_deps, [ $p_name, $p_version, $arch_neg, $arch_str ];
134         }
135         push @deps, [ 0, @or_deps ];
136     }
137     return \@deps;
138 }
139
140 1;