Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Generate a table.

  • Loading branch information...
commit 402a493e3b5f51f3435d7141e6da0b69d4796f46 1 parent 7a677a9
Dave Cross authored August 26, 2013

Showing 2 changed files with 135 additions and 0 deletions. Show diff stats Hide diff stats

  1. 112  get_rpm_table
  2. 23  table.tt
112  get_rpm_table
... ...
@@ -0,0 +1,112 @@
  1
+#!/usr/bin/perl
  2
+
  3
+use strict;
  4
+use warnings;
  5
+
  6
+use Getopt::Std;
  7
+use Parse::CPAN::Packages;
  8
+use Template;
  9
+
  10
+my %opts;
  11
+
  12
+getopts('p:d:r:', \%opts);
  13
+
  14
+my $packfile = $opts{p}
  15
+  || $ENV{CPAN_PACKFILE}
  16
+  || '/home/dave/cpan/modules/02packages.details.txt.gz';
  17
+
  18
+unless (-f $packfile) {
  19
+  require LWP::Simple;
  20
+
  21
+  warn "Downloading 02packages\n";
  22
+  LWP::Simple::getstore('http://www.cpan.org/modules/02packages.details.txt.gz',
  23
+                        $packfile);
  24
+};
  25
+
  26
+my $cmd = q(repoquery --repoid=REPO ) .
  27
+          q(--qf="%{name},%{version},%{vendor},%{repoid}" 'perl-*');
  28
+
  29
+my %repos = (
  30
+	     fedora => [ qw(fedora updates magnum rpmfusion-free
  31
+			    rpmfusion-nonfree rpmfusion-free-updates
  32
+			    rpmfusion-nonfree-updates) ],
  33
+	     centos => [ qw(base updates epel magnum rpmforge) ],
  34
+	    );
  35
+
  36
+my $dist = $opts{d};
  37
+
  38
+unless ($dist) {
  39
+  open my $rel, '<', '/etc/redhat-release' or
  40
+    die "Can't open redhat-release: $!\n";
  41
+  ($dist) = <$rel> =~ /^(\w+)/;
  42
+  $dist = lc $dist;
  43
+}
  44
+
  45
+die "$dist is an unknown distribution\n" unless exists $repos{$dist};
  46
+
  47
+my @repos;
  48
+
  49
+if ($opts{r}) {
  50
+  @repos = split /,/, $opts{r};
  51
+} else {
  52
+  @repos = @{ $repos{$dist} };
  53
+}
  54
+
  55
+my @cols = qw(name version vendor repo);
  56
+
  57
+my $rpm;
  58
+
  59
+my %xlate = (' http://dag.wieers.com/apt/' => 'rpmforge');
  60
+
  61
+foreach my $r (@repos) {
  62
+  my $exec = $cmd;
  63
+  $exec =~ s/REPO/$r/;
  64
+
  65
+  foreach (`$exec`) {
  66
+    chomp;
  67
+    my %rec;
  68
+    @rec{@cols} = split /,/;
  69
+
  70
+    if (exists $xlate{$rec{repo}}) {
  71
+      $rec{repo} = $xlate{$rec{repo}};
  72
+    }
  73
+
  74
+    $rpm->{$rec{name}}{$rec{repo}} = $rec{version};
  75
+  }
  76
+}
  77
+
  78
+my $p = Parse::CPAN::Packages->new($packfile);
  79
+
  80
+#print 'Distribution name,cpan,', join ',', @repos;
  81
+#print "\n";
  82
+
  83
+my @table;
  84
+foreach (sort keys %$rpm) {
  85
+  my $distname = $_;
  86
+  $distname =~ s/^perl-//;
  87
+  my $dist = $p->latest_distribution($distname);
  88
+
  89
+  if ($dist) {
  90
+    $rpm->{$_}{cpan} = $dist->version;
  91
+  }
  92
+
  93
+  my @out;
  94
+  push @out, $_;
  95
+
  96
+  foreach my $r ('cpan', @repos) {
  97
+    if (exists $rpm->{$_}{$r}) {
  98
+       push @out, $rpm->{$_}{$r};
  99
+    } else {
  100
+       push @out, '';
  101
+    }
  102
+  }
  103
+
  104
+  push @table, \@out;
  105
+}
  106
+
  107
+my $t = Template->new;
  108
+$t->process('table.tt', {
  109
+  table => \@table,
  110
+  repos => ['CPAN', @repos],
  111
+  dist  => $dist }, "$dist.html")
  112
+  or die $t->error;
23  table.tt
... ...
@@ -0,0 +1,23 @@
  1
+<html>
  2
+  <head>
  3
+    <title>RPMs for [% dist %]</title>
  4
+  <head>
  5
+  <body>
  6
+    <h1>RPMs for [% dist %]</h1>
  7
+    <table>
  8
+      <tr>
  9
+        <th>Distribution</th>
  10
+[% FOREACH repo IN repos -%]
  11
+        <th>[% repo %]</th>
  12
+[% END -%]
  13
+      </tr>
  14
+[% FOREACH row IN table -%]
  15
+      <tr>
  16
+[%   FOREACH cell IN row -%]
  17
+        <td>[% cell %]</td>
  18
+[%   END -%]
  19
+      </tr>
  20
+[% END -%]
  21
+    </table>
  22
+  </body>
  23
+</html>

0 notes on commit 402a493

Please sign in to comment.
Something went wrong with that request. Please try again.