Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

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



#!/usr/bin/perl -w
#    eXpanium converter tool V0.0.2
#   credits to a, 
tye, mkmcconn and all the other people at 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 :-)
# (at your option) any later version.
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# GNU Library General Public License for more details.
+, 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 
        if ($Dateiname eq "-t"){
            $TargetDir = shift @arguments or fail("target directory mi
            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.
                system ("mkdir","$TargetDir") or die "unable to create
+ $TargetDir: $!\n";
            }elsif (!-d $TargetDir){ fail("$TargetDir is not a directo
            $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);
    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){
            if (length($file) > 13){
                $shortenedname = substr($shortenedname, 0, 8-length($e
            }else {    
                $shortenedname = substr($shortenedname, 0, (length($fi
            $shortenedname = $shortenedname.$equalfilenumber.".mp3";
        } else {
            $equalfilenumber = 0;
            $oldfile = $shortenedname;
        push (@ShortFiles,$shortenedname);
    return @ShortFiles;

sub removenonmp3 {

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

    while ($file = shift @args){
            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";

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 ...";
        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
            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";

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

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

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

sub main {
    @directories = checkargs;

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


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.


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

    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 ...


      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


        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.


Back to Code Catacombs

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2014-12-26 01:53 GMT
Find Nodes?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?

    Results (163 votes), past polls