Browse Source

cinepantufas v.0.1

themage
theMage 5 years ago
commit
5cda9a8941

+ 19 - 0
cinepantufas.pl

@ -0,0 +1,19 @@
1
#!/usr/bin/perl -w
2
3
use strict;
4
use warnings;
5
6
use FindBin;
7
use lib "$FindBin::Bin/lib";
8
9
use CinePantufas::Setup;
10
BEGIN {
11
  CinePantufas::Setup->load;
12
}
13
14
use CinePantufas::Core;
15
use CinePantufas::Source::EZTV;
16
use CinePantufas::Client::Transmission;
17
18
CinePantufas::Core->main(@ARGV);
19

+ 169 - 0
lib/CinePantufas/Client/Transmission.pm

@ -0,0 +1,169 @@
1
package CinePantufas::Client::Transmission;
2
3
use strict;
4
use warnings;
5
6
use CinePantufas::Core;
7
use CinePantufas::Setup;
8
9
use HTTP::Tiny;
10
use JSON qw(to_json from_json);
11
12
my $session;
13
14
my %ok_res = map {$_ => 1} (
15
  'success',
16
  'duplicate torrent',
17
);
18
19
sub import {
20
  my $config = CinePantufas::Setup->config('transmission');
21
22
  if ($config and $config->{api_url}) {
23
    CinePantufas::Core->register_hooks(
24
      add_torrent           => \&add_torrent,
25
      list_running_torrents => \&list_torrents,
26
    );
27
  }
28
}
29
30
sub add_torrent {
31
  my $class = shift;
32
  my $link  = shift;
33
34
  my $config = CinePantufas::Setup->config('transmission');
35
  my $url = $config->{api_url};
36
37
  my $ua = HTTP::Tiny->new();
38
39
  unless ($session) {
40
    my $resp = $ua->get($url);
41
42
    if ($resp->{headers}->{'x-transmission-session-id'}) {
43
      $session = $resp->{headers}->{'x-transmission-session-id'};
44
    }
45
  }
46
47
  my $content = to_json({
48
      method    => 'torrent-add',
49
      arguments => {
50
        filename  => $link,
51
      }
52
    }, {utf8=>1});
53
54
  my $resp = $ua->post(
55
      $url,{
56
      headers => {
57
        "X-Transmission-Session-Id" => $session,
58
      },
59
      content => $content,
60
    });
61
62
  if ($resp->{status} == 200) {
63
    my $res = from_json($resp->{content});
64
    if ($ok_res{ $res->{result} } ) {
65
      return {
66
        status => 'ok',
67
        hashString => $res->{arguments}->{'torrent-added'}->{hashString}
68
                    ||'',
69
      };
70
    }
71
  } 
72
73
  return 0;
74
}
75
76
sub list_torrents {
77
  my $class = shift;
78
79
  my $config = CinePantufas::Setup->config('transmission');
80
  my $url = $config->{api_url};
81
82
  my $ua = HTTP::Tiny->new();
83
84
  unless ($session) {
85
    my $resp = $ua->get($url);
86
87
    if ($resp->{headers}->{'x-transmission-session-id'}) {
88
      $session = $resp->{headers}->{'x-transmission-session-id'};
89
    }
90
  }
91
92
  my $content = to_json({
93
      method    => 'torrent-get',
94
      arguments => {
95
        fields  => [qw(
96
            id
97
            hashString
98
            isFinished
99
            downloadDir
100
            files
101
          )],
102
      }
103
    }, {utf8=>1});
104
105
  my $resp = $ua->post(
106
    $url,{
107
      headers => {
108
        "X-Transmission-Session-Id" => $session,
109
      },
110
      content => $content,
111
    }
112
  );
113
 
114
  if ($resp->{success}) {
115
    my $res = from_json($resp->{content}, {utf8=>1});
116
    return unless $ok_res{ $res->{result} };
117
118
    my @torrents = @{ $res->{arguments}->{torrents} };
119
120
    return \@torrents;
121
  } else {
122
    die "error on transmission: $resp->{status} $resp->{reason}\n";
123
  }
124
}
125
126
sub remove_torrent {
127
  my $class = shift;
128
  my $tor   = shift;
129
130
  my $config = CinePantufas::Setup->config('transmission');
131
  my $url = $config->{api_url};
132
133
  my $ua = HTTP::Tiny->new();
134
135
  unless ($session) {
136
    my $resp = $ua->get($url);
137
138
    if ($resp->{headers}->{'x-transmission-session-id'}) {
139
      $session = $resp->{headers}->{'x-transmission-session-id'};
140
    }
141
  }
142
143
  my $content = to_json({
144
      method    => 'torrent-remove',
145
      arguments => {
146
        ids   => [ $tor->{id} ],
147
        'delete-local-data' => JSON::true,
148
      }
149
    }, {utf8=>1});
150
151
  my $resp = $ua->post(
152
    $url,{
153
      headers => {
154
        "X-Transmission-Session-Id" => $session,
155
      },
156
      content => $content,
157
    }
158
  );
159
 
160
  if ($resp->{success}) {
161
    my $res = from_json($resp->{content}, {utf8=>1});
162
    return $ok_res{ $res->{result} } || 0;
163
  } else {
164
    die "error on transmission: $resp->{status} $resp->{reason}\n";
165
  }
166
167
}
168
169
1;

+ 613 - 0
lib/CinePantufas/Core.pm

@ -0,0 +1,613 @@
1
package CinePantufas::Core;
2
3
use strict;
4
use warnings;
5
6
use CinePantufas::Setup;
7
use File::Copy qw(copy);
8
9
use DB_File;
10
use JSON qw(to_json from_json);
11
12
my %hooks;
13
14
sub main {
15
  my $class = shift;
16
  my ($cmd,@args) = @_;
17
18
  $cmd = 'help' unless $cmd;
19
  $cmd =~ s{-}{_}g;
20
21
  $class->_check_dirs;
22
23
  my @res = ();
24
  if (my $handler = $class->can("__cmd_$cmd")) {
25
    push @res, $handler->($class,@args);
26
  } elsif ( $hooks{$cmd} ) {
27
    for my $hook ( @{ $hooks{ $cmd } }){
28
      my $handler = $hook->{handler};
29
      my $cls   = $hook->{class};
30
      push @res, $handler->($cls,@args);
31
    }
32
  } else {
33
    die "unknow command: '$cmd @args'\n";
34
  }
35
36
  return @res;
37
}
38
39
sub register_hooks {
40
  my $class = shift;
41
  my %reghooks = @_;
42
43
  my ($cls) = caller();
44
45
  for my $k (keys %reghooks) {
46
    $hooks{ $k } ||= [];
47
    push @{ $hooks{ $k } }, {class=> $cls, handler=> $reghooks{$k} };
48
  }
49
50
}
51
52
sub __cmd_update {
53
  my $class = shift;
54
55
  my ($sources, $newshows)=(0,0);
56
  my @to_update = ();
57
  for my $hook (@{ $hooks{get_show_list} }) {
58
    my $cls = $hook->{class};
59
    my $srcname = $cls->source_name;
60
    my $handler = $hook->{handler};
61
    my @list = $handler->($cls);
62
    push @to_update, grep {
63
        $_->{name},
64
      } map {
65
        { %$_,
66
          class   => $cls,
67
          source  => $srcname,
68
        }
69
      } @list;
70
    $sources++
71
      if @list;
72
  }
73
74
  my $fname = ___show_file();
75
  my %epidb;
76
  tie %epidb, 'DB_File', $fname;
77
  for my $show (@to_update) {
78
    my $k = $show->{name};
79
    $k =~s{[^\w\s\-]}{_}g;
80
    $k =~s{__+}{_}g;
81
    $k =~s{_*\s+_*}{-}g;
82
    $k =~s{_*\z}{};
83
    $k = lc($k);
84
85
    my $rec;
86
    if ($epidb{$k}) {
87
      $rec = from_json($epidb{$k});
88
      $rec->{sources}->{ $show->{source} } = $show;
89
    } else {
90
      $rec = { sources => {$show->{source} => $show} };
91
      $rec->{first_seen} = time;
92
      $rec->{name} = $show->{name};
93
94
      $newshows++;
95
    }
96
    $epidb{$k} = to_json($rec, {utf8=>1});
97
  }
98
99
  print STDERR "updated $sources source(s): $newshows new shows\n";
100
}
101
102
103
sub __cmd_all_shows {
104
  my $class = shift;
105
  my $fname = ___show_file();
106
107
  my %epidb;
108
  tie %epidb, 'DB_File', $fname;
109
  for my $sid (sort keys %epidb) {
110
    my $show = from_json($epidb{$sid},{utf8=>1});
111
    my $name = $show->{name};
112
    my $srcs = scalar keys %{ $show->{sources} };
113
114
    if (length($sid)>30) {
115
      printf " %s\n %32s %2d %s\n", $sid,'',$srcs, $name;
116
    } else {
117
      printf " %-32s %2d %s\n", $sid, $srcs, $name;
118
    }
119
  }
120
}
121
*__cmd_all = *__cmd_all_shows;
122
123
sub __cmd_search {
124
  my $class = shift; 
125
  my @regs = map { qr{$_}i } @_;
126
  my $fname = ___show_file();
127
  
128
  my %showdb;
129
  tie %showdb, 'DB_File', $fname;
130
131
  SHOW:
132
  for my $sid (sort keys %showdb) {
133
    my $show = from_json($showdb{$sid},{utf8=>1});
134
    my $name = $show->{name};
135
    for my $r (@regs) {
136
      next SHOW unless $name =~ $r;
137
    }
138
139
    my $srcs = scalar keys %{ $show->{sources} };
140
141
    if (length($sid)>30) {
142
      printf " %s\n %32s %2d %s\n", $sid,'',$srcs, $name;
143
    } else {
144
      printf " %-32s %2d %s\n", $sid, $srcs, $name;
145
    }
146
  }
147
}
148
149
sub __cmd_add_show {
150
  my $class = shift;
151
  my ($show,$episode) = @_;
152
153
  my $sname = ___show_file();
154
  my %showdb;
155
  tie %showdb, 'DB_File', $sname;
156
157
  my $fname = ___follow_file();
158
  my %followdb;
159
  tie %followdb, 'DB_File', $fname;
160
161
  if ($showdb{$show}) {
162
    my $srec = from_json($showdb{$show}, {utf8=>1});
163
    if ($followdb{$show}) {
164
      print STDERR "Already following $show [$srec->{name}]\n";
165
    } else {
166
      my ($seas,$epis) = (0,0);
167
      if ($episode) {
168
        if ($episode =~m{S(\d+)E(\d+)}i) {
169
          $seas = $1;
170
          $epis = $2;
171
        } elsif ($episode =~ m{(\d+)x(\d+)}i) {
172
          $seas = $1;
173
          $epis = $2;
174
        }
175
      }
176
177
      $followdb{$show} = to_json({
178
          sid   => $show,
179
          since => time,
180
          first_season  => $seas,
181
          first_episode => $epis,
182
        },{utf8=>1});
183
    }
184
  } else {
185
    die "$show is missing - try update/search\n";
186
  }
187
}
188
*__cmd_add = *__cmd_add_show;
189
190
sub __cmd_del_show {
191
  my $class = shift;
192
  my $show  = shift;
193
194
  my $sname = ___show_file();
195
  my %showdb;
196
  tie %showdb, 'DB_File', $sname;
197
198
  my $fname = ___follow_file();
199
  my %followdb;
200
  tie %followdb, 'DB_File', $fname;
201
202
  if ($followdb{$show}) {
203
    my $info = from_json($showdb{$show}, {utf8=>1});
204
    my $follow  = from_json($followdb{$show},{utf8=>1});
205
    if ($info) {
206
      my $date=join"-", (localtime($follow->{since}))[5,4,3];
207
208
      printf "%s\nshowid: %s\nfollowed since: %s - from %dx%d\n%s\n",
209
        $info->{name}, $show,
210
        $follow->{since},
211
        $follow->{first_season},
212
        $follow->{first_episode},
213
        '-'x70;
214
      print "\n => stopped following\n";
215
216
      delete $followdb{$show};
217
    }
218
  } else {
219
    print STDERR "You are not following '$show'\n";
220
  }
221
}
222
*__cmd_del = *__cmd_del_show;
223
224
sub __cmd_list {
225
  my $class = shift;
226
  
227
  my $sname = ___show_file();
228
  my %showdb;
229
  tie %showdb, 'DB_File', $sname;
230
231
  my $fname = ___follow_file();
232
  my %followdb;
233
  tie %followdb, 'DB_File', $fname;
234
235
  for my $show (keys %followdb) {
236
    my $info    = from_json($showdb{$show},{utf8=>1});
237
    my $follow  = from_json($followdb{$show},{utf8=>1});
238
    
239
    unless ($info) {
240
      print STDERR "missing info for $show\n";
241
      next;
242
    }
243
244
    my $date=join"-", (localtime($follow->{since}))[5,4,3];
245
    printf "%s\nshowid: %s\nfollowed since: %s - from %dx%d\n%s\n",
246
        $info->{name}, $show,
247
        $follow->{since},
248
        $follow->{first_season},
249
        $follow->{first_episode},
250
        '-'x70;
251
  }
252
}
253
254
sub __cmd_get_new {
255
  my $class = shift;
256
257
  my $sname = ___show_file();
258
  my %showdb;
259
  tie %showdb, 'DB_File', $sname;
260
261
  my $fname = ___follow_file();
262
  my %followdb;
263
  tie %followdb, 'DB_File', $fname;
264
265
  my $ename = ___episode_file();
266
  my %epidb;
267
  tie %epidb, 'DB_File', $ename;
268
269
  my $total = 0;
270
  for my $show (keys %followdb) {
271
    my $new = 0;
272
    my $info      = from_json($showdb{$show},{utf8=>1});
273
    my $follow    = from_json($followdb{$show},{utf8=>1});
274
    
275
    for my $source (values %{ $info->{sources} }) {
276
      my $class = $source->{class};
277
278
      my @episodes = $class->get_episode_list( $source );
279
280
      for my $episode (@episodes) {
281
        my $k = $show.';:;'.$episode->{number};
282
        if ($epidb{$k}) {
283
          my $old = from_json($epidb{$k},{utf8=>1});
284
          next unless $episode->{is_prio} and !$old->{is_prio};
285
        }
286
287
        my $status = 'new';
288
        $status = 'skipped'
289
          if $episode->{season} < $follow->{first_season}
290
            or ($episode->{season} == $follow->{first_season}
291
              and $episode->{episode} < $follow->{first_episode}
292
            );
293
        my $info = {
294
            %$episode,
295
            first_seen  => time,
296
            status      => $status,
297
            show        => $show,
298
          };
299
300
        $epidb{$k} = to_json($info, {utf8=>1});
301
        $new++ if $status eq 'new';
302
      }
303
    }
304
    print STDERR "$info->{name}: $new new episodes\n"
305
      if $new;
306
    $total += $new;
307
  }
308
309
  print STDERR "Total: $total new episodes\n"
310
    if $total;
311
312
  untie %showdb;
313
  untie %followdb;
314
  untie %epidb;
315
316
  $class->__queue_new();
317
}
318
319
sub __queue_new {
320
  my $class = shift;
321
322
  my $ename = ___episode_file();
323
  my %epidb;
324
  tie %epidb, 'DB_File', $ename;
325
326
  my $queued = 0;
327
  EPISODE:
328
  for my $k (sort keys %epidb) {
329
    my $episode = from_json($epidb{$k}, {utf8=>1});
330
    next unless $episode->{status} eq 'new';
331
332
    my $link = ${$episode->{torrents}}[
333
        rand(scalar @{$episode->{torrents}})
334
      ];
335
336
    for my $hook (@{ $hooks{add_torrent}||[] }) {
337
      my $cls = $hook->{class};
338
      my $handler = $hook->{handler};
339
      my $res = $handler->($cls, $link);
340
341
      if ( $res and $res->{status} eq 'ok') {
342
        $episode->{status} = 'queued';
343
        $episode->{hashString} = $res->{hashString}
344
          if $res->{hashString};
345
        $epidb{$k} = to_json($episode,{utf8=>1});
346
        $queued++;
347
348
        next EPISODE;
349
      }
350
    }
351
  }
352
353
  print STDERR "Queued $queued new episodes\n"
354
    if $queued;
355
}
356
357
sub __cmd_reget {
358
  my $class = shift;
359
  my ($show,$episode) = @_;
360
361
  die "Missing show or episode\n"
362
    unless $show and $episode;
363
364
  my $fname = ___follow_file();
365
  my %followdb;
366
  tie %followdb, 'DB_File', $fname;
367
368
  my $ename = ___episode_file();
369
  my %epidb;
370
  tie %epidb, 'DB_File', $ename;
371
372
  unless ($followdb{ $show }) {
373
    die "You're not following '$show'";
374
  }
375
376
  my ($seas,$epi) = $episode =~ m{S?(\d+)[Ex](\d+)}i;
377
  $episode = ($seas+0).'x'.sprintf('%02d', $epi);
378
  my $k = $show.';:;'.$episode;
379
  if ($epidb{ $k }) {
380
    my $info = from_json($epidb{$k}, {utf8=>1});
381
    $info->{status} = 'new';
382
    $epidb{$k} = to_json($info);
383
384
    print STDERR "set to new $show - $episode\n";
385
  } else {
386
    die "Unknow episode $show - $episode\n";
387
  }
388
389
  untie %epidb;
390
  untie %followdb;
391
  $class->__queue_new();
392
}
393
394
sub __cmd_move_done {
395
  my $class = shift;
396
397
  my $ename = ___episode_file();
398
  my %epidb;
399
  tie %epidb, 'DB_File', $ename;
400
401
  HOOK:
402
  for my $hook (@{ $hooks{list_running_torrents}||[] }) {
403
    my $cls = $hook->{class};
404
    my $handler = $hook->{handler};
405
406
    print STDERR "calling hook in $cls\n";
407
    my $res = $handler->($cls);
408
    if ($res and ref $res eq 'ARRAY') {
409
      my %torrents = map { $_->{hashString} => $_ } 
410
          grep { $_->{isFinished} } @$res;
411
412
      next HOOK unless keys %torrents;
413
414
      for my $k (keys %epidb) {
415
        my $info = from_json($epidb{$k}, {utf8=>1});
416
        next unless $info->{status} eq 'queued';
417
        next unless my $tor = $torrents{ $info->{hashString} };
418
419
        if (__copy_files( $info => $tor )) {
420
          if ($cls->remove_torrent($tor) ) {
421
            $info->{status} = 'done';
422
            $epidb{$k} = to_json( $info, {utf8=>1});
423
424
            print STDERR "$info->{show} - $info->{number} ready\n";
425
            exit; #only remove 1
426
          }
427
        }
428
      }
429
    }
430
  }
431
}
432
433
sub __copy_files {
434
  my ($info, $tor) = @_;
435
  my $config = CinePantufas::Setup->config('move');
436
437
  return unless $config->{basedir};
438
439
  my $source = $tor->{downloadDir};
440
  my $fname  = __find_best_file( @{ $tor->{files} } );
441
442
  return unless $fname;
443
444
  my $ext = (split /\./, $fname)[-1];
445
446
  $source .= '/' unless substr($source,-1) eq '/';
447
  $source .= $fname;
448
449
  my $dest = $config->{basedir};
450
  $dest .= '/' unless substr($dest,-1) eq '/';
451
  $dest .= $info->{show}.'/';
452
  mkdir $dest unless -d $dest;
453
454
  $dest .= 'Season'.$info->{season}.'/';
455
  mkdir $dest unless -d $dest;
456
457
  $dest .= $info->{show}.'--'.$info->{number}.'.'.$ext;
458
459
  if ($config->{disabled}) {
460
    print STDERR "would move '$source' to '$dest'\n";
461
    return 0;
462
  } else {
463
    copy($source, $dest) or die "Copy failed: $!\n";
464
    return 1;
465
  }
466
}
467
468
my %good_types = map {$_ => 1} qw(
469
  mp4
470
  avi
471
  mkv
472
);
473
sub __find_best_file {
474
  my @files = @_;
475
476
  my ($file) = grep {
477
      my $ext = (split /\./, $_)[-1];
478
      $good_types{$ext};
479
    } map {
480
      $_->{name}
481
    } sort {
482
      $b->{length} <=> $a->{length}
483
    } @files;
484
485
  return $file ? $file : ();
486
}
487
488
my @helps = qw(
489
  update
490
  get_new
491
  list
492
  all_shows
493
  search
494
  add_show
495
  del_show
496
  reget
497
  move_done
498
);
499
my %help = (
500
  update    => 'update the list of known shows',
501
  get_new   => "update the list of episodes for the followed shows\n".
502
               "\t\tand queue the new ones",
503
  list      => 'list the followed shows',
504
  all_shows => 'list all known shows',
505
  search    => 'search for shows by keywork',
506
  add_show  => 'add a show to the followed list - first episode optional',
507
  del_show  => 'delete a show from the followed list',
508
  reget     => 'get a specific episode again',
509
  move_done => 'move the files that are complete to the final folder',
510
);
511
512
my %howto = (
513
  update    => 'update',
514
  get_new   => 'get-new',
515
  list      => 'list',
516
  all_shows => 'all-shows',
517
  search    => 'search castle',
518
  add_show  => 'add-show castle S05E07',
519
  del_show  => 'del-show castle',
520
  reget     => 'reget castle 06x09',
521
  move_done => 'move-done',
522
);
523
524
my %params = (
525
  search    => '<keyword> [<keyword>]*',
526
  add_show  => '<show-name> [<first-episode>]',
527
  del_show  => '<show-name>',
528
  reget     => '<show-name> <episode>',
529
);
530
sub __cmd_help {
531
  my ($class, $cmd) = @_;
532
533
  if ( $cmd and $help{$cmd} ) {
534
    my $params = $params{$cmd} || '';
535
    my $help  = $help{$cmd} || '';
536
    my $howto = $howto{$cmd} || '';
537
    print STDERR "$0 $cmd $params\n\n",
538
      "\t$help\n\n\tUsage:\n\t\t$0 $howto\n\n";
539
  } else {
540
    print STDERR "$0 <command>\n  Accepts commands:\n\n";
541
    for my $cmd (@helps) {
542
      my $help  = $help{$cmd} || '';
543
      print STDERR sprintf "   %-12s %s\n",$cmd, $help; 
544
    }
545
  }
546
  print STDERR "\nNote: <episode> can be <S00E00> or 00x00\n\n";
547
548
  return;
549
}
550
551
sub __cmd_dump_config {
552
  CinePantufas::Setup->dump();
553
}
554
555
556
sub _check_dirs {
557
  my $class = shift;
558
559
  my $datadir   = CinePantufas::Setup->config('','datadir');
560
  my $cachedir  = CinePantufas::Setup->config('','cachedir');
561
562
  __makedir( $datadir );
563
  __makedir( $cachedir );
564
}
565
566
sub __makedir {
567
  my $dir = shift;
568
569
  die "hien? '$dir'" unless $dir; 
570
  return if -d $dir;
571
  my ($parent) = $dir =~ m{(.*)/[^/]+/?\z};
572
573
  if (!-d $parent) {
574
    __makedir( $parent );
575
  }
576
577
  mkdir $dir
578
    or die "Error creating '$dir': $!\n";
579
}
580
581
sub ___show_file {
582
  my $fname = CinePantufas::Setup->config('','datadir');
583
  $fname .= '/' unless substr($fname,-1) eq '/';
584
  $fname .= 'shows.db';
585
586
  return $fname;
587
}
588
589
sub ___follow_file {
590
  my $fname = CinePantufas::Setup->config('','datadir');
591
  $fname .= '/' unless substr($fname,-1) eq '/';
592
  $fname .= 'follow.db';
593
594
  return $fname;
595
}
596
597
sub ___episode_file {
598
  my $fname = CinePantufas::Setup->config('','datadir');
599
  $fname  .= '/' unless substr($fname,-1) eq '/';
600
  $fname  .= 'episodes.db';
601
602
  return $fname;
603
}
604
605
sub ___show_episode_file {
606
  my $fname = CinePantufas::Setup->config('','datadir');
607
  $fname  .= '/' unless substr($fname,-1) eq '/';
608
  $fname  .= 'show_episodes.db';
609
610
  return $fname;
611
}
612
613
1;

+ 80 - 0
lib/CinePantufas/Setup.pm

@ -0,0 +1,80 @@
1
package CinePantufas::Setup;
2
3
use strict;
4
use warnings;
5
6
use Config::Tiny;
7
8
my $CONFIG;
9
10
my $basedir = $> == 0 
11
    ? '/var/cinepantufas'
12
    : $ENV{HOME}.'/.cinepantufas';
13
14
my $defaultcfg = $> == 0
15
    ? '/etc/cinepantufas.cfg'
16
    : $basedir.'/cinepantufas.cfg';
17
18
my %defaults = (
19
    datadir   => "$basedir/data",
20
    cachedir  => "$basedir/cache",
21
  );
22
23
sub load {
24
  my $class = shift;
25
  my $fname = shift || $defaultcfg;
26
27
  my $cfg = {};
28
  if ($fname and -f $fname) {
29
    $cfg = Config::Tiny->read($fname);
30
    if (!$cfg and my $err = Config::Tiny->errstr) {
31
      die "error reading config '$fname': $err\n";
32
    }
33
  }
34
35
  for my $k (keys %defaults) {
36
    $cfg->{_}->{$k} //= $defaults{$k};
37
  }
38
39
  $CONFIG = bless { __cfg => $cfg}, $class;
40
}
41
42
sub config {
43
  my $class = shift;
44
  my $self = $CONFIG;
45
  my ($sec,$key) = @_;
46
  $sec = '_' if !$sec and $key;
47
48
  my %sec = $sec
49
    ? %{ $self->{__cfg}->{$sec} || {} }
50
    : %{ $self->{__cfg} };
51
52
  if ($key) {
53
    return $sec{$key};
54
  }
55
56
  return wantarray ? %sec : \%sec;
57
}
58
59
sub dump {
60
  print STDERR "$defaultcfg\n\n";
61
62
  my $conf = $CONFIG->{__cfg};
63
64
  for my $k (keys %{$conf->{_}}) {
65
    print STDERR "$k = $conf->{_}->{$k}\n";
66
  }
67
  print STDERR "\n";
68
 
69
  for my $sec (keys %$conf) {
70
    next if $sec eq '_';
71
    print STDERR "[$sec]\n";
72
    for my $k (keys %{$conf->{$sec}}){
73
      print STDERR "$k = $conf->{$sec}->{$k}\n";
74
    }
75
    print STDERR "\n";
76
  }
77
78
}
79
80
1;

+ 85 - 0
lib/CinePantufas/Source/EZTV.pm

@ -0,0 +1,85 @@
1
package CinePantufas::Source::EZTV;
2
3
use strict;
4
use warnings;
5
6
use CinePantufas::Core;
7
8
use HTTP::Tiny;
9
10
my $prio = qr{HDTV};
11
12
sub source_name { "eztv" }
13
14
sub import {
15
  CinePantufas::Core->register_hooks(
16
    get_show_list => \&retrieve_show_list,
17
  );
18
}
19
20
sub retrieve_show_list {
21
  my $class = shift;
22
23
  my $resp = HTTP::Tiny->new->get('http://eztv.it');
24
25
  die "Failed: $resp->{status} $resp->{reason}\n"
26
    unless $resp->{success};
27
28
  my $html = $resp->{content} ||'';
29
30
  ($html) = $html =~ m{<select\sname="SearchString">(.*?)</select>}smx;
31
32
  my %shows = $html =~ m{<option value="(\d+)">([^<]+)</option}g;
33
34
  my @shows = map {
35
      { name      => $shows{$_},
36
        params    => {
37
          SearchString  => $_,
38
        },
39
      }
40
    } keys %shows;
41
42
  return @shows;
43
}
44
45
sub get_episode_list {
46
  my ($class,$show) = @_;
47
48
  my $resp = HTTP::Tiny->new->post_form('http://eztv.it/search/',
49
        $show->{params}
50
    );
51
52
  unless ($resp->{success}) {
53
    print STDERR "ERROR: $resp->{status} $resp->{reason}\n";
54
    return;
55
  }
56
57
  my @rows = $resp->{content} =~ m{<tr \s+ name="hover"[^>]+>(.*?)</tr>}smxg;
58
59
  my %episodes = ();
60
  for my $row (@rows) {
61
    my ($name) = $row =~ m{class="epinfo">([^>]+)</a>}smxi;
62
    my ($ses,$epi) = $name =~ m{S(\d+)E(\d+)};
63
    my %links = reverse
64
        $row=~m{<a \s href="([^"]+)" \s+ class="download_(\d+)"}smxgi;
65
66
    $_ = "http:$_" for grep { substr($_,0,1) eq '/' } values %links;
67
  
68
    my $episode=($ses+0).'x'.sprintf('%02d', $epi);
69
    my $isprio = $name =~ $prio;
70
    if (!$episodes{$episode} or $isprio ) {
71
      $episodes{$episode} = {
72
          filename  => $name,
73
          is_prio   => $isprio,
74
          torrents  => [values %links],
75
          season    => $ses,
76
          episode   => $epi,
77
          number    => $episode,
78
        };
79
    }
80
  }
81
82
  return values %episodes;
83
}
84
85
1;