view release on metacpan or  search on metacpan

Language.pm  view on Meta::CPAN

    my $class = shift;
    my $r = Apache->request;
    my ($package, $filename, $line) = caller;
    my $hash = {};
    tie (%$hash, __PACKAGE__, $r, $package, $filename, @_);  
    return bless $hash, $class;
    }  

#Old call preserved for compatibility.
sub message {
    my ($self, $key, @args) = @_;
    return sprintf $self->{$key}, @args;
    }  
    
#returns the list of requested languages by the client    
sub lang {
    my $self = shift;
    $self = tied %$self if tied %$self;
    return $self->{Lang};
    }
#returns Apache $r
sub request {
    my $self = shift;
    $self = tied %$self if tied %$self;
    return $self->{Request};
    }
sub extra_args {
    my $self = shift;
    $self = tied %$self if tied %$self;
    return $self->{Extra_Args};
    }
#returns the handler stack
sub handlers {
    my $self = shift;
    $self = tied %$self if tied %$self;
    return @ {$self->{Handlers}};
    }
#returns the filename of the calling Module/Script
sub filename {
    my $self = shift;
    $self = tied %$self if tied %$self;
    return $self->{Filename};
    }

#returns the package name of the calling Module/Script
sub package {
    my $self = shift;
    $self = tied %$self if tied %$self;
    return $self->{Package};
    }
    
#Dumps the language object for debugging purposes.
sub dump {
    my $self = shift;
    $self = tied %$self if tied %$self;
    print "<PRE>";
    print Dumper $self;
    print "</PRE>";
    }

#given an ordered list of knowns languages, returns the best language 
#choice according to the client request
#Called mostly by LanguageHandlers to figure out what language to pick
sub best_lang {
    my ($self,@offered) = @_;
    my ($result, $language);

    $self = tied %$self if tied %$self;
    foreach my $want (@ {$self->{Lang}}) {
        foreach my $offer (@offered) {
            my $similarity = similarity_language_tag($offer, $want);
            if ($similarity){
                return $offer if same_language_tag($offer, $want);
                }
            if ($similarity > $result){
                $result = $similarity;
                $language = $offer;
                }
        }
    }
    return $language;
}

sub AUTOLOAD {
      my $self = shift;
      my $untiedself = tied %$self if tied %$self;
      my $name = $AUTOLOAD;
      return if $name =~ /::DESTROY$/;
      
      my $type = ref($self) || die "$self is not an object";
      
      $name =~ s/.*://;
      
      foreach my $container (@ {$untiedself->{Handlers}}){
         my $conthash = $untiedself->{$container}{DATA};
         return $container->$name($untiedself, $conthash, @_) if ($container->can($name));
         }
      warning( "No $name defined in any LanguageHandlers, sorry.",1);
      return undef;
}


#TEST HANDLER
sub handler {
    my $r = shift;
   
    my $test = Apache::Language->new($r);
    $r->send_http_header('text/html');
    print "Hello<BR>";
    #foreach (keys %$test){
    #    print "$_ is " . $test->{$_} . "<BR>";
     #   }
     print $test->{'Parent'};
    print "<HR><PRE>";
    print Dumper %CACHE;
    print "</PRE>";
    #delete $test->{'voo1'};
    #%$test = ();
    }



#STATUS
sub status {