minimae - A small, cuddly version of maemian
+=head1 VERSION
+
+This document describes minimae version 0.1
+
=head1 PURPOSE
Maemian is the maemo version of lintian - a policy checker designed to
ascertain who uploaded it, and if they used the correct email address.
=head1 SYNOPSIS
-
+
# Check a debian description file
minimae -i file.dsc
+ # Check a deb
+ minimae -i file.deb
+
=cut
use strict;
use Getopt::Long;
use Pod::Usage;
use Carp;
-use lib qw(lib/);
+use lib qw(/home/jeremiah/maemian/lib/);
use Maemian::Output;
+use Maemian::Schedule;
+
+my $LINTIAN_LAB = "/home/jeremiah/maemian/lab";
# --- Command line options
-my $inputfile; # --- A file passed on the command line
-my ($help, $verbose);
+my $pkg_mode = 'a'; # auto -- automatically search for
+ # binary and source pkgs
+my $inputfile; # --- A file passed on the command line
+my ($help, $verbose, );
GetOptions
(
);
# --- Process Command line options
-pod2usage() if $help;
-pod2usage() if not $inputfile;
+pod2usage(1) if $help;
-# --- Output settings.
+# --- Output settings
my $out = new Maemian::Output;
if ($verbose) {
$out->verbose(1);
$out->v_msg("Verbose on");
+}
+else {
+ $out->quiet(0);
}
- # --- If this is set to true, then you only get msgs
-$out->quiet(0);
-$out->msg("Notice on");
-# --- If this is set to true, then you will get verbose messages.
$out->color("auto");
-
-
-
-
-
-
-
-
-
-
sub file_tests {
use File::Basename;
- my $path = shift;
- if (-r $path) {
- my ($filename, $dirs) = fileparse($path);
- # --- maemo is a trademarked term
- if ($filename =~ /maemo/) {
- print "W: Any use of the word \"maemo\" in the package name (not package version) is subject to trademark.\n";
- }
- # --- Open file into an array
- open my $file, '<', $path or die "Cannot open file: $!\n";
- my @lines = <$file>;
- close $file;
-
- my ($field, $maintainer) = map { split /: / } grep /Maintainer/, @lines;
- chomp($maintainer);
- if ($maintainer =~ /(ubuntu|debian)/i) {
- print "W: Maintainer email address ($maintainer) might be the same as upstream.\n";
- }
- else {
- $out->msg("$maintainer");
- }
- if (grep /BEGIN PGP SIGNED MESSAGE/, @lines) {
- $out->v_msg("$filename is signed");
- }
- $out->debug_msg(3, "\n$dirs\n$filename\n");
+ use Perl6::Slurp;
+ my ($filename, $path);
+ my $file = shift;
+ if (-r $file) {
+ ($filename, $path) = fileparse($file);
}
else {
- croak "File not readable: $!\n";
+ die "Cannot read $file\n";
+ }
+ # --- maemo is a trademarked term
+ if ($filename =~ /maemo/) {
+ $out->v_msg("Any use of the word \"maemo\" in the package name (not package version) is subject to trademark.");
+ }
+ $out->v_msg("File name is $filename");
+ $out->v_msg("Path is $path");
+
+ # We push the entire file into an array
+ # If the file is signed, the sig is separated by a blank line
+ my @control = slurp $file, { irs => qr/\n\n/xms };
+ my @lines;
+ if ($#control > 1) {
+ @lines = split /\n/, $control[1];
}
+ else {
+ @lines = split /\n/, $control[0];
+ }
+ print map { $_ } grep /Maintainer/, @lines;
}
if ($inputfile) {
} else {
croak "No input file found: $!\n";
}
+
+my $schedule = new Maemian::Schedule(verbose => $verbose);
+# .deb file?
+if ($inputfile =~ /\.deb$/) {
+ $out->v_msg("Lab is $LINTIAN_LAB");
+
+ # schedule is a hash containing two hashes followed by an array
+ $schedule->add_deb('b', $inputfile)
+ or warning("$inputfile is a zero-byte file, skipping");
+}
+
+
+
+
+1;