pctb/Commods.pm

   1
   2 package Commods;
   3 use IO::File;
   4
   5 use strict;
   6 use warnings;
   7
   8 BEGIN {
   9     use Exporter ();
  10     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  11     $VERSION     = 1.00;
  12     @ISA         = qw(Exporter);
  13     @EXPORT      = qw(&parse_masters %oceans %commods %clients
  14                       &parse_pctb_commodmap %pctb_commodmap @pctb_commodmap
  15                       &get_our_version);
  16     %EXPORT_TAGS = ( );
  17
  18     @EXPORT_OK   = qw();
  19 }
  20
  21 our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources;
  22 our %commods; # eg $commods{'Fine black cloth'}= $sources;
  23 our %clients; # eg $clients{'ypp-sc-tools'}= [ qw(last-page) ];
  24 # $sources = 's[l]b';
  25 #       's' = Special Circumstances; 'l' = local ; B = with Bleach
  26
  27 our (%pctb_commodmap,@pctb_commodmap);
  28
  29 my %colours; # eg $colours{'c'}{'black'}= $sources
  30 my @rawcm; # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth'
  31
  32 sub parse_master_master1 ($$) {
  33     my ($mmfn,$src)= @_;
  34     my $mm= new IO::File $mmfn, 'r' or die "$mmfn $!";
  35     my @ctx= ();
  36     while (<$mm>) {
  37         next if m/^\s*\#/;
  38         next unless m/\S/;
  39         s/\s+$//;
  40         if (m/^\%(\w+)$/) {
  41             my $colourkind= $1;
  42             @ctx= (sub { $colours{$colourkind}{lc $_} .= $src; });
  43         } elsif (m/^commods$/) {
  44             @ctx= (sub { push @rawcm, lc $_; });
  45         } elsif (m/^ocean (\w+)$/) {
  46             my $ocean= $1;
  47             @ctx= (sub {
  48                 $ocean or die; # ref to $ocean needed to work
  49                                # around a perl bug
  50                 my $arch= $_;
  51                 $ctx[1]= sub {
  52                     $oceans{$ocean}{$arch}{$_} .= $src;
  53                 };
  54             });
  55         } elsif (m/^client (\S+.*\S)$/) {
  56             my $client= $1;
  57             $clients{$client}= [ ];
  58             @ctx= (sub {
  59                 my $bug= $_;
  60                 push @{ $clients{$client} }, $bug;
  61             });
  62         } elsif (s/^ +//) {
  63             my $indent= length $&;
  64             die "wrong indent $indent" unless defined $ctx[$indent-1];
  65             &{ $ctx[$indent-1] }();
  66         } else {
  67             die "bad syntax";
  68         }
  69     }
  70     $mm->error and die $!;
  71     close $mm or die $!;
  72
  73 #print Dumper(\%oceans);
  74 #print Dumper(\@rawcm);
  75
  76     %commods= ();
  77     my $ca;
  78     $ca= sub {
  79         my ($s,$ss) = @_;
  80 #print "ca($s)\n";
  81         if ($s !~ m/\%(\w+)/) { $commods{ucfirst $s} .= $ss; return; }
  82         die "unknown $&" unless defined $colours{$1};
  83         foreach my $c (keys %{ $colours{$1} }) {
  84             &$ca($`.$c.$', $ss .'%'. $colours{$1}{$c});
  85         }
  86     };
  87     foreach (@rawcm) { &$ca($_,$src); }
  88 }
  89
  90 sub parse_masters () {
  91     parse_master_master1('master-master.txt','s');
  92 }
  93
  94 sub parse_pctb_commodmap () {
  95     undef %pctb_commodmap;
  96     foreach my $commod (keys %commods) { $commods{$commod} =~ s/b//; }
  97
  98     my $c= new IO::File '_commodmap.tsv' or die $!;
  99     if (!$c) { $!==&ENOENT or die $!; return 0; }
 100
 101     while (<$c>) {
 102         m/^(\S.*\S)\t(\d+)\n$/ or die "$_";
 103         die if defined $pctb_commodmap{$1};  $pctb_commodmap{$1}= $2;
 104         die if defined $pctb_commodmap[$2];  $pctb_commodmap[$2]= $1;
 105         $commods{$1} .= 'b';
 106     }
 107     $c->error and die $!;
 108     close $c or die $!;
 109     return 1;
 110 }
 111
 112 sub get_our_version ($) {
 113     my ($prefix);
 114     {
 115         no strict (qw(refs));
 116         ${ "${prefix}name"  }= 'ypp-sc-tools yarrg';
 117         ${ "${prefix}fixes" }= 'lastpage';
 118         ${ "${prefix}version" }= `git-describe --tags HEAD`;
 119         $? and die $?;
 120     }
 121 }
 122
 123 1;