# ODP::Stradivarius - A class for language strings (Version 0.01) # Copyright (C)2004 Richard P. Fuller # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA package ODP::Stradivarius; use strict; use LWP::UserAgent; use URI::Escape; # new - Initialises a new ODP::Stradivarius object # Parameters: none # Returns: ODP::Stradivarius object sub new () { my $object = {}; return bless $object; } # langs - Returns the valid language codes # Parameters: none # Returns: hash of valid language codes sub languages() { my %languages; # ara excluded for lack of flag foreach my $key (qw(bos cat chi_GB2312 cze dan deu dut eng eus fas fin fra glg hin hrv ina ita jpn kor kur lav lit nor pol por ron rus slk spa srd sve tat tur vie)) { $languages{$key} = $key; } return %languages; } # setlang - Sets the language of our object # Parameters: language # Returns: none sub setlang ($) { my $self = shift; $self->{'language'} = $_[0]; } # load - Load a set of strings # Parameters: string category (if the category is proceeded by research., load it from research.dmoz.org) # Returns: nothing sub load ($) { my $self = shift; my $class = shift; my $where = $INC{'ODP/Stradivarius.pm'}; $where =~ s!/Stradivarius.pm$!!; $where = "$where/strings"; if ($class =~ s!^research\.!!) { $where = '/home/dlugan/hosts/odp/data/translations'; } if ($class !~ m!^[A-Za-z0-9_]+$!) { return; } # If we've already loaded the strings, don't bother again (Simplifies things for the client) if ($self->{'loaded'}{$class}) { return; } if ($self->{'language'} ne 'eng') { open(STRINGS, "$where/eng/".$class.".dat"); while () { m!^([^:]+): (.*)$!; $self->{"strings.$class.$1"}=$2; $self->{"translated.$class.$1"} = 0; } close STRINGS; } my $language = $self->{'language'}; if ($language eq 'test'){$language = 'eng'} open(STRINGS, "$where/$language/".$class.".dat"); while () { m!^([^:]+): (.*)$!; if ($2) { $self->{"strings.$class.$1"}=$2; $self->{"translated.$class.$1"} = 1; } if ($self->{'language'} eq 'test') { $self->{"strings.$class.$1"} = $1; } } close STRINGS; $self->{'loaded'}{$class} = 1; } # reload - Reloads all strings, which may be required after a language switch # Parameters: none # Returns: nothing sub reload () { my $self = shift; foreach my $key (keys %{$self->{'loaded'}}) { delete $self->{'loaded'}{$key}; $self->load($key); } } # strings - Return a string, filling in %v1%, %v2%, etc. # Parameters: string, any variables that need filling in # Returns: Translated string sub strings() { my $self = shift; my $string = shift; $string = $self->{$string}; my $counter = 0; while (my $variable = shift) { $counter++; $string =~ s!\%v$counter\%!$variable!g; } return $string; } 1;