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