Name

version — print all sorts of Interchange-related system information

ATTRIBUTES

Attribute Pos. Req. Default Description
extended Yes 0 Print extended version report?
joiner <br> Record/line separator.
global_error 0 Print location of the global (Interchange) error file?
local_error 0 Print location of the local (catalog) error file? (The filename is provided as a hyperlink).
env 0 Print environment variable names? (the environment variables specified in Environment).
safe 0 Print SafeUntrap value?
child_pid 0 Print child process PID?
modtest | module_test | moduletest | require Test for availability of the specified Perl module.
pid 0 Print parent PID?
mode 0 Print Interchange ic run mode?
uid 0 Print Interchange process username and numerical ID?
global_locale_options 0 Print locale information? (Available locale codes and language names)
perl 0 Print Perl information? (Perl version and the location of the Perl binary)
perl_config 0 Print Perl config information? (output of the Config::myconfig() function)
hostname 0 Print hostname?
modules 0 Print modules information? (List of Interchange-related modules found and their installed versions. For optional modules, print why one would want to have them).
db 1, if none of the above options were set Print database information?
interpolate     0 interpolate output?
hide     0 Hide the tag return value?

DESCRIPTION

The tag produces all sorts of system information that is in some relation to Interchange.

BEHAVIOR

This tag appears to be affected by, or affects, the following:
Catalog Variables: UI_BASE

EXAMPLES

Example: Invoking the tag with the full set of options

[version
  extended=1
  global_error=1
  local_error=1
  env=1
  safe=1
  pid=1
  child_pid=1
  mode=1
  uid=1
  global_locale_options=1
  perl=1
  perl_config=1
  hostname=1
  db=1
  modules=1
  modtest=DBI
]

NOTES

AVAILABILITY

version is available in Interchange versions:

4.6.0-5.9.0 (git-head)

SOURCE

Interchange 5.9.0:

Source: code/UI_Tag/version.coretag
Lines: 233


# Copyright 2002-2007 Interchange Development Group and others
# 
# 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.  See the LICENSE file for details.
# 
# $Id: version.coretag,v 1.15 2007-08-05 08:01:03 kwalsh Exp $

UserTag version Order      extended
UserTag version attrAlias  module_test modtest
UserTag version attrAlias  moduletest modtest
UserTag version attrAlias  require modtest
UserTag version addAttr
UserTag version Version    $Revision: 1.15 $
UserTag version Routine    <<EOR
sub {
return $::VERSION unless shift;
my $opt = shift;
my $joiner = $opt->{joiner} || "<br$Vend::Xtrailer>";
my @out;
my $done_something;

if($opt->{global_error}) {
push @out, $Global::ErrorFile;
$done_something = 1;
}

if($opt->{local_error}) {
my $dfn = my $fn = $Vend::Cfg->{ErrorFile};
my $pre = $Global::Catalog{$Vend::Cat}->{dir} . '/';
$fn =~ s:^\Q$pre\E::;
my $href = $Tag->area("$::Variable->{UI_BASE}/do_view", $fn);
push(@out, qq{<a href="$href">$dfn</a>});
$done_something = 1;
}

if($opt->{env}) {
  push @out,
    ref $Global::Environment eq 'ARRAY' ?
    join ' ', @{$Global::Environment} :
    '(none)';
  $done_something = 1;
}

if($opt->{safe}) {
  push @out, join " ", @{$Global::SafeUntrap};
  $done_something = 1;
}

if($opt->{child_pid}) {
  push @out, $$;
  $done_something = 1;
}

if($opt->{modtest}) {
  eval "require $opt->{modtest}";
  if($@) {
    push @out, 0;
  }
  else {
    push @out, 1;
  }
  $done_something = 1;
}

if($opt->{pid}) {
  push @out, ::readfile($Global::PIDfile);
  $done_something = 1;
}

if($opt->{mode}) {
  push @out, Vend::Server::server_start_message('%s', 1);
  $done_something = 1;
}

if($opt->{uid}) {
  push @out, scalar getpwuid($>) . " (uid $>)";
  $done_something = 1;
}

if($opt->{global_locale_options}) {
  my @loc;
  my $curr = $Global::Locale;
  
  while ( my($k,$v) = each %$Global::Locale_repository ) {
    next unless $k =~ /_/;
    push @loc, "$v->{MV_LANG_NAME}~:~$k=$v->{MV_LANG_NAME}";
  }
  if(@loc > 1) {
    push @out, join ",", map { s/.*~:~//; $_ } sort @loc;
  }
  $done_something = 1;
}

if($opt->{perl}) {
  push @out, ($^V ? sprintf("%vd", $^V) : $]) . errmsg(" (called with: %s)", $^X);
  $done_something = 1;
}

if($opt->{perl_config}) {
  require Config;
  push @out, "<pre>\n" . Config::myconfig() . "</pre>";
  $done_something = 1;
}

if($opt->{hostname}) {
  require Sys::Hostname;
  push @out, Sys::Hostname::hostname()
    || errmsg("unable to determine hostname");
  $done_something = 1;
}

if(not $opt->{db} || $opt->{modules} || $done_something) {
  $opt->{db} = 1;
  push @out, "Interchange Version $::VERSION";
  push @out, "";
}

if($opt->{db}) {
  if($Global::GDBM) {
    push @out, errmsg('%s available (v%s)', 'GDBM', $GDBM_File::VERSION);
  }
  else {
    push @out, errmsg('No %s.', 'GDBM');
  }
  if($Global::DB_File) {
    push @out, errmsg('%s available (v%s)', 'Berkeley DB_File', $DB_File::VERSION);
  }
  else {
    push @out, errmsg('No %s.', 'Berkeley DB_File');
  }
  if($Global::LDAP) {
    push @out, errmsg('%s available (v%s)', 'LDAP', $Net::LDAP::VERSION);
  }
  if($Global::DBI and $DBI::VERSION) {
    push @out, errmsg ('DBI enabled (v%s), available drivers:', $DBI::VERSION);
    my $avail = join $joiner, DBI->available_drivers;
    push @out, "<blockquote>$avail</blockquote>";
  }
}

if($opt->{modules}) {
  my @wanted = qw/
    Archive::Tar
    Archive::Zip
    Bundle::LWP
    Business::UPS
    Compress::Zlib
    Crypt::SSLeay
    DBI
    Digest::MD5
    Digest::SHA
    Image::Size
    LWP::Simple
    MIME::Base64
    Safe::Hole
    Set::Crontab
    Spreadsheet::ParseExcel
    Spreadsheet::WriteExcel
    Storable
    Tie::ShadowHash
    Tie::Watch
    URI::URL
  /;
  my %l_than;
  my %g_than;
  my %info = (
    'Archive::Tar' => q{Only needed for supplementary UserTag definitions.},
    'Archive::Zip' => q{Only needed for supplementary UserTag definitions.},
    'Bundle::LWP' => q{Certain parts of these modules (URI::URL and MIME::Base64) \
 are required for Interchange's internal HTTP server. Also, \
 Business::UPS, for calculating shipping, requires this.},
    'Business::UPS' => q{Enables lookup of shipping costs directly from \
 www.ups.com. Requires Bundle::LWP.},
    'Compress::Zlib' => q{Only needed for supplementary UserTag definitions.},
    'Crypt::SSLeay' => q{Payment interface links via HTTPS/SSL.},
    'DBI' => q{Most people want to use SQL with Interchange, and this \
 is a requirement.  You will also need the appropriate DBD module, \
 i.e. DBD::mysql to support MySQL.},
    'Digest::MD5' => q{IMPORTANT: cache keys and other search-related functions will not work.},
    'Digest::SHA' => q{Used by sha1 filter, optional UserDB functionality, \
 and some payment modules.},
    'Image::Size' => q{Optional but recommended for [image ...] tag.},
    'LWP::Simple'  => q{External UPS lookup and other internet-related functions will not work.},
    'MIME::Base64' => q{Provides HTTP services for internal HTTP server \
 and basic authentication.},
    'Safe::Hole' => q{IMPORTANT: SQL and some tags will not work in embedded Perl.},
    'Set::Crontab' => q{Used by HouseKeepingCron task scheduler.},
    'Spreadsheet::ParseExcel' => q{Allows upload of XLS spreadsheets \
 for database import in the UI.},
    'Spreadsheet::WriteExcel' => q{Allows output of XLS spreadsheets \
 for database export in the UI.},
    'Storable' => q{Session and search storage will be slower.},
    'Tie::ShadowHash' => q{Needed for PreFork mode of Interchange, prevents \
 permanent write of configuration.},
    'Tie::Watch' => q{Minor: cannot set watch points in catalog.cfg.},
    'URI::URL' => q{Provides HTTP primitives for internal HTTP server.},
  );
  foreach my $name (@wanted) {
    no strict 'refs';
    eval "require $name";
    if($@) {
      my $info = errmsg($info{$name} || "May affect program operation.");
      push @out, "$name " . errmsg('not found') . ". $info"
    }
    elsif($l_than{$name}) {
      my $ver = ${"${name}::VERSION"};
      $ver =~ s/^(\d+\.\d+)\..*/$1/;
      if($ver > $l_than{$name}) {
        my $info = errmsg($info{$name} || "May affect program operation.");
        my $ex = errmsg(
              '%s too high a version, need %s or lower',
              $ver,
              $l_than{$name},
            );
        push @out, "$name $ex. $info";
      }
    }
    elsif($g_than{$name}) {
      my $ver = ${"${name}::VERSION"};
      $ver =~ s/^(\d+\.\d+)\..*/$1/;
      if($ver < $g_than{$name}) {
        my $info = errmsg($info{$name} || "May affect program operation.");
        my $ex = errmsg(
              '%s too low a version, need %s or higher',
              $ver,
              $g_than{$name},
            );
        push @out, "$name $ex. $info";
      }
    }
    else {
      my $ver = ${"$name" . "::VERSION"};
      $ver = $ver ? "v$ver" : 'no version info';
      push @out, "$name " . errmsg('found') . " ($ver).";
    }
  }
}

return join $joiner, @out;
}
EOR

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!