src/ruby/YaPI.pm.in

   1 # -*- perl -*-
   2 # @configure_input@
   3 # $Id: YaPI.pm.in 33405 2006-10-13 13:12:42Z mvidner $
   4
   5 package YaPI;
   6
   7 =head1 NAME
   8
   9 YaPI - common functions for modules implementing YaST API
  10
  11 =cut
  12
  13 BEGIN {
  14     # substituted by configure
  15     my $modules = '@yast2dir4perl@/modules';
  16     # unconditional 'use lib' could override a "use lib ." that
  17     # we do during compilation, #197099
  18     grep { $_ eq $modules } @INC or unshift(@INC, $modules);
  19 }
  20 use strict;
  21
  22 use Exporter;
  23 our @ISA = qw(Exporter);
  24 our @EXPORT = qw(textdomain __);
  25
  26 use YaST::YCP;
  27 use ycp;
  28
  29 use Locale::gettext ("!textdomain");
  30 use POSIX ();     # Needed for setlocale()
  31
  32 POSIX::setlocale(&POSIX::LC_MESSAGES, "");
  33
  34 our %TYPEINFO;
  35 my %__error = ();
  36 my $VERSION = "";
  37 our @CAPABILITIES = ();
  38
  39 =head2 base functions
  40
  41 These are to be used by modules that use YaPI as their base class.
  42
  43   use YaPI;
  44   our @ISA = ("YaPI");
  45
  46 =head3 Interface
  47
  48 Returns a reference to a list of hashes describing the functions
  49 in the current package. The information is taken from TYPEINFO.
  50
  51   [
  52    {
  53       functionName => "contains",
  54       return => "boolean",
  55       argument => [ "string", ["list", "string"]],
  56    },
  57    ...
  58   ]
  59
  60 =cut
  61
  62 BEGIN { $TYPEINFO{Interface} = ["function", "any"]; }
  63 sub Interface {
  64     my $self = shift;
  65     my @ret = ();
  66
  67     no strict "refs";
  68     my %TI = %{"${self}::TYPEINFO"};
  69
  70     foreach my $k (keys %TYPEINFO) {
  71         $TI{$k} = $TYPEINFO{$k};
  72     }
  73
  74     foreach my $funcName (sort keys %TI) {
  75         my @dummy = @{$TI{$funcName}};
  76         my $hash = {};
  77
  78         $hash->{'functionName'} = $funcName;
  79         $hash->{'return'}       = $dummy[1];
  80         splice(@dummy, 0, 2);
  81         $hash->{'argument'} = \@dummy;
  82         push @ret, $hash;
  83     }
  84     return \@ret;
  85 }
  86
  87 =head3 Version
  88
  89 Returns the version of the current package.
  90
  91 =cut
  92
  93 BEGIN { $TYPEINFO{Version} = ["function", "string"]; }
  94 sub Version {
  95     my $self = shift;
  96     no strict "refs";
  97     return ${"${self}::VERSION"};
  98 }
  99
 100 =head3 Supports
 101
 102 Greps C<@CAPABILITIES> of the current package.
 103
 104   if (YaPI::Foo->Supports ("frobnicate")) {...}
 105
 106 =cut
 107
 108 BEGIN { $TYPEINFO{Supports} = ["function", "boolean", "string"]; }
 109 sub Supports {
 110     my $self = shift;
 111     my $cap  = shift;
 112
 113     no strict "refs";
 114     my @c = @{"${self}::CAPABILITIES"};
 115     foreach my $k (@CAPABILITIES) {
 116         push @c, $k;
 117     }
 118
 119     return !!grep( ($_ eq $cap), @c);
 120 }
 121
 122
 123 =head3 SetError
 124
 125 Logs an error and remembers it for L</Error>.
 126
 127 Error map:
 128
 129   {
 130     code                # mandatory, an uppercase short string
 131     summary
 132     description
 133   # if all of the following are missing, caller () is used
 134     package
 135     file
 136     line
 137   }
 138
 139 =cut
 140
 141 BEGIN { $TYPEINFO{SetError} = ["function", "boolean", ["map", "string", "any" ]]; }
 142 sub SetError {
 143     my $self = shift;
 144     %__error = @_;
 145     if( !$__error{package} && !$__error{file} && !$__error{line})
 146     {
 147         @__error{'package','file','line'} = caller();
 148     }
 149     if ( defined $__error{summary} ) {
 150         y2error($__error{code}."[".$__error{line}.":".$__error{file}."] ".$__error{summary});
 151     } else {
 152         y2error($__error{code});
 153     }
 154     if(defined $__error{description} && $__error{description} ne "") {
 155         y2error("Description: ".$__error{description});
 156     }
 157
 158     return undef;
 159 }
 160
 161 =head3 Error
 162
 163 Returns the error set by L</SetError>
 164
 165 =cut
 166
 167 BEGIN { $TYPEINFO{Error} = ["function", ["map", "string", "any"] ]; }
 168 sub Error {
 169     my $self = shift;
 170     return \%__error;
 171 }
 172
 173 =head2 i18n
 174
 175 C<< use YaPI; >>
 176
 177 C<< textdomain "mydomain"; >>
 178
 179 Just use a double underscore to mark text to be translated: C<__("my text")>.
 180 Both C<textdomain> and C<__> are exported to the calling package.
 181
 182 These must not be used any longer because they collide with symbols
 183 exported by this module:
 184
 185  #  use Locale::gettext;    # textdomain
 186  #  sub _ { ... }
 187
 188 These don't hurt but aren't necessary:
 189
 190  #  use POSIX ();
 191  #  POSIX::setlocale(LC_MESSAGES, "");    # YaPI calls it itself now
 192
 193 =head3 textdomain
 194
 195 Calls Locale::gettext::textdomain
 196 and also
 197 remembers an association between the calling package and the
 198 domain. Later calls of __ use this domain as an argument to dgettext.
 199
 200 =cut
 201
 202 # See also bug 38613 where untranslated texts were seen because
 203 # a random textdomain was used instead of the proper one.
 204 my %textdomains;
 205
 206 sub textdomain
 207 {
 208     my $domain = shift;
 209     my ($package, $filename, $line) = caller;
 210
 211     if (defined ($textdomains{package}))
 212     {
 213         if ($textdomains{package} ne $domain)
 214         {
 215             y2error ("Textdomain '$domain' overrides old textdomain '$textdomains{package}' in package $package, $filename:$line");
 216         }
 217     }
 218     $textdomains{$package} = $domain;
 219     return Locale::gettext::textdomain ($domain);
 220 }
 221
 222 =head3 __ (double underscore)
 223
 224 Calls Locale::gettext::dgettext, supplying the textdomain of the calling
 225 package (set by calling textdomain).
 226
 227 Note: the single underscore function (_) will be removed because it
 228 is automaticaly exported to main:: which causes namespace conflicts.
 229
 230 =cut
 231
 232 # bug 39954: __ better than _
 233 sub __ {
 234     my $msgid = shift;
 235     my $package = caller;
 236     my $domain = $textdomains{$package};
 237     return Locale::gettext::dgettext ($domain, $msgid);
 238 }
 239
 240 # Compatibility by partial typeglob assignment:
 241 # &_ will call &__ but $_ will not be $__ which would happen
 242 # if we just asigned *_ = *__.
 243 # Cannot just call __ from _ because of "caller".
 244 *_ = \&__;
 245
 246 1;