perltidy.
[clive.git] / lib / clive / Video.pm
blob2444e0aee89f05fd4664400a4ad5788b9cfa298c
1 # -*- coding: ascii -*-
2 ###########################################################################
3 # clive, command line video extraction utility.
4 # Copyright 2007, 2008, 2009 Toni Gundogdu.
6 # This file is part of clive.
8 # clive is free software: you can redistribute it and/or modify it under
9 # the terms of the GNU General Public License as published by the Free
10 # Software Foundation, either version 3 of the License, or (at your option)
11 # any later version.
13 # clive is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
15 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
16 # details.
18 # You should have received a copy of the GNU General Public License along
19 # with this program. If not, see <http://www.gnu.org/licenses/>.
20 ###########################################################################
21 package clive::Video;
23 use warnings;
24 use strict;
26 use Carp;
27 use POSIX;
28 use File::Basename qw(basename);
29 use File::Spec::Functions;
30 use Cwd qw(getcwd);
31 use Encode qw(decode_utf8);
33 use clive::Util;
35 our $AUTOLOAD;
37 sub new {
38 my $class = shift;
39 my %fields = (
40 page_link => undef,
41 video_id => undef,
42 file_length => undef,
43 content_type => undef,
44 file_suffix => undef,
45 video_link => undef,
46 video_host => undef,
47 video_format => undef,
48 base_filename => undef,
49 filename => undef,
50 initial_length => undef,
51 time_stamp => undef,
52 nothing_todo => undef,
54 my $self = {
55 _permitted => \%fields,
56 %fields,
58 return bless( $self, $class );
61 sub page_title {
62 my $self = shift;
63 if (@_) {
64 my ( $content, $title ) = @_;
65 if ( !$title ) {
66 require HTML::TokeParser;
67 my $p = HTML::TokeParser->new($content);
68 $p->get_tag("title");
69 $self->{page_title} = $p->get_trimmed_text;
70 _cleanupTitle($self);
72 else {
73 $self->{page_title} = $title;
76 return $self->{page_title};
79 sub printVideo {
80 my $self = shift;
81 my $str = sprintf(
82 "file: %s %.1fM [%s]\n",
83 $self->{base_filename},
84 clive::Util::toMB( $self->{file_length} ),
85 $self->{content_type}
87 clive::Log->instance->out($str);
90 sub emitCSV {
91 my $self = shift;
93 require URI::Escape;
95 my @fields = qw(base_filename file_length video_link);
97 my $str = "csv:";
98 $str .= sprintf( qq/"%s",/, $self->$_ ) foreach (@fields);
99 $str =~ s/,$//;
101 clive::Log->instance->out("$str\n");
104 sub formatOutputFilename {
105 my $self = shift;
107 my $config = clive::Config->instance->config;
108 my $fname;
110 if ( !$config->{output_file} ) {
112 # Apply character-class.
113 my $title = $self->{page_title};
114 my $cclass = $config->{cclass} || qr|\w|;
116 $title = join( '', $self->{page_title} =~ /$cclass/g )
117 if ( !$config->{no_cclass} );
119 # Format output filename.
120 $fname = $config->{filename_format} || "%t.%s";
122 if ( !$title && $fname !~ /%i/ ) {
123 $title = $self->{video_id};
124 $title =~ s/-/_/g;
127 $fname =~ s/%t/$title/;
128 $fname =~ s/%s/$self->{file_suffix}/;
129 $fname =~ s/%i/$self->{video_id}/;
130 $fname =~ s/%h/$self->{video_host}/;
132 my $config = clive::Config->instance->config;
133 $fname = catfile( $config->{save_dir} || getcwd, $fname );
135 my $tmp = $fname;
137 for ( my $i = 1; $i < 9999; ++$i ) {
138 $self->{initial_length} = clive::Util::fileExists($fname);
140 if ( $self->{initial_length} == 0 ) {
141 last;
143 elsif ( $self->{initial_length} == $self->{file_length} ) {
144 $self->{nothing_todo} = 1;
145 last;
147 else {
148 if ( $config->{continue} ) {
149 last;
152 $fname = "$tmp.$i";
155 else {
156 $self->{initial_length}
157 = clive::Util->fileExists( $config->{output_file} );
158 if ( $self->{initial_length} == $self->{file_length} ) {
159 $self->{nothing_todo} = 1;
161 else {
162 $fname = $config->{output_file};
166 if ( !$config->{continue} ) {
167 $self->{initial_length} = 0;
170 $self->{base_filename} = basename($fname);
171 $self->{filename} = $fname;
174 sub fromCacheRecord {
175 my ( $self, $record ) = @_;
177 # No need to keep order in sync with clive::Video::toCacheRecord
178 # or clive::Cache::_mapRecord -- just make sure each item gets
179 # set here.
180 $self->{page_title} = decode_utf8( $$record{page_title} );
181 $self->{page_link} = $$record{page_link};
182 $self->{video_id} = $$record{video_id};
183 $self->{video_link} = $$record{video_link};
184 $self->{video_host} = $$record{video_host};
185 $self->{video_format} = $$record{video_format};
186 $self->{file_length} = $$record{file_length};
187 $self->{file_suffix} = $$record{file_suffix};
188 $self->{content_type} = $$record{content_type};
189 $self->{time_stamp} = $$record{time_stamp};
191 _cleanupTitle($self);
194 sub toCacheRecord {
195 my $self = shift;
197 # Should really remove all '#' from the strings
198 # before storing them. Living on the edge.
199 $self->{page_title} =~ tr{#}//d;
200 my $title = decode_utf8( $self->{page_title} );
202 # Keep the order in sync with clive::Cache::_mapRecord.
203 my $record
204 = $title . "#"
205 . $self->{page_link} . "#"
206 . $self->{video_id} . "#"
207 . $self->{video_link} . "#"
208 . $self->{video_host} . "#"
209 . $self->{video_format} . "#"
210 . $self->{file_length} . "#"
211 . $self->{file_suffix} . "#"
212 . $self->{content_type} . "#"
213 . POSIX::strftime( "%F %T", localtime ) # time_stamp
215 return $record;
218 sub _cleanupTitle {
219 my $self = shift;
220 my $title = $self->{page_title};
222 $title =~ s/(youtube|video|liveleak.com|sevenload|dailymotion)//gi;
223 $title =~ s/(cctv.com|redtube)//gi;
225 $title =~ s/^[-\s]+//;
226 $title =~ s/\s+$//;
228 $self->{page_title} = $title;
231 sub AUTOLOAD {
232 my $self = shift;
233 my $type = ref($self)
234 or croak("$self is not an object");
235 my $name = $AUTOLOAD;
236 $name =~ s/.*://;
237 unless ( exists( $self->{_permitted}->{$name} ) ) {
238 croak("cannot access `$name' field in class $type");
240 if (@_) {
241 return $self->{$name} = shift;
243 else {
244 return $self->{$name};
250 # Barefoot servants too.