Script Perl pour créer automatiquement des hard link (liens physiques)

Voici un programme en perl que j'utilise pour créer automatiquement des hardlink sur mes fichiers dupliqués.

Préambule

Environnement

• perl : perl 5

Instructions

• créer un fichier qui contiendra la liste des fichiers dupliqués (ici du répertoire /data avec la commande suivante :

user@host:~$ SEARCH=/data; find $SEARCH -not -empty -type f -printf %s\\n | sort -rn | uniq -d | xargs -I{} -n1 find $SEARCH -type f -size {}c -print0 | xargs -0 md5sum | sort | uniq -w32 --all-repeated=separate > fichier

• formater le fichier pour qu'il soit exploitable en supprimant les infos de hash :

user@host:~$ sed -i 's/[0-9a-f]*\s\s//' fichier

Utilisation

user@host:~$ deduphard.pl fichier

Code

#!/usr/bin/perl
# Role : script perl qui créé des hard link sur les fichiers dupliqués
# Auteur : http://shebangthedolphins.net/
# Instructions  : 
# - créer un fichier qui contiendra les fichiers dupliqués du répertoire data : SEARCH=/data; find $SEARCH -not -empty -type f -printf %s\\n | sort -rn | uniq -d | xargs -I{} -n1 find $SEARCH -type f -size {}c -print0 | xargs -0 md5sum | sort | uniq -w32 --all-repeated=separate > fichier
# - formater le fichier pour qu'il soit exploitable : 
#  * supprimer les infos de hash : sed -i 's/[0-9a-f]*\s\s//' fichier
# 1.0 premiere version

use strict;
use warnings;

my $fichier = $ARGV[0];
my $firstline;						#contiendra la première ligne de référence
my $stateligne;
my $temoin = 0;						#précise que la dernière ligne était vide
my $source;
my $destination;

open (F, '<', "$fichier") || die "Error: $!";       #ouverture du fichier au format unicode fournit en argument
while (my $ligne = <F>) {				#boucle pour parcourir le fichier
	$stateligne=&lignevide($ligne);		#appel de la fonction lignevide pour savoir si présence d'une ligne vide
	if ($stateligne==1){				#si ligne vide
		$temoin = 0;				
	}
	if ($stateligne==0 and $temoin==1){		#si ligne courante non vide et si derniere ligne pas vide
		$source=$firstline;			#le premiere ligne trouvée est la source
		$destination=$ligne;			#la nouvelle ligne est la destination
		chop($source);				#supprime le retour chariot
		chop($destination);			#supprime le retour chariot

		print "hardlink : ln $source $destination\n\n";	#affiche les informations
		`ln -fi "$source" "$destination"`;		#-f : supprimer les fichiers de destination existants; -i demander s'il faut supprimer les destinations
	}
	if ($stateligne==0 and $temoin==0){		#si ligne courante non vide et si derniere ligne vide
		$firstline = $ligne;			#stocke dans firstline la ligne courante
		$temoin = 1;				#signale qu'une ligne de référence a été trouvée
	}
}

#fonction pour vérifier la présence d'une ligne vide (retourne 1 si ligne vide)
sub lignevide {
	my $func_ligne = $_[0];	
	if ($func_ligne =~m/^$/){
		return 1;
	}
	else{
		return 0;
	}
}