emiya.pl

   1 #! /usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 #sub POE::Kernel::ASSERT_DEFAULT () { 1 }
   8 use POE qw(Component::Client::HTTP);
   9
  10 use HTTP::Request;
  11 use HTML::Entities;
  12 use Encode;
  13 use Digest::MD5 'md5_hex';
  14 use Time::HiRes 'time';
  15
  16 # TODO: allow loading all those variables from a configuration file
  17
  18 # Required for using the script. If you're using this script,
  19 # you already know what these are for and what you should put in here
  20 my $username = "PR";
  21 my $password = "";
  22
  23 # HTTP proxy. Must be in the form 'http://host:port'.
  24 # Port is required even if 80.
  25 # May work for SOCKS proxies by using the 'socks://' protocol, untested.
  26 my $proxy = $ENV{http_proxy};
  27
  28 # FILTERS
  29
  30 # The main purpose of this script.
  31 # Only files that pass any of the allow filters and fail all of the deny filters
  32 # get downloaded.
  33
  34 # These are hashes to arrayrefs. Each key is used to filter a field in the $info
  35 # hashref. Each element of the arrayrefs is treated as a case-sensitive regexp.
  36 # The fields are title, url and category. There are other fields, but they are
  37 # not really filterable through this method. You are welcome to try though.
  38 # Example: title => ['Kara_no_Kyoukai', 'Black Lagoon\[niizk\]']
  39
  40 # Use [0-9A-Fa-f]{8} for CRC32s
  41 # Use \d{1,3}v?\d? for episode numbers (catches v2s and v3s as well)
  42 # Remember to escape all '.', '[' and ']' on filenames with a '\'.
  43 my %file_allow_filters = ( title => [] );
  44 my %file_deny_filters = ( url => [] );
  45
  46 # HTTP Digest auth hack
  47 my $realm = "DeathWolf's Auto-Torrent Loving Realm";
  48 my $A1 = md5_hex("$username:$realm:$password");
  49 my $A2 = md5_hex("GET:/~DeathWolf/Recent/Latest-Files.html");
  50 my $cnonce = int(time());
  51 my $reqid = 1;
  52
  53 sub make_digest {
  54         my $www_auth = shift;
  55
  56         $www_auth =~ /nonce=\"(.*?)\"/;
  57         my $nonce = $1;
  58
  59         my $header = "Digest username=\"$username\", ";
  60         $header .= "realm=\"$realm\", nonce=\"$nonce\", ";
  61         $header .= "uri=\"/~DeathWolf/Recent/Latest-Files.html\", ";
  62         $header .= "qop=\"auth\", nc=$reqid, cnonce=\"$cnonce\", ";
  63         my $resp_digest = md5_hex("$A1:$nonce:$reqid:$cnonce:auth:$A2");
  64         $header .= "response=\"$resp_digest\"";
  65         return $header;
  66 }
  67
  68 use constant CHUNK_SIZE => 16384;
  69
  70 POE::Component::Client::HTTP->spawn(
  71         Agent     => 'Emiya/0.2',
  72         Alias     => 'ua',
  73         Timeout   => 45,                    # TODO: make it configurable
  74         Streaming => CHUNK_SIZE,
  75         Proxy     => $proxy
  76 );
  77
  78 sub entity_clean {
  79         my $str = decode_utf8(shift);
  80         use bytes; $str =~ s/%([0-9A-Fa-f]{2})/@{[chr(hex($1))]}/g; no bytes;
  81         decode_entities($str);
  82         return $str;
  83 }
  84
  85 ### Windows Unicode support wrappers
  86 if ($^O =~ /MSWin/) {
  87
  88         ### NOTE: ALL file manipulation files defined here *ONLY WORK WITH ABSOLUTE PATHS*
  89
  90         require Win32API::File; Win32API::File->import qw(:FuncW :Func :MOVEFILE_ :GENERIC_ :FILE_  FILE_END :FILE_SHARE_ OPEN_ALWAYS);
  91         require Win32::API; Win32::API->import;
  92
  93         # Enable output of UTF-8 text
  94
  95         my $SetConsoleOutputCP = Win32::API->new('kernel32.dll', 'SetConsoleOutputCP',
  96                                                                                          'I', '') or die "SetConsoleOutputCP: $^E";
  97
  98 #       if ($SetConsoleOutputCP->Call(65001)) {
  99 #               die "Error " . Win32::GetLastError () . " - " . Win32::FormatMessage (Win32::GetLastError ());
 100 #       }
 101
 102         my $GetStdHandle  = Win32::API->new('kernel32.dll', 'GetStdHandle',
 103                                             'I', 'I') or die "GetStdHandle: $^E";
 104         my $WriteConsoleW = Win32::API->new('kernel32.dll', 'WriteConsoleW',
 105                                             'IPIPP', 'I') or die "WriteConsoleW: $^E";
 106
 107         use constant STD_OUTPUT_HANDLE => 0xfffffff5;
 108
 109         my $stdout = $GetStdHandle->Call(STD_OUTPUT_HANDLE);
 110
 111         # Use Win32::API to load needed functions not defined by Win32API::File
 112
 113         use constant ERROR_NO_MORE_FILES  =>  18;
 114         use constant INVALID_HANDLE_VALUE =>  -1;
 115
 116         typedef Win32::API::Struct FILETIME => qw{
 117                 DWORD dwLowDateTime;
 118                 DWORD dwHighDateTime;
 119         }; # 8 bytes
 120
 121         use constant FILE_ATTRIBUTE_READONLY   =>   0x00000001;
 122         use constant FILE_ATTRIBUTE_HIDDEN     =>   0x00000002;
 123         use constant FILE_ATTRIBUTE_SYSTEM     =>   0x00000004;
 124         use constant FILE_ATTRIBUTE_DIRECTORY  =>   0x00000010;
 125         use constant FILE_ATTRIBUTE_ARCHIVE    =>   0x00000020;
 126         use constant FILE_ATTRIBUTE_NORMAL     =>   0x00000080;
 127         use constant FILE_ATTRIBUTE_TEMPORARY  =>   0x00000100;
 128         use constant FILE_ATTRIBUTE_COMPRESSED =>   0x00000800;
 129         use constant MAX_PATH                  =>   260;
 130
 131         typedef Win32::API::Struct WIN32_FIND_DATAW => qw{
 132                 DWORD dwFileAttributes;
 133                 FILETIME ftCreationTime;
 134                 FILETIME ftLastAccessTime;
 135                 FILETIME ftLastWriteTime;
 136                 DWORD nFileSizeHigh;
 137                 DWORD nFileSizeLow;
 138                 DWORD dwReserved0;
 139                 DWORD dwReserved1;
 140                 WCHAR cFileName[520];
 141                 WCHAR cAlternateFileName[28];
 142         }; # 4 + 8 x 3 + 4 x 4 + 520 + 28 = 592 bytes
 143
 144         my $FindFirstFileW = Win32::API->new('kernel32.dll', 'FindFirstFileW',
 145                                              'PS', 'N') or die "FindFirstFile: $^E";
 146         my $FindNextFileW  = Win32::API->new('kernel32.dll', 'FindNextFileW',
 147                                              'NS', 'I') or die "FindNextFile $^E";
 148         my $FindClose      = Win32::API->new('kernel32.dll', 'FindClose',
 149                                               'N', 'I') or die "FileClose $^E";
 150
 151         typedef Win32::API::Struct SHFILEOPSTRUCT => qw{
 152                 HWND hwnd;
 153                 UINT wFunc;
 154                 LPCWSTR pFrom;
 155                 LPCWSTR pTo;
 156                 WORD fFlags;
 157                 BOOL fAnyOperationsAborted;
 158                 LPVOID hNameMappings;
 159                 LPCTSTR lpszProgressTitle;
 160         };
 161
 162         my $SHFileOperationW = Win32::API->new('shell32.dll', 'SHFileOperationW',
 163                                                                                    'S', 'I') or die "SHFileOperation: $^E";
 164
 165         my $CreateDirectoryW = Win32::API->new('kernel32.dll',
 166                 'BOOL CreateDirectoryW(LPCWSTR lpPathName, LPVOID lpSecurityAttributes);') or die "CreateDirectoryW: $^E";
 167
 168         my $RemoveDirectoryW = Win32::API->new('kernel32.dll',
 169                 'BOOL RemoveDirectoryW(LPCWSTR lpPathName);') or die "RemoveDirectoryW: $^E";
 170
 171         my $enc = sub {
 172                 my $str = shift;
 173                 return encode("UTF-16LE", decode_utf8("$str\0"));
 174         };
 175
 176         *myprint = sub {
 177                 my $str = shift;
 178                 $str = $enc->($str);
 179                 my $count = 0;
 180                 return $count if $WriteConsoleW->Call($stdout, $str, (bytes::length($str)-1)/2, $count, []);
 181                 return 0;
 182         };
 183
 184         *mymkpath = sub {
 185                 my $path = shift;
 186                 my $p = $path;
 187                 $p =~ s/\//\\/g;
 188                 unless (myexists($path)) {
 189                         $! = 0;
 190                         unless ($CreateDirectoryW->Call($enc->("$p"), undef)) {
 191                                 my $parent = $path;
 192                                 $parent =~ s/\/[^\/]*$//;
 193                                 if ($parent eq $path) {
 194                                         return undef;
 195                                 }
 196                                 unless (mymkpath($parent)) {
 197                                         return undef;
 198                                 }
 199                                 # Parent made, try again making the child
 200                                 unless ($CreateDirectoryW->Call($enc->("$p"), undef)) {
 201                                         return undef;
 202                                 }
 203                         }
 204                 }
 205                 return $path;
 206         };
 207
 208         *myexists = sub {
 209                 my $p = shift;
 210                 $p =~ s/\//\\/g;
 211                 return GetFileAttributesW($enc->("$p")) != fileConstant("INVALID_FILE_ATTRIBUTES");
 212         };
 213
 214         *mysize = sub {
 215                 my $p = shift;
 216                 return 0 unless myexists($p);
 217                 $p =~ s/\//\\/g;
 218                 my $handle = CreateFileW($enc->("$p"), 0, fileConstant("FILE_SHARE_READ") |
 219                                                                  fileConstant("FILE_SHARE_WRITE"), [],
 220                                                                  fileConstant("OPEN_EXISTING"), 0, []);
 221                 my $size = getFileSize($handle);
 222                 CloseHandle($handle);
 223                 return $size;
 224         };
 225
 226         *myopen = sub {
 227                 my $mode = shift;
 228                 my $file = shift;
 229                 $file =~ s/\//\\/g;
 230                 $file = $enc->("$file");
 231                 if ($mode eq '<') {
 232                         die "Not implemented";
 233                 }
 234                 my $handle = CreateFileW($file, $mode eq '>>' ? FILE_APPEND_DATA() : GENERIC_WRITE(), FILE_SHARE_READ(), [], OPEN_ALWAYS(), 0, []);
 235                 setFilePointer($handle, 0, FILE_END());
 236                 return $handle;
 237         };
 238
 239         *mysyswrite = sub {
 240                 my $handle = shift;
 241                 my $data = shift;
 242                 my $outbytes;
 243                 return WriteFile($handle, $data, 0, $outbytes, []) ? $outbytes : undef;
 244         };
 245
 246         *myclose = sub {
 247                 CloseHandle(shift);
 248         };
 249
 250         *myunlink = sub {
 251                 DeleteFileW($enc->(shift));
 252         }
 253
 254 } else {
 255         $|++;
 256         *myprint = sub { print shift; };
 257         *mymkpath = sub { mkpath(shift); };
 258         *myexists = sub { -e shift; };
 259         *mysize = sub { -s shift; };
 260         *myopen = sub { open ($_, shift, shift); };
 261         *mysyswrite = sub { syswrite(shift, shift); };
 262         *myclose = sub { close(shift); };
 263         *myunlink = sub { unlink(shift); };
 264 }
 265
 266 sub shorten {
 267         my ($str, $maxlen) = @_;
 268
 269         return $str if length($str) <= $maxlen;
 270
 271         return undef if $maxlen < 3;
 272         return "..." if $maxlen == 3;
 273         return substr($str, 0, 1) . "..." if $maxlen == 4;
 274
 275         my $prelen = ($maxlen-3)/2;
 276         my $postlen = ($maxlen-3) - $prelen;
 277
 278         my $toggle = 0;
 279         while($prelen > int($prelen)) {
 280                 if (($toggle = !$toggle)) {
 281                         $prelen -= 1/2;
 282                         $prelen++;
 283                 } else {
 284                         $postlen -= 1/2;
 285                         $postlen++;
 286                 }
 287         }
 288
 289         return substr($str, 0, $prelen) . "..." . substr($str, -$postlen);
 290 }
 291
 292 sub shorten_path {
 293         my ($path, $maxlen) = @_;
 294         if (length($path) > $maxlen) {
 295                 my @paths = split('/', $path);
 296                 if (scalar(@paths) < 2) {
 297                         $path = shorten($path, $maxlen);
 298                 } else {
 299                         $path = "";
 300                         $maxlen -= length(($path = shift(@paths) . "/")) if length($paths[0]) < $maxlen/2;
 301
 302                         my $count = scalar(@paths);
 303                         my $len = int($maxlen / $count);
 304                         my $extra = int($maxlen) % $count;
 305                         my $last = pop @paths;
 306
 307                         foreach (@paths) {
 308                                 $path .= shorten("$_", $len - 1) . '/';
 309                         }
 310
 311                         $path .= shorten($last, $len + $extra);
 312                 }
 313         }
 314         return $path
 315 }
 316
 317 POE::Session->create(
 318         inline_states => {
 319                 # Makes initial request for the Digest authentication
 320                 _start => sub {
 321                         my ($kernel, $heap) = @_[KERNEL, HEAP];
 322
 323                         my $req = HTTP::Request->new(GET => 'http://saber.kawaii-shoujo.net/~DeathWolf/Recent/Latest-Files.html');
 324                         $heap->{progress_message} = "Requesting List...";
 325                         myprint ($heap->{progress_message} . " ");
 326                         $kernel->post('ua', 'request', 'authenticate', $req, 0);
 327                 },
 328                 _stop => sub {
 329                         my ($kernel) = $_[KERNEL];
 330                         $kernel->post('ua', 'shutdown');
 331                 },
 332                 # Authenticates and then actually fetch the list
 333                 authenticate => sub {
 334                         my $res = $_[ARG1]->[0];
 335                         return if defined $_[ARG1]->[1]; # Wait until the error page finishes downloading because of streaming
 336                         my $req = HTTP::Request->new(GET => 'http://saber.kawaii-shoujo.net/~DeathWolf/Recent/Latest-Files.html');
 337                         die $res->status_line unless ($res->status_line =~ /^(401|2)/);
 338                         unless ($res->is_success) {
 339                                 my $header = make_digest($res->header('WWW-Authenticate'));
 340                                 $req->header('Authorization', $header);
 341                         }
 342                         $_[KERNEL]->post('ua', 'request', 'stream_latest_files', $req, $reqid++, 'progress');
 343                 },
 344                 progress => sub {
 345                         my ($heap, $done, $left) = ($_[HEAP], @{$_[ARG1]}[0,1]);
 346                         my $msg = $heap->{progress_message};
 347                         myprint (sprintf("%3.2f%%\r$msg ", $done * 100 / $left));
 348                         myprint ("\n") if $done == $left;
 349                 },
 350                 # Puts the HTML in a temporary var
 351                 stream_latest_files => sub {
 352                         my ($kernel, $session, $heap, $res, $data) = (@_[KERNEL, SESSION, HEAP], @{$_[ARG1]});
 353
 354                         die $res->status_line unless ($res->is_success);
 355
 356                         if (defined $data) {
 357                                 $heap->{latest_files_data} = "" unless exists $heap->{latest_files_data};
 358                                 $heap->{latest_files_data} .= $data;
 359                         } else {
 360                                 $kernel->call($session, 'parse_latest_files');
 361                                 $kernel->yield('load_completed_files');
 362                                 $kernel->yield('filter_files');
 363                         }
 364                 },
 365                 # Parses the HTML, puts hashrefs in $_[HEAP]->{latest_files}
 366                 parse_latest_files => sub {
 367                         my $heap = $_[HEAP];
 368
 369                         my $content = $heap->{latest_files_data};
 370                         delete $heap->{latest_files_data};
 371                         my @files = ();
 372                         my $info = {};
 373
 374                         # TODO: use a XML parser, saber now uses XHTML 1.0
 375                         my @lines = split m/\n/, $content;
 376
 377                         foreach (@lines) {
 378                                 if(m/^\s*(<td.*)/) {
 379                                         $_ = $1;
 380                                         if (m!class="date".*?>(.+?)</td>!) {
 381                                                 $info->{date} = $1;
 382                                         } elsif (m!class="category".*?>(.+?)</td>!) {
 383                                                 $info->{category} = $1;
 384                                         } elsif (m!class="size".*?>(.+?)</td>!) {
 385                                                 $info->{size} = $1;
 386                                         } elsif (m!<td><a href="(.+?)">(.+?)</a></td>!) {
 387                                                 $info->{url} = entity_clean($1);
 388                                                 $info->{title} = entity_clean($2);
 389                                         }
 390                                 } elsif (m!^\s*</tr>! and $info->{url}) {
 391                                         push @files, $info;
 392                                         $info = {};
 393                                 }
 394                         }
 395
 396                         $heap->{latest_files} = \@files;
 397                 },
 398                 # Loads the list of completed files
 399                 load_completed_files => sub {
 400                         my $heap = $_[HEAP];
 401                         $heap->{completed_files} = [];
 402                         if (myexists("completed_files.txt")) {
 403                                 open my $in, "<", "completed_files.txt";
 404                                 foreach (<$in>) {
 405                                         chomp;
 406                                         s/\r$//;
 407                                         push @{$heap->{completed_files}}, decode_utf8($_);
 408                                 }
 409                                 close $in;
 410                         }
 411                 },
 412                 mark_as_completed => sub {
 413                         open my $completed_files, ">>", "completed_files.txt";
 414                         print $completed_files encode_utf8($_[ARG0] . "\n");
 415                         close $completed_files;
 416                 },
 417                 # Filters the file list
 418                 filter_files => sub {
 419                         # TODO: allow filtering by batch contents (subfolders)
 420                         # TODO: allow filtering by min / max filesize
 421                         my ($kernel, $heap) = @_[KERNEL, HEAP];
 422                         $heap->{allowed_files} = [];
 423                         my $skip;
 424                         my $filecount = scalar(@{$heap->{latest_files}});
 425                         my $i = 1;
 426                         foreach my $info (@{$heap->{latest_files}}) {
 427                                 myprint("\rFiltering " . $i++ . "/$filecount... ");
 428                                 $skip = 0;
 429                                 foreach (@{$heap->{completed_files}}) {
 430                                         if ($info->{title} eq $_) {
 431                                                 $skip = 1;
 432                                                 last;
 433                                         }
 434                                 }
 435                                 next if $skip;
 436                                 my $allowed = 0;
 437                                 foreach my $group (keys %file_allow_filters) {
 438                                         foreach my $filter (@{$file_allow_filters{$group}}) {
 439                                                 if (entity_clean($info->{$group}) =~ /$filter/) {
 440                                                         $allowed = 1;
 441                                                         last;
 442                                                 }
 443                                         }
 444                                         last if $allowed;
 445                                 }
 446
 447                                 foreach my $group (keys %file_deny_filters) {
 448                                         foreach my $filter (@{$file_deny_filters{$group}}) {
 449                                                 if (entity_clean($info->{$group}) =~ /$filter/) {
 450                                                         $allowed = 0;
 451                                                         last;
 452                                                 }
 453                                         }
 454                                         last unless $allowed;
 455                                 }
 456
 457                                 push @{$heap->{allowed_files}}, $info if $allowed;
 458                         }
 459                         delete $heap->{latest_files};
 460                         $kernel->yield('sort_allowed_files');
 461                         $kernel->yield('print_allowed_files');
 462                         $kernel->yield('download_entries');
 463                 },
 464                 sort_allowed_files => sub {
 465                         # TODO: actually sort them
 466                         # NOTE: the list is used in reverse order
 467                 },
 468                 print_allowed_files => sub {
 469                         my $heap = $_[HEAP];
 470                         my $a = @{$heap->{allowed_files}} > 0 ? ":" : ".";
 471                         myprint (@{$heap->{allowed_files}} . " entries accepted$a\n");
 472                         foreach (@{$heap->{allowed_files}}) {
 473                                 myprint ("  \"" . $_->{title} . ($_->{url} =~ m!/$! ? "/" : "") . "\" (" . $_->{size} . ")\n");
 474                         }
 475                 },
 476                 # This state is called after each file finishes downloading
 477                 download_entries => sub {
 478                         my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
 479                         my $info = pop @{$heap->{allowed_files}};
 480                         if ($info) {
 481                                 if ($info->{url} =~ /\/$/) {
 482                                         $kernel->call($session, 'subfolder_recurse', $info);
 483                                 } else {
 484                                         $kernel->call($session, 'download_file', $info);
 485                                 }
 486                         }
 487                 },
 488                 # Downloads folder listings
 489                 subfolder_recurse => sub {
 490                         # TODO: write the folder name to completed_files.txt after getting all files
 491                         # and skip if the folder name is found
 492                         my ($kernel, $heap, $info) = @_[KERNEL, HEAP, ARG0];
 493
 494                         my $req = HTTP::Request->new(GET => $info->{url});
 495                         $heap->{info} = $info;
 496                         $heap->{progress_message} = "Listing \"". $info->{title} ."/\":";
 497                         $kernel->call('ua', 'request', 'stream_subfolder', $req, $reqid++, 'progress');
 498                         while (defined $heap->{info}) { $kernel->run_one_timeslice(); }
 499                         $kernel->yield('download_entries');
 500                 },
 501                 stream_subfolder => sub {
 502                         my ($kernel, $heap, $res, $data) = (@_[KERNEL, HEAP], @{$_[ARG1]});
 503                         my $info = $heap->{info};
 504
 505                         die $res->status_line unless ($res->is_success);
 506
 507                         # HACK: I dunno why I use md5_hex, but it looked like a good idea at the time
 508                         # HACK: A very bizarre and most certainly broken filename made perl whine, so I added encode_entities
 509                         if (defined $data) {
 510                                 $heap->{"folder-" . md5_hex(encode_entities($info->{title}))} = "" unless exists $heap->{"folder-" . md5_hex(encode_entities($info->{title}))};
 511                                 $heap->{"folder-" . md5_hex(encode_entities($info->{title}))} .= $data;
 512                         } else {
 513                                 $kernel->yield('subfolder_parse');
 514                         }
 515                 },
 516                 # Parses folder listings, pushes subitems to allowed_files, folders last
 517                 # This makes subfolders be checked before files
 518                 subfolder_parse => sub {
 519                         my $heap = $_[HEAP];
 520
 521                         my $info = $heap->{info};
 522                         my @lines = split m/\n/, $heap->{"folder-" . md5_hex(encode_entities($info->{title}))};
 523                         my @files = ();
 524                         my @folders = ();
 525                         foreach (@lines) {
 526                                 if (m!<td class="n"><a href="(.*?)">.*<td class="t">Directory</td>!) {
 527                                         next if $1 eq "../";
 528                                         push @folders, $1;
 529                                 } elsif (m!<td class="n"><a href=".*?">(.*?)</a></td>.*<td class="s">(.*?)</td>!) {
 530                                         push @files, [$1, $2];
 531                                 }
 532                         }
 533
 534                         while ($_ = pop @files) {
 535                                 my $finfo = {%{$info}};
 536                                 $finfo->{title}    = $info->{title};
 537                                 $finfo->{title}   .= '/' unless $finfo->{title} =~ m!/$!;
 538                                 $finfo->{title}   .= entity_clean($_->[0]);
 539                                 $finfo->{url}      = $info->{url} . entity_clean($_->[0]),
 540                                 $finfo->{size}     = $_->[1];
 541
 542                                 my $skip = 0;
 543                                 foreach (@{$heap->{completed_files}}) {
 544                                         if ($finfo->{title} eq $_) {
 545                                                 $skip = 1;
 546                                                 last;
 547                                         }
 548                                 }
 549                                 push @{$heap->{allowed_files}}, $finfo unless $skip;
 550                         }
 551                         # There is no trailing slash on the title
 552                         # There IS a trailing slash on folder URLs
 553                         foreach (@folders) {
 554                                 my $subinfo = {%{$info}}; # make a copy
 555                                 $subinfo->{title}  = $info->{title};
 556                                 $subinfo->{title} .= '/' unless $subinfo->{title} =~ m!/$!;
 557                                 $subinfo->{title} .= entity_clean($_);
 558                                 $subinfo->{title} .= '/' unless $subinfo->{title} =~ m!/$!;
 559                                 $subinfo->{url}    = $info->{url} . entity_clean($_);
 560
 561                                 my $skip = 0;
 562                                 foreach (@{$heap->{completed_files}}) {
 563                                         if ($subinfo->{title} eq $_) {
 564                                                 $skip = 1;
 565                                                 last;
 566                                         }
 567                                 }
 568                                 push @{$heap->{allowed_files}}, $subinfo unless $skip;
 569                         }
 570
 571                         delete $heap->{"folder-" . md5_hex(encode_entities($info->{title}))};
 572                         $heap->{info} = undef;
 573                         delete $heap->{info};
 574                 },
 575                 # Actually downloads files
 576                 download_file => sub {
 577                         my ($kernel, $heap, $info) = @_[KERNEL, HEAP, ARG0];
 578
 579                         my $req = HTTP::Request->new(GET => $info->{url});
 580                         $req->header (Accept_Ranges => "bytes");
 581                         $heap->{have_size} = mysize($info->{title});
 582                         if ($heap->{have_size}) {
 583                                 $req->header (Range => "bytes=". $heap->{have_size} ."-");
 584                         } else {
 585                                 $heap->{have_size} = 0;
 586                         }
 587                         # 120 is the max length of the string on-screen
 588                         # TODO: make length customizable and/or somehow detect from the terminal the optimal length
 589                         $heap->{progress_message} = "\"" . shorten_path($info->{title}, 120) ."\" (". $info->{size} ."): ";
 590                         myprint($heap->{progress_message});
 591
 592                         $heap->{filename} = $info->{title};
 593
 594                         $heap->{last_time} = time;
 595                         $heap->{start_time} = $heap->{last_time};
 596                         $heap->{len} = 0;
 597                         $heap->{oct} = 0;
 598                         $kernel->delay('calculate_speed' => 2);
 599                         $kernel->call('ua', 'request', 'stream_file', $req, $reqid++, 'file_progress');
 600                 },
 601                 # Does the actual file downloading
 602                 stream_file => sub {
 603                         my ($kernel, $heap, $req, $res, $data) =
 604                                         (@_[KERNEL, HEAP, ARG0], @{$_[ARG1]});
 605
 606                         die $res->status_line unless $res->is_success or $res->status_line =~ /^416/;
 607
 608                         if (defined($data)) {
 609                                 unless ($heap->{outfh} and $heap->{content_length}) {
 610                                         $heap->{filename} =~ m!(.*)/!;
 611                                         mymkpath($1) if $1;
 612                                         $heap->{outfh} = myopen('>>',$heap->{filename});
 613                                         $heap->{content_length} = $res->header('Content-Length');
 614                                         # This is probably wrong
 615                                         if ($heap->{content_length} == $heap->{have_size}) {
 616                                                 myclose($heap->{outfh});
 617                                                 $kernel->call($_[SESSION], 'mark_as_completed', $heap->{filename});
 618                                                 $kernel->post('ua', 'cancel', $req);
 619                                                 $kernel->yield('download_entries');
 620                                         }
 621                                 }
 622                                 unless ($heap->{outfh} && mysyswrite($heap->{outfh}, $data)) {
 623                                         die "$!";
 624                                 }
 625                         } else { # Finished
 626                                 unless ($res->is_success or $res->status_line =~ /^416/) { # Requested Range not satisfiable
 627                                         die $res->status_line;
 628                                 }
 629                                 $kernel->call($_[SESSION], 'mark_as_completed', $heap->{filename});
 630                                 myclose($heap->{outfh});
 631                                 delete $heap->{outfh};
 632                                 $kernel->yield('download_entries');
 633                         }
 634                 },
 635                 calculate_speed => sub {
 636                         my ($kernel, $heap) = @_[KERNEL, HEAP];
 637
 638                         my $now = time;
 639                         if ($now == $heap->{last_time}) {
 640                                 $kernel->delay('calculate_speed' => 0.5);
 641                                 return;
 642                         }
 643                         my $spd = $heap->{oct} / 1024 / ($now - $heap->{last_time});
 644                         unless (defined $heap->{speeds}) {
 645                                 $heap->{speeds} = [];
 646                                 $heap->{speeds_i} = 0;
 647                                 for(my $i = 0; $i < 8; $i++) { $heap->{speeds}->[$i] = $spd; }
 648                         }
 649                         $heap->{speeds}->[$heap->{speeds_i}++] = $spd;
 650                         $heap->{speeds_i} %= @{$heap->{speeds}};
 651                         $heap->{oct} = 0;
 652
 653                         $heap->{spd} = 0;
 654                         foreach (@{$heap->{speeds}}) { $heap->{spd} += $_; }
 655                         $heap->{spd} /= @{$heap->{speeds}};
 656
 657                         $heap->{last_time} = time;
 658                         $kernel->delay('calculate_speed' => 0.5);
 659                 },
 660                 calculate_avg_speed => sub {
 661                         my $heap = $_[HEAP];
 662
 663                         my $now = time;
 664                         $heap->{spd} = $heap->{len} / 1024 / ($now - $heap->{start_time});
 665                 },
 666                 # Prints the progress report
 667                 file_progress => sub {
 668                         my ($kernel, $heap, $pos, $len, $oct)  = (@_[KERNEL, HEAP], @{$_[ARG1]});
 669
 670                         if ($pos eq $len) {
 671                                 $kernel->call($_[SESSION], 'calculate_avg_speed');
 672                                 my $line = sprintf("100.00%% (avg. %4.2f kB/s)", $heap->{spd});
 673                                 $heap->{prevlen} = 0 unless $heap->{prevlen};
 674                                 myprint("\r" . $heap->{progress_message} . " $line" . (" " x ($heap->{prevlen} - length($line))) . "\n");
 675                                 delete $heap->{have_size};
 676                                 delete $heap->{prev_time};
 677                                 delete $heap->{prevlen};
 678                                 delete $heap->{spd};
 679                                 delete $heap->{speeds};
 680                                 $heap->{speeds_i} = 0;
 681                                 $kernel->delay('calculate_speed');
 682                         } else {
 683                                 my $have_size = exists $heap->{have_size} ? $heap->{have_size} : 0;
 684
 685                                 my $spd = $heap->{spd} ? $heap->{spd} : undef;
 686
 687                                 my $octlen = length($oct);
 688                                 $heap->{oct} += $octlen;
 689                                 $heap->{len} += $octlen;
 690
 691                                 # $have_size may be a BigInt, use fixed point math / formatters
 692                                 my $pct = ($pos + $have_size)*10000/($len + $have_size);
 693
 694                                 my $line;
 695                                 if (defined($spd)) {
 696                                         $line = sprintf("%2d.%02d%% (%4.2f kB/s)", $pct / 100, $pct % 100, $spd);
 697                                 } else {
 698                                         $line = sprintf("%2d.%02d%%", $pct / 100, $pct % 100);
 699                                 }
 700                                 $heap->{prevlen} = length($line) unless defined $heap->{prevlen} and $heap->{prevlen} > length($line);
 701                                 myprint("$line" . (" " x ($heap->{prevlen} - length($line))) . "\r" . $heap->{progress_message});
 702                                 $heap->{prevlen} = length($line);
 703                         }
 704                 }
 705         }
 706 );
 707
 708 POE::Kernel->run();