version — print all sorts of Interchange-related system information
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? |
The tag produces all sorts of system information that is in some relation to Interchange.
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 ]
Interchange 5.9.0:
Source: code/UI_Tag/version.coretag
Lines: 233
# Copyright 2002-2016 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. 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 1.16 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 Business::UPS Compress::Zlib Crypt::Random Crypt::SSLeay DBI Digest::Bcrypt 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.}, 'Business::UPS' => q{Enables lookup of shipping costs directly from www.ups.com.}, 'Compress::Zlib' => q{Only needed for supplementary UserTag definitions.}, 'Crypt::Random' => q{Used for UserDB bcrypt password hashing.}, '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::Bcrypt' => q{Used for UserDB bcrypt password hashing.}, '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