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, $version, $data) = @_;
  16
  17     my %data = ( package => $pkg,
  18                  version => $version,
  19                  );
  20     chomp($data);
  21     $data =~ s/\n\s+/\377/g;
  22     while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
  23         my ($key, $value) = ($1, $2);
  24         $key =~ tr [A-Z] [a-z];
  25         $data{$key} = $value;
  26     }
  27 #       debug( "Merge package:\n".Dumper(\%data), 3 );
  28     return $self->merge_package( \%data );
  29 }
  30
  31 sub gettext { return $_[0]; }
  32
  33 our @DEP_FIELDS = qw( build-depends build-depends-indep
  34                       build-conflicts build-conflicts-indep);
  35 sub merge_package {
  36     my ($self, $data) = @_;
  37
  38     ($data->{package} && $data->{version}) || return;
  39     $self->{package} ||= $data->{package};
  40     ($self->{package} eq $data->{package}) || return;
  41     debug( "merge package $data->{package}/$data->{version} into $self (".($self->{version}||'').")", 2 );
  42
  43     if (!$self->{version}
  44         || (version_cmp( $data->{version}, $self->{version} ) > 0)) {
  45         debug( "added package is newer, replacing old information" );
  46
  47         $self->{data} = $data;
  48
  49         my @uploaders;
  50         if ($data->{maintainer} ||= '') {
  51             push @uploaders, [ split_name_mail( $data->{maintainer} ) ];
  52         }
  53         if ($data->{uploaders}) {
  54             my @up_tmp = split( /\s*,\s*/,
  55                                 $data->{uploaders} );
  56             foreach my $up (@up_tmp) {
  57                 if ($up ne $data->{maintainer}) { # weed out duplicates
  58                     push @uploaders, [ split_name_mail( $up ) ];
  59                 }
  60             }
  61         }
  62         $self->{uploaders} = \@uploaders;
  63
  64         if ($data->{files}) {
  65             $self->{files} = [];
  66             foreach my $sf ( split( /\377/, $data->{files} ) ) {
  67                 next unless $sf;
  68                 # md5, size, name
  69                 push @{$self->{files}}, [ split( /\s+/, $sf) ];
  70             }
  71         }
  72
  73         foreach (@DEP_FIELDS) {
  74             $self->normalize_dependencies( $_, $data );
  75         }
  76
  77         $self->{version} = $data->{version};
  78     }
  79 }
  80
  81 #FIXME: should be mergable with the Packages::Page version
  82 sub normalize_dependencies {
  83     my ($self, $dep_field, $data) = @_;
  84
  85     my ($deps_norm, $deps) = parse_deps( $data->{$dep_field}||'' );
  86     $self->{dep_fields}{$dep_field} =
  87         [ $deps_norm, $deps ];
  88 }
  89
  90 sub get_src {
  91     my ($self, $field) = @_;
  92
  93     return $self->{$field} if exists $self->{$field};
  94     return $self->{data}{$field};
  95 }
  96
  97 sub get_architectures {
  98     die "NOT SUPPORTED";
  99 }
 100
 101 sub get_arch_field {
 102     my ($self, $field) = @_;
 103
 104     return $self->{data}{$field};
 105 }
 106
 107 sub get_versions {
 108     my ($self) = @_;
 109
 110     return [ $self->{version} ];
 111 }
 112
 113 sub get_version_string {
 114     my ($self) = @_;
 115
 116     my $versions = $self->get_versions;
 117
 118     return ($self->{version}, $versions);
 119 }
 120
 121 sub get_dep_field {
 122     my ($self, $dep_field) = @_;
 123
 124     return $self->{dep_fields}{$dep_field}[1];
 125 }
 126
 127 1;