--- /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

--- /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:

--- /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:

--- /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:

--- /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:

--- /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:

--- /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:

--- /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: