nicht angemeldet
Perlscript nach PHP "übersetzen"
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);
}
-
Hallo Nina,
da verlangst du ein wenig viel. Ich glaub nicht, das dir hier jemand ein so langes Script mal eben nach PHP überträgt. Da wirst du nicht drum rumkommen, etwas Doku zu Perl zu lesen, oder du suchst dir eine Beispielfunktion raus, die du gern übertragen würdest.
Aber warum willst du es eigentlich nach PHP umschreiben? Vielleicht kann dir eher jemand helfen, es so wie es ist sinnvoll einzusetzen?
Gruss,
Holger-
Hallo Holger,
ich verlange NICHT, dass mir jemand das ganze Script übersetzt. Ich benötige nur ein paar Tipps um es selbst zu tun ... was ist z.B. dieses "my", was ist "$|" oder was muss ich mit PHP ganz anders machen ... muss ich andere Funtionen nehmen?
Mir genügt der Part des Scriptes, wo die Datei (Datenbank, binär) eingelesen wird und dann entsprechend die "Zeilen" (Titel, Artist, ...) ausgeben werden - ich will die Datei "nur" öffnen und dann in ein Plaintext-Format (csv) umschreiben bzw eine einfache Tabelle ausgeben.
Danke für Deine Hilfe,
Nina
-
Tag Nina.
ich verlange NICHT, dass mir jemand das ganze Script übersetzt.
Darum wirst du nicht drumherum kommen. Entweder du beschäftigst dich _eingehend_ mit Perl, um zu verstehen, was das Script tut, oder du suchst dir jemanden, der Perl und PHP beherrscht und dir das Script "übersetzt". Aber hast du vielleicht mal nachgeschaut, ob es in PHP bereits ein vorgefertigtes Script gibt? Google brachte mir u.a. Kung-Tunes und ITunes.php
Ansonsten wühle dich halt selber durch die Suchergebnisse von Google.
[dsf 3.6]
Siechfred--
»Sie kochten heimlich mit Wasser und tranken öffentlich Wein.« -
my declieniert die Variable als Eigentum der Routiene.
Ich hab den Code nur überflogen und weiß nicht, ob das wichtig ist
-
-