logo rss

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

Instructions

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
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;
	}
}
Creative Commons License
This work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License.

Contact :

adresse mail de contact