[Pkg-ocaml-maint-commits] [SCM] dh-ocaml packaging branch, master, updated. debian/0.5.0-4-g3490f28

[Sylvain Le Gall]

The following commit has been merged in the master branch:
commit 9e3e7928ca90e43ecfc956dfb4b06bbd79387200
Author: Sylvain Le Gall <gildor at debian.org>
Date:   Sun Jul 19 12:08:07 2009 +0200

    Rewrite ocaml-md5sums in perl.

diff --git a/ocaml-md5sums/ocaml-md5sums.pl b/ocaml-md5sums/ocaml-md5sums.pl
new file mode 100755
index 0000000..e110229
--- /dev/null
+++ b/ocaml-md5sums/ocaml-md5sums.pl
@@ -0,0 +1,360 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+my $verbose = 0;
+
+use constant VERSION => "0.1";
+
+sub info 
+{
+  print STDERR (@_, "\n") if $verbose;
+};
+
+package OCamlMD5Sums::File;
+
+use warnings;
+use strict;
+
+use Carp::Assert;
+use File::Find;
+
+sub new 
+{
+  my ($class, 
+      $dev, 
+      $runtime, 
+      $version) = @_;
+
+  my $self = ();
+  $self->{dev} = defined $dev ? $dev : "-";
+  $self->{runtime} = defined $runtime ? $runtime : "-";
+  $self->{version} = defined $version ? $version : "-";
+  $self->{exported} = ();
+  $self->{imported} = ();
+
+  bless $self, $class;
+  return $self;
+};
+
+sub squeeze_imported 
+{
+  my ($self) = @_;
+
+  foreach (keys(%{$self->{exported}}))
+  {
+    delete($self->{imported}{$_}) 
+      if exists($self->{imported}{$_});
+  };
+};
+
+sub add_object
+{
+  my ($self, $obj_file) = @_;
+
+  my $interface = undef;
+  my $symbol_table = undef;
+
+  foreach (`ocamlobjinfo $obj_file`)
+  {
+    if (/^\s*(Unit|Module) name: (\S+)$/)
+    {
+      $interface = $2;
+      main::info "Interface: $interface";
+    };
+    if (/^\s*([a-fA-F0-9]+)\s+(\S+)$/)
+    {
+      $symbol_table = "imported";
+      $symbol_table = "exported" if defined($interface) && ($interface eq $2);
+
+      warn "Already defined $interface is redefined with a different signatures" 
+      if defined($interface) 
+      && exists($self->{$symbol_table}{$2}) 
+      && $self->{$symbol_table}{$2} ne $1;
+
+      $self->{$symbol_table}{$2} = $1;
+      if ($symbol_table eq "exported")
+      {
+        if (exists($self->{imported}{$2}))
+        {
+          warn "Already required $interface is defined with a different signatures"
+          if defined($interface) 
+          && $self->{imported}{$2} ne $self->{exported}{$2};
+          delete($self->{imported}{$2});
+        };
+      };
+    };
+  };
+
+  $self->squeeze_imported();
+};
+
+sub read_dump
+{
+  my ($self, $file) = @_;
+  
+  my $section = undef;
+
+  open(FH, $file) || die "Cannot open file $file";
+  foreach (<FH>)
+  {
+    my ($section,$md5,$unit_name) = split /\s+/;
+    $section = "exported" if $section eq "defined";
+    $self->{$section}{$unit_name} = $md5;
+  };
+  close(FH) || die "Cannot close file $file";
+};
+
+sub write_dump
+{
+  my ($self, $file) = @_;
+
+  open(FH,">", $file) || die "Cannot open file $file";
+  print FH "imported $self->{imported}{$_} $_\n"
+   foreach (keys(%{$self->{imported}}));
+  print FH "defined  $self->{exported}{$_} $_\n"
+    foreach (keys(%{$self->{exported}}));
+  close(FH);
+};
+
+sub print
+{
+  my ($self) = @_;
+  print  
+    (join 
+      (" ",
+       $self->{exported}{$_}, 
+       $_, 
+       $self->{dev}, 
+       $self->{runtime}, 
+       $self->{version}),
+       "\n")
+    foreach (keys(%{$self->{exported}}));
+};
+
+sub load_assign 
+{
+  my ($self, $key, $b) = @_;
+  my $a = $self->{$key};
+
+  if ($a eq $b)
+  {
+    $self->{$key} = $a;
+  }
+  elsif ($a eq "-")
+  {
+    $self->{$key} = $b;
+  }
+  elsif ($b eq "-")
+  {
+    $self->{$key} = $a;
+  }
+  else
+  {
+    warn "$key is already defined as $a but trying to use $b instead";
+  };
+};
+
+sub load 
+{
+  my ($self, $file) = @_;
+  open(FH, "<", $file) || die "Cannot open file $file";
+  foreach (<FH>)
+  {
+    my ($md5, $unit_name, $dev, $runtime, $version) = split /\s+/;
+    $self->load_assign("dev", $dev);
+    $self->load_assign("runtime", $runtime);
+    $self->load_assign("version", $version);
+    $self->{exported}{$unit_name} = $md5;
+  };
+  close(FH);
+};
+
+# Check that self depends on another package
+sub depends_on
+{
+  my ($self, $other) = @_;
+
+  foreach (keys(%{$self->{imported}}))
+  {
+    if (defined $other->{exported}{$_} &&
+        $self->{imported}{$_} eq $other->{exported}{$_})
+    {
+      return 1;
+    };
+  };
+
+  return 0;
+};
+
+sub print_dep 
+{
+  my ($self) = @_;
+
+  print "$self->{dev} $self->{runtime} $self->{version}\n";
+};
+
+1;
+
+package main;
+
+use File::Spec;
+use Getopt::Long;
+use Pod::Usage;
+use File::Glob;;
+
+my $man = 0;
+my $help = 0;
+my $action = undef;
+my @objects;
+my $package_dev;
+my $package_runtime;
+my $package_version;
+my $dump_info_fn;
+my $load_info_fn;
+my $print_version;
+my $md5sums_dir="/var/lib/ocaml/md5sums";
+
+sub process_not_option
+{
+  if (defined($action)) 
+  {
+    push @objects, @_; 
+  }
+  else 
+  {
+    $action = $_[0];
+  };
+}
+
+sub get_objects 
+{
+  my ($already_loaded) = @_;
+  return <STDIN> unless @objects > 0 || $already_loaded;
+  return @objects;
+}
+
+GetOptions(
+  "package=s"     => \$package_dev,
+  "runtime=s"     => \$package_runtime,
+  "version=s"     => \$package_version,
+  "dump-info=s"   => \$dump_info_fn,
+  "load-info=s"   => \$load_info_fn,
+  "md5sums-dir=s" => \$md5sums_dir,
+  "my-version"    => \$print_version,
+  "v"             => \$verbose,
+  "<>"            => \&process_not_option, 
+  "help|?"        => \$help, 
+  "man"           => \$man) or pod2usage(2);
+pod2usage(1) if $help;
+pod2usage(-exitstatus => 0, -verbose => 2) if $man;
+
+if ($print_version)
+{
+  print(VERSION,"\n");
+  exit 0;
+};
+
+die "No action\n" unless defined($action);
+
+if ($action eq "compute" || $action eq "dep") 
+{
+
+  my $md5sums = 
+    OCamlMD5Sums::File->new 
+      ($package_dev, 
+       $package_runtime,
+       $package_version);
+  $md5sums->read_dump($load_info_fn) if defined($load_info_fn);
+  foreach (get_objects(defined($load_info_fn)))
+  {
+    info("Processing $_");
+    $md5sums->add_object($_);
+  };
+
+  if ($action eq "compute")
+  {
+    die "No dev. package defined" unless defined($package_dev);
+    $md5sums->write_dump($dump_info_fn) if defined($dump_info_fn);
+    $md5sums->print();
+  }
+  else # dep
+  {
+    my @files = <$md5sums_dir/*.md5sums>;
+    foreach (@files)
+    {
+      my $other_md5sums = OCamlMD5Sums::File->new();
+      $other_md5sums->load($_);
+      if ($md5sums->depends_on($other_md5sums))
+      {
+        info "Depends on $_";
+        $other_md5sums->print_dep ();
+      };
+    };
+  }
+}
+elsif ($action eq "update")
+{
+  # do nothing, on purpose
+}
+else
+{
+  die "Unknown action $action\n";
+};
+
+__END__
+
+=head1 NAME
+
+ocaml-md5sum - Use and maintain ocaml md5sums registry files
+
+=head1 SYNOPSIS
+
+ocaml-md5sum compute --package <name> [option ...] file ...
+ocaml-md5sum dep     [option ...] file ...
+ocaml-md5sum update  [option ...]
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--package> pkg
+
+Set package name for development dependency.
+
+=item B<--runtime> pkg
+
+Set package name for runtime dependency.
+
+=item B<--version> ver
+
+Set package version for dependencies.
+
+=item B<--dump-info> fn
+
+Dump ocamlobjinfo to file.
+
+=item B<--load-info> fn
+
+Restore ocamlobjinfo from file.
+
+=item B<-v>
+
+Increase verbosity.
+
+=item B<--my-version>
+
+Print ocaml-md5sum version and exit.
+
+=item B<-help>
+
+Print a brief help message and exits.
+
+=item B<-man>
+
+Prints the manual page and exits.
+
+=back
+
+=cut

-- 
dh-ocaml packaging