Group
Extension

PMInfoExtr/bin/modules-extractor.pl

#!/usr/bin/perl

#
# Copyright (c) 2014, Caixa Magica Software Lda (CMS).
# The work has been developed in the TIMBUS Project and the above-mentioned are Members of the TIMBUS Consortium.
# TIMBUS is supported by the European Union under the 7th Framework Programme for research and technological
# development and demonstration activities (FP7/2007-2013) under grant agreement no. 269940.
#
# Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at:   http://www.apache.org/licenses/LICENSE-2.0
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on
# an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including without
# limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTIBITLY, or FITNESS FOR A PARTICULAR
# PURPOSE. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise,
# unless required by applicable law or agreed to in writing, shall any Contributor be liable for damages, including
# any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this
# License or out of the use or inability to use the Work.
# See the License for the specific language governing permissions and limitation under the License.
#

#Author(s):
#	Nuno Martins <nuno.martins@caixamagica.pt>

use strict;
use warnings;

use PMInfoExtr::Manager;
use Cwd;
use Getopt::Long;
use PMInfoExtr::Version;

our $VERSION = $PMInfoExtr::Version::VERSION;

my $manager = PMInfoExtr::Manager->new();

sub add_folders {
	my ($opt_name, $opt_value) = @_;
	$manager->push_folders($opt_value);
}

sub output_file {
	my ($opt_name, $opt_value) = @_;
	$manager->set_options('output_file', $opt_value);
	return $opt_value;
}

sub help {
	my $line = shift;
	my $help_line = "perl $0 [--config-path-file = config_path_file | --debug | --folders = folder_name | --help | --cpan | --output = output_file]";
	if ($line) {
		print <<EOF;
$line

$help_line
EOF
	} else {
		print <<EOF;
$help_line
EOF
	}

	return;
}

sub read_config_path_file {
	my ($opt_name, $opt_value) = @_;
	if (-e $opt_value) {
		open my $path_config, "<", $opt_value or die("Could not open file $opt_value\n$!.");
		while (<$path_config>) {
			chomp $_;
			$manager->push_folders($_);
		}
		close $path_config;
	} else {
		help("Config file $opt_value does not exit");
		exit -1;
	}
}

sub main {
	my @options = @_;
	my $help = 0;
	my $debug = 0;
	my $cpan = 0;
	my $dpkg = 0;
	my $clean = 0;

	GetOptions (
		'help!' => \$help,
		'debug!' => \$debug,
		'folders=s' => \&add_folders,
		'output=s' => \&output_file,
		'cpan!' => \$cpan,
		'dpkg!' => \$dpkg,
		'config-path-file=s' => \&read_config_path_file,
		'clean!' => \$clean,
	);

	if ($help) {
		help();
		exit 0;
	}

	$manager->set_options("debug", $debug);
	$manager->set_options("dpkg", $dpkg);

	if ($cpan) {
		for (@INC) {
			my $link = readlink ($_);
			if (defined $link) {
				my ($path) = $_ =~ m/(.*\/)/g;
				$manager->push_folders($path . $link);
				$manager->push_folders($_);
			} else {
				if ($_ =~ m/^\.$/g) {
					$manager->push_folders(cwd());
				} else {
					$manager->push_folders($_);
				}
			}
		}
	}

	if ($clean) {
		unlink "output.json";
	}

	if (-e "output.json") {
		open my $output, "<", "output.json" || die ("Can't open file output.json. $!");
		my $data = <$output>;
		print STDOUT $data;
		exit 0;
	}

	unlink "not_found.log";
	$manager->start();
	return;
}

main(@ARGV);


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.