lib/Debian/ControlFile.pm
changeset 1 05c025e89571
--- /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: