#!perl # --------------------------------------------------------------------- # getmp3s.pl # a quick and dirty Perl script to backup your MP3's from your # Empeg / Rio Car player. # # Requires: # Perl 5.00something # The LWP::UserAgent module (Part of the Libwwwperl collection.) # Frank van Gestel's Displayserver v1.1 # # Notes: Right now, this only works for Windows. In theory it # should work fine in Unix, provided you translate '\' to '/' and # remove the lines where '\' is turned into '\\'. # Additional notes: Later, it now only works on Unix. :) # Verbosity is turned on by default # # $debugFlag = 1; if (scalar(@ARGV) != 2) { die "Usage getmp3.pl \n"; } $server = "http://$ARGV[0]/"; $localroot = $ARGV[1]; use LWP::UserAgent; $ua = new LWP::UserAgent; $ua->agent("AgentName/0.1 " . $ua->agent); #$localroot = "./imp"; #$server = "http://imp.nukote/"; $urlroot = "http://$ARGV[0]/mp3list.html"; #$urlroot = "http://imp.nukote/mp3list.html"; print "Retrieving MP3 files to $localroot from $server urlroot=$urlroot...\n" if $debugFlag; push(@destdir, $localroot); $ref_destdir = \@destdir; doPlaylist($urlroot, $ref_destdir); sub doPlaylist { my $listurl = @_[0]; my $ref = @_[1]; my $dest; for(@$ref_destdir) { $dest .= $_; } if ( ! -d $dest ) { print "[$dest]\n"; $ret = mkdir $dest; if (not $ret) { print "error making directory"; } } #print "getlist $listurl, $listname, @$ref_destdir\n"; $reqP = new HTTP::Request 'GET' => $listurl; $reqP->header('Accept' => 'text/html'); $resP = $ua->request($reqP); $contentP=$resP->content; my @linesP=split(/\n/,$contentP); PLOOP: foreach $line (@linesP) { if($line=~m!!) { $fileurl=$server . $1; $fileurl=~m!$server(.*\.mp3).*!; $filename=$1; doFileGet($fileurl, $filename); } } } } sub doFileGet { $fileurl = @_[0]; $filename = @_[1]; my $dest; for(@$ref_destdir) { $dest .= $_; } $filename =~ s/[?*":]/_/g; $filename =~ s/\//\-/g; $destfile = $dest . "/" . $filename; $destfilefixed = $destfile; $destfilefixed =~ s/\\/\\\\/g; $destfilefixed =~ s/[?*"]/_/g; #print "destfile: $destfile\n"; if ( -f $destfile ) { print "$destfile already exists\n"; return 2; } $outfile = ">" . $destfilefixed; $reqF = new HTTP::Request 'GET' => $fileurl; $reqF->header('Accept' => 'text/html'); print "Downloading $outfile...\n" if $debugFlag; $resF = $ua->request($reqF); $contentF=$resF->content; $type = $resF->content_type; $code = $resF->code; #print "$type, $code\n"; if( $type eq "application/octet-stream" && $code == 200 ) { $ret = open(OUT,$outfile); if (not $ret) { print "error opening $destfilefixed\n"; return -1; } binmode OUT; print "writing $destfile"; print OUT $contentF; close(OUT); print " ...done\n"; undef $contentF; } }