# HG changeset patch # User Heiko Schlittermann # Date 1236296593 -3600 # Node ID 05c025e89571848c1846495eb9e8e049cd5dafc7 # Parent 0d30ea853889f148e98a0b12d0dc53f940849296 Added the missing libs. diff -r 0d30ea853889 -r 05c025e89571 .hgignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgignore Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,1 @@ +v diff -r 0d30ea853889 -r 05c025e89571 lib/Debian/ChangesFile.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Debian/ChangesFile.pm Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,13 @@ +package Debian::ChangesFile; + +use strict; +use warnings; + +use Debian::ControlFile; + +our @ISA = qw/Debian::ControlFile/; + + +1; + +# vim:sts=4 sw=4 aw ai sm: diff -r 0d30ea853889 -r 05c025e89571 lib/Debian/ControlFile.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Debian/ControlFile.pm Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,160 @@ +package Debian::ControlFile; + +# Großbuchstabige Methoden beziehen sich auf die +# Attribute des Changes-Files, alles andere +# folgt dem 'get/set-Schema' + +use strict; +use warnings; +use File::Basename; +use Carp; +use IO::File; + +use Debian::File; + +sub new { + my $class = ref $_[0] ? ref shift : shift; + my $self = bless {}, $class; + + + if (ref($_[0]) =~ /^Debian::(ControlFile|File)$/) { + $self->{file} = $_[0]->file; + $self->{prefix} = $_[0]->prefix; + shift; + + } else { + $self->{file} = shift; + + my %args = @_; + if ($args{path}) { + $self->{current} = $self->{file}; + @{$self}{qw/file prefix/} = fileparse($args{path}); + + $self->{prefix} =~ s/\/$//; + } else { + $self->{prefix} = "."; + } + } + + $self->parse; + + return $self; +} + +sub parse { + my $self = shift; + + my $f = $self->{current} ? $self->{current} : $self->path; + my $in = new IO::File $f or croak "Can't open <$f: $!"; + + my ($key, %changes); + local $_; + while (<$in>) { chomp; + last if /^-----BEGIN PGP SIGNATURE-----/; + + if (/^([a-z].*?):\s*(\S.*)?/i) { + $key = lc($1); + + push @{$changes{$key}}, $2 if defined $2; + next; + } + if (/^\s+(.*)/) { + push @{$changes{$key}}, $1; + next; + } + } + + + if (!exists($changes{format}) && $changes{format} < 1.7) { + croak "format $changes{format}->[0] is < 1.7 in $self->{file}\n"; + } + + $self->{changes} = \%changes; + + foreach ($self->key("files")) { + push @{$self->{files}}, new Debian::File $_, prefix => $self->prefix, current_prefix => dirname($f); + } +} + +sub file { $_[0]->{file} } +sub prefix { $_[0]->{prefix} } +sub path { join "/", @{$_[0]}{qw/prefix file/}} + +# compares the files found in the directory with the information from the +# changes file +sub checkFiles { + my $self = shift; + foreach (@{$self->{files}}) { $_->check; } +} + +# returns a list of binary files (.deb) +sub binaryFiles { + my $self = shift; + return grep { $_->{file} =~ /\.deb$/ } @{$self->{files}}; +} + +# returns a list of source files (.dsc) +sub sourceFiles { + my $self = shift; + return grep { $_->{file} =~ /\.dsc$/ } @{$self->{files}}; +} + +# return a complete list of files +sub files { + my $self = shift; + return @{$self->{files}}; +} + +sub archs { + my $self = shift; + my %args = @_; + + my %r; + @r{split " ", $self->key("architecture")} = (); + + # replace all (if we know a replacement) + if ($args{all} and $r{all}) { + @r{@{$args{all}}} = (), delete $r{all}; + } + return keys %r; +} + +sub key { + my $self = shift; + my $key = shift; + carp "Key \"$key\" does not exist in $self->{filename}" + if not exists $self->{changes}{$key}; + + return @{$self->{changes}{$key}} if wantarray; + return join "\n", $self->key($key); +} + +sub component { + my $self = shift; + return $self->key("section") =~ /^(.*?)\// ? $1 : "main"; +} + +sub keys { + my $self = shift; + return map { $self->key($_) } @_; +} + +=head1 NAME + +Debian::ControlFile - a debian control file class + +=head1 SYNOPSIS + + use Debian::ControlFile; + + my $cf = new Debian::ControlFile $file; + +=head1 DESCRIPTION + + + + +=cut + +1; +# vim:sts=4 sw=4 aw ai sm: diff -r 0d30ea853889 -r 05c025e89571 lib/Debian/DebFile.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Debian/DebFile.pm Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,68 @@ +package Debian::DebFile; + +use strict; +use warnings; +use File::Basename; + +use Carp; + +sub new { + my $class = ref $_[0] ? ref shift : shift; + my $self = {}; bless $self, $class; + + # Wenn wir mit einer Referenz auf ein Debian::File initialisiert + # werden, dann können wir den prefix von fort übernehmen -- so + # haben wir dann in {file} den richtigen + + if (ref($_[0]) eq "Debian::File") { + $self->{file} = $_[0]->file; + $self->{prefix} = $_[0]->prefix; + } else { + $self->{file} = basename($_[0]); + $self->{prefix} = dirname($_[0]); + } + + $self->{path} = join "/", @{$self}{qw/prefix file/}; + + shift; + + $self->parse; + + return $self; +} + +sub file { $_[0]->{file} } +sub prefix { $_[0]->{prefix} } + +sub parse { + my $self = shift; + + my $key; + foreach (`dpkg --info $self->{path}`) { + s/^\s//; + + defined $key and /^\s+(\S.*)/ and do { + push @{$self->{deb}{$key}}, $1; + next; + }; + + /^(\S+):(?:\s+(.*))?/ and do { + $key = lc($1); + push @{$self->{deb}{$key}}, $2 if defined $2; + next; + }; + + } +} + +sub key { + my $self = shift; + my $key = shift; + + return @{$self->{deb}{$key}} if wantarray; + return join "\n", @{$self->{deb}{$key}}; +} + + +1; +# vim:sts=4 sw=4 aw ai sm: diff -r 0d30ea853889 -r 05c025e89571 lib/Debian/Dpkg.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Debian/Dpkg.pm Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,14 @@ +package Debian::Dpkg; + +use strict; +use warnings; +use Carp; + +sub compareVersions($$$) { + my $rc = system("dpkg", "--compare-versions", @_) >> 8; + return not $rc; + croak "unable to compare versions: \"@_\" gave $rc"; +} + +1; +# vim:sts=4 sw=4 aw ai sm: diff -r 0d30ea853889 -r 05c025e89571 lib/Debian/File.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Debian/File.pm Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,65 @@ +package Debian::File; + +use strict; +use warnings; + +use IO::File; +use Digest::MD5; +use Carp; + +sub new { + my $class = ref $_[0] ? ref shift : shift; + my $self = bless {}, $class; + my $description = shift; + my %args = @_; + + @{$self}{keys %args} = values %args; + + foreach my $a (qw/prefix current_prefix/) { + $self->{$a} =~ s/\/$//; + } + + my @fields = split " ", $description; + + if (@fields == 5) { + @{$self}{qw/md5 size section part file/} = @fields; + } elsif (@fields == 3) { + @{$self}{qw/md5 size file/} = @fields; + } else { + croak "Unknown format: $_\n"; + } + + $self->check; # will croak + return $self; +} + +sub md5 { $_[0]->{md5} } +sub size { $_[0]->{size} } +sub section { $_[0]->{section} } +sub part { $_[0]->{part} } +sub file { $_[0]->{file} } +sub prefix { $_[0]->{prefix} } +sub path { join "/", @{$_[0]}{qw/prefix file/} } +sub component { $_[0] =~ /^(.*?)\// ? $1 : "main" } + +sub check { + my $self = shift; + + + my $file = join "/", $self->{current_prefix} ? $self->{current_prefix} : $self->{prefix}, $self->file; + my $size = $self->size; + my $md5 = $self->md5; + + croak "File does not exist: $file\n" if !-f $file; + croak "Size mismatch: $file (" . (-s _) . " != $size)\n" if not $size == (-s _); + + my $digest = new Digest::MD5; + my $fh = new IO::File $file or croak "Can't open <$file: $!\n"; + $digest->addfile($fh); + + croak "MD5 mismatch: $file\n" if not $digest->hexdigest eq $md5; +} + +1; + +# vim:sts=4 sw=4 aw ai sm: diff -r 0d30ea853889 -r 05c025e89571 lib/Debian/Pool.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Debian/Pool.pm Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,26 @@ +package Debian::Pool; + +use strict; +use warnings; +use Carp; + +sub new { + my $class = ref $_[0] ? ref shift : shift; + my $self = {}; + + my %args = @_; + + $self->{archs} = @{$args->{archs}}; + $self->{root} = $args->{root}; + + bless $self, $class; +} + +sub getRoot { $_[0]->{root} } +sub getArchs { $_[0]->{archs} } +sub getBinArchs { grep !/^source$/, $_[0]->{archs} } +sub getSrcArchs { grep /^source$/, $_[0]->{archs} } + +1; + +# vim:sts=4 sw=4 aw ai sm: diff -r 0d30ea853889 -r 05c025e89571 lib/Debian/Repository.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/Debian/Repository.pm Fri Mar 06 00:43:13 2009 +0100 @@ -0,0 +1,89 @@ +package Debian::Repository; + +use strict; +use warnings; + +use File::Path; + +sub new { + my $class = ref $_[0] ? ref shift : shift; + my $self = bless {}, $class; + + $self->{vars} = shift; + + return $self; +} + +sub origin { $_[0]->{vars}{origin} } +sub dists { $_[0]->{vars}{dists} } +sub sections { $_[0]->{vars}{sections} } +sub binary { $_[0]->{vars}{binary} } +sub source { $_[0]->{vars}{source} } +sub root { $_[0]->{vars}{root} } + +sub checkDirs { + my $self = shift; + + my %args = @_; + + $args{create} ||= 0; + $args{umask} ||= umask; + + my $root = $self->root; + my $dists = $self->dists; + my $sections = $self->sections; + my $binary = $self->binary; + my $source =$self->source; + my $origin = $self->origin; + + my (@dirs, @archdirs); + push @dirs, "$root/pool"; + foreach my $dir (map { "$root/dists/$_" } @$dists) { + push @dirs, $dir; + foreach my $section (@$sections) { + push @dirs, "$dir/$section"; + foreach my $arch (@$binary) { + push @dirs, "$dir/$section/binary-$arch"; + push @archdirs, { dir => $dirs[-1], arch => $arch }; + } + foreach my $arch (@$source) { + push @dirs, "$dir/$section/$arch"; + push @archdirs, { dir => $dirs[-1], arch => $arch }; + } + } + } + + # create dirs + if ($args{create}) { + my $mask = umask($args{umask}); + foreach (@dirs) { + -d $_ or mkdir($_) or die "Can't mkdir $_: $!\n"; + } + + # create relases files + foreach my $dist (@$dists) { + #foreach my $dir ("$root/dists/$dist", @archdirs) { + foreach my $d (@archdirs) { + my ($dir, $arch); + if (ref $d eq "HASH") { + $arch = $d->{arch}; + $dir = $d->{dir}; + } else { $dir = $d } + + $_ = "$dir/Release"; + my $r = new IO::File ">$_" or die "Can't open >$_: $!\n"; + $r->print(<<___); +Release: $dist +Suite: $dist +Origin: $origin +___ + $r->print("Architecture: $arch\n") if defined $arch; + } + } + umask($mask); + } +} + +1; + +# vim:sts=4 sw=4 aw ai sm: