Benutzer-Werkzeuge

Webseiten-Werkzeuge


Writing /srv/www/htdocs/udo/singollo.de/linux.singollo.de/public_html/data/cache/7/723796adf5175c4d1516067861807af1.metadata failed
scripts:dateisuche_nach_mime

Dateisuche nach Mimetypen mit Perl

Wer hat sich nicht immer wieder mal darüber geärgert, wo nun die ganzen !„§$%& Dateien sind, die man von der virenverseuchten Festplatte vom besten Kumpel sichern sollte, und hat dann jedes Verzeichnis manuell abgesucht? Ich kenne diese Aktionen leider auch nur zu gut. Mir kam daher die Idee, einfach den Computer alle wichtigen Dateitypen suchen zu lassen und eventuell zu kopieren. Bei den ersten Versuchen mit der Bash hatte ich zwar einige Erfolge, aber im Script wollte es partout nicht immer klappen. Am Ende stand dann die Idee, es doch einfach mal mit Perl zu versuchen. Sucht man etwas im CPAN, so finden sich einige sehr interessante Perlmodule für diese Zwecke. Daraus habe ich dann folgendes Script entwickelt.

Script

searchmime.pl benötigt einige Standardmodule, die bei jeder Perl-Installation dabei sein sollten. Ansonsten lassen sich diese Module über CPAN nachinstallieren.

Die beiden Arrays @mimelist für die Mimetypen und @extlist für die Dateierweiterungen, für den Fall das die Mime-Erkennung versagt, sind für die meisten Fälle bereits ausreichend vorbelegt. Sollten dennoch einige Dateitypen fehlen, so kann man die betreffende Liste entsprechend erweitern.

Für den Fall, das man einen Virenscanner installiert hat, so kann man diesen mittels $virscan auf das entsprechende Binary (z.B. clamscan, clamdscan o.ä.) und entsprechenden Optionen verweisen. Damit wird dann vor dem Kopieren der Datei noch einen Virencheck durchgeführt. Schlägt der Test fehl, so wird diese Datei nicht kopiert und ein „failed“ ausgegeben.

searchmime.pl benötigt auf jeden Fall die Angabe des Quellverzeichnisses (-s Verzeichnis). Jede andere Option kann mit -h bzw. –help angezeigt werden.

#!/usr/bin/perl
use warnings;
use strict;
use Getopt::Std;
use File::Copy;
use File::Find;
use File::Type;
use File::Basename;
 
use vars qw( $VERSION $BUILD );
 
BEGIN {
  $VERSION = '0.0.2';
  $BUILD = '20111129';
}
 
$Getopt::Std::STANDARD_HELP_VERSION = 1;
 
my $print_false = 0;
my $print_match = 0;
my $print_verbose = 1;
my $relative = 1;
 
my %virscan = ('prg' => '/usr/bin/clamscan', 'opt' => ' --quiet --no-summary');
 
my $source = '';
my $target = '';
 
my @mimelist = qw( image/jpeg image/png image/tiff image/fax-g3 image/g3fax image/jpeg2000 image/tiff \
 audio/mpeg audio/x-aac audio/x-flac audio/x-m4a audio/x-mpeg audio/x-wav application/pdf application/msword \
 application/ogg application/rtf application/vnd.ms-excel application/vnd.ms-powerpoint application/x-bzip \
 application/x-bzip-compressed-tar application/x-cd-image application/x-compress application/x-compressed-tar \
 application/x-gzip application/x-rar application/x-rar-compressed application/x-tar application/zip \
 application/vnd.oasis.opendocument.chart application/vnd.oasis.opendocument.database \
 application/vnd.oasis.opendocument.formula application/vnd.oasis.opendocument.graphics \
 application/vnd.oasis.opendocument.graphics-template application/vnd.oasis.opendocument.image \
 application/vnd.oasis.opendocument.presentation application/vnd.oasis.opendocument.presentation-template \
 application/vnd.oasis.opendocument.spreadsheet application/vnd.oasis.opendocument.spreadsheet-template \
 application/vnd.oasis.opendocument.text application/vnd.oasis.opendocument.text-master \
 application/vnd.oasis.opendocument.text-template application/vnd.oasis.opendocument.text-web \
 application/vnd.stardivision.calc application/vnd.stardivision.chart application/vnd.stardivision.draw \
 application/vnd.stardivision.impress application/vnd.stardivision.mail application/vnd.stardivision.math \
 application/vnd.stardivision.writer application/vnd.sun.xml.calc application/vnd.sun.xml.calc.template \
 application/vnd.sun.xml.draw application/vnd.sun.xml.draw.template application/vnd.sun.xml.impress \
 application/vnd.sun.xml.impress.template application/vnd.sun.xml.math application/vnd.sun.xml.writer \
 application/vnd.sun.xml.writer.global application/vnd.sun.xml.writer.template application/vnd.wordperfect \
 video/mpeg video/x-avi video/x-ms-asf video/x-ms-wmv video/x-msvideo video/quicktime );
my @extlist = qw( doc xls ppt pdf );
 
main();
 
sub main
{
        my %opts;
 
        getopts('s:t:vqfmrahp', \%opts);
 
        if( $opts{p} ) {main::print_lists()}
        if( $opts{h} ) {main::VERSION_MESSAGE();main::HELP_MESSAGE();exit;}
 
        if( $opts{s} and -d $opts{s} ) {
                $source = $opts{s};
                print "source directory: $source\n";
        }
        if( ! $opts{t} || ! -d $opts{t} ) {
                print "searching for files...\n";
                $opts{m}=1;
                $opts{a}=1;
        } elsif ($opts{t} and -d $opts{t} ) {
                print "copying files...\n";
                $target = $opts{t};
                print "target directory: $target\n";
        }
 
        if( $opts{v} ) { $print_verbose=1;print "verbose: on\n"; }
        if( $opts{q} ) { $print_verbose=0;print "verbose: off\n"; }
        if( $opts{f} ) { $print_false=1;print "false matched files: on\n"; }
        if( $opts{m} ) { $print_match=1;print "matched files: on\n"; }
        if( $opts{r} && ! $opts{a} ) {$relative=1;print "relative path: on\n"; }
        if( $opts{a} ) { $relative=0;print "absolute path: on\n"; }
 
        if( -d $target and -f $virscan{prg} ) { print "scanning files with $virscan{prg}...\n"; }
 
        exit if ! $source || ! -d $source;
 
        print "\n";
 
        find (\&main::wanted, $source);
}
 
sub main::HELP_MESSAGE {
        print <<EOD
 
        -s              source directory (required)
        -t              target directory required only for copy, none for search (implies -m -a)
        -v              verbose
        -q              quiet
        -f              show false matched files
        -m              show matched files
        -r              relative path
        -a              absolute path
        -p              print types for searching
        -h/--help       help
        --version       version
 
EOD
}
 
sub main::VERSION_MESSAGE {
        print "\n".basename($0)." version $VERSION build $BUILD\n";
}
 
sub main::print_lists {
        main::VERSION_MESSAGE();
        print "\nused mimetypes:\n".join(", ",@mimelist)."\n\nextend list:\n".join(", ",@extlist)."\n\n";
        exit;
}
 
sub main::wanted {
        my $file = $File::Find::name;
        return if /^\~/;
 
        if ( -f $file and ! -l $file ) {
                my $filetype = File::Type->new();
                my $mime = $filetype->checktype_filename($file);
                if ( $relative eq "1" )  { $file =~ s/^$source//; }
                if ( grep /^$mime/,@mimelist ) {
                        if ( $print_match eq "1" ) { print "$file [$mime] -> ok\n"; }
                        if ( $target ) { copying ( $file,$mime ); }
                } else {
                        my $ext = ($file =~ m{\.([^.]+)$})[0];
                        if ( $ext ) {
                                $ext = lc($ext);
                                if ( grep /^$ext/,@extlist ) {
                                        $mime = "extended list";
                                        if ( $print_match eq "1" ) { print "$file [$mime] -> doesn`t match, but match second list\n"; }
                                        if ( $target ) { main::copying ( $file,$mime ); }
                                } else {
                                        if ( $print_false eq "1" ) { print "$file [$mime] -> doesn`t match\n"; }
                                }
                        } else {
                                if ( $print_false eq "1" ) { print "$file [$mime] -> doesn`t match\n"; }
                        }
                }
        }
}
 
sub main::copying {
        return if ! $target;
 
        my $file = shift;
        my $mime = shift;
 
        my ($fn,$vz,$ex) = fileparse($file);
        my $targetdir = $target.$vz;
        my $targetfile = $targetdir.$fn;
        if ( $relative ) { $file = $source.$file; }
 
        if ( ! -d $targetdir ) {
                if ( $print_verbose eq "1" ) { print "making target directory $targetdir.\n"; }
                system "mkdir -p \"$targetdir\"";
        }
 
        if ( $print_verbose eq "1" ) { print "copying $file [$mime]..."; }
        if ( -f $virscan{prg} ) {
                my $test = system $virscan{prg}." ".$virscan{opt}." \"$file\"";
                if ( $test ne 0 ) {
                        print "failed\n";
                        return;
                }
        }
        system "cp \"$file\" \"$targetfile\"";
        if ( -f $targetfile and  $print_verbose eq "1" ) {
                print "ok\n";
        } else {
                print "false\n";
        }
}

ToDo

* Variable $clamscan durch $virenscan ersetzen und auch auf die Rückmeldungen prüfen. → Mit Version 0.0.2 erledigt.

scripts/dateisuche_nach_mime.txt · Zuletzt geändert: 07.10.2012 18:31 (Externe Bearbeitung)