cpan/Locale-Codes/lib/Locale/Codes.pm

   1 package Locale::Codes;
   2 # Copyright (C) 2001      Canon Research Centre Europe (CRE).
   3 # Copyright (C) 2002-2009 Neil Bowers
   4 # Copyright (c) 2010-2014 Sullivan Beck
   5 # This program is free software; you can redistribute it and/or modify it
   6 # under the same terms as Perl itself.
   7
   8 use strict;
   9 require 5.006;
  10 use warnings;
  11
  12 use Carp;
  13 use Locale::Codes::Constants;
  14
  15 #=======================================================================
  16 #       Public Global Variables
  17 #=======================================================================
  18
  19 # This module is not called directly... %Data is filled in by the
  20 # calling modules.
  21
  22 our($VERSION,%Data,%Retired);
  23
  24 # $Data{ TYPE }{ code2id   }{ CODESET } { CODE }  = [ ID, I ]
  25 #              { id2code   }{ CODESET } { ID }    = CODE
  26 #              { id2names  }{ ID }                = [ NAME, NAME, ... ]
  27 #              { alias2id  }{ NAME }              = [ ID, I ]
  28 #              { id        }                      = FIRST_UNUSED_ID
  29 #              { codealias }{ CODESET } { ALIAS } = CODE
  30 #
  31 # $Retired{ TYPE }{ CODESET }{ code }{ CODE } = NAME
  32 #                            { name }{ NAME } = [CODE,NAME]  (the key is lowercase)
  33
  34 $VERSION='3.31';
  35
  36 #=======================================================================
  37 #
  38 # _code ( TYPE,CODE,CODESET )
  39 #
  40 #=======================================================================
  41
  42 sub _code {
  43    return 1  if (@_ > 3);
  44
  45    my($type,$code,$codeset) = @_;
  46    $code = ''  if (! $code);
  47
  48    # Determine the codeset
  49
  50    $codeset = $ALL_CODESETS{$type}{'default'}
  51      if (! defined($codeset)  ||  $codeset eq '');
  52    $codeset = lc($codeset);
  53    return 1  if (! exists $ALL_CODESETS{$type}{'codesets'}{$codeset});
  54    return (0,$code,$codeset)  if (! $code);
  55
  56    # Determine the properties of the codeset
  57
  58    my($op,@args) = @{ $ALL_CODESETS{$type}{'codesets'}{$codeset} };
  59
  60    if      ($op eq 'lc') {
  61       $code = lc($code);
  62
  63    } elsif ($op eq 'uc') {
  64       $code = uc($code);
  65
  66    } elsif ($op eq 'ucfirst') {
  67       $code = ucfirst(lc($code));
  68
  69    } elsif ($op eq 'numeric') {
  70       return (1)  unless ($code =~ /^\d+$/);
  71       my $l = $args[0];
  72       $code    = sprintf("%.${l}d", $code);
  73    }
  74
  75    return (0,$code,$codeset);
  76 }
  77
  78 #=======================================================================
  79 #
  80 # _code2name ( TYPE,CODE [,CODESET] [,'retired'] )
  81 #
  82 #=======================================================================
  83
  84 sub _code2name {
  85    my($type,@args)         = @_;
  86    my $retired             = 0;
  87    if (@args > 0  &&  $args[$#args]  &&  $args[$#args] eq 'retired') {
  88       pop(@args);
  89       $retired             = 1;
  90    }
  91
  92    my($err,$code,$codeset) = _code($type,@args);
  93    return undef  if ($err  ||
  94                      ! defined $code);
  95
  96    $code = $Data{$type}{'codealias'}{$codeset}{$code}
  97      if (exists $Data{$type}{'codealias'}{$codeset}{$code});
  98
  99    if (exists $Data{$type}{'code2id'}{$codeset}  &&
 100        exists $Data{$type}{'code2id'}{$codeset}{$code}) {
 101       my ($id,$i) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
 102       my $name    = $Data{$type}{'id2names'}{$id}[$i];
 103       return $name;
 104
 105    } elsif ($retired  &&  exists $Retired{$type}{$codeset}{'code'}{$code}) {
 106       return $Retired{$type}{$codeset}{'code'}{$code};
 107
 108    } else {
 109       return undef;
 110    }
 111 }
 112
 113 #=======================================================================
 114 #
 115 # _name2code ( TYPE,NAME [,CODESET] [,'retired'] )
 116 #
 117 #=======================================================================
 118
 119 sub _name2code {
 120    my($type,$name,@args)   = @_;
 121    return undef  if (! $name);
 122    $name                   = lc($name);
 123
 124    my $retired             = 0;
 125    if (@args > 0  &&  $args[$#args]  &&  $args[$#args] eq 'retired') {
 126       pop(@args);
 127       $retired             = 1;
 128    }
 129
 130    my($err,$tmp,$codeset) = _code($type,'',@args);
 131    return undef  if ($err);
 132
 133    if (exists $Data{$type}{'alias2id'}{$name}) {
 134       my $id = $Data{$type}{'alias2id'}{$name}[0];
 135       if (exists $Data{$type}{'id2code'}{$codeset}{$id}) {
 136          return $Data{$type}{'id2code'}{$codeset}{$id};
 137       }
 138
 139    } elsif ($retired  &&  exists $Retired{$type}{$codeset}{'name'}{$name}) {
 140       return $Retired{$type}{$codeset}{'name'}{$name}[0];
 141    }
 142
 143    return undef;
 144 }
 145
 146 #=======================================================================
 147 #
 148 # _code2code ( TYPE,CODE,CODESET )
 149 #
 150 #=======================================================================
 151
 152 sub _code2code {
 153    my($type,@args) = @_;
 154    (@args == 3) or croak "${type}_code2code() takes 3 arguments!";
 155
 156    my($code,$inset,$outset) = @args;
 157    my($err,$tmp);
 158    ($err,$code,$inset) = _code($type,$code,$inset);
 159    return undef  if ($err);
 160    ($err,$tmp,$outset) = _code($type,'',$outset);
 161    return undef  if ($err);
 162
 163    my $name    = _code2name($type,$code,$inset);
 164    my $outcode = _name2code($type,$name,$outset);
 165    return $outcode;
 166 }
 167
 168 #=======================================================================
 169 #
 170 # _all_codes ( TYPE [,CODESET] [,'retired'] )
 171 #
 172 #=======================================================================
 173
 174 sub _all_codes {
 175    my($type,@args)         = @_;
 176    my $retired             = 0;
 177    if (@args > 0  &&  $args[$#args]  &&  $args[$#args] eq 'retired') {
 178       pop(@args);
 179       $retired             = 1;
 180    }
 181
 182    my ($err,$tmp,$codeset) = _code($type,'',@args);
 183    return ()  if ($err);
 184
 185    if (! exists $Data{$type}{'code2id'}{$codeset}) {
 186       return ();
 187    }
 188    my @codes = keys %{ $Data{$type}{'code2id'}{$codeset} };
 189    push(@codes,keys %{ $Retired{$type}{$codeset}{'code'} })  if ($retired);
 190    return (sort @codes);
 191 }
 192
 193 #=======================================================================
 194 #
 195 # _all_names ( TYPE [,CODESET] [,'retired'] )
 196 #
 197 #=======================================================================
 198
 199 sub _all_names {
 200    my($type,@args)         = @_;
 201    my $retired             = 0;
 202    if (@args > 0  &&  $args[$#args]  &&  $args[$#args] eq 'retired') {
 203       pop(@args);
 204       $retired             = 1;
 205    }
 206
 207    my ($err,$tmp,$codeset) = _code($type,'',@args);
 208    return ()  if ($err);
 209
 210    my @codes = _all_codes($type,$codeset);
 211    my @names;
 212
 213    foreach my $code (@codes) {
 214       my($id,$i) = @{ $Data{$type}{'code2id'}{$codeset}{$code} };
 215       my $name   = $Data{$type}{'id2names'}{$id}[$i];
 216       push(@names,$name);
 217    }
 218    if ($retired) {
 219       foreach my $lc (keys %{ $Retired{$type}{$codeset}{'name'} }) {
 220          my $name = $Retired{$type}{$codeset}{'name'}{$lc}[1];
 221          push @names,$name;
 222       }
 223    }
 224    return (sort @names);
 225 }
 226
 227 #=======================================================================
 228 #
 229 # _rename ( TYPE,CODE,NAME,CODESET )
 230 #
 231 # Change the official name for a code. The original is retained
 232 # as an alias, but the new name will be returned if you lookup the
 233 # name from code.
 234 #
 235 #=======================================================================
 236
 237 sub _rename {
 238    my($type,$code,$new_name,@args) = @_;
 239
 240    my $nowarn   = 0;
 241    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 242
 243    my $codeset  = shift(@args);
 244    my $err;
 245    ($err,$code,$codeset) = _code($type,$code,$codeset);
 246
 247    if (! $codeset) {
 248       carp "rename_$type(): unknown codeset\n"  unless ($nowarn);
 249       return 0;
 250    }
 251
 252    $code = $Data{$type}{'codealias'}{$codeset}{$code}
 253      if (exists $Data{$type}{'codealias'}{$codeset}{$code});
 254
 255    # Check that $code exists in the codeset.
 256
 257    my $id;
 258    if (exists $Data{$type}{'code2id'}{$codeset}{$code}) {
 259       $id = $Data{$type}{'code2id'}{$codeset}{$code}[0];
 260    } else {
 261       carp "rename_$type(): unknown code: $code\n"  unless ($nowarn);
 262       return 0;
 263    }
 264
 265    # Cases:
 266    #   1. Renaming to a name which exists with a different ID
 267    #      Error
 268    #
 269    #   2. Renaming to a name which exists with the same ID
 270    #      Just change code2id (I value)
 271    #
 272    #   3. Renaming to a new name
 273    #      Create a new alias
 274    #      Change code2id (I value)
 275
 276    if (exists $Data{$type}{'alias2id'}{lc($new_name)}) {
 277       # Existing name (case 1 and 2)
 278
 279       my ($new_id,$i) = @{ $Data{$type}{'alias2id'}{lc($new_name)} };
 280       if ($new_id != $id) {
 281          # Case 1
 282          carp "rename_$type(): rename to an existing $type not allowed\n"
 283            unless ($nowarn);
 284          return 0;
 285       }
 286
 287       # Case 2
 288
 289       $Data{$type}{'code2id'}{$codeset}{$code}[1] = $i;
 290
 291    } else {
 292
 293       # Case 3
 294
 295       push @{ $Data{$type}{'id2names'}{$id} },$new_name;
 296       my $i = $#{ $Data{$type}{'id2names'}{$id} };
 297       $Data{$type}{'alias2id'}{lc($new_name)} = [ $id,$i ];
 298       $Data{$type}{'code2id'}{$codeset}{$code}[1] = $i;
 299    }
 300
 301    return 1;
 302 }
 303
 304 #=======================================================================
 305 #
 306 # _add_code ( TYPE,CODE,NAME,CODESET )
 307 #
 308 # Add a new code to the codeset. Both CODE and NAME must be
 309 # unused in the code set.
 310 #
 311 #=======================================================================
 312
 313 sub _add_code {
 314    my($type,$code,$name,@args) = @_;
 315
 316    my $nowarn   = 0;
 317    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 318
 319    my $codeset  = shift(@args);
 320    my $err;
 321    ($err,$code,$codeset) = _code($type,$code,$codeset);
 322
 323    if (! $codeset) {
 324       carp "add_$type(): unknown codeset\n"  unless ($nowarn);
 325       return 0;
 326    }
 327
 328    # Check that $code is unused.
 329
 330    if (exists $Data{$type}{'code2id'}{$codeset}{$code}  ||
 331        exists $Data{$type}{'codealias'}{$codeset}{$code}) {
 332       carp "add_$type(): code already in use: $code\n"  unless ($nowarn);
 333       return 0;
 334    }
 335
 336    # Check to see that $name is unused in this code set.  If it is
 337    # used (but not in this code set), we'll use that ID.  Otherwise,
 338    # we'll need to get the next available ID.
 339
 340    my ($id,$i);
 341    if (exists $Data{$type}{'alias2id'}{lc($name)}) {
 342       ($id,$i) = @{ $Data{$type}{'alias2id'}{lc($name)} };
 343       if (exists $Data{$type}{'id2code'}{$codeset}{$id}) {
 344          carp "add_$type(): name already in use: $name\n"  unless ($nowarn);
 345          return 0;
 346       }
 347
 348    } else {
 349       $id = $Data{$type}{'id'}++;
 350       $i  = 0;
 351       $Data{$type}{'alias2id'}{lc($name)} = [ $id,$i ];
 352       $Data{$type}{'id2names'}{$id}       = [ $name ];
 353    }
 354
 355    # Add the new code
 356
 357    $Data{$type}{'code2id'}{$codeset}{$code} = [ $id,$i ];
 358    $Data{$type}{'id2code'}{$codeset}{$id}   = $code;
 359
 360    return 1;
 361 }
 362
 363 #=======================================================================
 364 #
 365 # _delete_code ( TYPE,CODE,CODESET )
 366 #
 367 # Delete a code from the codeset.
 368 #
 369 #=======================================================================
 370
 371 sub _delete_code {
 372    my($type,$code,@args) = @_;
 373
 374    my $nowarn   = 0;
 375    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 376
 377    my $codeset  = shift(@args);
 378    my $err;
 379    ($err,$code,$codeset) = _code($type,$code,$codeset);
 380
 381    if (! $codeset) {
 382       carp "delete_$type(): unknown codeset\n"  unless ($nowarn);
 383       return 0;
 384    }
 385
 386    $code = $Data{$type}{'codealias'}{$codeset}{$code}
 387      if (exists $Data{$type}{'codealias'}{$codeset}{$code});
 388
 389    # Check that $code is valid.
 390
 391    if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
 392       carp "delete_$type(): code does not exist: $code\n"  unless ($nowarn);
 393       return 0;
 394    }
 395
 396    # Delete the code
 397
 398    my $id = $Data{$type}{'code2id'}{$codeset}{$code}[0];
 399    delete $Data{$type}{'code2id'}{$codeset}{$code};
 400    delete $Data{$type}{'id2code'}{$codeset}{$id};
 401
 402    # Delete any aliases that are linked to this code
 403
 404    foreach my $alias (keys %{ $Data{$type}{'codealias'}{$codeset} }) {
 405       next  if ($Data{$type}{'codealias'}{$codeset}{$alias} ne $code);
 406       delete $Data{$type}{'codealias'}{$codeset}{$alias};
 407    }
 408
 409    # If this ID is not used in any other codeset, delete it completely.
 410
 411    foreach my $c (keys %{ $Data{$type}{'id2code'} }) {
 412       return 1  if (exists $Data{$type}{'id2code'}{$c}{$id});
 413    }
 414
 415    my @names = @{ $Data{$type}{'id2names'}{$id} };
 416    delete $Data{$type}{'id2names'}{$id};
 417
 418    foreach my $name (@names) {
 419       delete $Data{$type}{'alias2id'}{lc($name)};
 420    }
 421
 422    return 1;
 423 }
 424
 425 #=======================================================================
 426 #
 427 # _add_alias ( TYPE,NAME,NEW_NAME )
 428 #
 429 # Add a new alias. NAME must exist, and NEW_NAME must be unused.
 430 #
 431 #=======================================================================
 432
 433 sub _add_alias {
 434    my($type,$name,$new_name,$nowarn) = @_;
 435
 436    $nowarn   = (defined($nowarn)  &&  $nowarn eq "nowarn" ? 1 : 0);
 437
 438    # Check that $name is used and $new_name is new.
 439
 440    my($id);
 441    if (exists $Data{$type}{'alias2id'}{lc($name)}) {
 442       $id = $Data{$type}{'alias2id'}{lc($name)}[0];
 443    } else {
 444       carp "add_${type}_alias(): name does not exist: $name\n"  unless ($nowarn);
 445       return 0;
 446    }
 447
 448    if (exists $Data{$type}{'alias2id'}{lc($new_name)}) {
 449       carp "add_${type}_alias(): alias already in use: $new_name\n"  unless ($nowarn);
 450       return 0;
 451    }
 452
 453    # Add the new alias
 454
 455    push @{ $Data{$type}{'id2names'}{$id} },$new_name;
 456    my $i = $#{ $Data{$type}{'id2names'}{$id} };
 457    $Data{$type}{'alias2id'}{lc($new_name)} = [ $id,$i ];
 458
 459    return 1;
 460 }
 461
 462 #=======================================================================
 463 #
 464 # _delete_alias ( TYPE,NAME )
 465 #
 466 # This deletes a name from the list of names used by an element.
 467 # NAME must be used, but must NOT be the only name in the list.
 468 #
 469 # Any id2name that references this name will be changed to
 470 # refer to the first name in the list.
 471 #
 472 #=======================================================================
 473
 474 sub _delete_alias {
 475    my($type,$name,$nowarn) = @_;
 476
 477    $nowarn   = (defined($nowarn)  &&  $nowarn eq "nowarn" ? 1 : 0);
 478
 479    # Check that $name is used.
 480
 481    my($id,$i);
 482    if (exists $Data{$type}{'alias2id'}{lc($name)}) {
 483       ($id,$i) = @{ $Data{$type}{'alias2id'}{lc($name)} };
 484    } else {
 485       carp "delete_${type}_alias(): name does not exist: $name\n"  unless ($nowarn);
 486       return 0;
 487    }
 488
 489    my $n = $#{ $Data{$type}{'id2names'}{$id} } + 1;
 490    if ($n == 1) {
 491       carp "delete_${type}_alias(): only one name defined (use _delete_${type} instead)\n"
 492         unless ($nowarn);
 493       return 0;
 494    }
 495
 496    # Delete the alias.
 497
 498    splice (@{ $Data{$type}{'id2names'}{$id} },$i,1);
 499    delete $Data{$type}{'alias2id'}{lc($name)};
 500
 501    # Every element that refers to this ID:
 502    #   Ignore     if I < $i
 503    #   Set to 0   if I = $i
 504    #   Decrement  if I > $i
 505
 506    foreach my $codeset (keys %{ $Data{'code2id'} }) {
 507       foreach my $code (keys %{ $Data{'code2id'}{$codeset} }) {
 508          my($jd,$j) = @{ $Data{'code2id'}{$codeset}{$code} };
 509          next  if ($jd ne $id  ||
 510                    $j < $i);
 511          if ($i == $j) {
 512             $Data{'code2id'}{$codeset}{$code}[1] = 0;
 513          } else {
 514             $Data{'code2id'}{$codeset}{$code}[1]--;
 515          }
 516       }
 517    }
 518
 519    return 1;
 520 }
 521
 522 #=======================================================================
 523 #
 524 # _rename_code ( TYPE,CODE,NEW_CODE,CODESET )
 525 #
 526 # Change the official code. The original is retained as an alias, but
 527 # the new name will be returned if you lookup the code from name.
 528 #
 529 #=======================================================================
 530
 531 sub _rename_code {
 532    my($type,$code,$new_code,@args) = @_;
 533
 534    my $nowarn   = 0;
 535    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 536
 537    my $codeset  = shift(@args);
 538    my $err;
 539    ($err,$code,$codeset)     = _code($type,$code,$codeset);
 540    ($err,$new_code,$codeset) = _code($type,$new_code,$codeset)
 541      if (! $err);
 542
 543    if (! $codeset) {
 544       carp "rename_$type(): unknown codeset\n"  unless ($nowarn);
 545       return 0;
 546    }
 547
 548    $code = $Data{$type}{'codealias'}{$codeset}{$code}
 549      if (exists $Data{$type}{'codealias'}{$codeset}{$code});
 550
 551    # Check that $code exists in the codeset.
 552
 553    if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
 554       carp "rename_$type(): unknown code: $code\n"  unless ($nowarn);
 555       return 0;
 556    }
 557
 558    # Cases:
 559    #   1. Renaming code to an existing alias of this code:
 560    #      Make the alias real and the code an alias
 561    #
 562    #   2. Renaming code to some other existing alias:
 563    #      Error
 564    #
 565    #   3. Renaming code to some other code:
 566    #      Error (
 567    #
 568    #   4. Renaming code to a new code:
 569    #      Make code into an alias
 570    #      Replace code with new_code.
 571
 572    if (exists $Data{$type}{'codealias'}{$codeset}{$new_code}) {
 573       # Cases 1 and 2
 574       if ($Data{$type}{'codealias'}{$codeset}{$new_code} eq $code) {
 575          # Case 1
 576
 577          delete $Data{$type}{'codealias'}{$codeset}{$new_code};
 578
 579       } else {
 580          # Case 2
 581          carp "rename_$type(): new code already in use: $new_code\n"  unless ($nowarn);
 582          return 0;
 583       }
 584
 585    } elsif (exists $Data{$type}{'code2id'}{$codeset}{$new_code}) {
 586       # Case 3
 587       carp "rename_$type(): new code already in use: $new_code\n"  unless ($nowarn);
 588       return 0;
 589    }
 590
 591    # Cases 1 and 4
 592
 593    $Data{$type}{'codealias'}{$codeset}{$code} = $new_code;
 594
 595    my $id = $Data{$type}{'code2id'}{$codeset}{$code}[0];
 596    $Data{$type}{'code2id'}{$codeset}{$new_code} = $Data{$type}{'code2id'}{$codeset}{$code};
 597    delete $Data{$type}{'code2id'}{$codeset}{$code};
 598
 599    $Data{$type}{'id2code'}{$codeset}{$id} = $new_code;
 600
 601    return 1;
 602 }
 603
 604 #=======================================================================
 605 #
 606 # _add_code_alias ( TYPE,CODE,NEW_CODE,CODESET )
 607 #
 608 # Adds an alias for the code.
 609 #
 610 #=======================================================================
 611
 612 sub _add_code_alias {
 613    my($type,$code,$new_code,@args) = @_;
 614
 615    my $nowarn   = 0;
 616    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 617
 618    my $codeset  = shift(@args);
 619    my $err;
 620    ($err,$code,$codeset)     = _code($type,$code,$codeset);
 621    ($err,$new_code,$codeset) = _code($type,$new_code,$codeset)
 622      if (! $err);
 623
 624    if (! $codeset) {
 625       carp "add_${type}_code_alias(): unknown codeset\n"  unless ($nowarn);
 626       return 0;
 627    }
 628
 629    $code = $Data{$type}{'codealias'}{$codeset}{$code}
 630      if (exists $Data{$type}{'codealias'}{$codeset}{$code});
 631
 632    # Check that $code exists in the codeset and that $new_code
 633    # does not exist.
 634
 635    if (! exists $Data{$type}{'code2id'}{$codeset}{$code}) {
 636       carp "add_${type}_code_alias(): unknown code: $code\n"  unless ($nowarn);
 637       return 0;
 638    }
 639
 640    if (exists $Data{$type}{'code2id'}{$codeset}{$new_code}  ||
 641        exists $Data{$type}{'codealias'}{$codeset}{$new_code}) {
 642       carp "add_${type}_code_alias(): code already in use: $new_code\n"  unless ($nowarn);
 643       return 0;
 644    }
 645
 646    # Add the alias
 647
 648    $Data{$type}{'codealias'}{$codeset}{$new_code} = $code;
 649
 650    return 1;
 651 }
 652
 653 #=======================================================================
 654 #
 655 # _delete_code_alias ( TYPE,CODE,CODESET )
 656 #
 657 # Deletes an alias for the code.
 658 #
 659 #=======================================================================
 660
 661 sub _delete_code_alias {
 662    my($type,$code,@args) = @_;
 663
 664    my $nowarn   = 0;
 665    $nowarn      = 1, pop(@args)  if (@args  &&  $args[$#args] eq "nowarn");
 666
 667    my $codeset  = shift(@args);
 668    my $err;
 669    ($err,$code,$codeset)     = Locale::Codes::_code($type,$code,$codeset);
 670
 671    if (! $codeset) {
 672       carp "delete_${type}_code_alias(): unknown codeset\n"  unless ($nowarn);
 673       return 0;
 674    }
 675
 676    # Check that $code exists in the codeset as an alias.
 677
 678    if (! exists $Data{$type}{'codealias'}{$codeset}{$code}) {
 679       carp "delete_${type}_code_alias(): no alias defined: $code\n"  unless ($nowarn);
 680       return 0;
 681    }
 682
 683    # Delete the alias
 684
 685    delete $Data{$type}{'codealias'}{$codeset}{$code};
 686
 687    return 1;
 688 }
 689
 690 1;
 691 # Local Variables:
 692 # mode: cperl
 693 # indent-tabs-mode: nil
 694 # cperl-indent-level: 3
 695 # cperl-continued-statement-offset: 2
 696 # cperl-continued-brace-offset: 0
 697 # cperl-brace-offset: 0
 698 # cperl-brace-imaginary-offset: 0
 699 # cperl-label-offset: -2
 700 # End: