[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

[SCM] Debian package checker branch, master, updated. 2.5.8-6-g8750202



The following commit has been merged in the master branch:
commit 59dee7497043784015a00f4946d73c9fb1c29c9f
Author: Niels Thykier <niels@thykier.net>
Date:   Tue Jun 5 00:17:08 2012 +0200

    L::Path: Create module to represent path entries in packages
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/debian/changelog b/debian/changelog
index 6378727..780533a 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -14,8 +14,12 @@ lintian (2.5.9) UNRELEASED; urgency=low
     + [NT] raster-image-in-scalable-directory was added in 2.5.7,
       not removed.
 
+  * lib/Lintian/Collect/Package.pm:
+    + [NT] Represent files (from index) as Lintian::Path objects.
   * lib/Lintian/Package/Source.pm:
     + [NT] sorted_index now returns a list rather than a list ref.
+  * lib/Lintian/Path.pm:
+    + [NT] New file.
 
  -- Niels Thykier <niels@thykier.net>  Tue, 29 May 2012 13:19:07 +0200
 
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index 545b864..45fcaa4 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -24,6 +24,7 @@ use warnings;
 use base 'Lintian::Collect';
 
 use Carp qw(croak);
+use Lintian::Path;
 use Lintian::Util qw(perm2oct);
 
 # Returns the path to the dir where the package is unpacked
@@ -63,7 +64,6 @@ sub file_info {
 }
 
 # Returns the information from the indices
-# FIXME: should maybe return an object
 # sub index Needs-Info index
 sub index {
     my ($self) = @_;
@@ -224,6 +224,9 @@ sub _fetch_index_data {
             }
         }
     }
+    foreach my $file (keys %idxh) {
+        $idxh{$file} = Lintian::Path->new ($idxh{$file});
+    }
     $self->{$field} = \%idxh;
     close $idx;
     close $num_idx if $num_idx;
@@ -311,7 +314,7 @@ Note the file names do not have any leading "./" nor "/".
 
 =item index
 
-Returns a hashref to the index information (permissions, file type etc).
+Returns a hashref to the index information (Lintian::Path objects).
 
 Note the file names do not have any leading "./" nor "/".
 
diff --git a/lib/Lintian/Path.pm b/lib/Lintian/Path.pm
new file mode 100644
index 0000000..61ad67a
--- /dev/null
+++ b/lib/Lintian/Path.pm
@@ -0,0 +1,210 @@
+# -*- perl -*-
+# Lintian::Path -- Representation of path entry in a package
+
+# Copyright (C) 2011 Niels Thykier
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Lintian::Path;
+
+use strict;
+use warnings;
+
+use base qw(Class::Accessor);
+
+=head1 NAME
+
+Lintian::Path - Lintian representation of a path entry in a package
+
+=head1 SYNOPSIS
+
+    my ($name, $type, $dir) = ('lintian', 'source', '/path/to/entry');
+    my $info = Lintian::Collect->new ($name, $type, $dir);
+    my $path = $info->index->{'bin/ls'};
+    if ($path->is_file) {
+       # is file (or hardlink)
+       if ($path->is_hardlink) { }
+       if ($path->is_regular_file) { }
+    } elsif ($path->is_dir) {
+       # is dir
+       if ($path->owner eq 'root') { }
+       if ($path->group eq 'root') { }
+    } elsif ($path->is_symlink) {
+       my $target = $path->link;
+       # is symlink (points to $target)
+    }
+
+=head1 INSTANCE METHODS
+
+=over 4
+
+=item Lintian::Path->new ($data)
+
+Internal constructor (used by Lintian::Collect::Package).
+
+Argument is a hash containing the data read from the index file.
+
+=cut
+
+sub new {
+    my ($type, $data) = @_;
+    my $self = {
+        # copy the data into $self
+        %$data,
+    };
+    return bless $self, $type;
+}
+
+=item name
+
+Returns the name of the file (relative to the package root).
+
+NB: It will never have any leading "./" (or "/") in it.
+
+=item owner
+
+Returns the owner of the path entry as a username.
+
+NB: If only numerical owner information is available in the package,
+this may return a numerical owner (except uid 0 is always mapped to
+"root")
+
+=item group
+
+Returns the group of the path entry as a username.
+
+NB: If only numerical owner information is available in the package,
+this may return a numerical group (except gid 0 is always mapped to
+"root")
+
+=item uid
+
+Returns the uid of the owner of the path entry.
+
+NB: If the uid is not available, undef will be returned.
+This usually happens if the numerical data is not collected (e.g. in
+source packages)
+
+=item gid
+
+Returns the gid of the owner of the path entry.
+
+NB: If the gid is not available, undef will be returned.
+This usually happens if the numerical data is not collected (e.g. in
+source packages)
+
+=item link
+
+If this is a link (i.e. is_symlink or is_hardlink returns a truth
+value), this method returns the target of the link.
+
+If this is not a link, then this returns undef.
+
+If the path is a symlink this method can be used to determine if the
+symlink is relative or absolute.  This is I<not> true for hardlinks,
+as the hardlink normalization may change a relative link into an
+absolute link.
+
+NB: Even for symlinks, a leading "./" will be stripped.
+
+=item size
+
+Returns the size of the path in bytes.
+
+NB: This is only well defined for files.
+
+=item date
+
+Return the modification date as YYYY-MM-DD.
+
+=item operm
+
+Returns the file permissions of this object in octal (e.g. 0644).
+
+NB: This is only well defined for file entries that are subject to
+permissions (e.g. files).  Particularly, the value is not well defined
+for symlinks.
+
+=cut
+
+Lintian::Path->mk_ro_accessors (qw(name owner group link type uid gid size date operm));
+
+# Backing method implementing the is_X tests
+sub _is_type {
+    my ($self, $t) = @_;
+    return $self->type eq $t;
+}
+
+=item is_symlink
+
+Returns a truth value if this entry is a symlink.
+
+=item is_hardlink
+
+Returns a truth value if this entry is a hardlink to a regular file.
+
+NB: The target of a hardlink is always a regular file (and not a dir etc.).
+
+=item is_dir
+
+Returns a truth value if this entry is a dir.
+
+NB: Unlike the "-d $dir" operator this will never return true for
+symlinks, even if the symlink points to a dir.
+
+=item is_file
+
+Returns a truth value if this entry is a regular file (or a hardlink to one).
+
+NB: Unlike the "-f $dir" operator this will never return true for
+symlinks, even if the symlink points to a file (or hardlink).
+
+=item is_regular_file
+
+Returns a truth value if this entry is a regular file.
+
+This is eqv. to $path->is_file and not $path->is_hardlink.
+
+NB: Unlike the "-f $dir" operator this will never return true for
+symlinks, even if the symlink points to a file.
+
+=cut
+
+sub is_symlink { return $_[0]->_is_type ('l'); }
+sub is_hardlink { return $_[0]->_is_type ('h'); }
+sub is_dir { return $_[0]->_is_type ('d'); }
+sub is_file { return $_[0]->_is_type ('-') || $_[0]->_is_type ('h'); }
+sub is_regular_file  { return $_[0]->_is_type ('-'); }
+
+=back
+
+=head1 AUTHOR
+
+Originally written by Niels Thykier <niels@thykier.net> for Lintian.
+
+=head1 SEE ALSO
+
+lintian(1), Lintian::Collect(3), Lintian::Collect::Binary(3),
+Lintian::Collect::Source(3)
+
+=cut
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et
+

-- 
Debian package checker


Reply to: