#!/usr/bin/perl -w
#
# LeechM3U - zapisuje pliki mp3 z pliku m3u.
# Cz pakietu Leecharoo - przeznaczonego do obsugi wszystkich trudnych
# do automatycznego pobierania miejsc.
# http://disobey.com/d/code/ lub kontaktuj si z morbus@disobey.com.
#
# Kod ten jest darmowym oprogramowaniem; mona go rozpowszechnia i/lub
# modyfikowa na takich samych warunkach, jak samego Perla.
#

use strict; $|++;
my $VERSION = "1.0";
use File::Spec::Functions;

# upewniamy si, e mamy wszystkie potrzebne moduy; jeli nie, koczymy.
eval("use LWP 5.6.9;"); die "[err] Wymagane LWP w wersji 5.6.9 lub wyszej.\n" if $@;
eval("use URI::Escape;"); die "[err] Brak moduu URI::Escape.\n" if $@;

my $dir = "mp3s";  # gdzie zapisywa pliki?
mkdir $dir;        # aby na pewno istnia katalog.
my $mp3_data;      # ostateczne miejsce na nasze MP3.
my $total_size;    # czna wielko MP3.

# ptla po kolejnych plikach M3U.
foreach my $file (@ARGV) {

    # otwarcie przekazanego pliku M3U lub przejcie do nastpnego.
    open(URLS, "<$file") or print "[err] Nie mona otworzy $file: $!\n";

    # dla kadego wiersza.
    while (<URLS>) {
        next if /^#/;       # jeli komentarz, pomijamy.
        chomp;              # usuwamy kocowe znaki koca wiersza.
        my $url = $_;       # nabrao znaczenia, prawda?

        # podzia URL na czci wedug ogranicznika "/".
        # uyjemy tego do okrelenia nazwy pliku oraz jego katalogu
        # macierzystego. Katalog macierzysty to zwykle nazwa pyty.
        my @parts = split(/\//, $url);

        # Prawidowo zakodowane adresy URL s kodowane dziesitnie,
        # gdzie %20 oznacza spacj itd. Gdyby nie robi konwersji, 
        # nazwy naszych plikw zawierayby takie dziwne napisy.
        foreach (@parts) { $_ = uri_unescape($_); }

        # pobieramy przedostatni cz bdc nazw katalogu macierzystego
        # naszego pliku. Zakadamy, e jest to tytu pyty.
        my $album_dir = $parts[$#parts-1];

        # tworzenie cieki albumu zgodnej z wymogami systemu operacyjnego.
        my $album_path = catdir($dir, $album_dir);
        my $file_name = $parts[$#parts]; # adniej.
        my $file_path = catfile($album_path, $file_name);
mkdir $album_path; # przygotowanie do pobierania.

        # pobranie wielkoci pliku MP3 - potrzebne w pasku postpu.
        # niektre witryny blokuj User-Agent Perla, wic drobne oszustwo
        print "Pobieranie \"$file_path\"...\n";
        my $ua = LWP::UserAgent->new(agent => 
            'Mozilla/4.76 [en] (Win98; U)');
        $total_size = $ua->head($url)->headers->content_length;

        # pobieramy tylko pliki, ktrych jeszcze nie mamy.
        if (-e $file_path and (stat($file_path))[7] == $total_size) {
           print " Pomijam - plik by ju pobierany.\n";
           next;
        }

        # pobieranie pliku z pokazywaniem paska postpu.
        $ua->get($url, ':content_cb' => \&callback);

        # kiedy dane s zaadowane przez callback do $mp3_data,
        # zapis informacji w $file_path.
        open (MP3, ">$file_path") or die "[err] Niemoliwy zapis: $!\n";
        print MP3 $mp3_data; close(MP3); $mp3_data = undef;
    }

    # next file!
    close(URLS);
}

# co fragment.
sub callback {
   my ($data, $response, $protocol) = @_;
   $mp3_data .= $data; # doczanie do istniejcych danych.
   print progress_bar( length($mp3_data), $total_size, 25, '=' );
}

# podobnie jak wget. procedura autorstwa tachyona
# z http://tachyon.perlmonk.org/
sub progress_bar {
    my ( $got, $total, $width, $char ) = @_;
    $width ||= 25; $char ||= '=';
    my $num_width = length $total;
    sprintf "|%-${width}s| Pobrano %${num_width}s bajtw z %s (%.2f%%)\r", 
        $char x (($width-1)*$got/$total). '>', 
        $got, $total, 100*$got/+$total;
}

