nicht angemeldet
Hallo Ihr,
ich möchte gerne ein Perlscript in ein PHP-Script "übersetzen".
Mit PHP kenne ich mich (ganz gut) aus - allerdings nicht so mit Perl.
Es sieht ganz ähnlich aus ... aber so einfach ist es dann doch nicht.
Könntet Ihr mir helfen?
Ich hänge das Script mal einfach an ...
Vielen, vielen Dank,
Eure Nina
# Copyright (C) 2003-2005 Joe Mallon <jmmallon at joescafe dot com>
# Reads data from iTunesDB & generates data from it
# URL: http://www.joescafe.com/tunes2html
# Uses code from tunes2pod.pl in GNUPod
# Copyright (C) 2002-2003 Adrian Ulrich <pab at blinkenlights.ch>
# Part of the gnupod-tools collection
# URL: http://www.gnu.org/software/gnupod/
# 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 General Public License for more details:
# http://www.gnu.org/licenses/gpl.txt
# 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
# This script has been tested on Windows 98, Windows 2000 Professional,
# Windows ME, Windows XP, Linux, Mac OS X, Solaris 5.7, and Solaris 5.8, using
# Perl 5.005 and Perl 6.
# iTunes and iPod are trademarks of Apple
# This product is not supported/written/published by Apple!
header of a valid iTunesDB
my $ipodmagic = "6d 68 62 64 68 00 00 00";
$| = "1";
$ver = "1.0";
$file = $ARGV[0];
open(FILE, "$file") or die "Could not open $file: $!\n";
binmode(FILE); #for Non-Unix systems..
#check the header
if(getfoo(0, (length($ipodmagic)+2)/3) ne $ipodmagic)
{
die "err: could open $file, but:\nI don't think, thats an ipod - tunes db!\n";
}
$qq = 292; #the magic number!! (the HARDCODED start of the first mhit)
$spacer = 156;
if (getfoo($qq + $spacer, 4) ne "6d 68 6f 64") {
$spacer = 244;
if (getfoo($qq + $spacer, 4) ne "6d 68 6f 64") {
die "err: Can't locate mhod w/ known spacers!\n";
}
}
gnutunes header
while($qq != -1) {
%info = ();
($qq,$stuffptr) = get_nod_a($qq,$spacer); #get_nod_a returns wher it's guessing the next MHIT, if it fails, it returns '-1'
}
close(FILE);
sub get_nod_a {
my(@jerk, $sum, $spacer, $zip, $otxt, $oid);
my %stuff = ();
my %mhod_id = (1, "title", 2, "path", 3, "album", 4, "artist", 5, "genre", 6, "fdesc", 7, "eq", 8, "comment", 12, "composer");
($sum,$spacer) = @_;
if(getfoo($sum, 4) eq "6d 68 69 74") #aren't we lost?
{
print "id: " . getshoe($sum+16 , 4) . "\n";
print "size : " . getshoe($sum+36 , 4) . "\n";
print "length: " . int(getshoe($sum+40,4)/1000) . "\n";
print "track: " . getshoe($sum+44,4) . "\n";
print "tracks: " . getshoe($sum+48,4) . "\n";
print "year: " . getshoe($sum+52,4) . "\n";
print "bitrate: " . getshoe($sum+56,4) . "\n";
print "disc: " . getshoe($sum+92,4) . "\n";
print "discs: " . getshoe($sum+96,4) . "\n";
$zip = 0;
$sum += $spacer;
while($zip != -1) {
$sum = $zip+$sum;
($zip, $oid, $otxt) = get_mhod($sum); #returns the number where its guessing the next mhod, -1 if it's failed
print "$mhod_id{$oid}: " . $otxt . "\n" unless ($zip == -1);
}
print "\n";
#foreach $i (keys(%stuff)) {
print "$i - $stuff{$i}\n";
#}
#print ".";
return ($sum-$zip-1,%stuff); #black magic
}
else {
return "-1";
}
}
#get a SINGLE mhod entry:
get_mhod(START_OF_MHOD);
return+seek = new_mhod should be there
sub get_mhod() {
my($seek, $xl, $ml, $mty, $foo, $id);
($seek) = @_;
$id = getfoo($seek, 4); #are we lost?
#print OUTHTML "ID: ".getstr($seek, 4)."\n";
if($id ne "6d 68 6f 64") { $ml = -1;} #is the id INcorrect??
else {
#get the TYPE of the DB-Entry
$ml = getshoe($seek+8, 4);
$mty = getshoe($seek+12, 4); #genre number
$xl = getshoe($seek+28,4); #Entrylength
$foo = getstr($seek+40, $xl); #string of the entry
$foo =~ tr/\0//d; #we have many \0.. killem!
return ($ml, $mty, $foo);
}
}
sub xmlstring
{
my($ret) = @_;
$ret =~ s/&/&/g;
$ret =~ s/"/"/g;
$ret =~ s/</</g;
$ret =~ s/>/>/g;
$ret =~ s/'/'/g;
return $ret;
}
sub uncode
{
my($ret) = @_;
$ret =~ s/&/&/g;
$ret =~ s/"/"/g;
$ret =~ s/'/'/g;
return $ret;
}
sub getfoo {
#reads $anz chars from FILE and returns HEX values!
my($anz, $buffer, $xx, $xr, $start, $noseek);
($start, $anz, $noseek) = @_;
paranoia checks
if(!$start) { $start = 0; }
if(!$anz) { $anz = "1"; }
#seek to the given position
seek(FILE, $start, 0);
#start reading
read(FILE, $buffer, $anz);
foreach(split(//, $buffer)) {
$xx = sprintf("%02x ", ord($_));
$xr = "$xr$xx";
}
chop($xr);# no whitespace at end
return $xr;
}
sub getshoe {
#reads $anz chars from FILE and returns int
my($anz, $buffer, $xx, $xr, $start, $noseek, $xxt);
($start, $anz, $noseek) = @_;
paranoia checks
if(!$start) { $start = 0; }
if(!$anz) { $anz = "1"; }
#seek to the given position
seek(FILE, $start, 0);
#start reading
read(FILE, $buffer, $anz);
foreach(split(//, $buffer)) {
$xx = sprintf("%02X", ord($_));
$xr = "$xx$xr";
}
$xr = oct("0x".$xr);
return $xr;
}
sub getstr {
#reads $anz chars from FILE and returns a string!
my($anz, $buffer, $xx, $xr, $start, $noseek);
($start, $anz, $noseek) = @_;
paranoia checks
if(!$start) { $start = 0; }
if(!$anz) { $anz = "1"; }
#seek to the given position
#if 3th ARG isn't defined
seek(FILE, $start, 0);
#start reading
read(FILE, $buffer, $anz);
return $buffer;
}
sub read_config_file {
my ($file,$hash) = @_;
my ($filebad, $key, $val);
my %hash = %$hash;
open(FI,$file) or $filebad = 1;
if ($filebad) {
print "\nCouldn't read $file.\n";
} else {
while (<FI>) {
next if (/^#/);
chomp;
next if (/^\s*#/);
s/^\s*//;
s/\s*$//;
($key, $value) = split(/[\s=>-:]+/,$_,2);
$hash{$key} = $value;
}
}
return(%hash);
}
sub read_command_line {
my ($list,$hash) = @_;
my %hash = %$hash;
my @args = @$list;
while (my $arg = shift(@args)) {
if ($arg =~ /^-/) {
$arg =~ s/^-//;
my $val = shift(@args);
$hash{$arg} = $val if ($val);
}
}
return(%hash);
}