Newer
Older
m2m / stats-revues / statsRevues.pl
#!/usr/bin/perl


# Déclaration des pragmas
use strict;
use utf8;
use open qw/:std :utf8/;

# Appel des modules externes de base
use Encode;
use Getopt::Long;

my ($programme) = $0 =~ m|^(?:.*/)?(.+)|;

my $version     = "1.2.1";
my $dateModif   = "06 Octobre 2017";

# Variables pour les options et variable prédéfinie
my $fichier = "";
my $types   = "journal";
my @types   = ();

eval	{
	$SIG{__WARN__} = sub {usage(1);};
	GetOptions(
		"fichier=s"   => \$fichier,
		"types=s"     => \@types,
		);
	};
$SIG{__WARN__} = sub {warn $_[0];};

usage(2) if not $fichier;

if ( @types ) {
	$types = join(",", @types);
	}

if ( $types !~ /^\w+(-\w+)?(,\w+(-\w+)?)*\z/ ) {
	print STDERR "$programme : Erreur dans l'écriture de l'option \"-t\"\n";
	exit 3;
	}

my %type = map {$_ => 1} split(/,/, $types);

# Variables et tableaux
my %annee  = ();
my %cat    = ();
my %corpus = ();
my %eissn  = ();
my %issn   = ();
my %nb     = ();
my %titre  = ();

if ( $fichier =~ /\.gz\z/ ) {
	open(INP, "gzcat $fichier |") or die "$!,";
	binmode(INP, ":utf8");
	}
elsif ( $fichier eq '-' ) {
	open(INP, "<&STDIN") or die "Cannot duplicate STDIN: $!,";
	}
else	{
	open(INP, "<:utf8", $fichier) or die "$!,";
	}

while(<INP>) {
	chomp;
	s/\r//go;
	my @champs = split(/\t/);
	my $corpus = $champs[1];
	my $type   = $champs[3];
	my $issn   = $champs[4];
	my $eissn  = $champs[5];
	my $revue  = $champs[7];
	my $annee  = $champs[8];
	my $catWoS = $champs[15];
	my $catSM  = $champs[16];

	# type correct ?
	my $ok = 0;
	foreach my $item (split/\s*[;,]\s*/, $type) {
		if ( $type{$item} ) {
			$ok ++;
			last;
			}
		}
	next if not $ok;

	my $titre  = $revue;
	$titre     =~ s/^\([^)]+\) *//o;
	$titre     =~ s/[\s:]*\([^)]+\)$//o;
	$titre     =~ s/^the +//io;
	$titre     =~ s/^der +//io;
	$titre     =~ s/^die +//io;
	$titre     =~ s/^les? +//io;
	$titre     =~ s/^la +//io;
	$titre     =~ s/^l\' *//io;
	$titre     =~ s/^du +//io;
	$titre     =~ s/^il +//io;
	$nb{$revue} ++;
	$titre{$revue} = $titre;
	if ( $issn ) {
		$eissn{$revue}{$eissn} ++;
		}
	if ( $eissn ) {
		$issn{$revue}{$issn} ++;
		}
	if ( $annee ) {
		$annee{$revue}{$annee} ++;
		}
	if ( $catWoS ) {
		$cat{$revue}{'WoS'}{$catWoS} ++;
		}
	if ( $catSM ) {
		$cat{$revue}{'SM'}{$catSM} ++;
		}
	}
close INP;

if ( %titre ) {
	print "\x{FEFF}Nb.\tTitre de revue\tISSN\te-ISSN\t";
	print "Date(s) de publication\tCatégories WoS\tCatégories Science-Metrix\n";
	}

foreach my $revue (sort {$titre{$a} cmp $titre{$b}} keys %titre) {
	print "$nb{$revue}\t$revue\t";
	if ( defined $issn{$revue} ) {
		my @issn = sort keys %{$issn{$revue}};
		print join("/", grep(/./, @issn));
		}
	print "\t";
	if ( defined $eissn{$revue} ) {
		my @eissn = sort keys %{$eissn{$revue}};
		print join("/", grep(/./, @eissn));
		}
	print "\t";
	if ( defined $annee{$revue} ) {
		my @annees = sort {$a <=> $b} keys %{$annee{$revue}};
		my $debut = shift @annees;
		my $fin = $debut;
		while ( @annees ) {
			my $annee = shift @annees;
			if ( $annee = $fin + 1 ) {
				$fin = $annee;
				}
			elsif ( $debut < $fin ) {
				print "$debut-$fin,";
				$debut = $annee;
				$fin = $annee;
				}
			else	{
				print "$debut,";
				$debut = $annee;
				$fin = $annee;
				}
			}
		if ( $debut < $fin ) {
			print "$debut-$fin";
			}
		else	{
			print "$debut";
			}
		}
	print "\t";
	if ( defined $cat{$revue}{'WoS'} ) {
		my @cats = sort {$cat{$revue}{'WoS'}{$b} <=> $cat{$revue}{'WoS'}{$a} or $a cmp $b} keys %{$cat{$revue}{'WoS'}};
		print join("/", @cats);
		}
	print "\t";
	if ( defined $cat{$revue}{'SM'} ) {
		my @cats = sort {$cat{$revue}{'SM'}{$b} <=> $cat{$revue}{'SM'}{$a} or $a cmp $b} keys %{$cat{$revue}{'SM'}};
		print join("/", @cats);
		}
	print "\n";
	}


exit 0;


sub usage
{
my $code = shift;

print STDERR "Usage : $programme -f fichier [ -t type1[,type2]* ]\n";

exit $code;
}