download.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional