view release on metacpan or  search on metacpan

get_flash_videos  view on Meta::CPAN

    info "Development version, not updated";
  }

  update_plugins();

  return 0; # exit code
}

sub update_script {
  my($browser, $url, $info) = @_;

  info "Downloading new version...";
  die "Cannot update -- unable to write to $0\n" unless -w $0;

  my $new_file = $0 . ".new";
  $browser->mirror($url, $new_file);

  if($browser->response->is_success && -f $new_file) {
    rename $0, "$0.old" or die "Unable to rename $0 to $0.old: $!";
    rename $new_file, $0 or die "Unable to rename $new_file to $0: $!";
    chmod 0755, $0;

    info "New version installed as $0";
    info "(previous version backed up to $0.old).";
    info $info;
  } else {
    die "Download failed: " . $browser->response->status_line;
  }
}

sub update_plugins {
  my $browser = FlashVideo::Mechanize->new;

  foreach my $plugin(get_installed_plugins()) {
    debug "Seeing if there is an update for $plugin..";

    my $file = get_plugin_dir() . "/$plugin";
    require $file;

    my $package = "FlashVideo::Site::" . ($plugin =~ /(.*)\.pm$/)[0];

    if($package->can("update")) {
      # Allow plugin to override generic updater
      $package->update();
    } else {
      no strict 'refs';

      my $downloaded  = 0;
      my $newer_found = 0;

      foreach my $update_url (@{ "$package\::update_urls" }) {
        $browser->head($update_url);

        if (!$browser->response->is_success) {
          # This shouldn't be fatal
          debug "Couldn't retrieve $update_url for $plugin: " . $browser->response->status_line;
          next;
        }

        # Compare the last modified time of the plugin to the time of the file on disk
        my $file_mtime = stat($file)->mtime;

        my $remote_plugin_mtime = $browser->response->last_modified;

        if ($remote_plugin_mtime > $file_mtime) {
          info "Newer version of plugin $plugin found at $update_url, trying to download and install";
          $newer_found = 1;

          if ($downloaded = install_plugin($browser, $update_url, $file)) {
            last;
          }
        }
        else {
          debug "Plugin $plugin is already the lastest version.";
          debug "(Remote: " . $browser->response->header("Last-Modified")
            . "; Local: " . gmtime($file_mtime) . " GMT)";
        }
      }

      if ($newer_found and !$downloaded) {
        die "Couldn't install $plugin plugin";
      }
    }
  }
}

# Upgrade a plugin or install a new one.
sub install_plugin {
  my ($browser, $url, $file) = @_;

  # So we can track newly installed plugins as well as updated ones
  my $plugin_exists = -f $file;

  my $new_file = $plugin_exists ? "$file.new" : $file;

  $browser->mirror($url, $new_file);

  if ($browser->response->is_success && -f $new_file) {
    my $short_name = basename($file);

    if ($plugin_exists) {
      rename $file, "$file.old" or die "Unable to rename $file to $file.old: $!";
      rename $new_file, $file   or die "Unable to rename $new_file to $file: $!";

      info "New version of $short_name installed as $file";
      info "(previous version backed up to $file.old).";
    }
    else {
      info "New plugin $short_name installed as $file";
    }

    return 1;
  }
  else {
    warn "Download failed: " . $browser->response->status_line;
  }

  return 0;
}

# Coderef to this in @INC means Perl will call it for every module that it