AFS
view release on metacpan or search on metacpan
Version 2.6.3 (released 25 Oct 2012, revision 1142)
http://www.mpa-garching.mpg.de/~nog/perl/AFS-2.6.3.tar.gz
NOTICE:
* This release does not support AFS system libraries version 3.4 or
version 3.5
* This release does not support any features and interfaces from
AFSPerl "version 1"
User-visible changes:
* added patch for OpenAFS to create "PIC" type system libraries on
64-bit platforms
* compiles with OpenAFS system libraries version 1.4.X on 32-bit and
on 64-bit platforms
* added installation description for 64-bit platforms
* released the BOS methods
- addhost
- removehost
- adduser
- removeuser
- setrestart
User-visible changes:
* compiles with OpenAFS system libraries version 1.4.12
* fixed method AFS::VLDB->listvldb: fixed segmentation error
* improved Makefile.PL script for Perl 5.10.0 and "threaded PIC" libraries
* updated example scripts for the modules AFS::VLDB and AFS::VOS
* improved test drivers for the modules AFS::VLDB and AFS::VOS;
Developer-visible changes:
* convertet all VERSION variables to "dotted decimal version" with leading "v"
* changed argument type from "int" to "string" for method AFS::VLDB->removeaddr
Version 2.6.1 (released 17 Nov 2008, revision 906)
http://www.mpa-garching.mpg.de/~nog/perl/AFS-2.6.1.tar.gz
NOTICE:
* This release does not support AFS system libraries version 3.4 or
version 3.5
* Two of the hash key names returned by the VLDB method "listaddrs" have
Version 2.02 (released 12 July 2002, revision 221)
User-visible changes:
* fixed bug in method AFS::KAS->setfields resp. AFS::KAS->KAM_SetFields
introduced in version 2.01
Developer-visible changes:
* modified 'typemap' file: added type 'uint32'
Version 2.01 (released 8 July 2002, revision 211)
User-visible changes:
* improved Makefile.PL script
* new method '-AFS::KTC_TOKEN->FromString'
* new functions 'XSVERSION', 'get_syslib_version', 'get_server_version',
'getcrypt' and 'setcrypt'
* new set of POD documentations for version 2.0
Developer-visible changes:
* compiles with OpenAFS
* constructor methods for all AFS classes have been corrected to
conform with the Perl OO conventions.
* modified 'typemap' file: renamed following types
AFS::PTS_SERVER AFS::PTS
AFS::KA_AUTHSERVER AFS::KAS
AFS::KTC_ENCRYPTIONKEY AFS::KTC_EKEY
Version 1.11 (released 6 December 2001, revision 80)
User-visible changes:
tar xvf AFS-<version>.tar
'cd' into that directory, make, test and install the modules.
You have to specify the location of the AFS system
libraries. While running the 'perl Makefile.PL' step you will be
prompted for the location of the AFS system libraries. If you
want to avoid that query, you should specify the environment
variable 'AFSPATH' before you start [1].
If your AFS system type is not yet known by the make file because
you can't run the "fs sysname" command, you can specify the
environment variable 'AFS_SYSNAME' before you start [2].
This is the sequence of commands to build the modules:
cd AFS-<version>
[1] this step is optional
setenv AFSPATH 'path_to_the_AFS_system_libraries' # tcsh-shell
export AFSPATH='path_to_the_AFS_system_libraries' # sh-shell
[2] this step is optional
setenv AFS_SYSNAME 'AFS_system_type' # tcsh-shell
export AFS_SYSNAME 'AFS_system_type' # sh-shell
perl Makefile.PL
----> Which AFS system libraries should be used? [/usr/afsws]
make
make test
make install
make html ;#(if you want to get the HTML documentation, see also next section)
PLATFORMS
the AFS file system. Otherwise most of the test cases
('make test') are skipped.
REQUIREMENTS
Before you can build the AFS module bundle you need to have the
following installed on your system:
* Perl v5.10.0 or newer
* C compiler
* OpenAFS system libraries 64-bit version (PIC type or standard)
WHAT TYPE OF OpenAFS SYSTEM LIBRARIES ARE NEEDED
Depending on the installed Perl version you have to use the proper
type of OpenAFS system libraries. If you have a "threaded" version
of Perl, you have to link the AFS modules against the PIC type
system libraries, for a "non-threaded" Perl you have to use the
standard libraries.
To find out what type of Perl you are using, just run the command:
perl ./test_ptype
If it says
'Your Perl is 'Non-Threaded Perl'
then you need the standard system libraries and you can skip to
the next section (BUILDING & INSTALLING).
If it says
Your Perl is 'Threaded Perl'
then you need the PIC type system libraries. Unfortunately the
PIC type system libraries are not created for OpenAFS 1.4.X by
default. Therefore you have to patch your OpenAFS installation.
This is the sequence of commands to build the PIC type system libraries:
gunzip AFS-<version>.tar.gz
tar xvf AFS-<version>.tar
cd openafs-1.4.X
patch < AFS-<version>/openafs-pic.patch
make clean
make
make install
Now you have created the additional PIC type system libraries for
OpenAFS 1.4.X and you can start building the AFS modules.
BUILDING & INSTALLING
Building the modules is straightforward. The AFS module bundle is
distributed as a single gzipped tar archive file:
AFS-<version>.tar.gz
Unpack the archive to create an AFS installation directory:
tar xvf AFS-<version>.tar
'cd' into that directory, make, test and install the modules.
You have to specify the location of the AFS system
libraries. While running the 'perl Makefile.PL' step you will be
prompted for the location of the AFS system libraries. If you
want to avoid that query, you should specify the environment
variable 'AFSPATH' before you start [1].
If your AFS system type is not yet known by the make file because
you can't run the "fs sysname" command, you can specify the
environment variable 'AFS_SYSNAME' before you start [2].
This is the sequence of commands to build the modules:
cd AFS-<version>
[1] this step is optional
setenv AFSPATH 'path_to_the_AFS_system_libraries' # tcsh-shell
export AFSPATH='path_to_the_AFS_system_libraries' # sh-shell
[2] this step is optional
setenv AFS_SYSNAME 'AFS_system_type' # tcsh-shell
export AFS_SYSNAME 'AFS_system_type' # sh-shell
perl Makefile.PL
----> Which AFS system libraries should be used? [/usr/afsws]
make
make test
make install
make html ;#(if you want to get the HTML documentation, see also next section)
PLATFORMS
LICENCES/COPYING view on Meta::CPAN
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.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
pod/v2/afsperlvos.pod
pod/v2/Makefile.inp
pod/v2/README
pod/v2/zpod2html
README
src/ACL/ACL.pm
src/ACL/Makefile.PL
src/ACL/t/ACL.t
src/AFS.pm
src/AFS.xs
src/afs_prototypes.h
src/BOS/BOS.pm
src/BOS/Makefile.PL
src/BOS/t/BOS.t
src/Cell/Cell.pm
src/Cell/Makefile.PL
src/Cell/t/Cell.t
src/CM/CM.pm
src/CM/Makefile.PL
src/CM/t/CM.t
src/com_err.h
src/KTC_TOKEN/KTC_TOKEN.pm
src/KTC_TOKEN/Makefile.PL
src/KTC_TOKEN/t/KTC_TOKEN.t
src/Makefile.PL
src/ppport.h
src/PTS/Makefile.PL
src/PTS/PTS.pm
src/PTS/t/PTS.t
src/t/AFS.t
src/t/pod.t
src/typemap
src/Utils/Makefile.PL
src/Utils/t/Utils.t
src/Utils/Utils.pm
src/VLDB/Makefile.PL
src/VLDB/t/VLDB.t
src/VLDB/VLDB.pm
src/VOS/Makefile.PL
src/VOS/t/VOS.t
src/VOS/VOS.pm
test_ptype
TODO
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
examples/v2/bos/create view on Meta::CPAN
#!/usr/local/bin/perl
use blib;
use strict;
use warnings;
use AFS::BOS;
my ($server, $process, $type, $commands, @commands, $notifier, $bos, $ok);
die "Usage: $0 server process type commands [notifier]\n" if $#ARGV < 3;
$server = shift;
$process = shift;
$type = shift;
$commands = shift;
$notifier = shift;
#warn ">$server< >$process< >$type< >$commands< >$notifier< \n";
if (defined $commands and $commands =~ / /) { @commands = split / /, $commands; }
$bos = AFS::BOS->new($server);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n" and die;
if (@commands) {
if ($notifier) { $ok = $bos->create($process, $type, \@commands, $notifier); }
else { $ok = $bos->create($process, $type, \@commands); }
}
else {
if ($notifier) { $ok = $bos->create($process, $type, $commands, $notifier); }
else { $ok = $bos->create($process, $type, $commands); }
}
if ($AFS::CODE) { print "AFS::CODE = $AFS::CODE\n"; }
else { print "OK = $ok \n"; }
$bos->DESTROY;
examples/v2/vos/examine view on Meta::CPAN
$vldblist = $vldb->listvldbentry($volume);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
print_vol($vollist);
print_vldb($vldblist);
sub print_vol {
my $vollist = shift;
print "$vollist->{name} \t$vollist->{volid} $vollist->{type} \t $vollist->{size} K $vollist->{inUse}\n";
print "\t$vollist->{server} $vollist->{partition}\n";
print "\tRWrite $vollist->{parentID} ROnly $vollist->{cloneID} Backup $vollist->{backupID}\n";
print "\tMaxQuota $vollist->{maxquota} K\n";
print "\tCreation ", ctime($vollist->{creationDate}), "\n";
print "\tCopy ", ctime($vollist->{copyDate}), "\n";
print "\tBackup ", ctime($vollist->{backupDate}), "\n";
print "\tLast Update ", ctime($vollist->{updateDate}), "\n";
print "\t$vollist->{dayUse} accesses in the past day (i.e., vnode references)\n";
}
sub print_vldb {
my ($vldblist) = @_;
print "\tRWrite: $vldblist->{$volume}->{RWrite} \n";
print "\tnumber of sites -> $vldblist->{$volume}->{nServers}\n";
foreach my $srv (@{$vldblist->{$volume}->{server}}) {
print "\t\tserver $srv->{name} partition $srv->{partition} $srv->{type} site\n";
}
}
examples/v2/vos/listvol view on Meta::CPAN
elsif ($vol =~ /volume_busy/) {
print "**** Volume $partlist->{$part}->{$vol}->{'volid'} is busy **** \n";
next;
}
elsif ($vol =~ /volume_notok/) {
print "**** Could not attach volume $partlist->{$part}->{$vol}->{'volid'} **** \n";
next;
}
else { $totvol++; printf "%-30s ", $vol; }
print " $partlist->{$part}->{$vol}->{'volid'}";
print " $partlist->{$part}->{$vol}->{'type'}";
printf " %10s K", $partlist->{$part}->{$vol}->{'size'};
print " $partlist->{$part}->{$vol}->{'inUse'}";
print "\n";
# foreach (keys %{$partlist->{$part}->{$vol}}) {
# print "\t\tKey: $_, Value: $partlist->{$part}->{$vol}->{$_}\n";
# }
}
print "\nTotal volumes onLine $partlist->{$part}->{' totalOK'} ;";
print "\tTotal volumes offLine $partlist->{$part}->{' totalNotOK'} ;";
print "\tTotal busy $partlist->{$part}->{' totalBusy'} \n";
examples/v2/vos/listvolume view on Meta::CPAN
my $vollist = $vos->listvolume($volume);
$AFS::CODE and print "AFS::CODE = $AFS::CODE\n";
$Debugging && print_debug($vollist) && exit;
print_volume($vollist);
sub print_volume {
my $vollist = shift;
print "$vollist->{name} \t$vollist->{parentID} $vollist->{type} \t $vollist->{size} K $vollist->{inUse}\n";
print "\t$vollist->{server} $vollist->{partition}\n";
print "\tRWrite $vollist->{parentID} ROnly $vollist->{cloneID} Backup $vollist->{backupID}\n";
print "\tMaxQuota $vollist->{maxquota} K\n";
print "\tCreation ", ctime($vollist->{creationDate}), "\n";
print "\tCopy ", ctime($vollist->{copyDate}), "\n";
print "\tBackup ", ctime($vollist->{backupDate}), "\n";
print "\tLast Access ", ctime($vollist->{accessDate}), "\n";
print "\tLast Update ", ctime($vollist->{updateDate}), "\n";
print "\t$vollist->{dayUse} accesses in the past day (i.e., vnode references)\n";
}
pod/v2/afsperl.pod view on Meta::CPAN
B<Bernard Antoine> - for his bug report on a memory leak in the method
"AFS::ACL->retrieve".
B<Peter Scott> - for his bug report on a memory leak in the function
"getvolstats"
B<Peter Scott> - for his bug report on the function AFS::constant
B<Venkata Phani Achanta> - for his improved test drivers for several modules
B<David R. Boldt> - for his bug report on an undefined "typemap" entry
B<Alf Wachsmann> and B<Venkata Phani Achanta> - for their implementation
of the BOS, VOS, and VLDB modules
B<Phil Moore> - for his bug report on Itanium ia64 platform
B<Frank Burkhardt> and B<David Miller> - for their problem reports on
Perl "unthreaded" version within the Debian "unstable" distribution
B<Pierre-Yves Fontaniere> - for his configuration report for rs_aix51
pod/v2/afsperlbos.pod view on Meta::CPAN
array of names. It calls the AFS system library function
I<BOZO_AddSUser>.
=item B<$ok = $bos-E<gt>create(PROCESS, TYPE, COMMAND [, NOTIFIER]);>
=item B<$ok = $bos-E<gt>create(PROCESS, TYPE, \@COMMAND [, NOTIFIER]);>
Creates a server PROCESS entry in the local C<BosConfig> file on the
server machine, sets the process's status to I<Run> in the
C<BosConfig> file and in memory, and starts the process. TYPE
specifies the process's type. Acceptable values are: 'simple', 'cron',
and 'fs'. COMMAND is either a scalar value or an array reference
containing the commands the BOS Server should run to start the
process. NOTIFIER specifies the complete pathname of a program that
the BOS Server invokes when the process terminates. It calls the AFS
system library function I<BOZO_CreateBnode>.
=item B<$ok = $bos-E<gt>delete(INSTANCE);>
=item B<$ok = $bos-E<gt>delete(\@INSTANCE);>
pod/v2/afsperlbos.pod view on Meta::CPAN
Set BAK to 1 (default 0) to remove all files from the local
C</usr/afs/bin> directory that have a C<BAK> extension.
Set OLD to 1 (default 0) to remove all files from the local
C</usr/afs/bin> directory that have an C<OLD> extension.
Set CORE to 1 (default 0) to remove all files from the local
C</usr/afs/logs> directory that have a C<core> prefix.
Set ALL to 1 (default 0) to remove all three types of files at once.
If none of these flags are set, no files are removed, but a warning
message is displayed. It calls the AFS system library function
I<BOZO_Prune>.
=item B<$ok = $bos-E<gt>removehost(HOST);>
=item B<$ok = $bos-E<gt>removehost(\@HOST);>
Removes the database server machine HOST from the local C<CellServDB>
pod/v2/afsperlutils.pod view on Meta::CPAN
unlog;
=head1 DESCRIPTION
This module provides several utility functions for the B<AFS module
bundle>. You can retrieve the version number for the underlying AFS
system libraries, for the XS module, and for the AFS server processes.
And it contains several commands that do not belong to any AFS command
suites like creating a new PAG or retrieving and setting the
CPU/operating system type. Any function required must by explicitly
listed by the C<use> statement to be exported into the calling package.
=head1 COMPATIBILITY
B<This release does NOT support any features and interfaces
from version 1.>
=head1 EXPORTS
=head2 Standard Exports
pod/v2/afsperlutils.pod view on Meta::CPAN
=item B<$ok = setpag;>
Creates a new command shell (owned by the issuer of the command) and
associates a new process authentication group (PAG) with the shell and
the user. A PAG is a number guaranteed to identify the issuer of
commands in the new shell uniquely to the local Cache Manager.
=item B<$sysname = sysname([NEWSYSNAME]);>
Reports the CPU/operating system type or sets the CPU/operating system
type to NEWSYSNAME.
=item B<unlog;>
Discards all of the issuer's tokens.
=back
=head1 CURRENT AUTHOR
Norbert E. Gruener E<lt>nog@MPA-Garching.MPG.deE<gt>
pod/v2/afsperlvos.pod view on Meta::CPAN
about access patterns for each volume. If you set FAST (default 0) to
1, it returns only the volume IDs and the numbers of volumes.
The return value is a reference to a hash table containing the values
from the C structure C<volintinfo>. The hash table has the following
keys
backupID cloneID creationDate
dayUse inUse maxquota
parentID server size
status type updateDate
copyDate backupDate accessDate
volid
It calls the AFS system library function I<UV_ListPartitions>.
You can find an example how to print the entire content of the
returned hash reference in the C<examples/v2/vos> directory.
=item B<$vollist = $vos-E<gt>listvolume(VOLUME);>
pod/v2/afsperlvos.pod view on Meta::CPAN
=item B<i> if restoring an incremental dump file.
=back
Set OFFLINE (default 0) to 1 to leave restored volume offline. Set
READONLY (default 0) to 1 to make the restored volume read-only.
If the VOLUME already exists, the OVERWRITE argument is omitted, and
the INTER argument (default 0) is set to 1 the method is interactively
prompting for the type of restore (exactly like the I<vos restore>
command).
It calls the AFS system library function I<UV_RestoreVolume>.
=item B<$ok = $vos-E<gt>setquota(VOLUME, QUOTA [, CLEAR]);>
Sets the QUOTA for the specified volume. Specify the number of
one-kilobyte blocks as a positive integer (1024 is one megabyte).
VOLUME specifies either the complete name or volume ID number of the
volume. Set CLEAR (default 0) to 1 to clear the access counter on the
struct AFSFid Fid;
};
/* tpf nog 03/29/99 */
/* the following was added by leg@andrew, 10/9/96 */
/*#ifdef __hpux*//* only on hp700_ux90 systems */
#if defined(__hpux) || defined(_AIX) || defined(sun) || defined(__sun__) || defined(__sgi) || defined(__linux)
static int32 name_is_numeric(char *);
#endif
typedef SV *AFS__ACL;
typedef struct ktc_principal *AFS__KTC_PRINCIPAL;
typedef struct ktc_token *AFS__KTC_TOKEN;
typedef struct ktc_encryptionKey *AFS__KTC_EKEY;
typedef struct ubik_client *AFS__KAS;
typedef struct ubik_client *AFS__PTS;
typedef struct ubik_client *AFS__VLDB;
typedef struct ubik_client *AFS__VOS;
typedef struct rx_connection *AFS__BOS;
extern struct ubik_client *cstruct;
#include "afs_prototypes.h"
extern int afs_setpag();
static rxkad_level vsu_rxkad_level = rxkad_clear;
static struct ktc_token the_null_token;
static int32 convert_numeric_names = 1;
static int32 rx_initialized = 0;
#define MAXSIZE 2048
#define MAXINSIZE 1300
case VL_ENTDELETED:
sprintf(buffer, "VLDB: entry is deleted (soft delete)\n");
break;
case VL_BADNAME:
sprintf(buffer, "VLDB: volume name is illegal\n");
break;
case VL_BADINDEX:
sprintf(buffer, "VLDB: index was out of range\n");
break;
case VL_BADVOLTYPE:
sprintf(buffer, "VLDB: bad volume type\n");
break;
case VL_BADSERVER:
sprintf(buffer, "VLDB: illegal server number (not within limits)\n");
break;
case VL_BADPARTITION:
sprintf(buffer, "VLDB: bad partition number\n");
break;
case VL_REPSFULL:
sprintf(buffer, "VLDB: run out of space for replication sites\n");
break;
case VL_IDALREADYHASHED:
sprintf(buffer, "VLDB: (RO/BACK) Id already hashed\n");
break;
case VL_ENTRYLOCKED:
sprintf(buffer, "VLDB: vldb entry is already locked\n");
break;
case VL_BADVOLOPER:
sprintf(buffer, "VLDB: bad volume operation code\n");
break;
case VL_BADRELLOCKTYPE:
sprintf(buffer, "VLDB: bad release lock type\n");
break;
case VL_RERELEASE:
sprintf(buffer, "VLDB: status report: last release was aborted\n");
break;
case VL_BADSERVERFLAG:
sprintf(buffer, "VLDB: invalid replication site server flag\n");
break;
case VL_PERM:
sprintf(buffer, "VLDB: no permission access for call\n");
break;
{
if (cryptflag) {
vsu_rxkad_level = rxkad_crypt;
}
else {
vsu_rxkad_level = rxkad_auth;
}
}
#endif
int32 GetVolumeInfo(volid, server, part, voltype, rentry)
afs_int32 volid, *server, *part, *voltype;
register struct nvldbentry *rentry;
{
afs_int32 vcode;
int i, index = -1;
vcode = VLDB_GetEntryByID(volid, -1, rentry);
if (vcode) {
char buffer[256];
sprintf(buffer, "Could not fetch the entry for volume %u from VLDB \n", volid);
VSETCODE(vcode, buffer);
return (vcode);
}
MapHostToNetwork(rentry);
if (volid == rentry->volumeId[ROVOL]) {
*voltype = ROVOL;
for (i = 0; i < rentry->nServers; i++) {
if ((index == -1) && (rentry->serverFlags[i] & ITSROVOL) &&
!(rentry->serverFlags[i] & RO_DONTUSE))
index = i;
}
if (index == -1) {
char buffer[256];
sprintf(buffer, "RO volume is not found in VLDB entry for volume %u\n",
volid);
VSETCODE(-1, buffer);
}
index = Lp_GetRwIndex(rentry);
if (index == -1) {
char buffer[256];
sprintf(buffer, "RW Volume is not found in VLDB entry for volume %u\n", volid);
VSETCODE(-1, buffer);
return -1;
}
if (volid == rentry->volumeId[RWVOL]) {
*voltype = RWVOL;
*server = rentry->serverNumber[index];
*part = rentry->serverPartition[index];
return 0;
}
if (volid == rentry->volumeId[BACKVOL]) {
*voltype = BACKVOL;
*server = rentry->serverNumber[index];
*part = rentry->serverPartition[index];
return 0;
}
/* should never reach this ? */
printf("FIXME: reached end of control at %d\n",__LINE__);
return -1;
}
static int VolNameOK(name)
if (fast) {
safe_hv_store(vol, "volid", 5, newSViv(pntr->volid), 0);
}
else {
safe_hv_store(vol, "status", 6, newSViv(pntr->status), 0);
safe_hv_store(vol, "volid", 5, newSViv(pntr->volid), 0);
if (pntr->status == VOK) {
safe_hv_store(vol, "name", 4, newSVpv(pntr->name, strlen((char *) pntr->name)), 0);
if (pntr->type == 0)
safe_hv_store(vol, "type", 4, newSVpv("RW", 2), 0);
if (pntr->type == 1)
safe_hv_store(vol, "type", 4, newSVpv("RO", 2), 0);
if (pntr->type == 2)
safe_hv_store(vol, "type", 4, newSVpv("BK", 2), 0);
safe_hv_store(vol, "size", 4, newSViv(pntr->size), 0);
if (pntr->inUse == 1) {
safe_hv_store(vol, "inUse", 5, newSVpv("On-line", 7), 0);
*totalOK += 1;
}
else {
safe_hv_store(vol, "inUse", 5, newSVpv("Off-line", 8), 0);
*totalNotOK += 1;
HV *stat6 = (HV *) sv_2mortal((SV *) newHV());
HV *stat7 = (HV *) sv_2mortal((SV *) newHV());
HV *stat8 = (HV *) sv_2mortal((SV *) newHV());
/* Fully-detailed listing. */
safe_hv_store(stats, "status", 6, newSViv(a_xInfoP->status), 0);
safe_hv_store(stats, "volid", 5, newSViv(a_xInfoP->volid), 0);
if (a_xInfoP->status == VOK) {
/* Volume's status is OK - all the fields are valid. */
if (a_xInfoP->type == 0)
safe_hv_store(stats, "type", 4, newSVpv("RW", 2), 0);
if (a_xInfoP->type == 1)
safe_hv_store(stats, "type", 4, newSVpv("RO", 2), 0);
if (a_xInfoP->type == 2)
safe_hv_store(stats, "type", 4, newSVpv("BK", 2), 0);
safe_hv_store(stats, "size", 4, newSViv(a_xInfoP->size), 0);
safe_hv_store(stats, "filecount", 9, newSViv(a_xInfoP->filecount), 0);
if (a_xInfoP->inUse == 1) {
safe_hv_store(stats, "inUse", 5, newSVpv("On-line", 7), 0);
(*a_totalOKP)++;
}
else {
safe_hv_store(stats, "inUse", 5, newSVpv("Off-line", 8), 0);
else if (a_xInfoP->status == VBUSY) {
(*a_totalBusyP)++;
qPut(&busyHead, a_xInfoP->volid);
} /*Busy volume */
else {
(*a_totalNotOKP)++;
qPut(¬okHead, a_xInfoP->volid);
} /*Screwed volume */
} /*myXDisplayFormat */
static void VolumeStats(volinfo, pntr, entry, server, part, voltype)
HV *volinfo;
volintInfo *pntr;
struct nvldbentry *entry;
int voltype;
afs_int32 server, part;
{
int totalOK, totalNotOK, totalBusy;
myDisplayFormat(volinfo, pntr, server, part, &totalOK, &totalNotOK, &totalBusy, 0);
return;
}
static void DisplayVolumes(partition, server, part, pntr, count, fast)
HV *partition;
for (i = 0; i < entry->nServers; i++) {
HV *server = (HV *) sv_2mortal((SV *) newHV());
MapPartIdIntoName(entry->serverPartition[i], pname);
strcpy(hostname, (char *) hostutil_GetNameByINet(entry->serverNumber[i]));
safe_hv_store(server, "name", 4, newSVpv(hostname, strlen((char *) hostname)), 0);
safe_hv_store(server, "partition", 9, newSVpv(pname, strlen((char *) pname)), 0);
safe_hv_store(server, "serverFlags", 11, newSViv(entry->serverFlags[i]), 0);
if (entry->serverFlags[i] & ITSRWVOL)
safe_hv_store(server, "type", 4, newSVpv("RW", 2), 0);
else
safe_hv_store(server, "type", 4, newSVpv("RO", 2), 0);
if (isMixed) {
if (entry->serverFlags[i] & NEW_REPSITE)
safe_hv_store(server, "release", 7, newSVpv("New release", 11), 0);
else
safe_hv_store(server, "release", 7, newSVpv("Old release", 11), 0);
}
else {
if (entry->serverFlags[i] & RO_DONTUSE)
safe_hv_store(server, "release", 7, newSVpv("Not released", 12), 0);
sprintf(buf, "%s", (char *) hostutil_GetNameByINet(*addrp));
safe_hv_store(addr, key, 6, newSVpv(buf, strlen(buf)), 0);
#ifdef OpenAFS
}
#endif
} /* for loop */
return;
}
static void GetServerAndPart(entry, voltype, server, part, previdx)
struct nvldbentry *entry;
afs_int32 *server, *part;
int voltype;
int *previdx;
{
int i, istart, vtype;
*server = -1;
*part = -1;
/* Doesn't check for non-existance of backup volume */
if ((voltype == RWVOL) || (voltype == BACKVOL)) {
vtype = ITSRWVOL;
istart = 0; /* seach the entire entry */
}
else {
vtype = ITSROVOL;
/* Seach from beginning of entry or pick up where we left off */
istart = ((*previdx < 0) ? 0 : *previdx + 1);
}
for (i = istart; i < entry->nServers; i++) {
if (entry->serverFlags[i] & vtype) {
*server = entry->serverNumber[i];
*part = entry->serverPartition[i];
*previdx = i;
return;
}
}
/* Didn't find any, return -1 */
*previdx = -1;
BSETCODE(code, buf);
return -1;
}
if (firstTime && aint32p && (istatus.flags & BOZO_BADDIRACCESS)) {
char buf[256];
sprintf(buf, "Bosserver reports inappropriate access on server directories\n");
BSETCODE(-1, buf);
}
/*printf("Instance %s, ", aname); */
if (aint32p) {
/* printf("(type is %s) ", buffer); */
safe_hv_store(stats, "type", 4, newSVpv(buffer, strlen(buffer)), 0);
}
sprintf(info, "%s", "");
if (istatus.fileGoal == istatus.goal) {
if (!istatus.goal)
sprintf(info, "%s", "disabled");
}
else {
if (istatus.fileGoal)
sprintf(info, "%s", "temporarily disabled");
if (code)
break;
/* fprintf(stderr, " Command %d is '%s'\n", i+1, buffer); */
av_push(av, newSVpv(buffer, strlen(buffer)));
}
safe_hv_store(stats, "command", 7, newRV_inc((SV *) (av)), 0);
tp = buffer;
code = BOZO_GetInstanceParm(aconn, aname, 999, &tp);
if (!code) {
/* Any type of failure is treated as not having a notifier program */
/* printf(" Notifier is '%s'\n", buffer); */
safe_hv_store(stats, "notifier", 8, newSVpv(buffer, strlen(buffer)), 0);
}
/* printf("\n"); */
}
return 0;
}
static afs_int32 GetServerGoal(aconn, aname)
char *aname;
}
return 1;
}
static int parse_volstat(stats, space)
HV *stats;
char *space;
{
struct VolumeStatus *status;
char *name, *offmsg, *motd;
char type[32];
status = (VolumeStatus *) space;
name = (char *) status + sizeof(*status);
offmsg = name + strlen(name) + 1;
motd = offmsg + strlen(offmsg) + 1;
safe_hv_store(stats, "Name", 4, newSVpv(name, strlen(name)), 0);
safe_hv_store(stats, "OffMsg", 6, newSVpv(offmsg, strlen(offmsg)), 0);
safe_hv_store(stats, "Motd", 4, newSVpv(motd, strlen(motd)), 0);
safe_hv_store(stats, "Vid", 3, newSViv(status->Vid), 0);
safe_hv_store(stats, "ParentId", 8, newSViv(status->ParentId), 0);
safe_hv_store(stats, "Online", 6, newSViv(status->Online), 0);
safe_hv_store(stats, "InService", 9, newSViv(status->InService), 0);
safe_hv_store(stats, "Blessed", 7, newSViv(status->Blessed), 0);
safe_hv_store(stats, "NeedsSalvage", 12, newSViv(status->NeedsSalvage), 0);
if (status->Type == ReadOnly)
strcpy(type, "ReadOnly");
else if (status->Type == ReadWrite)
strcpy(type, "ReadWrite");
else
sprintf(type, "%d", status->Type);
safe_hv_store(stats, "Type", 4, newSVpv(type, strlen(type)), 0);
safe_hv_store(stats, "MinQuota", 8, newSViv(status->MinQuota), 0);
safe_hv_store(stats, "MaxQuota", 8, newSViv(status->MaxQuota), 0);
safe_hv_store(stats, "BlocksInUse", 11, newSViv(status->BlocksInUse), 0);
safe_hv_store(stats, "PartBlocksAvail", 15, newSViv(status->PartBlocksAvail), 0);
safe_hv_store(stats, "PartMaxBlocks", 13, newSViv(status->PartMaxBlocks), 0);
return 1;
}
/* end of helper functions for FS class: */
int plen, nlen;
int32 rights;
char *name, *perm;
if (sv_isa(acl, "AFS::ACL") && SvROK(acl)
&& (SvTYPE(SvRV(acl)) == SVt_PVAV)
) {
object = (AV *) SvRV(acl);
}
else {
croak("acl is not of type AFS::ACL");
}
ph = nh = NULL;
sv = av_fetch(object, 0, 0);
if (sv) {
SV *sph = *sv;
if (SvROK(sph) && (SvTYPE(SvRV(sph)) == SVt_PVHV)) {
ph = (HV *) SvRV(sph);
}
XSRETURN(1);
}
int32
vos_release(cstruct, name, force=Nullsv)
AFS::VOS cstruct
char *name
SV * force
PREINIT:
struct nvldbentry entry;
afs_int32 avolid, aserver, apart, vtype, code, err;
int iforce;
CODE:
{
if (!force) {
force = newSViv(0);
}
if (!SvIOKp(force)) {
char buffer[256];
sprintf(buffer, "Flag \"force\" should be numeric.\n");
VSETCODE(EINVAL, buffer);
avolid = vsu_GetVolumeID(name, cstruct, &err);
if (avolid == 0) {
char buffer[256];
if (err)
set_errbuff(buffer, err);
else
sprintf(buffer, "AFS::VOS: can't find volume '%s'\n", name);
VSETCODE(err ? err : ENOENT, buffer);
goto done;
}
code = GetVolumeInfo(avolid, &aserver, &apart, &vtype, &entry);
if (code) {
SETCODE(code);
goto done;
}
if (vtype != RWVOL) {
char buffer[256];
sprintf(buffer, "%s not a RW volume\n", name);
VSETCODE(ENOENT, buffer);
goto done;
}
if (!ISNAMEVALID(entry.name)) {
char buffer[256];
sprintf(buffer, "Volume name %s is too long, rename before releasing\n", entry.name);
VSETCODE(E2BIG, buffer);
;
}
OUTPUT:
RETVAL
int32
vos_backup(cstruct, name)
AFS::VOS cstruct
char *name
PREINIT:
int32 avolid, aserver, apart, vtype, code, err;
int32 buvolid, buserver, bupart, butype;
struct nvldbentry entry;
struct nvldbentry buentry;
CODE:
{
RETVAL = 0;
avolid = vsu_GetVolumeID(name, cstruct, &err);
if (avolid == 0) {
char buffer[256];
if (err)
set_errbuff(buffer, err);
else
sprintf(buffer, "AFS::VOS: can't find volume ID or name '%s'\n", name);
VSETCODE(err ? err : ENOENT, buffer);
goto done;
}
code = GetVolumeInfo(avolid, &aserver, &apart, &vtype, &entry);
if (code) {
SETCODE(code);
goto done;
}
/* verify this is a readwrite volume */
if (vtype != RWVOL) {
char buffer[256];
sprintf(buffer, "%s not RW volume\n", name);
VSETCODE(-1, buffer);
goto done;
}
/* is there a backup volume already? */
if (entry.flags & BACK_EXISTS) {
/* yep, where is it? */
buvolid = entry.volumeId[BACKVOL];
code = GetVolumeInfo(buvolid, &buserver, &bupart, &butype, &buentry);
if (code) {
SETCODE(code);
goto done;
}
/* is it local? */
code = VLDB_IsSameAddrs(buserver, aserver, &err);
if (err) {
char buffer[256];
sprintf(buffer,
"Failed to get info about server's %d address(es) from vlserver; aborting call!\n",
if (previdx == -1) {
char buffer[256];
sprintf(buffer, "Volume %s does not exist in VLDB\n\n", name);
VSETCODE(ENOENT, buffer);
goto done;
}
Zero(&info, 1, volintInfo);
info.volid = volid;
info.type = RWVOL;
info.creationDate = -1;
info.updateDate = -1;
info.dayUse = -1;
info.maxquota = -1;
info.flags = -1;
info.spare0 = -1;
info.spare1 = -1;
info.spare2 = -1;
info.spare3 = -1;
char *name
char *file
char *id
SV * inter
char *overwrite
SV * offline
SV * readonly
PREINIT:
afs_int32 avolid, aparentid, aserver, apart, code, vcode, err;
afs_int32 aoverwrite = AFS_ASK;
int restoreflags, voltype = RWVOL, ireadonly = 0, ioffline = 0;
char afilename[NameLen], avolname[VOLSER_MAXVOLNAME +1];
char volname[VOLSER_MAXVOLNAME +1];
struct nvldbentry entry;
CODE:
{
aparentid = 0;
if (!inter) {
inter = newSViv(0);
}
if (!offline) {
else {
char buffer[256];
sprintf(buffer, "AFS::VOS: %s is not a valid OVERWRITE argument\n",
overwrite);
VSETCODE(-1, buffer);
RETVAL = 0;
goto done;
}
}
if ((ireadonly))
voltype = ROVOL;
aserver = GetServer(server);
if (aserver == 0) {
char buffer[256];
sprintf(buffer, "AFS::VOS: server '%s' not found in host table\n", server);
VSETCODE(-1, buffer);
RETVAL = 0;
goto done;
}
apart = volutil_GetPartitionID(partition);
}
}
else if ((!ireadonly && Lp_GetRwIndex(&entry) == -1) /* RW volume does not exist - do a full */
||(ireadonly && !Lp_ROMatch(0, 0, &entry))) { /* RO volume does not exist - do a full */
restoreflags = RV_FULLRST;
if ((aoverwrite == AFS_INC) || (aoverwrite == AFS_ABORT))
fprintf(stderr, "%s Volume does not exist; Will perform a full restore\n",
ireadonly ? "RO" : "RW");
if (avolid == 0) {
avolid = entry.volumeId[voltype];
}
else if (entry.volumeId[voltype] != 0 && entry.volumeId[voltype] != avolid) {
avolid = entry.volumeId[voltype];
}
aparentid = entry.volumeId[RWVOL];
}
else { /* volume exists - do we do a full incremental or abort */
int Oserver, Opart, Otype, vol_elsewhere = 0;
struct nvldbentry Oentry;
int c, dc;
if (avolid == 0) {
avolid = entry.volumeId[voltype];
}
else if (entry.volumeId[voltype] != 0 && entry.volumeId[voltype] != avolid) {
avolid = entry.volumeId[voltype];
}
aparentid = entry.volumeId[RWVOL];
/* A file name was specified - check if volume is on another partition */
vcode = GetVolumeInfo(avolid, &Oserver, &Opart, &Otype, &Oentry);
if (vcode) {
SETCODE(0);
RETVAL = 0;
goto done;
}
vcode = VLDB_IsSameAddrs(Oserver, aserver, &err);
if (err) {
char buffer[256];
sprintf(buffer,
VSETCODE(-1, buffer);
RETVAL = 0;
goto done;
}
/* Ask what to do */
if (vol_elsewhere) {
char buffer[256];
sprintf(buffer,
"The volume %s %u already exists on a different server/part\n",
volname, entry.volumeId[voltype]);
VSETCODE(-1, buffer);
fprintf(stderr, "Do you want to do a full restore or abort? [fa](a): ");
}
else {
char buffer[256];
sprintf(buffer, "The volume %s %u already exists in the VLDB\n",
volname, entry.volumeId[voltype]);
VSETCODE(-1, buffer);
fprintf(stderr,
"Do you want to do a full/incremental restore or abort? [fia](a): ");
}
dc = c = getchar();
while (!(dc == EOF || dc == '\n'))
dc = getchar(); /* goto end of line */
if ((c == 'f') || (c == 'F'))
aoverwrite = AFS_FULL;
else if ((c == 'i') || (c == 'I'))
vos_dump(cstruct, id, time=NULL, file=NULL, server=NULL, partition=NULL, clone=Nullsv, omit=Nullsv)
AFS::VOS cstruct
char *id
char *time
char *file
char *server
char *partition
SV * clone
SV * omit
PREINIT:
afs_int32 avolid, aserver, apart, voltype, fromdate=0, code=0, err, i;
char filename[NameLen];
struct nvldbentry entry;
afs_int32 omitdirs = 0;
CODE:
{
if (!clone)
clone = newSViv(0);
if (!omit)
omit = newSViv(0);
if ((!SvIOKp(omit))) {
}
apart = volutil_GetPartitionID(partition);
if (apart < 0) {
char buffer[256];
sprintf(buffer, "Invalid partition name\n");
VSETCODE(-1, buffer);
goto done;
}
}
else {
code = GetVolumeInfo(avolid, &aserver, &apart, &voltype, &entry);
if (code) {
SETCODE(code);
goto done;
}
}
if (time && strcmp(time, "0")) {
code = ktime_DateToInt32(time, &fromdate);
if (code) {
char buffer[256];
void
vos_listvolume(cstruct, name)
AFS::VOS cstruct
char *name
PREINIT:
struct nvldbentry entry;
afs_int32 vcode = 0;
volintInfo *pntr = (volintInfo *)0;
afs_int32 volid;
afs_int32 code, err;
int voltype, foundserv = 0, foundentry = 0;
afs_int32 aserver, apart;
char apartName[10];
int previdx = -1;
HV *volinfo = (HV*)sv_2mortal((SV*)newHV());
PPCODE:
{
volid = vsu_GetVolumeID(name, cstruct, &err); /* -id */
if (volid == 0) {
char buffer[256];
if (err)
}
vcode = VLDB_GetEntryByID(volid, -1, &entry);
if (vcode) {
char buffer[256];
sprintf(buffer, "Could not fetch the entry for volume number %u from VLDB \n", volid);
VSETCODE(vcode, buffer);
XSRETURN_UNDEF;
}
MapHostToNetwork(&entry);
if (entry.volumeId[RWVOL] == volid)
voltype = RWVOL;
else if (entry.volumeId[BACKVOL] == volid)
voltype = BACKVOL;
else /* (entry.volumeId[ROVOL] == volid) */
voltype = ROVOL;
do { /* do {...} while (voltype == ROVOL) */
/* Get the entry for the volume. If its a RW vol, get the RW entry.
* It its a BK vol, get the RW entry (even if VLDB may say the BK doen't exist).
* If its a RO vol, get the next RO entry.
*/
GetServerAndPart(&entry, ((voltype == ROVOL) ? ROVOL : RWVOL), &aserver, &apart,
&previdx);
if (previdx == -1) { /* searched all entries */
if (!foundentry) {
char buffer[256];
sprintf(buffer, "Volume %s does not exist in VLDB\n\n", name);
VSETCODE(ENOENT, buffer);
XSRETURN_UNDEF;
}
break;
}
foundentry = 1;
/* Get information about the volume from the server */
code = UV_ListOneVolume(aserver, apart, volid, &pntr);
if (code) {
char buffer[256];
if (code == ENODEV) {
if ((voltype == BACKVOL) && !(entry.flags & BACK_EXISTS)) {
/* The VLDB says there is no backup volume and its not on disk */
sprintf(buffer, "Volume %s does not exist\n", name);
}
else {
sprintf(buffer,
"Volume does not exist on server %s as indicated by the VLDB\n",
hostutil_GetNameByINet(aserver));
}
}
else {
if (pntr)
free(pntr);
VSETCODE(code, buffer);
XSRETURN_UNDEF;
}
else {
foundserv = 1;
MapPartIdIntoName(apart, apartName);
/* safe_hv_store(volinfo, "name", 4, newSVpv(name, strlen((char *) name)), 0); */
safe_hv_store(volinfo, "partition", 9, newSVpv(apartName, strlen((char *) apartName)), 0);
VolumeStats(volinfo, pntr, &entry, aserver, apart, voltype);
if ((voltype == BACKVOL) && !(entry.flags & BACK_EXISTS)) {
/* The VLDB says there is no backup volume yet we found one on disk */
char buffer[256];
sprintf(buffer, "Volume %s does not exist in VLDB\n", name);
if (pntr)
free(pntr);
VSETCODE(ENOENT, buffer);
XSRETURN_UNDEF;
}
}
if (pntr)
free(pntr);
} while (voltype == ROVOL);
SETCODE(0);
ST(0) = sv_2mortal(newRV_inc((SV *) volinfo));
XSRETURN(1);
}
MODULE = AFS PACKAGE = AFS::VLDB PREFIX = vldb_
AFS::VLDB
strcpy(buf, string);
else {
/* prompt for key */
code = des_read_pw_string(buf, sizeof(buf), "input key: ", 0);
if (code || strlen(buf) == 0) {
char buffer[256];
sprintf(buffer, "Bad key: \n");
BSETCODE(code ? code : -1, buffer);
RETVAL = 0;
}
code = des_read_pw_string(ver, sizeof(ver), "Retype input key: ", 0);
if (code || strlen(ver) == 0) {
char buffer[256];
sprintf(buffer, "Bad key: \n");
BSETCODE(code ? code : -1, buffer);
RETVAL = 0;
}
if (strcmp(ver, buf) != 0) {
char buffer[256];
sprintf(buffer, "\nInput key mismatch\n");
BSETCODE(-1, buffer);
} /* for loop */
}
}
SETCODE(code);
RETVAL = (code == 0);
}
OUTPUT:
RETVAL
int32
bos__create(self, name, type, object, notifier=NULL)
AFS::BOS self
char *name
char *type
SV *object
char *notifier
PREINIT:
int32 i, len, code = 0;
char *parms[6];
AV *av; SV *sv;
STRLEN namelen;
CODE:
{
if (SvTYPE(SvRV(object)) != SVt_PVAV) {
for (i = 0; i <= len && i < 6; i++) {
sv = *av_fetch(av, i, 0);
if (sv)
parms[i] = SvPV(sv, namelen);
}
}
if (notifier == NULL)
notifier = NONOTIFIER;
code = BOZO_CreateBnode(self, type, name, parms[0], parms[1], parms[2],
parms[3], parms[4], notifier);
if (code) {
char buffer[256];
sprintf(buffer,
"AFS::BOS: failed to create new server instance %s of type '%s' (%s)\n", name,
type, em(code));
BSETCODE(code, buffer);
goto done;
}
SETCODE(code);
done:
RETVAL = (code == 0);
}
OUTPUT:
RETVAL
int32
bos_setrestart(self, time, general=Nullsv, newbinary=Nullsv)
AFS::BOS self
char *time
SV * general
SV * newbinary
PREINIT:
int32 code = 0, count = 0;
struct ktime restartTime;
afs_int32 type;
int igeneral;
int inewbinary;
CODE:
{
if (!general) {
general = newSViv(0);
}
if (!SvIOKp(general)) {
char buffer[256];
sprintf(buffer, "AFS::BOS: Flag \"general\" should be numeric.\n");
if (!SvIOKp(newbinary)) {
char buffer[256];
sprintf(buffer, "AFS::BOS: Flag \"newbinary\" should be numeric.\n");
BSETCODE(-1, buffer);
XSRETURN_UNDEF;
}
igeneral = SvIV(general);
inewbinary = SvIV(newbinary);
if (igeneral) {
count++;
type = 1;
}
if (inewbinary) {
count++;
type = 2;
}
if (count > 1) {
char buffer[80];
sprintf(buffer, "AFS::BOS: can't specify more than one restart time at a time\n");
BSETCODE(-1, buffer);
goto done;
}
if (count == 0)
type = 1; /* by default set general restart time */
if (code = ktime_ParsePeriodic(time, &restartTime)) {
char buffer[240];
sprintf(buffer, "AFS::BOS: failed to parse '%s' as periodic restart time(%s)\n",
time, em(code));
BSETCODE(code, buffer);
goto done;
}
code = BOZO_SetRestartTime(self, type, &restartTime);
if (code) {
char buffer[240];
sprintf(buffer, "AFS::BOS: failed to set restart time at server (%s)\n", em(code));
BSETCODE(code, buffer);
goto done;
}
code = 0;
SETCODE(code);
done:
int32 code
PPCODE:
{
ST(0) = sv_newmortal();
sv_setpv(ST(0), (char *) error_message(code));
XSRETURN(1);
}
/* this function is generated automatically by constant_gen */
/* You didn't think I would type in this crap did you? */
/* thats what perl is for :-) */
#if defined(AFS_3_4)
void
constant(name, arg=0)
char * name
int arg
PPCODE:
{
src/BOS/BOS.pm view on Meta::CPAN
sub DESTROY {
my (undef, undef, undef, $subroutine) = caller(1);
if (! defined $subroutine or $subroutine !~ /eval/) { undef $_[0]; } # self->DESTROY
else { AFS::BOS::_DESTROY($_[0]); } # undef self
}
sub create {
my $self = shift;
my $process = shift;
my $type = shift;
my $command = shift;
my $notifier = shift;
if (! defined $process ||
! defined $type ||
! defined $command) {
carp "AFS::BOS->create: incomplete arguements specified ...\n";
return 0;
}
if (ref($command) eq 'ARRAY') {
if ($notifier) { $self->_create($process, $type, $command, $notifier); }
else { $self->_create($process, $type, $command); }
}
elsif (ref($command) eq '' ) {
my @commands;
$commands[0] = $command;
if ($notifier) { $self->_create($process, $type, \@commands, $notifier); }
else { $self->_create($process, $type, \@commands); }
}
else {
carp "AFS::BOS->create: not a valid COMMAND input ...\n";
return 0;
}
}
sub restart {
my $self = shift;
src/Makefile.PL view on Meta::CPAN
}
if ($v_numb gt v1.4.11 and $v_string =~ /openafs/) {
$d_flag .= ' -DOpenAFS_1_4_12';
}
# print out a summary of determined data
print "AFS Version = $v_string v$v_numb \n";
print "Your AFS system libraries are located at: $AFSPath \n";
print " their major version is: $m_version \n";
print " and their type is: \"pthreaded\"\n" if ($Config{usethreads});
print "Your AFS system type seems to be: $alpha_sys \n\n";
print "The Compile Flags are set to: $a_flag \n";
print " $d_flag \n";
print " $e_flag \n";
print " $p_flag\n\n";
# set the Makefile values
my $ccflags = $Config::Config{ccflags} || '';
my %MakefileArgs = (
'NAME' => 'AFS',
'VERSION_FROM' => 'AFS.pm',
src/Makefile.PL view on Meta::CPAN
#$MakefileArgs{LD} = 'gcc';
$MakefileArgs{CCCDLFLAGS} = '-fPIC';
}
elsif ($Config{osname} =~ /linux/) {
$MakefileArgs{LIBS}->[0] .= ' -lresolv';
}
# elsif ($Config{osname} =~ /dec_osf/) {
# # hier fehlt noch was !!!!!
# }
else {
warn("System type '$Config{osname}' not yet tested with this Makefile.PL...\n\n"
. "Using the default values, which may or may not work\n"
. "If it is working, please inform the maintainer of this package.\n"
. "Thank you.\n\n");
}
WriteMakefile(%MakefileArgs);
# change the library name of the AFS system library "util.a"
my $command = "\'s#-lutil#$AFSPath/lib/afs/util.a#\'";
system("perl -p -i.bak -e $command Makefile") unless -f "$AFSPath/lib/afs/libutil.a";
src/Makefile.PL view on Meta::CPAN
# change the library name of the AFS system library "-lafsauthent"
if ($alpha_sys =~ /linux/ && $alpha_sys !~ /i386_linux2/) {
$command = "\'s#-lc -lafsauthent -lc#$AFSPath/lib/libafsauthent_pic.a#g\'";
}
else {
$command = "\'s#-lc -lafsauthent -lc#$AFSPath/lib/libafsauthent.a#g\'";
}
system("perl -p -i.bak -e $command Makefile");
# make changes to the typemap file if Perl < 5.6.0
$command = "\'s#T_UV#T_IV#\'";
system("perl -p -i.bak -e $command typemap") unless $] >= 5.006;
src/afs_prototypes.h view on Meta::CPAN
/*
* afs_prototypes.h for AFS Perl Extension module
*
* Prototypes for OpenAFS subroutines
* picked up from the OpenAFS header files
*/
#if defined(OpenAFS_1_0) || defined(OpenAFS_1_1) || defined(OpenAFS_1_2) || defined(OpenAFS_1_3)
extern const char *error_message();
#endif
extern int UV_SetSecurity(struct rx_securityClass *, afs_int32);
extern char *hostutil_GetNameByINet();
extern struct hostent *hostutil_GetHostByName(register char *ahost);
extern char *volutil_PartitionName();
src/afs_prototypes.h view on Meta::CPAN
extern int VLDB_IsSameAddrs(afs_int32, afs_int32, afs_int32 *);
extern int VLDB_ListAttributes(VldbListByAttributes *attrp, afs_int32 *entriesp, nbulkentries *blkentriesp);
extern int VLDB_ListAttributesN2(VldbListByAttributes *attrp, char *name, afs_int32 thisindex,
afs_int32 *nentriesp, nbulkentries *blkentriesp, afs_int32 *nextindexp);
extern int VL_ChangeAddr( struct rx_connection *z_conn, afs_int32, afs_int32);
extern int VL_DeleteEntry(struct rx_connection *,afs_int32, afs_int32 );
extern int VL_GetAddrs( struct rx_connection *, afs_int32 Handle, afs_int32, VLCallBack *,
afs_int32 * nentries, bulkaddrs *);
extern int VL_GetAddrsU(struct rx_connection *z_conn, ListAddrByAttributes * inaddr,
afsUUID * uuidp1, afs_int32 * uniquifier, afs_int32 * nentries, bulkaddrs * blkaddrs);
extern int VL_SetLock(struct rx_connection *z_conn, afs_int32 Volid, afs_int32 voltype,
afs_int32 voloper);
extern int VL_ReleaseLock(struct rx_connection *z_conn, afs_int32 Volid, afs_int32 voltype,
afs_int32 ReleaseType);
/* extern void des_string_to_key(char *str, register des_cblock * key); */
extern void des_string_to_key();
#if defined(OpenAFS_1_4) || defined(OpenAFS_1_5)
extern int vsu_ExtractName(char rname[], char name[]);
#endif
extern afs_uint32 util_GetUInt32(register char *as, afs_uint32 * aval);
extern afs_int32 util_GetInt32(register char *as, afs_int32 * aval);
src/inc/Test/Builder.pm view on Meta::CPAN
$result->{name} = $name;
}
else {
$result->{name} = '';
}
if( $todo ) {
my $what_todo = $todo;
$out .= " # TODO $what_todo";
$result->{reason} = $what_todo;
$result->{type} = 'todo';
}
else {
$result->{reason} = '';
$result->{type} = '';
}
$Test_Results[$Curr_Test-1] = $result;
$out .= "\n";
$self->_print($out);
unless( $test ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
$self->diag(" $msg test ($file at line $line)\n");
src/inc/Test/Builder.pm view on Meta::CPAN
$self->ok($test, $name);
$self->_is_diag($got, '==', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '==', $expect, $name);
}
sub _is_diag {
my($self, $got, $type, $expect) = @_;
foreach my $val (\$got, \$expect) {
if( defined $$val ) {
if( $type eq 'eq' ) {
# quote and force string context
$$val = "'$$val'"
}
else {
# force numeric context
$$val = $$val+0;
}
}
else {
$$val = 'undef';
src/inc/Test/Builder.pm view on Meta::CPAN
%13s '%s'
DIAGNOSTIC
}
return $ok;
}
sub cmp_ok {
my($self, $got, $type, $expect, $name) = @_;
my $test;
{
local $^W = 0;
local($@,$!); # don't interfere with $@
# eval() sometimes resets $!
$test = eval "\$got $type \$expect";
}
local $Level = $Level + 1;
my $ok = $self->ok($test, $name);
unless( $ok ) {
if( $type =~ /^(eq|==)$/ ) {
$self->_is_diag($got, $type, $expect);
}
else {
$self->_cmp_diag($got, $type, $expect);
}
}
return $ok;
}
sub _cmp_diag {
my($self, $got, $type, $expect) = @_;
$got = defined $got ? "'$got'" : 'undef';
$expect = defined $expect ? "'$expect'" : 'undef';
return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
%s
%s
%s
DIAGNOSTIC
}
sub BAILOUT {
my($self, $reason) = @_;
src/inc/Test/Builder.pm view on Meta::CPAN
lock($Curr_Test);
$Curr_Test++;
my %result;
share(%result);
%result = (
'ok' => 1,
actual_ok => 1,
name => '',
type => 'skip',
reason => $why,
);
$Test_Results[$Curr_Test-1] = \%result;
my $out = "ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # skip $why\n";
$Test->_print($out);
src/inc/Test/Builder.pm view on Meta::CPAN
lock($Curr_Test);
$Curr_Test++;
my %result;
share(%result);
%result = (
'ok' => 1,
actual_ok => 0,
name => '',
type => 'todo_skip',
reason => $why,
);
$Test_Results[$Curr_Test-1] = \%result;
my $out = "not ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # TODO & SKIP $why\n";
$Test->_print($out);
src/inc/Test/Builder.pm view on Meta::CPAN
$Curr_Test = $num;
if( $num > @Test_Results ) {
my $start = @Test_Results ? $#Test_Results + 1 : 0;
for ($start..$num-1) {
my %result;
share(%result);
%result = ( ok => 1,
actual_ok => undef,
reason => 'incrementing test number',
type => 'unknown',
name => undef
);
$Test_Results[$_] = \%result;
}
}
}
return $Curr_Test;
}
src/inc/Test/More.pm view on Meta::CPAN
return $ok;
}
sub _format_stack {
my(@Stack) = @_;
my $var = '$FOO';
my $did_arrow = 0;
foreach my $entry (@Stack) {
my $type = $entry->{type} || '';
my $idx = $entry->{'idx'};
if( $type eq 'HASH' ) {
$var .= "->" unless $did_arrow++;
$var .= "{$idx}";
}
elsif( $type eq 'ARRAY' ) {
$var .= "->" unless $did_arrow++;
$var .= "[$idx]";
}
elsif( $type eq 'REF' ) {
$var = "\${$var}";
}
}
my @vals = @{$Stack[-1]{vals}}[0,1];
my @vars = ();
($vars[0] = $var) =~ s/\$FOO/ \$got/;
($vars[1] = $var) =~ s/\$FOO/\$expected/;
my $out = "Structures begin differing at:\n";
src/inc/Test/More.pm view on Meta::CPAN
sub eq_array {
my($a1, $a2) = @_;
return 1 if $a1 eq $a2;
my $ok = 1;
my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
for (0..$max) {
my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
$ok = _deep_check($e1,$e2);
pop @Data_Stack if $ok;
last unless $ok;
}
return $ok;
}
sub _deep_check {
my($e1, $e2) = @_;
src/inc/Test/More.pm view on Meta::CPAN
$ok = eq_array($e1, $e2);
}
elsif( UNIVERSAL::isa($e1, 'HASH') and
UNIVERSAL::isa($e2, 'HASH') )
{
$ok = eq_hash($e1, $e2);
}
elsif( UNIVERSAL::isa($e1, 'REF') and
UNIVERSAL::isa($e2, 'REF') )
{
push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
pop @Data_Stack if $ok;
}
elsif( UNIVERSAL::isa($e1, 'SCALAR') and
UNIVERSAL::isa($e2, 'SCALAR') )
{
push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
}
else {
push @Data_Stack, { vals => [$e1, $e2] };
$ok = 0;
}
}
}
return $ok;
src/inc/Test/More.pm view on Meta::CPAN
sub eq_hash {
my($a1, $a2) = @_;
return 1 if $a1 eq $a2;
my $ok = 1;
my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
foreach my $k (keys %$bigger) {
my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
$ok = _deep_check($e1, $e2);
pop @Data_Stack if $ok;
last unless $ok;
}
return $ok;
}
sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
src/ppport.h view on Meta::CPAN
grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
load_module() NEED_load_module NEED_load_module_GLOBAL
mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
src/ppport.h view on Meta::CPAN
av_pop|||
av_push|||
av_reify|||
av_shift|||
av_store|||
av_tindex||5.017009|
av_top_index||5.017009|
av_undef|||
av_unshift|||
ax|||n
bad_type_gv|||
bad_type_pv|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
blockhook_register||5.013003|
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
bytes_cmp_utf8||5.013007|
src/ppport.h view on Meta::CPAN
call_pv|5.006000||p
call_sv|5.006000||p
caller_cx||5.013005|
calloc||5.007002|n
cando|||
cast_i32||5.006000|
cast_iv||5.006000|
cast_ulong||5.006000|
cast_uv||5.006000|
check_locale_boundary_crossing|||
check_type_and_open|||
check_uni|||
check_utf8_print|||
checkcomma|||
ckWARN|5.006000||p
ck_entersub_args_core|||
ck_entersub_args_list||5.013006|
ck_entersub_args_proto_or_list||5.013006|
ck_entersub_args_proto||5.013006|
ck_warner_d||5.011001|v
ck_warner||5.011001|v
src/ppport.h view on Meta::CPAN
cophh_fetch_pvn||5.013007|
cophh_fetch_pvs||5.013007|
cophh_fetch_pv||5.013007|
cophh_fetch_sv||5.013007|
cophh_free||5.013007|
cophh_new_empty||5.019003|
cophh_store_pvn||5.013007|
cophh_store_pvs||5.013007|
cophh_store_pv||5.013007|
cophh_store_sv||5.013007|
core_prototype|||
core_regclass_swash|||
coresub_op|||
could_it_be_a_POSIX_class|||
cr_textfilter|||
create_eval_scope|||
croak_memory_wrap||5.019003|n
croak_no_mem|||n
croak_no_modify||5.013003|n
croak_nocontext|||vn
croak_popstack|||n
src/ppport.h view on Meta::CPAN
grok_bslash_x|||
grok_hex|5.007003||p
grok_number|5.007002||p
grok_numeric_radix|5.007002||p
grok_oct|5.007003||p
group_end|||
gv_AVadd|||
gv_HVadd|||
gv_IOadd|||
gv_SVadd|||
gv_add_by_type||5.011000|
gv_autoload4||5.004000|
gv_autoload_pvn||5.015004|
gv_autoload_pv||5.015004|
gv_autoload_sv||5.015004|
gv_check|||
gv_const_sv||5.009003|
gv_dump||5.006000|
gv_efullname3||5.004000|
gv_efullname4||5.006001|
gv_efullname|||
src/ppport.h view on Meta::CPAN
gv_fetchpvn_flags|5.009002||p
gv_fetchpvs|5.009004||p
gv_fetchpv|||
gv_fetchsv|5.009002||p
gv_fullname3||5.004000|
gv_fullname4||5.006001|
gv_fullname|||
gv_handler||5.007001|
gv_init_pvn||5.015004|
gv_init_pv||5.015004|
gv_init_svtype|||
gv_init_sv||5.015004|
gv_init|||
gv_magicalize_isa|||
gv_name_set||5.009004|
gv_stashpvn|5.004000||p
gv_stashpvs|5.009003||p
gv_stashpv|||
gv_stashsv|||
gv_try_downgrade|||
handle_regex_sets|||
src/ppport.h view on Meta::CPAN
mess_sv||5.013001|
mess||5.006000|v
method_common|||
mfree||5.007002|n
mg_clear|||
mg_copy|||
mg_dup|||
mg_find_mglob|||
mg_findext|5.013008|5.013008|p
mg_find|||
mg_free_type||5.013006|
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
minus_v|||
missingterm|||
src/ppport.h view on Meta::CPAN
newRANGE|||
newRV_inc|5.004000||p
newRV_noinc|5.004000||p
newRV|||
newSLICEOP|||
newSTATEOP|||
newSTUB|||
newSUB|||
newSVOP|||
newSVREF|||
newSV_type|5.009005||p
newSVhek||5.009003|
newSViv|||
newSVnv|||
newSVpadname||5.017004|
newSVpv_share||5.013006|
newSVpvf_nocontext|||vn
newSVpvf||5.004000|v
newSVpvn_flags|5.010001||p
newSVpvn_share|5.007001||p
newSVpvn_utf8|5.010001||p
src/ppport.h view on Meta::CPAN
newTOKEN|||
newUNOP|||
newWHENOP||5.009003|
newWHILEOP||5.013007|
newXS_flags||5.009004|
newXS_len_flags|||
newXSproto||5.006000|
newXS||5.006000|
new_collate||5.006000|
new_constant|||
new_ctype||5.006000|
new_he|||
new_logop|||
new_numeric||5.006000|
new_stackinfo||5.005000|
new_version||5.009000|
new_warnings_bitfield|||
next_symbol|||
nextargv|||
nextchar|||
ninstr|||n
src/ppport.h view on Meta::CPAN
packlist||5.008001|
pad_add_anon||5.008001|
pad_add_name_pvn||5.015001|
pad_add_name_pvs||5.015001|
pad_add_name_pv||5.015001|
pad_add_name_sv||5.015001|
pad_alloc_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type||5.009003|
pad_findlex|||
pad_findmy_pvn||5.015001|
pad_findmy_pvs||5.015001|
pad_findmy_pv||5.015001|
pad_findmy_sv||5.015001|
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new||5.008001|
pad_peg|||n
src/ppport.h view on Meta::CPAN
savepvs||5.009003|
savepv|||
savesharedpvn||5.009005|
savesharedpvs||5.013006|
savesharedpv||5.007003|
savesharedsvpv||5.013006|
savestack_grow_cnt||5.008001|
savestack_grow|||
savesvpv||5.009002|
sawparens|||
scalar_mod_type|||n
scalarboolean|||
scalarkids|||
scalarseq|||
scalarvoid|||
scalar|||
scan_bin||5.006000|
scan_commit|||
scan_const|||
scan_formline|||
scan_heredoc|||
src/ppport.h view on Meta::CPAN
sv_pvbyte||5.006000|
sv_pvn_force_flags|5.007002||p
sv_pvn_force|||
sv_pvn_nomg|5.007003|5.005000|p
sv_pvn||5.005000|
sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_ref|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_reset|||
sv_rvweaken||5.006000|
sv_sethek|||
sv_setiv_mg|5.004050||p
sv_setiv|||
src/ppport.h view on Meta::CPAN
sv_utf8_upgrade||5.007001|
sv_uv|5.005000||p
sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn_flags||5.017002|
sv_vcatpvfn||5.004000|
sv_vcatpvf|5.006000|5.004000|p
sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
sv_vsetpvf|5.006000|5.004000|p
sv_xmlpeek|||
svtype|||
swallow_bom|||
swash_fetch||5.007002|
swash_init||5.006000|
swatch_get|||
sys_init3||5.010000|n
sys_init||5.010000|n
sys_intern_clear|||
sys_intern_dup|||
sys_intern_init|||
sys_term||5.010000|n
src/ppport.h view on Meta::CPAN
$file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
}
}
$file{needs_inc_ppport} = keys %{$file{uses}};
if ($file{needs_inc_ppport}) {
my $pp = '';
for $func (sort keys %{$file{needs}}) {
my $type = $file{needs}{$func};
next if $type eq 'extern';
my $suffix = $type eq 'global' ? '_GLOBAL' : '';
unless (exists $file{"needed_$type"}{$func}) {
if ($type eq 'global') {
diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
}
else {
diag("File needs $func, adding static request");
}
$pp .= "#define NEED_$func$suffix\n";
}
}
if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
src/ppport.h view on Meta::CPAN
#ifndef dNOOP
# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
#endif
#ifndef NVTYPE
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
# define NVTYPE long double
# else
# define NVTYPE double
# endif
typedef NVTYPE NV;
#endif
#ifndef INT2PTR
# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
# define PTRV UV
# define INT2PTR(any,d) (any)(d)
# else
# if PTRSIZE == LONGSIZE
# define PTRV unsigned long
# else
src/ppport.h view on Meta::CPAN
#ifndef PERLIO_FUNCS_DECL
# ifdef PERLIO_FUNCS_CONST
# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
# else
# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
# define PERLIO_FUNCS_CAST(funcs) (funcs)
# endif
#endif
/* provide these typedefs for older perls */
#if (PERL_BCDVERSION < 0x5009003)
# ifdef ARGSproto
typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
# else
typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
# endif
typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
#endif
#ifndef isPSXSPC
# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
#endif
#ifndef isBLANK
# define isBLANK(c) ((c) == ' ' || (c) == '\t')
#endif
src/ppport.h view on Meta::CPAN
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* MY_CXT.member.
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
src/ppport.h view on Meta::CPAN
#endif
#ifndef SvREFCNT_inc_void_NN
# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
#ifndef SvREFCNT_inc_simple_void_NN
# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
#ifndef newSV_type
#if defined(NEED_newSV_type)
static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
static
#else
extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
#endif
#ifdef newSV_type
# undef newSV_type
#endif
#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
#define Perl_newSV_type DPPP_(my_newSV_type)
#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
SV*
DPPP_(my_newSV_type)(pTHX_ svtype const t)
{
SV* const sv = newSV(0);
sv_upgrade(sv, t);
return sv;
}
#endif
#endif
src/ppport.h view on Meta::CPAN
} STMT_END
#else
# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
#endif
#if !defined(mg_findext)
#if defined(NEED_mg_findext)
static MAGIC * DPPP_(my_mg_findext)(pTHX_ SV * sv, int type, const MGVTBL *vtbl);
static
#else
extern MAGIC * DPPP_(my_mg_findext)(pTHX_ SV * sv, int type, const MGVTBL *vtbl);
#endif
#ifdef mg_findext
# undef mg_findext
#endif
#define mg_findext(a,b,c) DPPP_(my_mg_findext)(aTHX_ a,b,c)
#define Perl_mg_findext DPPP_(my_mg_findext)
#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
MAGIC *
DPPP_(my_mg_findext)(pTHX_ SV * sv, int type, const MGVTBL *vtbl) {
if (sv) {
MAGIC *mg;
#ifdef AvPAD_NAMELIST
assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
#endif
for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
if (mg->mg_type == type && mg->mg_virtual == vtbl)
return mg;
}
}
return NULL;
}
#endif
#endif
#if !defined(sv_unmagicext)
#if defined(NEED_sv_unmagicext)
static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
static
#else
extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
#endif
#ifdef sv_unmagicext
# undef sv_unmagicext
#endif
#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
int
DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
{
MAGIC* mg;
MAGIC** mgp;
if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
return 0;
mgp = &(SvMAGIC(sv));
for (mg = *mgp; mg; mg = *mgp) {
const MGVTBL* const virt = mg->mg_virtual;
if (mg->mg_type == type && virt == vtbl) {
*mgp = mg->mg_moremagic;
if (virt && virt->svt_free)
virt->svt_free(aTHX_ sv, mg);
if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
if (mg->mg_len > 0)
Safefree(mg->mg_ptr);
else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
else if (mg->mg_type == PERL_MAGIC_utf8)
Safefree(mg->mg_ptr);
}
if (mg->mg_flags & MGf_REFCOUNTED)
SvREFCNT_dec(mg->mg_obj);
Safefree(mg);
}
else
mgp = &mg->mg_moremagic;
}
if (SvMAGIC(sv)) {
src/ppport.h view on Meta::CPAN
#define Perl_grok_number DPPP_(my_grok_number)
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
int
DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
const UV max_div_10 = UV_MAX / 10;
const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
int sawinf = 0;
int sawnan = 0;
while (s < send && isSPACE(*s))
s++;
if (s == send) {
return 0;
} else if (*s == '-') {
s++;
numtype = IS_NUMBER_NEG;
}
else if (*s == '+')
s++;
if (s == send)
return 0;
/* next must be digit or the radix separator or beginning of infinity */
if (isDIGIT(*s)) {
/* UVs are at least 32 bits, so the first 9 decimal digits cannot
src/ppport.h view on Meta::CPAN
break;
}
if (digit >= 0 && digit <= 9
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
worry about setting *valuep. */
do {
s++;
} while (s < send && isDIGIT(*s));
numtype |=
IS_NUMBER_GREATER_THAN_UV_MAX;
goto skip_value;
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
numtype |= IS_NUMBER_IN_UV;
if (valuep)
*valuep = value;
skip_value:
if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT;
while (s < send && isDIGIT(*s)) /* optional digits after the radix */
s++;
}
}
else if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
/* no digits before the radix means we need digits after it */
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
if (valuep) {
/* integer approximation is valid - it's 0. */
*valuep = 0;
}
}
src/ppport.h view on Meta::CPAN
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
return 0;
if (sawinf) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
} else if (sawnan) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
} else if (s < send) {
/* we can have an optional exponent part */
if (*s == 'e' || *s == 'E') {
/* The only flag we keep is sign. Blow away any "it's UV" */
numtype &= IS_NUMBER_NEG;
numtype |= IS_NUMBER_NOT_INT;
s++;
if (s < send && (*s == '-' || *s == '+'))
s++;
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
}
else
return 0;
}
}
while (s < send && isSPACE(*s))
s++;
if (s >= send)
return numtype;
if (len == 10 && memEQ(pv, "0 but true", 10)) {
if (valuep)
*valuep = 0;
return IS_NUMBER_IN_UV;
}
return 0;
}
#endif
#endif
#
# To find out the type of Perl you are using
#
use warnings;
use strict;
use Config;
if ($Config{usethreads}) {
print "Your Perl is \'Threaded Perl\'\n";
}
else {
( run in 0.730 second using v1.01-cache-2.11-cpan-677af5a14d3 )