История изменений

#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Std;

=pod

Usage:

  find /etc -type f | perl hdd-file-preload.pl -c -s [ -u ] [ -l list-file ]

Reads list of files from standard output and move or remove them from page cache.

Options:

-c - cache files
-s - while caching sort files according to their placement on disk to limit head moving
-l - just produce list of files suitable for "vmtouch -b <file>"
-u - uncache files

=cut

my %cli_opts;
getopts('cusl:', \%cli_opts);

die "Need -c or -u option to specify action, or just -l" unless ($cli_opts{'l'} or $cli_opts{'c'} or $cli_opts{'u'});

our @files = ();

sub process_file {
    use vars qw( @files );
    my ($filepath) = @_;

    my @lines = split(/\n/, `filefrag -e "$filepath"`);
    foreach my $line (@lines) {
        $line =~ / ([0-9]{3,12}).. +([0-9]+):/;
        if (! $1) {
            next;
        }

        push @files, [int($1), $filepath];
        last;
    }
}

my $total_files = 0;
while (my $inp = <>) {
    chomp $inp;
    if ($cli_opts{'c'} or $cli_opts{'l'}) {
        process_file($inp);
    }
    else {
        push @files, [0, $inp];
    }
    $total_files++;
}


if ($cli_opts{'s'}) {
    @files = sort { $a->[0] <=> $b->[0]; } @files;
}

if ($cli_opts{'l'}) {
    open (my $OUTP, '>', $cli_opts{'l'}) or die "$!";
    foreach my $file (@files) {
        print $OUTP "$file->[1]\n";
    }
    close ($OUTP);
    exit;
}


my $max_args = 255;
for (my $i = 0; $i < scalar(@files); $i += $max_args ) {
    my $cur_args = ($i + $max_args < scalar(@files) ) ? $max_args : (scalar(@files) - $i-1);
    my $command = $cli_opts{'c'} ? '-t' : '-e';
    my $execs = "vmtouch $command " . join(" ", map { "\"" . $_->[1] . "\""; } @files[$i..($i+$cur_args)]);
    system $execs;
}

#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Std;

=pod

Usage:

  find /etc -type f | perl hdd-file-preload.pl -c -s [ -u ] [ -l list-file ]

Reads list of files from standard output and move or remove them from page cache.

Options:

-c - cache files
-s - while caching sort files according to their placement on disk to limit head moving
-l - just produce list of files suitable for "vmtouch -b <file>"
-u - uncache files

=cut

my %cli_opts;
getopts('cusl:', \%cli_opts);

die "Need -c or -u option to specify action, or just -l" unless ($cli_opts{'l'} or $cli_opts{'c'} or $cli_opts{'u'});

our @files = ();

sub process_file {
    use vars qw( @files );
    my ($filepath) = @_;

    my @lines = split(/\n/, `filefrag -e "$filepath"`);
    foreach my $line (@lines) {
        $line =~ / ([0-9]{3,12}).. +([0-9]+):/;
        if (! $1) {
            next;
        }

        push @files, [int($1), $filepath];
        last;
    }
}

my $total_files = 0;
while (my $inp = <>) {
    chomp $inp;
    if ($cli_opts{'c'} or $cli_opts{'l'}) {
        process_file($inp);
    }
    else {
        push @files, [0, $inp];
    }
    $total_files++;
}


if ($cli_opts{'s'}) {
    @files = sort { $a->[0] <=> $b->[0]; } @files;
}

if ($cli_opts{'l'}) {
    open (my $OUTP, '>', $cli_opts{'l'}) or die "$!";
    foreach my $file (@files) {
        print $OUTP "$file->[1]\n";
    }
    close ($OUTP);
    exit;
}


my $max_args = 255;
for (my $i = 0; $i < scalar(@files); $i += $max_args ) {
    my $cur_args = ($i + $max_args < scalar(@files) ) ? $max_args : (scalar(@files) - $i-1);
    my $command = $cli_opts{'c'} ? '-t' : '-e';
    my $execs = "vmtouch $command " . join(" ", map { "\"" . $_->[1] . "\""; } @files[$i..($i+$cur_args)]);
    system $execs;
}