lib/Packages/SrcPage.pm

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