From 95cfb2c9d369b9e21500bae1313c7474b42800de Mon Sep 17 00:00:00 2001 From: legatvs Date: Thu, 26 Aug 2010 18:22:54 +0300 Subject: [PATCH] initial. --- ChangeLog | 5 + MANIFEST | 5 + MANIFEST.SKIP | 4 + Makefile.PL | 41 ++++++ README | 46 +++++++ bin/grake | 390 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 491 insertions(+) create mode 100644 ChangeLog create mode 100644 MANIFEST create mode 100644 MANIFEST.SKIP create mode 100755 Makefile.PL create mode 100644 README create mode 100755 bin/grake diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..d7c5688 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,5 @@ + +Version 0.0.1 +August 26, 2010 + + * Initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..b6e73b4 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,5 @@ +bin/grake +ChangeLog +Makefile.PL +MANIFEST This list of files +README diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..bd296d1 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,4 @@ +^MANIFEST\. +^Makefile$ +^blib/ +^\. diff --git a/Makefile.PL b/Makefile.PL new file mode 100755 index 0000000..42342d7 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,41 @@ +#!/usr/bin/env perl + +use warnings; +use strict; + +use ExtUtils::MakeMaker; + +my $version = find_version(); + +WriteMakefile( + 'NAME' => 'grake', + ( $[ >= 5.8 ) + ? ( AUTHOR => 'Toni Gundogdu ', + 'ABSTRACT' => 'Scan webpages for Youtube video links', + ) + : (), + 'VERSION' => $version, + 'EXE_FILES' => ['bin/grake'], + 'PREREQ_PM' => { + 'Getopt::ArgvFile' => 1.11, # tested, earlier may work + 'LWP::UserAgent' => 5.835, # tested, earlier may work + }, + 'LICENSE' => 'gpl', + dist => { + COMPRESS => 'bzip2', + SUFFIX => '.bz2' + }, +); + +sub find_version { + my $path = 'bin/grake'; + open my $fh, "<", $path or die "$path: $!"; + foreach (<$fh>) { + close $fh and return $1 + if $_ =~ /VERSION = "(.*?)"/; + } + close $fh; + die '$path: could not find version string.'; +} + + diff --git a/README b/README new file mode 100644 index 0000000..a99aecc --- /dev/null +++ b/README @@ -0,0 +1,46 @@ + + + In brief + +grake is a command line tool for scanning webpages for Youtube links. + +Make sure you read the manual page for grake (see Installation below). + +Project: + + +Development repository: + + + + Installation + +This is an optional step, you could just as well copy the bin/grake +file to your path and start using it. The installation takes care +of generating the grake(1) manual from bin/grake but you can also +use "perldoc bin/grake" if you want to skip the installation +altogether. + +Prerequisites: + + * See Makefile.PL for these + +If you choose to install: + + * Make sure you REMOVE any earlier version of grake before you continue + + * INSTALL_BASE can be passed into Makefile.PL to change where grake will + be installed, e.g.: + + perl Makefile.PL INSTALL_BASE=/usr/local + + * Typical steps: + + perl Makefile.PL + make + make install + + Refer to the ExtUtils::MakeMaker documentation when in doubt: + + + diff --git a/bin/grake b/bin/grake new file mode 100755 index 0000000..5bbc05a --- /dev/null +++ b/bin/grake @@ -0,0 +1,390 @@ +#!/usr/bin/perl +# -*- coding: ascii -*- + +# +# Copyright (C) 2010 Toni Gundogdu . +# +# 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 . +# + +use warnings; +use strict; + +binmode STDOUT, ":utf8"; +binmode STDERR, ":utf8"; + +use Getopt::ArgvFile( home => 1, startupFilename => [qw(.grakerc)] ); +use Getopt::Long qw(:config bundling); + +my $VERSION = "0.0.1"; +my %config; + +exit main(); + +sub init { + GetOptions( + \%config, + 'interactive|i', + 'title|t', + 'csv', + 'version' => \&print_version, + 'license' => \&print_license, + 'help' => \&print_help, + ) or exit 1; + + $config{title} ||= $config{csv}; +} + +sub print_version { + print "grake version $VERSION\n"; + exit 0; +} + +sub print_license { + print + "Copyright (C) 2010 Toni Gundogdu. GNU GPL v3+. This is free software; +see the source for copying conditions. There is NO warranty; not even +for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +"; + exit 0; +} + +sub print_help { + require Pod::Usage; + Pod::Usage::pod2usage( -exitstatus => 0, -verbose => 1 ); +} + +my @ids; +my @links; + +sub main { + + init(); + + print_help() unless scalar @ARGV; + + print STDERR "Checking ..."; + + require LWP; + require URI::Escape; + + my $a = new LWP::UserAgent; + + $a->env_proxy; + + my $q = qr{v[=/]([-_\w]{11,11}+)}; + + foreach (@ARGV) { + + my $r = $a->get ($_); + + unless ($r->is_success) { + printf STDERR "\nerror: $_: %s\n", $r->status_line; + next; + } + + my $d = URI::Escape::uri_unescape ($r->content); + @ids = uniq ( (@ids, $d =~ /$q/g) ); + + print STDERR "."; + } + + unless (scalar @ids) { + print STDERR "error: nothing found.\n"; + return 0; + } + else { + print STDERR "done.\n"; + } + + print STDERR "Getting ..."; + + foreach my $id (@ids) { + + my %tmp = ( + id => $id, + url => "http://youtube.com/v=$id", + gvi => "http://www.youtube.com/get_video_info?&video_id=$id" + . "&el=detailpage&ps=default&eurl=&gl=US&hl=en", + title => undef, + selected => 1 + ); + + $tmp{title} = get_title ($a, $tmp{gvi}) if $config{title}; + + push @links, \%tmp; + } + + print STDERR "done.\n"; + + prompt() if $config{interactive}; + + foreach (@links) { + $config{csv} + ? print qq/"$_->{title}","$_->{url}"\n/ + : print "$_->{url}\n" if $_->{selected}; + } + + return 0; +} + +sub get_title { + + my ($a, $url) = @_; + + my $r = $a->get ($url); + + unless ($r->is_success) { + printf STDERR "\nerror: $url: %s\n", $r->status_line; + return; + } + + my $title; + + require CGI; + + my $q = CGI->new ($r->content); + + if ($q->param ('reason')) { + printf STDERR "\nerror: %s: %s (errorcode: %d)\n", + $url, $q->param ("reason"), $q->param ("errorcode"); + } + else { + require Encode; + $title = Encode::decode_utf8 ($q->param ('title')); + } + + unless ($title) { + print STDERR "\nwarning: $url: use id instead\n"; + } + else { + print STDERR "."; + } + + return $title; +} + +sub uniq { return keys %{{ map { $_ => 1 } @_ }}; } # Original order lost. + +my $done = 0; + +sub prompt { + + my %cmds = ( + 'h' => \&help, + 'q' => \&quit, + 'l' => \&list, + 'a' => \&select_all, + 'n' => \&select_none, + 'i' => \&invert_selection, + 'd' => \&dump, + ); + + print STDERR "Enter prompt. " . qq/Type "help" to get a list of commands.\n/; + list(); + + my $p = "(grake) "; + + while (!$done) { + print STDERR $p; + my $ln = ; + next unless $ln; + chomp $ln; + if ($ln =~ /(\d+)/) { + toggle_caption ($1); + } + else { + next unless $ln =~ /(\w)/; + $cmds{$1}() if defined $cmds{$1}; + } + } +} + +sub help { + print STDERR "Commands: + help .. this + list .. display found links (> indicates selected for download) + all .. select all + none .. select none + invert .. invert selection + (number) .. toggle caption + dump .. dump selected links and exit + quit .. quit without dumping links\n" + . qq/Command name abbreviations are allowed, e.g. "h" instead of "help"\n/; +} + +sub quit { exit 0; } + +sub list { + my $i = 0; + foreach (@links) { + printf STDERR "%2s%02d: %s\n", + $_->{selected} ? ">":"", + ++$i, + $_->{title} || $_->{url}; + } +} + +sub select_all { + $_->{selected} = 1 foreach @links; + list(); +} + +sub select_none { + $_->{selected} = 0 foreach @links; + list(); +} + +sub invert_selection { + $_->{selected} = !$_->{selected} foreach @links; + list(); +} + +sub dump { + $done = 1; +} + +sub toggle_caption { + my $i = (shift) - 1; + if ($i >= 0 && exists $links[$i]) { + $links[$i]->{selected} = !$links[$i]->{selected}; + list(); + } + else { + print STDERR "error: out of rate\n"; + } +} + +__END__ + +=head1 NAME + +grake - Youtube video link scanner + +=head1 SYNOPSIS + +grake [options] [URL ...] + +=head1 DESCRIPTION + +grake is a command line tool for scanning webpages for Youtube video links. +Each found link is separated with a newline and dumped to the standard output. + +You can use grake together with such tools like C. If you +need to select the videos, use the C<--interactive> switch. + +=head1 OPTIONS + + --help print help and exit + --version print version and exit + --license print license and exit + -i, --interactive run in interactive mode + -t, --title get title for video link + --csv print details in csv, implies -t + +=head1 OPTION DESCRIPTIONS + +=over 4 + +=item B<--help> + +Print help and exit. + +=item B<--version> + +Print version and exit. + +=item B<--license> + +Print license and exit. + +=item B<-i, --interactive> + +Enable interactive prompt which can be used to select the found +video links to be dumped to stdout. By default grake dumps all +found links without prompting. + +=item B<-t, --title> + +Get a video title for each found link. The default is no. + +=item B<--csv> + +Print details in CSV ("$title","$url"\n). Implies C<--title>. + +=back + +=head1 EXAMPLES + +=over 4 + +=item B + +Typical use. + +=item B + +Same but use C to download the found videos. + +=back + +=head1 EXIT STATUS + +Exits 0 on success, otherwise E0; + +=head1 FILES + +=over 4 + +=item $HOME/.grakerc, for example: + +echo "--title" >> ~/.grakerc + +=back + +=head1 NOTES + +=over 4 + +=item B + +grake depends on LWP::UserAgent which reads the http_proxy environment +setting. + env http_proxy=http://foo:1234 grake URL + +=item B + + + +=item B + + + +e.g. git clone git://repo.or.cz/grake.git + +=back + +=head1 SEE ALSO + +C + +=head1 AUTHOR + +Toni Gundogdu + +=cut + + + + -- 2.11.4.GIT