1 package Debian::ControlFile;

     2 

     3 # Großbuchstabige Methoden beziehen sich auf die

     4 # Attribute des Changes-Files, alles andere

     5 # folgt dem 'get/set-Schema'

     6 

     7 use strict;

     8 use warnings;

     9 use File::Basename;

    10 use Carp;

    11 use IO::File;

    12 

    13 use Debian::File;

    14 

    15 sub new {

    16     my $class = ref $_[0] ? ref shift : shift;

    17     my $self = bless {}, $class;

    18 

    19 

    20     if (ref($_[0]) =~ /^Debian::(ControlFile|File)$/) {

    21 	$self->{file} = $_[0]->file;

    22 	$self->{prefix} = $_[0]->prefix;

    23 	shift;

    24 

    25     } else {

    26 	$self->{file} = shift;

    27 

    28 	my %args = @_;

    29 	if ($args{path}) {

    30 	    $self->{current} = $self->{file};

    31 	    @{$self}{qw/file prefix/} = fileparse($args{path});

    32 

    33 	    $self->{prefix} =~ s/\/$//; 

    34 	} else {

    35 	    $self->{prefix} = ".";

    36 	}

    37     }

    38 

    39     $self->parse;

    40 

    41     return $self;

    42 }

    43 

    44 sub parse {

    45     my $self = shift;

    46 

    47     my $f = $self->{current} ? $self->{current} : $self->path;

    48     my $in = new IO::File $f or croak "Can't open <$f: $!";

    49 

    50     my ($key, %changes);

    51     local $_;

    52     while (<$in>) { chomp;

    53 	last if /^-----BEGIN PGP SIGNATURE-----/;

    54 

    55 	if (/^([a-z].*?):\s*(\S.*)?/i) {

    56 	    $key = lc($1);

    57 

    58 	    push @{$changes{$key}}, $2 if defined $2;

    59 	    next;

    60 	}

    61 	if (/^\s+(.*)/) {

    62 	    push @{$changes{$key}}, $1;

    63 	    next;

    64 	}

    65     }

    66 

    67 

    68     if (!exists($changes{format}) && $changes{format} < 1.7) { 

    69 	croak "format $changes{format}->[0] is < 1.7 in $self->{file}\n";

    70     }

    71 

    72     $self->{changes} = \%changes;

    73 

    74     foreach ($self->key("files")) {

    75 	push @{$self->{files}}, new Debian::File $_, prefix => $self->prefix, current_prefix => dirname($f);

    76     }

    77 }

    78 

    79 sub file { $_[0]->{file} }

    80 sub prefix { $_[0]->{prefix} }

    81 sub path { join "/", @{$_[0]}{qw/prefix file/}} 

    82 

    83 # compares the files found in the directory with the information from the

    84 # changes file

    85 sub checkFiles {

    86     my $self = shift;

    87     foreach (@{$self->{files}}) { $_->check; }

    88 }

    89 

    90 # returns a list of binary files (.deb)

    91 sub binaryFiles {

    92     my $self = shift;

    93     return grep { $_->{file} =~ /\.deb$/ } @{$self->{files}};

    94 }

    95 

    96 # returns a list of source files (.dsc)

    97 sub sourceFiles {

    98     my $self = shift;

    99     return grep { $_->{file} =~ /\.dsc$/ } @{$self->{files}};

   100 }

   101 

   102 # return a complete list of files

   103 sub files {

   104     my $self = shift;

   105     return @{$self->{files}};

   106 }

   107 

   108 sub archs {

   109     my $self = shift;

   110     my %args = @_;

   111 

   112     my %r;

   113     @r{split " ", $self->key("architecture")} = ();

   114 

   115     # replace all (if we know a replacement)

   116     if ($args{all} and $r{all}) {

   117 	@r{@{$args{all}}} = (), delete $r{all};

   118     }

   119     return keys %r;

   120 }

   121 

   122 sub key {

   123     my $self = shift;

   124     my $key = shift;

   125     carp "Key \"$key\" does not exist in $self->{filename}" 

   126 	if not exists $self->{changes}{$key};

   127 

   128     return @{$self->{changes}{$key}} if wantarray;

   129     return join "\n", $self->key($key);

   130 }

   131 

   132 sub component {

   133     my $self = shift;

   134     return $self->key("section") =~ /^(.*?)\// ? $1 : "main";

   135 }

   136 

   137 sub keys {

   138     my $self = shift;

   139     return map { $self->key($_) } @_;

   140 }

   141 

   142 =head1 NAME

   143 

   144 Debian::ControlFile - a debian control file class

   145 

   146 =head1 SYNOPSIS

   147 

   148     use Debian::ControlFile;

   149 

   150     my $cf = new Debian::ControlFile $file;

   151 

   152 =head1 DESCRIPTION

   153 

   154 

   155 

   156 

   157 =cut

   158 

   159 1;

   160 # vim:sts=4 sw=4 aw ai sm: