view release on metacpan or  search on metacpan

lib/CPAN/Search/Lite/PPM.pm  view on Meta::CPAN

		curr_mtimes => {}, update_mtimes => {}};
    bless $self, $class;
}

sub fetch_info {
  my $self = shift;
  unless ($self->{setup}) {
    $self->fetch_mtime() or return;
  }
  my $dists = $self->{dists};
  my $ppm = {};
  for my $id (keys %$repositories) {
    my $location = $repositories->{$id}->{LOCATION};
    print "Getting ppm information from $location\n";
    my $packages = $self->summary($id, $location);
    next unless $packages;
    if (ref($packages) eq 'HASH') {
      foreach my $package (keys %$packages) {
	next unless $dists->{$package};
	my $version = ppd2cpan_version($packages->{$package}->{version});
	my $abstract = $packages->{$package}->{abstract};
	$dists->{$package}->{description} = $abstract
	  unless $dists->{$package}->{description};
	$ppm->{$id}->{$package} = {
				   version => $version,
				   abstract => $abstract,
				  };
      }
    }
    else {
      $ppm->{$id} = 1;
    }
  }
  $self->{ppms} = $ppm;
  $self->update_mtime() if (has_data($self->{update_mtimes}));
  return 1;
}

sub fetch_mtime {
  my $self = shift;
  my $mtimes = {};
  unless ($dbh) {
    $self->{error_msg} = q{No db handle available};
    return;
  }
  my $sql = q{ SELECT rep_id,mtime FROM reps };
  my $sth = $dbh->prepare($sql);
  $sth->execute() or do {
    $self->db_error($sth);
    return;
  };
  while (my ($rep_id, $mtime) = $sth->fetchrow_array) {
    next unless $rep_id;
    $mtimes->{$rep_id} = $mtime;
  }
  $sth->finish;
  $self->{curr_mtimes} = $mtimes;
  return 1;
}

sub update_mtime {
  my $self = shift;
  my $mtimes = $self->{update_mtimes};
  unless ($dbh) {
    $self->{error_msg} = q{No db handle available};
    return;
  }
  my $sth;
  foreach my $id(keys %$mtimes) {
    my $mtime = $mtimes->{$id};
    next unless (defined $id and defined $mtime);
    my $sql = q{ UPDATE LOW_PRIORITY reps } .
      qq{ SET mtime="$mtime" WHERE rep_id=$id};
    $sth = $dbh->prepare($sql);
    $sth->execute() or do {
      $self->db_error($sth);
      return;
    };
    $sth->finish;
  }
  $dbh->commit or do {
    $self->db_error($sth);
    return;
  };
  return 1;
}

sub summary {
  my ($self, $id, $url) = @_;
  $url .= '/' unless $url =~ m@/$@;
  my $file;
  my ($type, $length, $mtime, $expires, $server);
  foreach my $try (@tries) {
    ($type, $length, $mtime, $expires, $server) = head("$url$try");
    if (defined $mtime) {
      $file = $try;
      last;
    }
  }
  unless (defined $mtime) {
    print "Could not get ppm info from $url\n";
    return;
  }

  my $mtimes = $self->{curr_mtimes};
  my $string = time2str($mtime);
  my ($wday, $day, $month, $year, $time, $tz) = split ' ', $string;
  my $stamp = "$year-$months{$month}-$day $time";
  if (defined $mtimes->{$id} and $mtimes->{$id} eq $stamp) {
    print "$url is up to date\n";
    return 1;
  }

  $arch = $arch{$repositories->{$id}->{PerlV}};
  my $packages = parse($url, $file);
  unlink $file;
  unless (has_data($packages)) {
    print "Info from $url contains no data\n";
    return;
  }
  $self->{update_mtimes}->{$id} = $stamp;