Generated: Tue Feb 2 17:54:30 2010 from download.pl 2008/08/01 3.2 KB.
#!perl -w # NAME: download.pl # AIM: Download a file from the web # that is get a url - get url - fetch url - download url # if it is a binary file, then this will download that binary, # however if say a PHP or ASP, then only the HTML output will be received. # 01/08/2008 geoff mclane http://geoffair.net/mperl use strict; use warnings; use LWP::Simple; use LWP::UserAgent; require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); ###prt( "$0 ... Hello, World ...\n" ); # SET THE FILE TO FETCH ####################### my $get_url = 'http://hommage.iriscreations.net/event.php?ev_id=37&action=valider&btn_valider=View+event'; ###my $get_url = 'http://hommage.iriscreations.net/retail_locations.php'; ###my $get_url = 'http://hommage.iriscreations.net/FLVPlayer_Progressive.swf'; ###my $get_url = 'http://hommage.iriscreations.net/menu.swf'; ##my $get_url = 'http://www.google.com/uds/css/green_settings.gif'; ##my $get_url = 'http://www.google.com/uds/css/green_check.gif'; # program variables my $input = ''; prt( "Fetch $get_url\n" ); # assume ends in a file name, before parameters, if any ... my $infile = 'temptemp.fil'; my $ind = rindex($get_url, '/'); if ($ind > 0) { $infile = substr($get_url,($ind + 1)); $ind = index($infile, '?'); if ($ind > 0) { $infile = substr($infile,0,$ind); } prt( "Got in file name of [$infile] ...\n" ); if (-f $infile) { prt( "WARNING: $infile already exists! OVERWRITE? Y to continue ... :" ); $input = <STDIN>; prt( "$input\n" ); if ($input =~ /^y/i) { prt( "Continuing ...\n" ); } else { prt( "Aborting ...\n" ); exit(0); } } } # don't buffer the prints to make the status update $| = 1; open(IN,"> $infile") or mydie( "FAILED to create $infile ... $! ...\n" ); binmode(IN); my $ua = LWP::UserAgent->new(); my $received_size = 0; my $url = $get_url; prt( "Fetching $url\n" ); my $request_time = time; my $last_update = 0; my $response = $ua->get($url, ':content_cb' => \&callback, ':read_size_hint' => 8192, ); prt( "\n" ); close IN; #play the flv file with mplayer ###system( $infile ); close_log($outfile,0); exit(0); ################################################################### sub callback { my ($data, $response, $protocol) = @_; my $total_size = $response->header('Content-Length') || 0; $received_size += length $data; # write the $data to a filehandle or whatever should happen # with it here. print IN $data; my $time_now = time; # this to make the status only update once per second. return unless $time_now > $last_update or $received_size == $total_size; $last_update = $time_now; prt( "\rReceived $received_size bytes" ); prt( printf " (%i%%)", (100/$total_size)*$received_size ) if $total_size; prt( printf " %6.1f/bps", $received_size/(($time_now-$request_time)||1) ) if $received_size; } # eof - download.pl