Perl Script to convert to .lrf for Sony PRS

[chas]

Here is a small perl script I wrote that goes recursively through sub-directories looking for .lit, .pdf, .txt, .html. .htm, .txt, .rtf files and then converts them to the same name into the specified directory.

It actually simply calls "any2lrf" to do the actual work so you will need to install libprs500 and clit18 as well.

Hope this helps some of you out.

Usage is:

convlrf.pl [-r] <sourcedir> <destdir>

eg. To convert the files in the current directory and put them into
/data/eReader simply: convlrf.pl -r . /data/eReader

It prefers .lit files rather than any other format so if you have multiple formats of the same book the .lit will be the one you get.

Enjoy.

#### Cut below this line and save to convlrf.pl ######

#!/usr/bin/perl
#
# Recursively go through directory structure from current directory looking
# for books and then convert them to .lrf and place in
# a single directory (won't replace filenames with ones that
# already exist) so you can upload them to your Sony eReader.
#
# Basically it just calls lit2lrf
# Don't panic if it takes a while converting in the BBeB stage takes TIME!!!
#

use File::Basename;

sub
usage
{
	print "convlrf.pl [-r] <litdir> <lrfdir>\n";
	print "\t[-r]: recurse through subdirs for .lit files.\n";
	print "\tlitdir: directory to start from.\n";
	print "\tlrfdir: destination directory.\n";
	exit 1;
}

#
# Return yes if first arg matches one of the rest in the list
#
sub
suffmatch
{
	my ($s, $suff) = @_;

	my $ret = 0;
	$suff =~ tr/a-z/A-Z/;
	$s =~ tr/a-z/A-Z/;
	
	my (@suffix) = split /:/, $s;
	foreach my $sfx (@suffix)
	{
		next if ("$suff" eq "");
		if ("$sfx" eq "$suff")
		{
#			print "Match:$suff=$sfx\n";
			$ret = 1;
			break;
		}
	}
#	print "No Match:$suff|$s|\n" if (! $ret);
	$ret;
}

#
# MAIN
#

if (
	($#ARGV != 1 && $#ARGV != 2)
	||
	($#ARGV == 2 && $ARGV[0] ne "-r")
	||
	($#ARGV == 1 && $ARGV[0] eq "-r")
)
{
	usage();
}

if ($ARGV[0] eq "-r")
{
	$litdir = $ARGV[1];
	$lrfdir = $ARGV[2];
	if (! -d $litdir || ! -d $lrfdir)
	{
		print "No litdir directory: $litdir\n" if (! -d $litdir);
		print "No lrfdir directory: $lrfdir\n" if (! -d $lrfdir);
		usage();
	}
	$FILES = "/usr/bin/find $litdir -type f -print";
}
else
{
	$litdir = $ARGV[0];
	$lrfdir = $ARGV[1];
	if (! -d $litdir || ! -d $lrfdir)
	{
		print "No litdir directory: $litdir\n" if (! -d $litdir);
		print "No lrfdir directory: $lrfdir\n" if (! -d $lrfdir);
		usage();
	}
	$FILES = "/usr/bin/ls -1 $litdir";
}

open F, "$FILES |" || die "Cant open $FILES\n";

my @suffix = ('.lit', '.txt', '.htm', '.html', '.rtf', '.pdf', '.rar', '.zip');
my $sufflist = "";
foreach my $i (@suffix)
{
	$sufflist .= ":$i";
}
while (<F>)
{
	chop;
	$infile = $_;
	# Valid suffix's we can convert to .lrf's
	my ($name, $path, $suff) = File::Basename::fileparse($infile, @suffix);
#	print "Name=$name\nPath=$path\nSuffix=$suff\n";

	# Get rid of things in file name unneccessary so we dont get dupes
	# of the same book
	$name =~ s/\s*\(lit\)//;
	$name =~ s/\s*\(txt\)//;
	$name =~ s/\s*\(htm\)//;
	$name =~ s/\s*\(html\)//;
	$name =~ s/\s*\(rtf\)//;
	$name =~ s/\s*\(pdf\)//;
	$name =~ s/\s*\(rar\)//;
	$name =~ s/\s*\(LIT\)//;
	$name =~ s/\s*\(TXT\)//;
	$name =~ s/\s*\(HTM\)//;
	$name =~ s/\s*\(HTML\)//;
	$name =~ s/\s*\(RTF\)//;
	$name =~ s/\s*\(PDF\)//;
	$name =~ s/\s*\(RAR\)//;

	#
	# If we already have a lrf and we now have a .lit then do it in pref
	# don't bother otherwise lets jsut keep what we have already done
	#

	next if (-e "$lrfdir/$name.lrf" && ! suffmatch(".lit", "$suff"));
	if (suffmatch("$sufflist", "$suff"))
	{
		print "Doing:$name\n";
		system 'any2lrf', '--ignore-tables', '-p', 'prs500', '-o', "$lrfdir/$name.lrf", "$infile";
	}
}
close(F);
exit 0;

[kovidgoyal]

Is it platform independent?

[chas]

Originally Posted by kovidgoyal

Is it platform independent?

As is. No, it is OK for linux, bsd & Mac OSX. With a bit of fiddling the "find" needs to be replaced by native perl calls to recurse through the directory. Not much effort, I'll play around a bit ad get it "Widowz ready"

[kovidgoyal]

Cool

[Miwa]

Can you just replace find with dir /s /b on Windows?

[chas]

Originally Posted by Miwa

Can you just replace find with dir /s /b on Windows?

You could, however hang on a few days as I will be releasing a new version. I have noticed that any2lrf hangs on some input files so I am putting some intelligence in the perl script to detect that and skip to the next file. With that I will also use the native perl library call for recursing through directories that makes the app universal.

[kovidgoyal]

Send me a file that any2lrf hangs on.

[stustaff]

This sounds interesting, some step by step instructions for someone who doesnt know his perl from his pearly whites would be great