# duck - check for debian/control files # Copyright (C) 2016 Simon Kainz # # 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 # he 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. # # On Debian GNU/Linux systems, the complete text of the GNU General # Public License can be found in `/usr/share/common-licenses/GPL-2'. # # You should have received a copy of the GNU General Public License # along with this program. If not, you can find it on the World Wide # Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, # MA 02110-1301, USA. package DUCK::control_file; use strict; use warnings; use autodie; use Data::Dumper; use Parse::DebControl qw(parse_file); my %try_https=( "Homepage" => 1, "Vcs-Browser" =>1 #TODO: more entries?? ); my %options=( "f:" => " -f file\tspecify path to control file", "F" => " -F\t\tskip processing of debian/control file"); sub opts() { return keys %options; } sub desc() { my $r; foreach (sort keys %options) { $r.=$options{$_}."\n"; } return $r; } sub run() { my ($sname,$params,$entries_ref)=@_; my %opt=%$params; # my @entries=@$entries_ref; if (!$opt{F} ) { my $cf_parser = new Parse::DebControl; if ($opt{f}) { if (! -r $opt{f}) { print STDERR "Unable to open user-specified control file: ".$opt{f}."\n"; exit(2); } } if (!$opt{f}) { if (! -r "debian/control") { return; } } my $opts= {stripComments => 'true'}; my $cf=($opt{f} or "debian/control"); # no user specified file/path, try to find default debian/control file if ( (!$opt{f}) && (-r "debian/control")||($opt{f}) ) { my @data_file = $cf_parser->parse_file($cf, $opts); my @cfdata=$data_file[0][0]; # create list of urls from debian/control foreach my $cfline1 (@data_file) { foreach my $cfline2 (@$cfline1) { foreach my $k (keys %$cfline2) { my $identifier=$cf.$k.$cfline2->{$k}; push (@$entries_ref, [$cf,$k,$cfline2->{$k},0, { filename => $cf, certainty => "certain", checkmethod => $k, val => $cfline2->{$k}, origline => $k.": ".$cfline2->{$k}, verbose => $cf.": ".$k.": ".$cfline2->{$k} } ]); } } } } } return; } 1;