Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

eXpanium file converter

by C-Keen (Monk)
on Feb 19, 2001 at 13:16 UTC ( #59360=sourcecode: print w/ replies, xml ) Need Help??

Category: Audio related programs
Author/Contact Info ChristianKellermann@gmx.net
Description: This is a fast hack I wrote for converting my mp3 files to dos 8.3 format. This is how my eXpanium mp3 player wants them. Since mkisofs does not preserve the .mp3 extension this hack is necessary. Enjoy! P.S.: Please have mercy with this piece of code since it is my first attempt in perl :-) Suggestions, comments, encouragements... are welcome.

Update

This new version includes a recovery feature and many bug fixes. I have also included some code from the suggestions. Thanks to ervey body who helped me with that. P.P.S: Yes I know the file shortening process could still be more flexible with the files it gets but I will get it done sooner or later :-)

#!/usr/bin/perl -w
#    eXpanium converter tool V0.0.2
#
#   credits to a, 
tye, mkmcconn and all the other people at perlmonks.org who helped me 
+with regexps!
#
# This program should convert MP3 file names into the dos format (8.3)
# and store  the original names into a file. Once the names are conver
+tet the
# procedure can be reversed with said file.
#
# This program is used to make mp3 files burnable with mkisofs since t
+his program
# does not preserve the .mp3 extension on files that would have the sa
+me filename when
# shortened to 8.3 format. 
#
# The program takes directories or filenames as parameters. See source
+ code for details :-)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307
+, USA.

use strict;
use File::Copy;        # If somebody knows a more comfortable way to c
+opy a file with perl please let me know

my (@newfiles);
my (@directories);
my (@mp3files);

my $logfile;
my $recover = 0;
my $alttarget = 0;        # if 1: another directory as the current is 
+used to store the renamed / recovered files
my $TargetDir;         # Place were all the files will go to
my $version = "V0.0.2";


sub checkargs {

my $Dateiname;
my @arguments = @ARGV;
my @dirs;


    while ($Dateiname = shift @arguments){
        if ($Dateiname eq "-r"){
            print "Recovering activated...";
             $recover = 1;
            $Dateiname = shift @arguments or fail("source directories 
+missing.\n");
        }
        if ($Dateiname eq "-t"){
            $TargetDir = shift @arguments or fail("target directory mi
+ssing.\n");
            print "using alternative dir $TargetDir to store files..."
+;
            $alttarget = 1;
            if ($TargetDir =~/\/|\\$/) {chop $TargetDir;}        #if d
+irectory name ends with a slash or a backslash throw it away
            if (!-e ($TargetDir)){
                print("$TargetDir does not exist. Creating $TargetDir.
+.\n");
                system ("mkdir","$TargetDir") or die "unable to create
+ $TargetDir: $!\n";
            }elsif (!-d $TargetDir){ fail("$TargetDir is not a directo
+ry.\n");}
            $Dateiname = shift @arguments or fail("source directory is
+ missing.\n");
        }
        if ($Dateiname eq "--help") {morehelp();}
        (-d $Dateiname) or fail("$Dateiname is not a directory. Please
+ check your arguments.\n");
        if ($Dateiname =~m/\/|\\$/) {chop $Dateiname;}        #if dire
+ctory name ends with a slash or a backslash throw it away
        push (@dirs, $Dateiname);
    }
    return @dirs;
}

sub createfilenames {

my $dir = $_[0];
my @files;
my $file;


    opendir(VERZEICHNIS,$dir) || die "Cannot open directory $dir: $!\n
+";
    while ($file = readdir(VERZEICHNIS)){
        
        @files = (@files, $file);
    }
    closedir(VERZEICHNIS);
    return @files;
}

sub shortenfilenames  {

my $equalfilenumber = 0;
my $file = "";
my $oldfile = "";
my $shortenedname = "";
my @FileArray = @_;
my @ShortFiles;



    @FileArray = sort (@FileArray);        # sorts the Array before we
+ can shorten longer filenames

    foreach $file (@FileArray){
    
        if (length($file)>13){
    
            $shortenedname = substr($file, 0, 8);
            $shortenedname = $shortenedname.".mp3";
        } else {$shortenedname = $file;}
        
        

        if ($shortenedname eq $oldfile){
            if (length($equalfilenumber) > 7){
                print "WARNING: TOO MANY SIMILAR FILES! CANNOT SHORTEN
+ ANY MORE FILES THAT HAVE THE SAME BEGINNING AS ".$shortenedname."\n"
+;
                exit(1);
            }
            if (length($file) > 13){
                $shortenedname = substr($shortenedname, 0, 8-length($e
+qualfilenumber));
            }else {    
                $shortenedname = substr($shortenedname, 0, (length($fi
+le)-length($equalfilenumber)-4));
            }
            $shortenedname = $shortenedname.$equalfilenumber.".mp3";
            $equalfilenumber++;
        } else {
            $equalfilenumber = 0;
            $oldfile = $shortenedname;
        }
        push (@ShortFiles,$shortenedname);
    }
    return @ShortFiles;
}

sub removenonmp3 {

my @args = @_;
my $file;
my @mp3files;

    while ($file = shift @args){
        if ($file =~ /\.mp3$/i){
            push(@mp3files, $file);
        }
    }
    return @mp3files;
}

sub renamefiles{

my $file;
my $newfile;
my $sourcedir = $_[0];

    open(LOGFILE, $logfile) or die "Unableto open  $logfile!: $!\n";
    
    while ($file = shift(@newfiles)){
        $newfile = shift @mp3files;
        if ($alttarget) {
            # necessary to keep out oold files in the old directory (r
+ename removes them)
            copy("$sourcedir/$file","$TargetDir/$newfile") or die "Can
+not copy files: $!";            
        }
        else {rename("$sourcedir/$file", "$sourcedir/$newfile") or die
+ "Cannot rename $file in $newfile: $!.\n";}
        print LOGFILE "$file:$newfile\n" or die "Cannot write to $logf
+ile: $! !\n";
    }
    close(LOGFILE);
}

sub convert {

    my $directory;    

    foreach $directory (@directories){
        print "Getting mp3 files...";
        @newfiles = createfilenames($directory);
        @newfiles = removenonmp3(@newfiles);
        print "done.\n";
        
        print "Shortening names...";
        @mp3files = shortenfilenames(@newfiles);
        print "done.\n";
        
        if ($alttarget == 1) {
            if (-e "$TargetDir/eXpanium.log"){
                die "Logfile in alternative $TargetDir already exists.
+\nAborting now to avoid loss of older names.\n";
            } else {$logfile = ">$TargetDir/eXpanium.log";}
        }
        elsif (-e "$directory/eXpanium.log"){die "Logfile in $director
+y already exists. \nAborting now to avoid loss of older names.\n";}
        else {$logfile = ">$directory/eXpanium.log";}
        print "\nChange log: $logfile.\n";
        
        @newfiles = sort(@newfiles);
        
        print "Renaming files ...";
        renamefiles($directory);
        print "done.\n";
    }
}

sub recoverfiles{

my $dir = $directories[0];
my $line;
my ($oldname, $newname);
my @names;
    
    
    foreach $dir (@directories){
        $logfile = "$dir/eXpanium.log";
        # first look for the log file
        print "Logfile is: $logfile\n";
        (-e ("$logfile")) or die "There seems to be no log file $logfi
+le in $dir. Recovering is not possible sorry.\n";}
        print "$dir\n";
        open(LOGFILE, "$logfile") or die "Cannot open /$logfile: $!\n"
+;
        print "Recovering...";
        while ($line = <LOGFILE>){
            @names = split(/:/, $line);
            $oldname = shift @names;
            $newname = shift @names;
            chop($newname);    # split leaves a newline character behi
+nd
            if ($alttarget){ copy ("$dir/$newname","$TargetDir/$oldnam
+e") or die "Cannot copy filename: $!";}
            else {rename ("$dir/$newname", "$dir/$oldname") or die "Ca
+nnot change filename $dir/$newname to $dir/$oldname: $!\n";}
        }
        print "done.\n";
        if ($alttarget == 0){
            print "Deleting logfile...";
            if (system ("rm","$logfile")){die "Unable to delete log fi
+le: $!\n";}
            print "done.\n";
        }
        close(LOGFILE);
}

sub shorthelp {
    print "eXpanium converter $version\n==============================
+============\n";
    print "Usage: eXpanium [-r] [-t targetdir] source directories\n";
    print "For more help try eXpanium --help\n"
}

sub morehelp { #:-)
    shorthelp();
    print"\n";
    print "More help is not available at the moment. Please try again 
+later :-)\n";    
    exit(0);
}

sub fail {    # little function for the arg sorting at the beginning. 
+should save a lot of unnecessary lines
my $Message = $_[0];
    shorthelp();
    print "$Message";
    exit(1);
}
        

sub main {
    @directories = checkargs;

    if ($recover) {
        print "Recovering files in following directories: @directories
+.\n";
        recoverfiles();
    } else {
        print "Changing filenames in: @directories.\n";
        convert();
        }
    print "Have a nice day!\n";
}

main();

Comment on eXpanium file converter
Download Code
Re: eXpanium file converter
by C-Keen (Monk) on Feb 19, 2001 at 13:23 UTC
    Can anybody tell me why this code is so messed up? When I pasted it looked ok.
      Do you mean the line wraps with the red +'s? The Perlmonks back-end software does this, otherwise long lines of code would make really wide browser windows.

      --
      IndyZ

Re: eXpanium file converter
by a (Friar) on Feb 20, 2001 at 09:40 UTC
    A couple of things. Your method of passing arrays is okay but could be troublesome if you've got big lists - by doing: @newfiles = removenonmp3(@newfiles); you 'flatten' @newfiles to a list, put it into the various arrays @_, @args and the send it back as a list which gets 'slurped' back into @newfiles. If you pass by reference ("removenonmp3(\@newfiles)") you won't do all that copying. For:@dirs = (@dirs, $Dateiname); you should:push(@dirs, $Dateiname); Again, it doesn't unravel/reravel (?) @dirs, just pushes the value on the end. Add a 'closedir' for completeness.

    Your shortenfilename could use a hash, something like:

    my %oldfiles; foreach $file (@FileArray){ if (length($file)>13){ $shortenedname = substr($file, 0, 8); $shortenedname = $shortenedname.".mp3"; } else {$shortenedname = $file;} if ( $oldfiles{$shortenedname}++ ) { # short name already exist, try again ...
    Using MS's idea of 6 and ~X, you could then:
    if ( $oldfiles{$shortenedname}++ ) { my $base = substr($file, 0, 6); my $test_shortenedname = 'not found'; for my $i ( 1 .. 9, a .. z ) { $test_shortenedname = $base . '~' . $i; unless $oldfiles{$test_shortenedname}; } next if ($test_shortenedname eq 'not found'); # rather than die, just skip the bad/unshortenable name $shortenedname = $test_shortenedname } push @short_files, $shortenedname; } return @short_files;
    which it to also point out that shortenfilenames seems to be returning the same array it gets, unchanged. Change $file isn't going to modify the array members.

    removemp, you probably want:

    if ($file =~ /\.mp3$/i ){ push(@mp3files, $file); }
    That is, you want only files that end in '.mp3', not
    kiki_dee.mp3.tar.gz

    I think you'll be clobbering your log file everytime, as you're opening it in overwrite mode ('>eXpanium.log') each time. There's something odd about redefining the log file name in one sub and opening it in another. Log file names, unless you're numbering them (logfile1.log, logfile2.log) are probably better global. You pass @newfiles all the time, except for rename, probably should be consistent on that or just 'in-line' rename in main.

    Just some suggestions, YM will always V ...

    a

      Thank you I will look into it and post the new code with the next version which will include a recover mode so that you can redo the renaming. This would make it easy to use the more descriptive filenames e.g. when writing the files back from a cd-rom.

      But I think just skipping a filename would mess up my list which has to be in the same order as the list with the original names doesn't it? I like the idea of the ~X method though. Thank you very much

      C-Keen

        Well, perhaps ... you could do something so you remove the "unshortenable" name from the list (a decent error msg "can not shorten $file" ('nicht canst ger-shorten' ;-)) too. Just seems a shame to quit the whole mess if only one file can't be handled.

        a

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://59360]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (8)
As of 2014-10-25 17:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (146 votes), past polls