abclinuxu.cz AbcLinuxu.cz itbiz.cz ITBiz.cz HDmag.cz HDmag.cz abcprace.cz AbcPráce.cz
AbcLinuxu hledá autory!
Inzerujte na AbcPráce.cz od 950 Kč
Rozšířené hledání
×
    včera 23:22 | Komunita

    Organizace Software Freedom Conservancy vyzývá všechny vývojáře svobodného a open source softwaru k opuštění GitHubu. Proprietárního GitHubu vlastněného společností Microsoft, jejíž manažeři opakovaně napadají copyleftové licence a komerční Copilot je dokonce ignoruje.

    Ladislav Hagara | Komentářů: 0
    včera 20:33 | Nová verze

    Byla vydána verze 1.62.0 programovacího jazyka Rust (Wikipedie). Podrobnosti v poznámkách k vydání. Vyzkoušet Rust lze například na stránce Rust by Example.

    Ladislav Hagara | Komentářů: 1
    včera 20:11 | IT novinky

    OpenGL (Wikipedie) slaví 30 let. Specifikace verze 1.0 byla vydána 30. června 1992.

    Ladislav Hagara | Komentářů: 3
    včera 13:00 | IT novinky

    Rodina Raspberry Pi se rozrostla o 3 nové členy Raspberry Pi Pico W, H a WH aneb jednočipový počítač Raspberry Pi Pico s Wi-Fi, Header (piny) a Wi-Fi a Header.

    Ladislav Hagara | Komentářů: 7
    včera 12:22 | Komunita

    Byly zveřejněny prezentace a videozáznamy přednášek z česko-slovenského setkání poskytovatelů přístupu k internetu, provozovatelů telekomunikačních sítí, registrátorů domén a provozovatelů počítačových sítí a technických nadšenců CSNOG 2022 (Czech and Slovak Network Operators Group) konaného 20. a 21. června v Brně.

    Ladislav Hagara | Komentářů: 0
    včera 08:00 | Nová verze

    Společnost Collabora vydala verzi 22.05 online kancelářského balíku Collabora Online Development Edition (CODE). Přehled novinek i s náhledy v oznámení. Nová je kontrola stylu a gramatiky pomocí LanguageTool. Calc umí 16 384 sloupců. Přidána byla podpora WebP. Zdrojové kódy jsou k dispozici na GitHubu. Vydání Collabora Online s podporou je plánováno na červenec.

    Ladislav Hagara | Komentářů: 0
    29.6. 16:33 | Humor

    Slovenská ministryně investic, regionálního rozvoje a informatizace používá heslo Mirri2020. Zveřejnila video, kde je vidět heslo nalepené na notebooku (Facebook, TA3).

    Ladislav Hagara | Komentářů: 30
    29.6. 16:11 | Nová verze

    UBports, nadace a komunita kolem Ubuntu pro telefony a tablety Ubuntu Touch (seznam podporovaných zařízení), vydala Ubuntu Touch OTA-23. Nejnovější verze je pořád založena na Ubuntu 16.04. Pracuje se na přechodu na Ubuntu 20.04.

    Ladislav Hagara | Komentářů: 0
    29.6. 14:11 | Nová verze

    Svobodný video editor Pitivi (Wikipedie) byl vydán ve verzi 2022.06 — Reel Easing. Z novinek je zdůrazněna možnost sledování objektu pomocí OpenCV a detekce rytmu pomocí librosa. Nový Pitivi by měl být na Flathubu do několika dnů.

    Ladislav Hagara | Komentářů: 0
    29.6. 13:33 | Zajímavý software

    Vývojáři běhového prostředí (runtime) pro JavaScript a TypeScript Deno oznámili vydání stabilní verze 1.0 full stack web frameworku Fresh pro Deno.

    Ladislav Hagara | Komentářů: 0
    Na sociálních sítích nebo jiných webových diskuzích vystupuji pod
     (65%)
     (17%)
     (18%)
    Celkem 710 hlasů
     Komentářů: 29, poslední 24.5. 00:02
    Rozcestník

    Stahujeme z mujrozhlas.cz

    20.5.2021 17:47 | Přečteno: 2608× | poslední úprava: 20.5.2021 17:47

    Nedávno se tu objevil dotaz na hromadné stahování audia z webu mujrozhlas.cz. Já také občas poslouchám jejich pořady a měl jsem v plánu si takový skript někdy napsat. Níže je skript, který jsem vytvořil. Pod ním najdete více okomentovaný kód, s komentáři česky – ne každý umí Perl.

    #! /usr/bin/env perl
    
    # mujrozhlas.pl – stahuje pořady z webu mujrozhlas.cz
    # Copyright (C) 2021  jiwopene (https://www.abclinuxu.cz/lide/jiwopene)
    # 
    # 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 3 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.
    # 
    # You should have received a copy of the GNU General Public License
    # along with this program.  If not, see <https://www.gnu.org/licenses/>.
    
    use strict;
    use v5.13;
    use utf8;
    
    use Cwd;
    use File::Copy qw(move);
    use File::Fetch;
    use Getopt::Long;
    use HTML::TagParser;
    use HTTP::Tiny;
    use JSON::PP;
    
    my $download_unknown_urls = 0;
    my $overwrite_files = 0;
    my $skip_audio_download = 0;
    my $write_yaml = 0;
    my $make_subdirs = 0;
    
    my $output_root_dir = getcwd;
    
    # Děkuji za připomenutí tohoto řádku:
    #  see https://www.abclinuxu.cz/poradna/linux/show/468500#26
    binmode STDOUT, ':utf8';
    binmode STDERR, ':utf8';
    
    # Download something using HTTP(S) and return its response text.
    #
    # my $response_text = download($url);
    sub download {
    	my ($url) = @_;
    
    	my $resp = HTTP::Tiny->new->get($url);
    	die "Nemůžu stáhnout $url: $resp->{status} $resp->{reason}\n"
    		unless $resp->{success};
    
    	return $resp->{content};
    }
    
    # Get episode metadata as hashmap.
    #
    # my %meta = get_episode_meta($episode_uuid);
    sub get_episode_meta {
    	my ($episode_uuid) = @_;
    	return decode_json download "https://api.mujrozhlas.cz/episodes/$episode_uuid";
    }
    
    # Download episode to file with given name base.
    #
    # download_episode $name_base, $episode_meta;
    sub download_episode {
    	my ($name_base, $episode_meta) = @_;
    
    	my $audio_links = $episode_meta->{data}->{attributes}->{audioLinks};
    	for my $audio_link ( @$audio_links ) {
    		my $audio_file_name = "$name_base.$audio_link->{bitrate}.$audio_link->{variant}";
    		$audio_file_name =~ tr@/@-@;
    
    		unless ($skip_audio_download) {
    			if (-e $audio_file_name) {
    				if ($overwrite_files) {
    					unlink $audio_file_name;
    				} else {
    					say "$audio_file_name již existuje, přeskakuji.";
    					next;
    				}
    			}
    
    			say "Stahuji $audio_file_name";
    			my $fetch = File::Fetch->new(
    				uri => $audio_link->{url}
    			);
    			unless ($fetch) {
    				say "Přeskakuji $audio_link->{url}";
    				next;
    			}
    
    			my $where = $fetch->fetch(to => '/tmp');
    			unless ($where) {
    				say "Nemůžu stáhnout $fetch->uri";
    				next;
    			}
    			move $where, "./$audio_file_name";
    		} else {
    			say 'Stahování audia vypnuto, přeskakuji.';
    		}
    	}
    }
    
    sub episode_info_from_elem {
    	my ($episode_elem) = @_;
    
    	my $episode_info_json = $episode_elem->getAttribute('data-entry');
    	my $episode_info = decode_json $episode_info_json;
    }
    
    # Download series with some url.
    #
    # URL example:
    #     https://www.mujrozhlas.cz/stripky-z-archivu/stare-povesti-ceske
    #
    # download_series_by_url $page_url;
    sub download_series_by_url {
    	my ($page_url) = @_;
    
    	if (not $download_unknown_urls and $page_url !~ m@^https?://(www.)?mujrozhlas.cz/@) {
    		say "URL stránky $page_url nevypadá platně, přeskakuji.";
    		return 0;
    	}
    
    	my $page_html = download $page_url;
    	my $page = HTML::TagParser->new($page_html);
    
    	my @episode_elems;
    
    	# Create and go into subdir if asked to do so.
    	if ($make_subdirs) {
    		my $detail_title_elem = $page->getElementById('detail-title');
    
    		my $episode_dir = $detail_title_elem->innerText;
    		$episode_dir =~ tr@/@-@;
    
    		mkdir $episode_dir unless -e $episode_dir;
    		chdir $episode_dir;
    	}
    
    	# Get series ID.
    	my $more_link_elem = $page->getElementsByClassName('more-link__link ajax');
    	if ($more_link_elem) {
    		my $more_episodes_url = $more_link_elem->getAttribute('href');
    		# in format /ajax/ajax_list/FOO?page=1&size=9&id=FOO-1234&rid=1234
    		$more_episodes_url =~ m@ajax_list/(\w+)@;
    		my $show_class = $1;
    		$more_episodes_url =~ /[&?]id=(.*?)([&?]|$)/;
    		my $show_id = $1;
    		$more_episodes_url =~ /[&?]rid=(.*?)([&?]|$)/;
    		my $show_rid = $1;
    
    		my $episode_links_response = decode_json download "https://www.mujrozhlas.cz/ajax/ajax_list/$show_class?id=$show_id&rid=$show_rid&size=1000000";
    		# unset size= gives 20 entries
    		my $episode_links_html = $episode_links_response->{snippets}->{$show_id}->{content};
    		my $episodes_page = HTML::TagParser->new($episode_links_html);
    		@episode_elems = $episodes_page->getElementsByClassName("b-episode");
    	} else {
    		# More link not available, fallback to direct HTML analysis.
    		
    		say 'Nemohu najít odkaz na více episod. Stahuji to co mám.';
    		@episode_elems = $page->getElementsByClassName("b-episode");
    	}
    
    	for my $episode_elem ( @episode_elems ) {
    		my $episode_info = episode_info_from_elem $episode_elem;
    
    		say '';
    		say "#$episode_info->{id}: $episode_info->{title}";
    
    		my $episode_meta = get_episode_meta $episode_info->{uuid};
    
    		my $name_base = "$episode_info->{id}_$episode_info->{title}";
    		$name_base =~ tr@/@-@;
    
    		if ($write_yaml) {
    			YAML::PP->new->dump_file("$name_base.yaml", $episode_meta);
    		} else {
    			open my $meta_file, ">", "$name_base.json";
    			print $meta_file encode_json $episode_meta;
    			close $meta_file;
    		}
    
    		download_episode $name_base, $episode_meta;
    	}
    
    	# Go back.
    	chdir $output_root_dir;
    
    	return 1;
    }
    
    sub print_help {
    	$_ = "$0 -- strahování pořadů z mujrozhlas.cz
    
    Použití:
    	perl $0 https://mujrozhlas.cz/lorem/ipsum
    
    Volby:
    	--help
    		Zobrazí tuto nápovědu.
    
    	--unknown-urls
    		Pokusí se stáhovat i z adres, které nevypadají platně.
    
    	--overwrite
    		Přepisuje soubory místo přeskočení existujících.
    
    	--no-audio
    		Bude stahovat jen metadata.
    
    	--write-yaml
    		Ukládá metadata jako YAML, ne JSON.
    
    	--subdirs
    		Vytvoří podadresář pro každý pořad.
    ";
    	chomp;
    	say;
    }
    
    my $show_help = 0;
    GetOptions(
    	'help' => \$show_help,
    	'unknown-urls' => \$download_unknown_urls,
    	'overwrite' => \$overwrite_files,
    	'no-audio' => \$skip_audio_download,
    	'write-yaml' => \$write_yaml,
    	'subdirs' => \$make_subdirs,
    ) or die 'Neplatné volby. Viz $0 --help.';
    
    require YAML::PP if $write_yaml;
    
    if ($show_help) {
    	print_help;
    	exit;
    }
    
    say "mujrozhlas.pl, verze 1.1";
    
    for my $url (@ARGV) {
    	download_series_by_url $url;
    }

    Použití

    Použití je jednoduché: skriptu předáme jako argumenty jednu nebo více URL pořadů na webu https://www.mujrozhlas.cz/. Například takto:

    perl mujrozhlas.pl https://www.mujrozhlas.cz/stripky-z-archivu/stare-povesti-ceske https://www.mujrozhlas.cz/bijacek

    Skript používá také několik dlouhých voleb. --help zobrazí nápovědu (vizte konec kódu, nechcete-li ho spouštět). Ve výchozím nastavení ukládá metadata (JSON, případně YAML) do souboru s názvem ve tvaru 1234_Název episody.json (resp. 1234_Název episody.yaml) a zvuk do souboru s názvem ve tvaru 1234_Název episody.bitrate.typ, kde 1234 je číselný identifikátor episody. Stahování audia vypneme volbou --no-audio. Volba --subdirs vytváří pro pořady podadresáře.

    Audio je stahované do dočasných souborů a poté překopírované do cílového adresáře. Pokud již soubor s audiem existuje, přeskakuje se, ale soubor s metadaty se přepíše. Volba --overwrite smaže případný soubor s audiem před stažením.

    Skript provádí základní ověření tvaru URL. Pokdu ho chcete obejít, zapněte --unknown-urls, což toto ověření vypne. To můžete použít například při stahování audia, ke kterému máte soubor HTML na nějakém zrcadle a nemáte původní URL.

    Stručný úvod do Perlu

    Skript je psaný v jazyce Perl. Ten je obzvlášť vhodný pro zpracovávání textů.¹ Obsahuje například podporu pro regulární výrazy včetně operátorů pro práci s nimi, atd. Vzhledem k tomu, že tazatel v diskusi napsal, že Perlu moc nerozumí, tak základy vysvětlím. Předpokládám alespoň základní znalosti programování.

    Komentáře jsou od # po konec řádku. Stringy píšeme do uvozovek (s expanzí proměnných), mezi apostrofy (bez ní) nebo jiným způsobem (viz níže). Je dynamicky typovaný. Boolean neexistuje – prázdný string nebo 0 je false, jiné hodnoty (s pár vyjímkami) jsou true.

    Podmínky píšeme do if (podmínka) { tělo; } (jako v C). Když napíšeme místo if unless, vyhodnocujue se negace podmínky (prohodí se větve if a else). Podmínku můžeme psát i za statement, a to takto: télo if podmínka; (případně s unless). Cyklus for-each se zapisuje takto: for proměnná (pole) { tělo; }.

    Řádky s use načítají balíčky (knihovny), případně určují verzi interpretru nebo jiná nastavení.

    Názvy proměnných začínají sigilem: $ pro skaláry, @ pro pole a % pro hashmapy. Pokud čteme skalární prvek pole/hashmapy, píšeme $. K metodám přistupujeme přes ->, k hodnotě z hashmapy pomocí ->{klíč} (klíč je buď napsaný přímo, nebo jako string). K věcem v balíčku se přistupuje pomocí ::.

    Lokální proměnné deklarujeme pomocí klíčového slova my

    Subrutiny (funkce) vytváříme pomocí sub název { tělo }. Argumenty dostane předané v poli @_.

    Regulární výrazy píšeme do /lomítek/, nahrazení s prefixem s: s/co/čím/volby. Jakmile píšeme regulárný výrazy nebo stringy s tím prefixem (s, m, q, qw, qq, tr, …), můžeme zvolit i jiný znak než lomítka (závorky, zavináče, …), takže nemusíme escapovat lomítka. Prefix s uvozuje nahrazení, q a qq string (jako by byl s jednoduchými nebo dvojitými uvozovkami – dle počtu Qček), tr nahrazení znaků (jako shellový příkaz tr(1)), qw pole stringů (slov), m regulární výraz.

    Komentovaný kód

    Komentáře přidané do předchozího kódu jsou značené #-.

    #! /usr/bin/env perl
    
    # mujrozhlas.pl – stahuje pořady z webu mujrozhlas.cz
    # Copyright (C) 2021  jiwopene (https://www.abclinuxu.cz/lide/jiwopene)
    # 
    # 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 3 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.
    # 
    # You should have received a copy of the GNU General Public License
    # along with this program.  If not, see <https://www.gnu.org/licenses/>.
    
    use strict; #- Více chyb.
    use v5.13; #- Verze Perlu.
    use utf8; #- Kód obsahue UTF-8.
    
    #- Knihovny.
    use Cwd;
    use File::Copy qw(move);
    use File::Fetch;
    use Getopt::Long;
    use HTML::TagParser;
    use HTTP::Tiny;
    use JSON::PP;
    
    #- Sem ukládáme volby z příkazové řádky.
    my $download_unknown_urls = 0;
    my $overwrite_files = 0;
    my $skip_audio_download = 0;
    my $write_yaml = 0;
    my $make_subdirs = 0;
    
    #- Uložíme si adresář při spuštění, abychom se sem mohli vrátit při stahování do podadresáře.
    my $output_root_dir = getcwd;
    
    #- stdout a stderr jsou v UTF-8.
    # Děkuji za připomenutí tohoto řádku:
    #  see https://www.abclinuxu.cz/poradna/linux/show/468500#26
    binmode STDOUT, ':utf8';
    binmode STDERR, ':utf8';
    
    # Download something using HTTP(S) and return its response text.
    #
    # my $response_text = download($url);
    sub download {
    	#- Rozbijeme argumenty do proměnných.
    	my ($url) = @_;
    
    	my $resp = HTTP::Tiny->new->get($url);
    	die "Nemůžu stáhnout $url: $resp->{status} $resp->{reason}\n"
    		unless $resp->{success};
    
    	return $resp->{content};
    }
    
    # Get episode metadata as hashmap.
    #
    # my %meta = get_episode_meta($episode_uuid);
    sub get_episode_meta {
    	#- Rozbijeme argumenty do proměnných.
    	my ($episode_uuid) = @_;
    	return decode_json download "https://api.mujrozhlas.cz/episodes/$episode_uuid";
    }
    
    # Download episode to file with given name base.
    #
    # download_episode $name_base, $episode_meta;
    sub download_episode {
    	#- Rozbijeme argumenty do proměnných.
    	my ($name_base, $episode_meta) = @_;
    
    	my $audio_links = $episode_meta->{data}->{attributes}->{audioLinks};
    	for my $audio_link ( @$audio_links ) { #- Pro každou položku audioLink z metadat,
    		#- Vygeneruj název souboru.
    		my $audio_file_name = "$name_base.$audio_link->{bitrate}.$audio_link->{variant}";
    
    		#- Nahraď lomítka ASCII mínusy.
    		$audio_file_name =~ tr@/@-@;
    
    		#- Pokud nepřeskakujeme stahování audia,
    		unless ($skip_audio_download) {
    			# tak, pokud exisuje soubor s audieam
    			if (-e $audio_file_name) {
    				if ($overwrite_files) { #- a přepisujeme soubory
    					unlink $audio_file_name; #- ho smažeme.
    				} else {
    					#- Jinak si postěžujeme a ...
    					say "$audio_file_name již existuje, přeskakuji.";
    
    					#- jdeme na další audioLink.
    					next;
    				}
    			}
    
    			say "Stahuji $audio_file_name";
    
    			#- Stáhneme URL do dočasného souboru $where (viz níže).
    			my $fetch = File::Fetch->new(
    				uri => $audio_link->{url}
    			);
    			unless ($fetch) { #- Při chybě.
    				say "Přeskakuji $audio_link->{url}";
    				next;
    			}
    
    			my $where = $fetch->fetch(to => '/tmp');
    			unless ($where) { #- Při chybě.
    				say "Nemůžu stáhnout $fetch->uri";
    				next;
    			}
    
    			#- Přesuneme soubot na příslušné místo v pracovním adresáři.
    			move $where, "./$audio_file_name";
    		} else {
    			say 'Stahování audia vypnuto, přeskakuji.';
    		}
    	}
    }
    
    sub episode_info_from_elem {
    	my ($episode_elem) = @_;
    
    	#- Vyčteme JSON se základními metadaty z HTML elementu.
    
    	my $episode_info_json = $episode_elem->getAttribute('data-entry');
    	my $episode_info = decode_json $episode_info_json;
    }
    
    # Download series with some url.
    #
    # URL example:
    #     https://www.mujrozhlas.cz/stripky-z-archivu/stare-povesti-ceske
    #
    # download_series_by_url $page_url;
    sub download_series_by_url {
    	#- Rozbijeme argumenty do proměnných.
    	my ($page_url) = @_;
    
    	#- Ověření platnosti URL.
    	if (not $download_unknown_urls and $page_url !~ m@^https?://(www.)?mujrozhlas.cz/@) {
    		say "URL stránky $page_url nevypadá platně, přeskakuji.";
    		return 0;
    	}
    
    	#- Stáhnu a naparsuji HTML stránky.
    	my $page_html = download $page_url;
    	my $page = HTML::TagParser->new($page_html);
    
    	my @episode_elems; #- Sem přijdou elementy s metadaty.
    
    	# Create and go into subdir if asked to do so.
    	if ($make_subdirs) {
    		#- Vyčteme titulek a nahradíme lomítka ASCII mínusy.
    		my $detail_title_elem = $page->getElementById('detail-title');
    
    		my $episode_dir = $detail_title_elem->innerText;
    		$episode_dir =~ tr@/@-@;
    
    		#- Vytvoříme adresář pokud neexistuje (not -e).
    		mkdir $episode_dir unless -e $episode_dir;
    
    		#- Vstoupíme do něj.
    		chdir $episode_dir;
    	}
    
    	# Get series ID.
    	my $more_link_elem = $page->getElementsByClassName('more-link__link ajax');
    	if ($more_link_elem) { #- Pokud je na stránce odkaz na více episod, vezmeme jeho adresu, upravíme ji pro získání
    	                       #- max. 1000000 záznamů a stáhneme HTML z ní (to je zabalené v JSONu), jinak ho bereme přímo
    						   #- ze stažené stránky.
    		my $more_episodes_url = $more_link_elem->getAttribute('href');
    		# in format /ajax/ajax_list/FOO?page=1&size=9&id=FOO-1234&rid=1234
    		$more_episodes_url =~ m@ajax_list/(\w+)@;
    		my $show_class = $1; #- $1 je první skupina z regexu.
    		$more_episodes_url =~ /[&amp;?]id=(.*?)([&?]|$)/;
    		my $show_id = $1; #- $1 je první skupina z regexu.
    		$more_episodes_url =~ /[&?]rid=(.*?)([&?]|$)/;
    		my $show_rid = $1; #- $1 je první skupina z regexu.
    
    		#- Vytvoříme si nové URL a stáhneme ho.
    		my $episode_links_response = decode_json download "https://www.mujrozhlas.cz/ajax/ajax_list/$show_class?id=$show_id&rid=$show_rid&size=1000000";
    		# unset size= gives 20 entries
    		#- Vyndáme z JSONu HTML,
    		my $episode_links_html = $episode_links_response->{snippets}->{$show_id}->{content};
    		#- naparsujeme ho a ...
    		my $episodes_page = HTML::TagParser->new($episode_links_html);
    		#- vezmeme si z něj elementy se třídou b-episode.
    		@episode_elems = $episodes_page->getElementsByClassName("b-episode");
    	} else {
    		# More link not available, fallback to direct HTML analysis.
    		
    		say 'Nemohu najít odkaz na více episod. Stahuji to co mám.';
    		@episode_elems = $page->getElementsByClassName("b-episode");
    	}
    
    	#- Pro každý element s odkazem an episodu,
    	for my $episode_elem ( @episode_elems ) {
    		my $episode_info = episode_info_from_elem $episode_elem;
    
    		say ''; #- Odřádkuji.
    		say "#$episode_info->{id}: $episode_info->{title}"; #- Napíšu ID a název episody.
    
    		my $episode_meta = get_episode_meta $episode_info->{uuid}; #- Získám metadata episody.
    
    		#- Vydělám si název souboru a ...
    		my $name_base = "$episode_info->{id}_$episode_info->{title}";
    		#- nahradím lomítka ASCII mínusy.
    		$name_base =~ tr@/@-@;
    
    		#- Uložím metadata.
    		if ($write_yaml) {
    			YAML::PP->new->dump_file("$name_base.yaml", $episode_meta);
    		} else {
    			open my $meta_file, ">", "$name_base.json";
    			print $meta_file encode_json $episode_meta;
    			close $meta_file;
    		}
    
    		#- Stáhnu episodu.
    		download_episode $name_base, $episode_meta;
    	}
    
    	# Go back.
    	chdir $output_root_dir;
    
    	return 1; #- 1 je úspěch.
    }
    
    sub print_help {
    	$_ = "$0 -- strahování pořadů z mujrozhlas.cz
    
    Použití:
    	perl $0 https://mujrozhlas.cz/lorem/ipsum
    
    Volby:
    	--help
    		Zobrazí tuto nápovědu.
    
    	--unknown-urls
    		Pokusí se stáhovat i z adres, které nevypadají platně.
    
    	--overwrite
    		Přepisuje soubory místo přeskočení existujících.
    
    	--no-audio
    		Bude stahovat jen metadata.
    
    	--write-yaml
    		Ukládá metadata jako YAML, ne JSON.
    
    	--subdirs
    		Vytvoří podadresář pro každý pořad.
    ";
    	chomp; #- Odstaním newline z konce.
    	say; #- Vypíšu.
    }
    
    my $show_help = 0;
    GetOptions(
    	'help' => \$show_help,
    	'unknown-urls' => \$download_unknown_urls,
    	'overwrite' => \$overwrite_files,
    	'no-audio' => \$skip_audio_download,
    	'write-yaml' => \$write_yaml,
    	'subdirs' => \$make_subdirs,
    ) or die 'Neplatné volby. Viz $0 --help.';
    
    require YAML::PP if $write_yaml; #- require jde dát do podmínky, use ne.
    
    if ($show_help) {
    	print_help;
    	exit;
    }
    
    say "mujrozhlas.pl, verze 1.1";
    
    for my $url (@ARGV) {
    	download_series_by_url $url;
    }

    ¹ To je můj názor. Zcela jistě si někteří myslí něco jiného.

           

    Hodnocení: 100 %

            špatnédobré        

    Tiskni Sdílej: Linkuj Jaggni to Vybrali.sme.sk Google Del.icio.us Facebook

    Komentáře

    Vložit další komentář

    Gréta avatar 20.5.2021 20:39 Gréta | skóre: 35 | blog: Grétin blogísek | Stockholm
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz

    supr skriptík užitečnej dík :D ;D

    Ten je obzvlášť vhodný pro zpracovávání textů

    na dělání regexpů je prej vo moc víc rychlejší než python třeba :O :O maďarskej krejčí to jakoby měřil hele :O ;D

    tamten vávrův slíkací doktor filozofie hele je prej teďko linuxák hele videjko 🤭 😁 😁
    21.5.2021 12:10 _
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Jo u takovýhohle skriptu je rychlost strášně důležitá :)

    V pythonu by to mělo 1/4 řádků a bylo by to čitelnější.
    Bedňa avatar 21.5.2021 21:59 Bedňa | skóre: 34 | blog: Žumpa | Horňany
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    To určite, ale zas Perl mám rád so spomienok keď som vňom písal kód. Pred cca dvoma rokmi som sa predsa rozhodol ísť naplno do Python enviroment a príde mi to fakt super, či komunita a všetko okolo, ale na Perl určite nadávať nebudem.
    KERNEL ULTRAS video channel >>>
    Petr Tomášek avatar 23.5.2021 09:17 Petr Tomášek | skóre: 39 | blog: Vejšplechty
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Pyčon? To je ta sračka, kde různé typy mezer mají různý význam? To fuckt raději Perl...
    multicult.fm | monokultura je zlo | welcome refugees!
    23.5.2021 20:51 ...
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    ano pro zastydle pubose bude lepsi perl nebo jiny masturbator
    20.5.2021 22:04 keke
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Sel by dat skriptik na github? A slo by nejak nakonfigurovat pojmenovavani souboru? Stahl jsem Osudy vojaka Svejka a je to pojmenovano docela nestastne:
    810705_Osudy dobrého vojáka Švejka (11-13).128.mp3
    810708_Osudy dobrého vojáka Švejka (4-13).256.mp3
    810714_Osudy dobrého vojáka Švejka (3-13).256.mp3
    810717_Osudy dobrého vojáka Švejka (1-13).128.mp3
    810720_Osudy dobrého vojáka Švejka (10-13).128.mp3
    810723_Osudy dobrého vojáka Švejka (6-13).128.mp3
    810729_Osudy dobrého vojáka Švejka (5-13).256.mp3
    810732_Osudy dobrého vojáka Švejka (9-13).128.mp3
    810735_Osudy dobrého vojáka Švejka (8-13).128.mp3
    810738_Osudy dobrého vojáka Švejka (2-13).128.mp3
    810741_Osudy dobrého vojáka Švejka (13-13).128.mp3
    810744_Osudy dobrého vojáka Švejka (7-13).128.mp3
    810747_Osudy dobrého vojáka Švejka (12-13).128.mp3
    
    Logictejsi by bylo neco jako:
    Osudy dobrého vojáka Švejka (01/13)[810717].mp3
    Osudy dobrého vojáka Švejka (02/13)[810738].mp3
    
    Ale jinak diky moc za skriptik!
    21.5.2021 07:38 Tomáš | skóre: 30 | blog: Tomik
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Dobrá práce.

    Občas jsem něco stahoval ručně, je to piplačka.
    21.5.2021 12:58 Vlado99 | skóre: 10 | blog: vlado99
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Chválim pekný coding-style :-), Perl totiž vie byť "write-only" language, keď sa autor nechá uniesť.

    @Gréta:

    Perl RE ďaleko presahujú definíciu Extended regular expressions [1] a vďaka tomu, ako sú integrované do jazyka (dalo by sa povedať, že celý jazyk je postavený okolo RE), sa s nimi programátorovi robí nesmierne príjemne. A že je to rýchle? Je to predsa Perl! :-)

    Myslím, že Perl tie RE, alebo časti RE, ktoré môže, kompiluje [2] spolu so zvyškom skriptu, RE transformuje na konečné automaty, ktoré potom nakŕmi dátami. Ale to je len odhad, nemám detailné znalosti z vnútra Perl-u.

    [1] https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_04

    [2] https://stackoverflow.com/questions/5376559/is-perl-a-compiled-or-an-interpreted-programming-language
    21.5.2021 15:27 OldFrog {Ondra Nemecek} | skóre: 36 | blog: Žabákův notes | Praha
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Regexpy snad umožňují kompilovat všechny rozumné knihovny. Jinak si to každý může přepsat do svého oblíbeného jazyka a pam můžeme dát soutěž o nejhezčí kód :)
    -- OldFrog
    Gréta avatar 23.5.2021 12:39 Gréta | skóre: 35 | blog: Grétin blogísek | Stockholm
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz

    když sem to jako maďaroj dycky nazačátku zkompilovala hele vtom pythonu skriptík už nebyl pomalej 20x ale asi jakoby jenom 4-5x takže ztoho ten perl asi furt de jako víc lepšejší děladlo s textama :D ;D

    tamten vávrův slíkací doktor filozofie hele je prej teďko linuxák hele videjko 🤭 😁 😁
    25.5.2021 13:27 ...
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    v tom pythonu se zase 10x rychleji pise, takze perl se hodi, pokud mas stado IT otroku a extremni mnozstvi textu na zpracovani

    pro ostatni pripady je python
    21.5.2021 17:07 jiwopene | skóre: 31 | blog: Od každého trochu…
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    V Perlu jsem to psal především z toho důvodu, že jsem nevěděl co mě čeká – nakonec jsem sáhnul po knihovně na parsování HTML, ale jinak jsem čekal velké množství regulárních výrazů.
    .sig virus 3.2_cz: Prosím, okopírujte tento text do vaší patičky.
    23.5.2021 16:05 retroslava | skóre: 9 | blog: TryCatch | Žižkoff
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Ono stačí zjistit ID toho seriálu a pak se to dá stáhnout bez problémů.

    Například v Ruby.

    Jinak to API má i dokumentaci.
    Pozor! Jsem naprostý idiot. Co jsem napsal včera dnes už dávno neplatí. Zavazuji se, že budu diskutovat nezávazně.
    23.5.2021 23:02 OldFrog {Ondra Nemecek} | skóre: 36 | blog: Žabákův notes | Praha
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Tak to je hodně dobrý.
    -- OldFrog
    Gréta avatar 24.5.2021 12:40 Gréta | skóre: 35 | blog: Grétin blogísek | Stockholm
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz

    supr ;D

    tamten vávrův slíkací doktor filozofie hele je prej teďko linuxák hele videjko 🤭 😁 😁
    24.5.2021 20:04 jiwopene | skóre: 31 | blog: Od každého trochu…
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Děkuji za odkaz – o API jsem nevěděl. Jenom mi je trochu záhadou proč z té dokumentace odkazují na e-shop s vinylovými fotopozadími a podlahami.
    .sig virus 3.2_cz: Prosím, okopírujte tento text do vaší patičky.
    24.5.2021 22:41 Olaf
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Jo, stejně tak je tam de facto placeholder-emailová adresa. A pro aplikace by se měla používat asi verze API na https://api.mujrozhlas.cz/{endpoint}. To jejich vývojové API totiž někdy nevrací správné výsledky.
    vencour avatar 23.5.2021 17:40 vencour | skóre: 56 | blog: Tady je Vencourovo | Praha+západní Čechy
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Funguje, díky.
    Ty nejhlubší objevy nečekají nutně za příští hvězdou. Jsou uvnitř nás utkány do vláken, která nás spojují, nás všechny.
    26.5.2021 12:26 Mayhem
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Skriptik pekny, ale dluzno dodat, ze slusny clovek zadnym zpusobem nekonzumuje obsah statnich (ci chceteli verejnopravnich) medii.
    29.5.2021 07:27 OldFrog {Ondra Nemecek} | skóre: 36 | blog: Žabákův notes | Praha
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Proč?
    -- OldFrog
    2.2. 13:34 nekromant
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Pozor, někdo to vrací m4a stream. V takovém případě zase ve vývojářských nástrojích vytáhnu manifest.mpd, ale předám ho ffmpeg:
    ffmpeg -i "https://croaod.cz/stream/sem-dej-uuid.m4a/manifest.mpd" -map 0:0 -codec copy jmeno-souboru.m4a
    2.2. 22:18 OldFrog {Ondra Nemecek} | skóre: 36 | blog: Žabákův notes | Praha
    Rozbalit Rozbalit vše Re: Stahujeme z mujrozhlas.cz
    Nebo to .mpd url předám youtube-dl a ten to taky zvládne :)
    -- OldFrog

    Založit nové vláknoNahoru

    ISSN 1214-1267   www.czech-server.cz
    © 1999-2015 Nitemedia s. r. o. Všechna práva vyhrazena.