Platon Technologies
neprihlásený Prihlásiť Registrácia
SlovakEnglish
open source software development oslavujeme 10 rokov vývoja otvoreného softvéru! Piatok, 19. apríl 2024

Súbor: [Platon] / scripts / perl / filesystem / hardlink-files.pl (stiahnutie)

Revízia 1.1, Sun Apr 17 16:31:07 2005 UTC (19 years ago) by rajo

Create hardlinks from duplicate files - saves space on your hard disk

#!/usr/bin/perl

#
# hardlink-files.pl - create hardlinks from duplicate files
#
# Tested on Linux and FreeBSD.
#
# Developed by Lubomir Host 'rajo' <rajo AT platon.sk>
# Copyright (c) 2005 Platon SDG, http://platon.sk/
# Licensed under terms of GNU General Public License.
# All rights reserved.
#
# Changelog:
# 2005-04-17 - created
#

# $Platon$

use strict;
#use Data::Dumper;

$| = 1;

my $md5binary;

my $md5sums = {
};

if ($^O eq 'linux') {
    $md5binary = 'md5sum';
}
elsif ($^O eq 'freebsd') {
    $md5binary = 'md5 -r';
}
else {
    die "Unsupported platform, please, specify path to md5sum binary manualy and send patch.";
}

foreach my $path (@ARGV) {
    open(FIND, "find $path -type f -exec $md5binary {} \\; |");
    while (my $line = <FIND>) {
        chomp $line;
        if ($line =~ m/^([^\s]+)\s+(.*)$/g) { # Linux format
            my ($md5, $filename) = ($1, $2);
            push @{$md5sums->{$md5}}, $filename;
        }
    }
    close(FIND);
}

print scalar(keys %$md5sums), " unique files found\n";

foreach my $key (keys %$md5sums) {
    my $arr = $md5sums->{$key};
    if (scalar(@$arr) > 1) {
        my $source = $arr->[0];
        print "$source <--- ";
        for (my $i = 1; $i < scalar(@$arr); $i++) {
            print $arr->[$i];
            unlink $arr->[$i] or warn "\n\nunlink error: $!\n";
            link $source, $arr->[$i] or warn "\n\nlink error: $!\n";
        }
        print "\n\n";
    }
}

#print Dumper($md5sums);

# vim: ts=4
# vim600: fdm=marker fdl=0 fdc=3


Platon Group <platon@platon.sk> http://platon.sk/
Copyright © 2002-2006 Platon Group
Stránka používa redakčný systém Metafox
Na začiatok