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;