File: deprecate_codes

package info (click to toggle)
liblocale-codes-perl 3.82-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 4,756 kB
  • sloc: perl: 137,696; sh: 22; makefile: 2
file content (134 lines) | stat: -rwxr-xr-x 3,856 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#!/usr/bin/perl -w

use lib "./lib";
use IO::File;
use YAML::Syck qw(LoadFile DumpFile);
use Locale::Codes::Constants;
use Locale::Codes::Country_Retired;
use Locale::Codes::Language_Retired;
use Locale::Codes::Currency_Retired;
use Locale::Codes::Script_Retired;
use Locale::Codes::LangExt_Retired;
use Locale::Codes::LangVar_Retired;

############################################################################

our %mod_list = qw(country     Country
                   currency    Currency
                   langext     LangExt
                   langvar     LangVar
                   language    Language
                   script      Script
                 );

our $curr    = "internal/curr.yaml";
our $prev    = "internal/prev.yaml";

our %curr    = %{ LoadFile($curr) };
our %prev    = %{ LoadFile($prev) };

our $mod_dir = "lib/Locale/Codes";

############################################################################
############################################################################

foreach my $type (keys %mod_list) {
   update_retired($type);
   write_module($type);
}

############################################################################
# UPDATE_MODULE
############################################################################

sub update_retired {
   my($type)  = @_;
   my $module = $mod_list{$type};

   foreach my $codeset (keys %{ $ALL_CODESETS{$type}{'codesets'} }) {
      foreach my $code (keys %{ $prev{$type}{$codeset}{'code'} }) {
         next  if (exists $curr{$type}{$codeset}{'code'}{$code});
         my $name = $prev{$type}{$codeset}{'code'}{$code};

         $Locale::Codes::Retired{$type}{$codeset}{'code'}{$code} = $name;
      }

      foreach my $lc (keys %{ $prev{$type}{$codeset}{'name'} }) {
         next  if (exists $curr{$type}{$codeset}{'name'}{$lc});
         my($code,$name) = @{ $prev{$type}{$codeset}{'name'}{$lc} };

         $Locale::Codes::Retired{$type}{$codeset}{'name'}{$lc} =
           [$code,$name];
      }
   }
}

############################################################################
# WRITE_MODULE
############################################################################

sub write_module {
   my($type)  = @_;
   my $module = $mod_list{$type};

   my $file   = "$mod_dir/${module}_Retired.pm";

   my $out    = new IO::File;
   $out->open(">$file");
   my $timestamp   = `date`;
   chomp($timestamp);

   print $out "package #
Locale::Codes::${module}_Retired;

# This file was automatically generated.  Any changes to this file will
# be lost the next time 'deprecate_codes' is run.
#    Generated on: $timestamp

use strict;
require 5.006;
use warnings;
use utf8;

our(\$VERSION);
\$VERSION='3.82';

";

   foreach my $codeset (sort keys %{ $ALL_CODESETS{$type}{'codesets'} }) {
      print $out "\$Locale::Codes::Retired{'$type'}{'$codeset'}{'code'} = {\n";
      foreach my $code (sort keys %{ $Locale::Codes::Retired{$type}{$codeset}{'code'} }) {
         my $name = $Locale::Codes::Retired{$type}{$codeset}{'code'}{$code};
         print $out "   q($code) => q($name),\n";
      }
      print $out "};\n\n";
   }

   foreach my $codeset (sort keys %{ $ALL_CODESETS{$type}{'codesets'} }) {
      print $out "\$Locale::Codes::Retired{'$type'}{'$codeset'}{'name'} = {\n";
      foreach my $lc (sort keys %{ $Locale::Codes::Retired{$type}{$codeset}{'name'} }) {
         my ($code,$name) =
           @{ $Locale::Codes::Retired{$type}{$codeset}{'name'}{$lc} };
         print $out "   q($lc) => [ q($code), q($name) ],\n";
      }
      print $out "};\n\n";
   }

   print $out "
1;
";
   $out->close();
}

1;

# Local Variables:
# mode: cperl
# indent-tabs-mode: nil
# cperl-indent-level: 3
# cperl-continued-statement-offset: 2
# cperl-continued-brace-offset: 0
# cperl-brace-offset: 0
# cperl-brace-imaginary-offset: 0
# cperl-label-offset: 0
# End: