[Debpool-commits] [SCM] Debpool Project Repository branch, master, updated. debian/0.4.0-6-g4d31c8b

Andres Mejia mcitadel at gmail.com
Sun Oct 26 06:58:17 UTC 2008


The following commit has been merged in the master branch:
commit 4d31c8b8cae2cab8832c2439da00165ace65382a
Author: Andres Mejia <mcitadel at gmail.com>
Date:   Sun Oct 26 02:58:09 2008 -0400

    various fixes

diff --git a/debian/README.Debian b/debian/README.Debian
index 9e37fdb..faecc27 100644
--- a/debian/README.Debian
+++ b/debian/README.Debian
@@ -23,3 +23,9 @@ Dependencies:
   just needs libc to run and gcc to build (aside from texinfo for documentation)
   therefore in this case, libcompress-bzip2-perl was allowed as a dependency for
   debpool.
+
+Dpkg.pm
+
+* Dpkg.pm will provide the basic dpkg operations that we use. It will be
+  licensed under GPL in hopes that it can be used and improved alongside the
+  regular dpkg programs and scripts.
diff --git a/debian/changelog b/debian/changelog
index cbe1df0..9795930 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,11 @@
-debpool (0.4.2) experimental; urgency=low
+debpool (0.5.0) experimental; urgency=low
 
   * Create a new module (Dpkg.pm) that will handle our dpkg routines in a pure
-    Perl process. (NOT YET IMPLEMENTED).
+    Perl process.
   * Updated copyright file. Dpkg.pm is licensed under GPL.
+  * Use DebPool::Logging for error messages in Parser.pm.
+  * Use Parser.pm for parsing the control file information.
+  * Add in SHA1 and SHA256 information in Packages and Sources file.
 
  -- Andres Mejia <mcitadel at gmail.com>  Sat, 25 Oct 2008 22:23:11 -0400
 
diff --git a/lib/DebPool/Dpkg.pm b/lib/DebPool/Dpkg.pm
index d076961..a2b8a9f 100644
--- a/lib/DebPool/Dpkg.pm
+++ b/lib/DebPool/Dpkg.pm
@@ -32,7 +32,7 @@ require 5.006_000;
 use strict;
 use warnings;
 
-use File::Temp qw(tempfile); # For making tempfiles
+use File::Temp qw(tempfile tempdir); # For making tempfiles
 use Archive::Ar; # For extracting ar files (the format for .deb files)
 use Archive::Tar; # For extracting tar files
 
@@ -53,12 +53,14 @@ BEGIN {
     );
 
     @EXPORT_OK = qw(
-        &Dpkg_Field
-        &Compare_Version
+        &DpkgDeb_Control
+        &DpkgDeb_Field
+        &Dpkg_Compare_Version
     );
 
     %EXPORT_TAGS = (
-        'functions' => [qw(&Dpkg_Field &Compare_Version)],
+        'functions' => [qw(&DpkgDeb_Control &DpkgDeb_Field
+                        &Dpkg_Compare_Version)],
         'vars' => [qw()],
     );
 }
@@ -84,33 +86,78 @@ our($Error);
 
 ### Meaningful functions
 
-# Dpkg_Field($file, $fields)
-# Parameter data types (string, array_ref)
-#
-# Method that mimics the behavior of 'dpkg --field <deb_file> [fields]'. This is
-# the pure perl method of performing said operation. We return the contents of
-# the control file in an array reference.
+# DpkgDeb_Control($file, $dir)
+# Parameter data types (string, string)
 #
-# Note that this is actually a dpkg-deb operation.
+# Method that mimics 'dpkg-deb --control <deb_file> <directory>'.
+# This is the pure perl method of performing said operation. We return 1 on
+# success, 0 on failure.
 
-sub Dpkg_Field {
-    my ($file, $fields) = @_;
+sub DpkgDeb_Control {
+    my ($file, $dir) = @_;
+
+    # If $dir is not specified, we default to DEBIAN.
+    $dir = 'DEBIAN' if (!$dir);
+
+    # Make the directory if it doesn't exist. Print an error if we've failed.
+    if ((! -d $dir) and (! mkdir $dir,755)) {
+        Log_Message("Could not make directory $dir: $!",
+            LOG_GENERAL, LOG_ERROR);
+        return 0;
+    }
 
     # First get the contents of the control gzip tarball from the deb file.
     my $ar = Archive::Ar->new($file);
+    if (!$ar) {
+        Log_Message("Could not load deb file $file: $!",
+            LOG_GENERAL, LOG_ERROR);
+        return 0;
+    }
     # get_content() returns a hash reference
     my $ar_control = $ar->get_content("control.tar.gz");
 
     # Now write the control gzip tarball into a tempfile.
-    my ($control_tar_gz_fh, $control_tar_gz) = tempfile();
+    my ($control_tar_gz_fh, $control_tar_gz) = tempfile(UNLINK => 1);
     print $control_tar_gz_fh $ar_control->{data};
     binmode $control_tar_gz_fh;
 
     # Now extract and read the contents of the control file to an array.
-    my ($control_fh, $control_file) = tempfile();
+    my ($control_fh, $control_file) = tempfile(UNLINK => 1);
     my $control_tar_object = Archive::Tar->new($control_tar_gz,1);
-    $control_tar_object->extract_file('./control',$control_file);
+    if (!$control_tar_object) {
+        Log_Message("Could not load control file from deb file $file: $!",
+            LOG_GENERAL, LOG_ERROR);
+        return 0;
+    }
+    $control_tar_object->extract_file('./control',"$dir/control");
+    return 1;
+}
+
+# DpkgDeb_Field($file, $fields)
+# Parameter data types (string, array_ref)
+#
+# Method that mimics the behavior of 'dpkg-deb --field <deb_file> [fields]'.
+# This is the pure perl method of performing said operation. We return the
+# contents of the control file in an array reference.
+
+sub DpkgDeb_Field {
+    my ($file, $fields) = @_;
+
+    # Take advantage of DpkgDeb_Control() to extract the control file.
+    my $tmpdir = tempdir(CLEANUP => 1);
+    if (!DpkgDeb_Control($file, $tmpdir)) {
+        Log_Message("Could not load deb file $file: $!",
+            LOG_GENERAL, LOG_ERROR);
+    }
+
+    # Now open the file and place the contents of the control file in an array.
+    my $control_fh;
+    if (!open($control_fh, '<', "$tmpdir/control")) {
+        print "Could not open $tmpdir/control: $!";
+        return;
+    }
     my @control_file_data = <$control_fh>;
+    close $control_fh;
 
     # Just return our control file data if we didn't specify any fields
     return \@control_file_data if (!$fields);
@@ -136,7 +183,7 @@ sub Dpkg_Field {
     return \@output;
 }
 
-# Compare_Version($version1, $operator, $version2)
+# Dpkg_Compare_Version($version1, $operator, $version2)
 # Paramater data types (string, string, string)
 #
 # Method that compares two version numbers and returns either 1 or 0 (true or
@@ -144,7 +191,7 @@ sub Dpkg_Field {
 #
 # TODO: For now, we just use dpkg. We'll make this a pure Perl subroutine later.
 
-sub Compare_Version {
+sub Dpkg_Compare_Version {
     my ($version1, $operator, $version2) = @_;
 
     my $dpkg_bin = '/usr/bin/dpkg';
diff --git a/lib/DebPool/Packages.pm b/lib/DebPool/Packages.pm
index 6763adc..82660a6 100644
--- a/lib/DebPool/Packages.pm
+++ b/lib/DebPool/Packages.pm
@@ -44,7 +44,7 @@ use strict;
 use warnings;
 
 use POSIX; # WEXITSTATUS
-use File::Temp qw(tempfile);
+use File::Temp qw(tempfile tempdir);
 
 ### Module setup
 
@@ -94,33 +94,6 @@ BEGIN {
 
 our $Error;
 
-# Fields (other than package relationships) from dpkg --info that we
-# actually care about in some fashion.
-
-my @Info_Fields = (
-#    'Package',
-    'Priority',
-    'Section',
-    'Installed-Size',
-#    'Maintainer',
-    'Architecture',
-#    'Version',
-    'Essential',
-);
-
-# Package relationship fieldnames.
-
-my @Relationship_Fields = (
-    'Pre-Depends',
-    'Depends',
-    'Provides',
-    'Conflicts',
-    'Recommends',
-    'Suggests',
-    'Enhances',
-    'Replaces',
-);
-
 ### File lexicals
 
 # None
@@ -143,6 +116,7 @@ sub Allow_Version {
     use DebPool::Config qw(:vars);
     use DebPool::DB qw(:functions);
     use DebPool::Logging qw(:functions :facility :level);
+    use DebPool::Dpkg qw(:functions);
 
     my($package, $version, $distribution, $arch) = @_;
     my $old_version = Get_Version($distribution, $package, 'meta');
@@ -179,12 +153,8 @@ sub Allow_Version {
         return 1;
     }
 
-    my $dpkg_bin = '/usr/bin/dpkg';
-    my @args = ('--compare-versions', $version, 'gt', $old_version);
-
-    my $sysret = WEXITSTATUS(system($dpkg_bin, @args));
-
-    if (0 != $sysret) { # DPKG says no go.
+    if (!Dpkg_Compare_Versions($version, 'gt', $old_version)) {
+        # DPKG says no go.
         my $msg = "Version comparison for '$package': proposed version for ";
         $msg .= "$distribution ($version) is not greater than current ";
         $msg .= "version ($old_version)";
@@ -387,7 +357,7 @@ sub Install_Package {
         }
     }
 
-    if ($dsc && %{$dsc_data}) {
+    if ($dsc and $dsc_data) {
         my $src_file = Generate_Source($dsc, $dsc_data, $changes_data);
 
         if (!defined($src_file)) {
@@ -683,6 +653,8 @@ sub Generate_Package {
     use DebPool::Config qw(:vars);
     use DebPool::Dirs qw(:functions);
     use DebPool::Logging qw(:functions :facility :level);
+    use DebPool::Dpkg qw(:functions);
+    use DebPool::Parser qw(:functions);
 
     my($changes_data, $arch) = @_;
     my $source = $changes_data->{'Source'};
@@ -729,10 +701,18 @@ sub Generate_Package {
 
         next if (-1 == $marker);
 
-        # Run Dpkg_Info to grab the dpkg --info data on the package.
+        # Run DpkgDeb_Control() to extract the control file from the deb
+        # archive. Then parse the control file.
 
         my $file = $files[$marker];
-        my $info = Dpkg_Info("$Options{'pool_dir'}/$pool/$file");
+        my $tmpdir = tempdir(CLEANUP => 1);
+        if (!DpkgDeb_Control("$Options{'pool_dir'}/$pool/$file", $tmpdir)) {
+            my $msg = "Could not extract control file from deb file ";
+            $msg .= "$Options{'pool_dir'}/$pool/$file";
+            Log_Message($msg, LOG_GENERAL, LOG_ERROR);
+            return;
+        }
+        my $info = Parse_File("$tmpdir/control");
 
         # Dump all of our data into the metadata tempfile.
 
@@ -755,7 +735,7 @@ sub Generate_Package {
         print $tmpfile_handle "Maintainer: $changes_data->{'Maintainer'}\n";
         print $tmpfile_handle "Architecture: $arch\n";
         if ($source_version) {
-            print $tmpfile_handle "Source: $source" . "_($source_version)\n";
+            print $tmpfile_handle "Source: $source ($source_version)\n";
         } else {
             print $tmpfile_handle "Source: $source\n";
         }
@@ -764,9 +744,12 @@ sub Generate_Package {
         # All of the inter-package relationships go together, and any
         # one of them can potentially be empty (and omitted).
 
+        my @Relationship_Fields = ('Pre-Depends', 'Depends', 'Provides',
+            'Conflicts', 'Recommends', 'Suggests', 'Enhances', 'Replaces',);
         foreach my $field (@Relationship_Fields) {
             if (defined($info->{$field})) {
-                print $tmpfile_handle "${field}: $info->{$field}\n";
+                print $tmpfile_handle "${field}: " .
+                    join(', ', @{$info->{$field}}) . "\n";
             }
         }
 
@@ -779,8 +762,19 @@ sub Generate_Package {
             $changes_data->{'Files'}{$files[$marker]}[1] . "\n";
         print $tmpfile_handle "MD5sum: " .
             $changes_data->{'Files'}{$files[$marker]}[0] . "\n";
+        print $tmpfile_handle "SHA1: " .
+            $changes_data->{'Checksums-Sha1'}{$files[$marker]}[0] . "\n";
+        print $tmpfile_handle "SHA256: " .
+            $changes_data->{'Checksums-Sha256'}{$files[$marker]}[0] . "\n";
+
+        print $tmpfile_handle "Description: ";
+        foreach my $tmp (@{$info->{'Description'}}) {
+            print $tmpfile_handle "$tmp\n";
+        }
 
-        print $tmpfile_handle "Description: $info->{'Description'}";
+        if (defined $info->{'Homepage'}) {
+            print $tmpfile_handle "Homepage: $info->{'Homepage'}\n";
+        }
 
         print $tmpfile_handle "\n";
     }
@@ -805,6 +799,10 @@ sub Generate_Source {
     my($dsc, $dsc_data, $changes_data) = @_;
     my $source = $dsc_data->{'Source'};
     my @files = (keys %{$dsc_data->{'Files'}});
+    my @checksums_sha1 = grep(!/\.dsc$/,
+        (keys %{$dsc_data->{'Checksums-Sha1'}}));
+    my @checksums_sha256 = grep(!/\.dsc$/,
+        (keys %{$dsc_data->{'Checksums-Sha256'}}));
 
     # Figure out the priority and section, using the DSC filename and
     # the Changes file data.
@@ -854,59 +852,53 @@ sub Generate_Source {
         (PoolBasePath(), PoolDir($source, $section), $source)) . "\n";
 
     print $tmpfile_handle "Files:\n";
-
     foreach my $fileref (@files) {
         print $tmpfile_handle " " . $dsc_data->{'Files'}{$fileref}[0];
         print $tmpfile_handle " " . $dsc_data->{'Files'}{$fileref}[1];
         print $tmpfile_handle " $fileref\n";
     }
 
-    print $tmpfile_handle "\n";
-
-    # All done
-
-    close($tmpfile_handle);
-    return $tmpfile_name;
-}
-
-# Dpkg_Info($file)
-#
-# Runs dpkg --info on $file, and returns a hash of relevant information.
-#
-# Internal support function for Generate_Package.
+    if (defined $dsc_data->{'Uploaders'}) {
+        print $tmpfile_handle "Uploaders: ";
+        print $tmpfile_handle join(', ', @{$dsc_data->{'Uploaders'}}) . "\n";
+    }
 
-sub Dpkg_Info {
-    my($file) = @_;
-    my %result;
+    if (defined $dsc_data->{'Dm-Upload-Allowed'}) {
+        print $tmpfile_handle "Dm-Upload-Allowed: " .
+            $dsc_data->{'Dm-Upload-Allowed'} . "\n";
+    }
 
-    # Grab the info from dpkg --info.
+    if (defined $dsc_data->{'Homepage'}) {
+        print $tmpfile_handle "Homepage: $dsc_data->{'Homepage'}\n";
+    }
 
-    my @info = `/usr/bin/dpkg --info $file`;
-    my $smashed = join('', @info);
+    my @vcs = sort(grep(/^Vcs/, (keys %{$dsc_data})));
+    foreach my $tmp (@vcs) {
+        print $tmpfile_handle "$tmp: $dsc_data->{$tmp}\n";
+    }
 
-    # Look for each of these fields in the info. All are single line values,
-    # so the matching is fairly easy.
+    print $tmpfile_handle "Checksums-Sha1: \n";
+    foreach my $fileref (@checksums_sha1) {
+        print $tmpfile_handle " " . $dsc_data->{'Checksums-Sha1'}{$fileref}[0];
+        print $tmpfile_handle " " . $dsc_data->{'Checksums-Sha1'}{$fileref}[1];
+        print $tmpfile_handle " $fileref\n";
+    }
 
-    foreach my $field (@Info_Fields, @Relationship_Fields) {
-        if ($smashed =~ m/\n ${field}:\s+(\S.*)\n/) {
-            $result{$field} = $1;
-        }
+    print $tmpfile_handle "Checksums-Sha256: \n";
+    foreach my $fileref (@checksums_sha256) {
+        print $tmpfile_handle " " .
+            $dsc_data->{'Checksums-Sha256'}{$fileref}[0];
+        print $tmpfile_handle " " .
+            $dsc_data->{'Checksums-Sha256'}{$fileref}[1];
+        print $tmpfile_handle " $fileref\n";
     }
 
-    # And, finally, grab the description.
+    print $tmpfile_handle "\n";
 
-    my $found = 0;
-    foreach my $line (@info) {
-        if ($found) {
-            $line =~ s/^ //;
-            $result{'Description'} .= $line;
-        } elsif ($line =~ m/^ Description: (.+)/) {
-            $result{'Description'} = "$1\n";
-            $found = 1;
-        }
-    }
+    # All done
 
-    return \%result;
+    close($tmpfile_handle);
+    return $tmpfile_name;
 }
 
 # Install_List($archive, $component, $architecture, $listfile, $zfiles)
diff --git a/lib/DebPool/Parser.pm b/lib/DebPool/Parser.pm
index ac7e965..1dece83 100644
--- a/lib/DebPool/Parser.pm
+++ b/lib/DebPool/Parser.pm
@@ -84,7 +84,7 @@ my %Field_Types = (
     'Format' => 'string', # both
     'Date' => 'string', # changes
     'Source' => 'string', # both
-    'Binary' => 'space_array', # both
+    'Binary' => 'space_array', # both (comma_array in dsc file)
     'Architecture' => 'space_array', # both
     'Version' => 'string', # both
     'Distribution' => 'space_array', # both
@@ -106,6 +106,21 @@ my %Field_Types = (
     'Dm-Upload-Allowed' => 'string', #dsc
 #    'X-Any-Fields' => 'multiline_array', # both
     'Source-Version' => 'string', # used when binNMU is detected
+
+    # The rest of these fields are found in the control file of a package.
+    'Package' => 'string',
+    'Priority' => 'string',
+    'Section' => 'string',
+    'Installed-Size' => 'string',
+    'Essential' => 'string',
+    'Pre-Depends' => 'comma_array',
+    'Depends' => 'comma_array',
+    'Provides' => 'comma_array',
+    'Conflicts' => 'comma_array',
+    'Recommends' => 'comma_array',
+    'Suggests' => 'comma_array',
+    'Enhances' => 'comma_array',
+    'Replaces' => 'comma_array',
 );
 
 ### File lexicals
@@ -128,13 +143,13 @@ sub Parse_File {
     my ($file) = @_;
 
     use DebPool::GnuPG qw(:functions); # To strip GPG encoding
-
+    use DebPool::Logging qw(:functions :facility :level);
 
     # Read in the entire file, stripping GPG encoding if we find
     # it. It should be small, this is fine.
     my $fh;
     if (!open($fh, '<', $file)) {
-        print "Couldn't open file '$file': $!";
+        Log_Message("Couldn't open file '$file': $!", LOG_GENERAL, LOG_ERROR);
         return;
     }
     my @data = <$fh>;
@@ -161,8 +176,8 @@ sub Parse_File {
             if ($2) { # Only add entries if there's something to add
                 push @values, $2;
             }
-        } else { #Still in the same field, we omit the first white space
-            push @values, (substr $line, 1);
+        } else { #Still in the same field
+            push @values, $line;
         }
     }
     # Once we're done with the for loop, we still have to process the last
@@ -192,9 +207,8 @@ sub Parse_File {
 sub Process_Type {
     my ($field, $file, $values) = @_;
 
-    # Change the Files field type to appropriate type dependending on file
-    # being parsed.
-    my $fieldtype = $Field_Types{$field};
+    # Change the field type of certain fields to appropriate type dependending
+    # on the file being parsed.
     if ($field eq 'Files') {
         if ($file =~ m/^.*\Q.changes\E$/) {
             $Field_Types{$field} = 'file_entries';
@@ -202,6 +216,13 @@ sub Process_Type {
             $Field_Types{$field} = 'checksums';
         }
     }
+    if ($field eq 'Binary') {
+        if ($file =~ m/^.*\Q.dsc\E$/) {
+            $Field_Types{$field} = 'comma_array';
+        } else {
+            $Field_Types{$field} = 'space_array';
+        }
+    }
 
     # Add the Vcs-* entries into the %Field_Types hash. We do this to
     # compensate for the many different Vcs-* entries that may exist
@@ -231,7 +252,7 @@ sub Process_Type {
         # second element being the size.
         my %data;
         foreach my $value (@{$values}) {
-            my ($checksum, $size, $file) = split /\s+/, $value;
+            my (undef, $checksum, $size, $file) = split /\s+/, $value;
             $data{$file} = [ $checksum, $size ];
         }
         return \%data;
@@ -242,7 +263,7 @@ sub Process_Type {
         # third is the section and the fourth is the priority.
         my %data;
         foreach my $value (@{$values}) {
-            my ($checksum, $size, $section, $priority, $file) =
+            my (undef, $checksum, $size, $section, $priority, $file) =
                 split /\s+/, $value;
             $data{$file} = [ $checksum, $size, $section, $priority ];
         }
diff --git a/pure-perl-testing/debperltest b/pure-perl-testing/debperltest
index 3bce4b4..0f30a53 100755
--- a/pure-perl-testing/debperltest
+++ b/pure-perl-testing/debperltest
@@ -26,7 +26,7 @@ if (($previous) and ($next)) {
 
 # Method used to compare two revisions. This method will be implemented for
 # the Allow_Version() method in Packages.pm in the future.
-sub Compare_Versions {
+sub Dpkg_Compare_Versions {
     my ($prevrev, $nextrev) = @_;
     # Some variables that will carry us through this method
     my $count = 0;
@@ -173,33 +173,75 @@ sub Compare_Char {
     }
 }
 
-# Dpkg_Field($file, $fields)
-# Parameter data types (string, array_ref)
-#
-# Method that mimics the behavior of 'dpkg --field <deb_file> [fields]'. This is
-# the pure perl method of performing said operation. We return the contents of
-# the control file in an array reference.
+# DpkgDeb_Control($file, $dir)
+# Parameter data types (string, string)
 #
-# Note that this is actually a dpkg-deb operation.
+# Method that mimics 'dpkg-deb --control <deb_file> <directory>'.
+# This is the pure perl method of performing said operation. We return 1 on
+# success, 0 on failure.
 
-sub Dpkg_Field {
-    my ($file, $fields) = @_;
+sub DpkgDeb_Control {
+    my ($file, $dir) = @_;
+
+    # If $dir is not specified, we default to DEBIAN.
+    $dir = 'DEBIAN' if (!$dir);
+
+    # Make the directory if it doesn't exist. Print an error if we've failed.
+    if ((! -d $dir) and (! mkdir $dir,755)) {
+        print "Could not make directory $dir: $!";
+        return 0;
+    }
 
     # First get the contents of the control gzip tarball from the deb file.
     my $ar = Archive::Ar->new($file);
+    if (!$ar) {
+        print "Could not load deb file $file: $!";
+        return 0;
+    }
     # get_content() returns a hash reference
     my $ar_control = $ar->get_content("control.tar.gz");
 
     # Now write the control gzip tarball into a tempfile.
-    my ($control_tar_gz_fh, $control_tar_gz) = tempfile();
+    my ($control_tar_gz_fh, $control_tar_gz) = tempfile(UNLINK => 1);
     print $control_tar_gz_fh $ar_control->{data};
     binmode $control_tar_gz_fh;
 
     # Now extract and read the contents of the control file to an array.
-    my ($control_fh, $control_file) = tempfile();
+    my ($control_fh, $control_file) = tempfile(UNLINK => 1);
     my $control_tar_object = Archive::Tar->new($control_tar_gz,1);
-    $control_tar_object->extract_file('./control',$control_file);
+    if (!$control_tar_object) {
+        print "Could not load control gzip tarball from deb file $file: $!";
+        return 0;
+    }
+    $control_tar_object->extract_file('./control',"$dir/control");
+    return 1;
+}
+
+# DpkgDeb_Field($file, $fields)
+# Parameter data types (string, array_ref)
+#
+# Method that mimics the behavior of 'dpkg-deb --field <deb_file> [fields]'.
+# This is the pure perl method of performing said operation. We return the
+# contents of the control file in an array reference.
+
+sub DpkgDeb_Field {
+    my ($file, $fields) = @_;
+
+    # Take advantage of DpkgDeb_Control() to extract the control file.
+    my $tmpdir = tempdir(CLEANUP => 1);
+    if (!DpkgDeb_Control($file, $tmpdir)) {
+        print "Could not extract control file from deb file $file\n";
+        return;
+    }
+
+    # Now open the file and place the contents of the control file in an array.
+    my $control_fh;
+    if (!open($control_fh, '<', "$tmpdir/control")) {
+        print "Could not open $tmpdir/control: $!";
+        return;
+    }
     my @control_file_data = <$control_fh>;
+    close $control_fh;
 
     # Just return our control file data if we didn't specify any fields
     return \@control_file_data if (!$fields);
@@ -238,7 +280,7 @@ if ($previous && $next) {
     print "\n";
 
     print "Test with a pure Perl way\n";
-    my $comparereturn = Compare_Versions($previous, $next);
+    my $comparereturn = Dpkg_Compare_Versions($previous, $next);
     if ($comparereturn == -1) {
         print "Previous $previous is less than Next $next\n";
     } elsif ($comparereturn == 0) {
@@ -247,8 +289,10 @@ if ($previous && $next) {
         print "Previous $previous is greater than Next $next\n";
     }
 } elsif ($file) {
-    my $output = Dpkg_Field($file,);
+    my $output = DpkgDeb_Field($file);
     foreach my $tmp (@{$output}) {
         print "$tmp";
     }
+    my $subreturn = DpkgDeb_Control($file, '/tmp');
+    print "successfully extracted control file from $file.\n" if ($subreturn);
 }

-- 
Debpool Project Repository



More information about the Debpool-commits mailing list