#!/usr/bin/perl # Copyright (C) Jeremiah C. Foster 2009, based on: # Lintian -- Debian package checker # Copyright (C) 1998 Christian Schwarz and Richard Braakman =head1 NAME 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 assure the quality of a package uploaded into the maemo.org repositories. The goal of maemian is to improve quality by checking that the maemo packaging policy is followed. In order to do that it reads files in the uploaded deb. Currently maemian only looks at the .dsc file and tries 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 warnings; use Getopt::Long; use Pod::Usage; use Carp; use lib qw(/home/jeremiah/maemian/lib/); use Maemian::Output; use Maemian::Schedule; my $LINTIAN_LAB = "/home/jeremiah/maemian/lab"; # --- Command line options 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 ( 'help' => \$help, 'verbose' => \$verbose, 'inputfile|i=s' => \$inputfile, ); # --- Process Command line options pod2usage(1) if $help; # --- Output settings my $out = new Maemian::Output; if ($verbose) { $out->verbose(1); $out->v_msg("Verbose on"); } else { $out->quiet(0); } $out->color("auto"); sub file_tests { use File::Basename; use Perl6::Slurp; my ($filename, $path); my $file = shift; if (-r $file) { ($filename, $path) = fileparse($file); } else { 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) { file_tests($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;