File: //proc/self/root/proc/self/root/proc/self/root/proc/self/root/proc/thread-self/cwd/share.tar
man/man1/heif-info.1 0000644 00000001541 15154541104 0010102 0 ustar 00 .TH HEIF-INFO 1
.SH NAME
heif-info \- show information on HEIC/HEIF file
.SH SYNOPSIS
.B heif-info
[\fB\-d\fR|\fB--dump-boxes\fR]
[\fB\-h\fR|\fB--help\fR]
[\fB\-v\fR|\fB--version\fR]
.IR filename
.SH DESCRIPTION
.B heif-info
Show information on HEIC/HEIF file.
.SH OPTIONS
.TP
.BR \-d ", " \-\-dump-boxes\fR
Show a low-level dump of all MP4 file boxes.
.TP
.BR \-h ", " \-\-help\fR
Show help. A filename is not required or used.
.TP
.BR \-v ", " \-\-version\fR
Show version information for the tool, library version, and the plugin path. A filename is not required or used.
.SH EXIT STATUS
.PP
\fB0\fR
.RS 4
Success
.RE
.PP
\fB1\fR
.RS 4
Failure (syntax or usage error; error while loading image).
.RE
.SH BUGS
Please reports bugs or issues at https://github.com/strukturag/libheif
.SH AUTHORS
Dirk Farin, struktur AG
.SH COPYRIGHT
Copyright \[co] 2017 struktur AG
man/man1/heif-enc.1 0000644 00000004612 15154541111 0007714 0 ustar 00 .TH HEIF-ENC 1
.SH NAME
heif-enc \- convert image to HEIC/HEIF
.SH SYNOPSIS
.B heif-enc
[\fB\-h\fR|\fB--help\fR]
[\fB\-q\fR \fIQUALITY\fR|\fB--quality\fR \fIQUALITY\fR]
[\fB\-L\fR|\fB--lossless\fR]
[\fB\-t\fR \fISIZE\fR|\fB--thumb\fR \fISIZE\fR]
[\fB--no-alpha\fR]
[\fB--no-thumb-alpha\fR]
[\fB\-o\fR \fIFILENAME\fR|\fB--output\fR \fIFILENAME\fR]
[\fB\-v\fR|\fB--verbose\fR]
[\fB\-P\fR|\fB--params\fR]
[\fB\-b\fR \fIDEPTH\fR]
[\fB\-p\fR \fINAME\fR\fB=\fR\fIVALUE\fR]
.IR filename[.jpg|.png|.y4m]
.SH DESCRIPTION
.B heif-enc
Convert image to HEIC/HEIF.
.SH OPTIONS
.TP
.BR \-q\fR\ \fIQUALITY\fR ", " \-\-quality\fR\ \fIQUALITY\fR
Defines quality level between 0 and 100 for the generated output file.
.TP
.BR \-L ", "\-\-lossless\fR
Generate lossless output (\fB-q\fR has no effect)
.TP
.BR \-t\fR\ \fISIZE\fR ", " \-\-thumb\fR\ \fISIZE\fR
Generate thumbnail with maximum size \fISIZE\fR pixels (default: off).
.TP
.BR \-\-no-alpha\fR
Do not save alpha channel.
.TP
.BR \-\-no-thumb-alpha\fR
Do not save alpha channel in thumbnail image.
.TP
.BR \-o\fR\ \fIFILENAME\fR ", " \-\-output\fR\ \fIFILENAME\fR
Output filename (optional).
.TP
.BR \-\-verbose\fR
Enable logging output (more will increase logging level).
.TP
.BR \-P ", "\-\-params\fR
Show all encoder parameters and exit. Input file is not required or used.
.TP
.BR \-b\fR\ \fIDEPTH\fR
Bit-depth of generated HEIF file when using 16-bit PNG input (default: 10 bit).
.TP
.BR \-p\fR\ \fINAME\fR\fB=\fR\fIVALUE\fR
Set additional encoder parameters. See \fBNOTES\fR below.
.SH EXIT STATUS
.PP
\fB0\fR
.RS 4
Success
.RE
.PP
\fB1\fR
.RS 4
Failure (syntax or usage error; error while loading, converting or writing image).
.RE
.SH NOTES
The available input formats depend on the libraries that were available at
compile time. Supported are JPEG, PNG and Y4M, the file type is determined based
on the extension of the input file.
When specifying multiple source images, they will all be saved into the same
HEIF file.
When using the x265 encoder, you may pass it any of its parameters by
prefixing the parameter name with \fBx265:\fR.
Hence, to set the \fBctu\fR parameter, you will have to set \fBx265:ctu\fR
in libheif (e.g.: \fB-p x265:ctu=64\fR).
Note that there is no checking for valid parameters when using the prefix.
.SH BUGS
Please reports bugs or issues at https://github.com/strukturag/libheif
.SH AUTHORS
Dirk Farin, struktur AG
.SH COPYRIGHT
Copyright \[co] 2017 struktur AG
man/man1/heif-dec.1 0000644 00000001625 15154541116 0007710 0 ustar 00 .TH HEIF-CONVERT 1
.SH NAME
heif-dec \- decode HEIC/HEIF image
.SH SYNOPSIS
.B heif-dec
[\fB\-q\fR \fIQUALITY\fR]
.IR filename
.IR output[.jpg|.png|.y4m]
.SH DESCRIPTION
.B heif-dec
Convert HEIC/HEIF image to a different image format.
.SH OPTIONS
.TP
.BR \-q\fR\ \fIQUALITY\fR
Defines quality level between 0 and 100 for the generated output file. Only used for JPEG.
.SH EXIT STATUS
.PP
\fB0\fR
.RS 4
Success
.RE
.PP
\fB1\fR
.RS 4
Failure (syntax or usage error; error while loading, converting or writing image).
.RE
.SH NOTES
The available output formats depend on the libraries that were available at
compile time. Supported are JPEG, PNG and Y4M, the file type is determined based
on the extension of the output file.
.SH BUGS
Please reports bugs or issues at https://github.com/strukturag/libheif
.SH AUTHORS
Joachim Bauch, struktur AG
.br
Dirk Farin, struktur AG
.SH COPYRIGHT
Copyright \[co] 2017 struktur AG
man/man1/heif-thumbnailer.1 0000644 00000001340 15154541123 0011457 0 ustar 00 .TH HEIF-THUMBNAILER 1
.SH NAME
heif-thumbnailer \- create thumbnails from HEIC/HEIF files
.SH SYNOPSIS
.B heif-thumbnailer
[\fB\-s\fR \fISIZE\fR]
.IR filename
.IR output
.SH DESCRIPTION
.B heif-thumbnailer
Create thumbnail images from HEIC/HEIF files that can be used for example by Nautilus.
.SH OPTIONS
.TP
.BR \-s\fR\ \fISIZE\fR
Defines the maximum width and height of the thumbnail to generate.
Default is 512 pixel.
.SH EXIT STATUS
.PP
\fB0\fR
.RS 4
Success
.RE
.PP
\fB1\fR
.RS 4
Failure (syntax or usage error; error while loading, converting or writing image).
.RE
.SH BUGS
Please reports bugs or issues at https://github.com/strukturag/libheif
.SH AUTHORS
Dirk Farin, struktur AG
.SH COPYRIGHT
Copyright \[co] 2018 struktur AG
doc/alt-libheif/README.md 0000644 00000041165 15154541143 0010762 0 ustar 00 # libheif
[](https://github.com/strukturag/libheif/actions) [](https://ci.appveyor.com/project/strukturag/libheif) [](https://scan.coverity.com/projects/strukturag-libheif)
libheif is an ISO/IEC 23008-12:2017 HEIF and AVIF (AV1 Image File Format) file format decoder and encoder.
There is partial support for ISO/IEC 23008-12:2022 (2nd Edition) capabilities.
HEIF and AVIF are new image file formats employing HEVC (H.265) or AV1 image coding, respectively, for the
best compression ratios currently possible.
libheif makes use of [libde265](https://github.com/strukturag/libde265) for HEIC image decoding and x265 for encoding.
For AVIF, libaom, dav1d, svt-av1, or rav1e are used as codecs.
## Supported features
libheif has support for:
* HEIC, AVIF, VVC, AVC, JPEG-in-HEIF, JPEG2000, uncompressed (ISO/IEC 23001-17:2024) codecs
* alpha channels, depth maps, thumbnails, auxiliary images
* multiple images in a file
* tiled images with decoding individual tiles and encoding tiled images by adding tiles one after another
* HDR images, correct color transform according to embedded color profiles
* image transformations (crop, mirror, rotate), overlay images
* plugin interface to add alternative codecs
* reading EXIF and XMP metadata
* region annotations and mask images
* decoding of files while downloading (e.g. extract image size before file has been completely downloaded)
Supported codecs:
| Format | Decoders | Encoders |
|:-------------|:-------------------:|:----------------------------:|
| HEIC | libde265, ffmpeg | x265, kvazaar |
| AVIF | AOM, dav1d | AOM, rav1e, svt-av1 |
| VVC | vvdec | vvenc, uvg266 |
| AVC | openh264 | - |
| JPEG | libjpeg(-turbo) | libjpeg(-turbo) |
| JPEG2000 | OpenJPEG | OpenJPEG |
| HTJ2K | OpenJPEG | OpenJPH |
| uncompressed | built-in | built-in |
## API
The library has a C API for easy integration and wide language support.
The decoder automatically supports both HEIF and AVIF (and the other compression formats) through the same API. The same decoding code can be used to decode any of them.
The encoder can be switched between HEIF and AVIF simply by setting `heif_compression_HEVC` or `heif_compression_AV1`
to `heif_context_get_encoder_for_format()`, or using any of the other compression formats.
Loading the primary image in an HEIF file is as easy as this:
```C
heif_context* ctx = heif_context_alloc();
heif_context_read_from_file(ctx, input_filename, nullptr);
// get a handle to the primary image
heif_image_handle* handle;
heif_context_get_primary_image_handle(ctx, &handle);
// decode the image and convert colorspace to RGB, saved as 24bit interleaved
heif_image* img;
heif_decode_image(handle, &img, heif_colorspace_RGB, heif_chroma_interleaved_RGB, nullptr);
int stride;
const uint8_t* data = heif_image_get_plane_readonly(img, heif_channel_interleaved, &stride);
// ... process data as needed ...
// clean up resources
heif_image_release(img);
heif_image_handle_release(handle);
heif_context_free(ctx);
```
Writing an HEIF file can be done like this:
```C
heif_context* ctx = heif_context_alloc();
// get the default encoder
heif_encoder* encoder;
heif_context_get_encoder_for_format(ctx, heif_compression_HEVC, &encoder);
// set the encoder parameters
heif_encoder_set_lossy_quality(encoder, 50);
// encode the image
heif_image* image; // code to fill in the image omitted in this example
heif_context_encode_image(ctx, image, encoder, nullptr, nullptr);
heif_encoder_release(encoder);
heif_context_write_to_file(ctx, "output.heic");
heif_context_free(ctx);
```
Get the EXIF data from an HEIF file:
```C
heif_item_id exif_id;
int n = heif_image_handle_get_list_of_metadata_block_IDs(image_handle, "Exif", &exif_id, 1);
if (n==1) {
size_t exifSize = heif_image_handle_get_metadata_size(image_handle, exif_id);
uint8_t* exifData = malloc(exifSize);
struct heif_error error = heif_image_handle_get_metadata(image_handle, exif_id, exifData);
}
```
See the header file `heif.h` for the complete C API.
There is also a C++ API which is a header-only wrapper to the C API.
Hence, you can use the C++ API and still be binary compatible.
Code using the C++ API is much less verbose than using the C API directly.
### Reading and Writing Tiled Images
For very large resolution images, it is not always feasible to process the whole image.
In this case, `libheif` can process the image tile by tile.
See [this tutorial](https://github.com/strukturag/libheif/wiki/Reading-and-Writing-Tiled-Images) on how to use the API for this.
## Compiling
This library uses the CMake build system (the earlier autotools build files have been removed in v1.16.0).
For a minimal configuration, we recommend to use the codecs libde265 and x265 for HEIC and AOM for AVIF.
Make sure that you compile and install [libde265](https://github.com/strukturag/libde265)
first, so that the configuration script will find this.
Also install x265 and its development files if you want to use HEIF encoding, but note that x265 is GPL.
An alternative to x265 is kvazaar (BSD).
The basic build steps are as follows (--preset argument needs CMake >= 3.21):
````sh
mkdir build
cd build
cmake --preset=release ..
make
````
There are CMake presets to cover the most frequent use cases.
* `release`: the preferred preset which compiles all codecs as separate plugins.
If you do not want to distribute some of these plugins (e.g. HEIC), you can omit packaging these.
* `release-noplugins`: this is a smaller, self-contained build of libheif without using the plugin system.
A single library is built with support for HEIC and AVIF.
* `testing`: for building and executing the unit tests. Also the internal library symbols are exposed. Do not use for distribution.
* `fuzzing`: all codecs like in release build, but configured into a self-contained library with enabled fuzzers. The library should not distributed.
You can optionally adapt these standard configurations to your needs.
This can be done, for example, by calling `ccmake .` from within the `build` directory.
### CMake configuration variables
Libheif supports many different codecs. In order to reduce the number of dependencies and the library size,
you can choose which of these codecs to include. Each codec can be compiled either as built-in to the library
with a hard dependency, or as a separate plugin file that is loaded dynamically.
For each codec, there are two configuration variables:
* `WITH_{codec}`: enables the codec
* `WITH_{codec}_PLUGIN`: when enabled, the codec is compiled as a separate plugin.
In order to use dynamic plugins, also make sure that `ENABLE_PLUGIN_LOADING` is enabled.
The placeholder `{codec}` can have these values: `LIBDE265`, `X265`, `AOM_DECODER`, `AOM_ENCODER`, `SvtEnc`, `DAV1D`, `FFMPEG_DECODER`, `JPEG_DECODER`, `JPEG_ENCODER`, `KVAZAAR`, `OpenJPEG_DECODER`, `OpenJPEG_ENCODER`, `OPENJPH_ENCODER`, `VVDEC`, `VVENC`, `UVG266`.
Further options are:
* `WITH_UNCOMPRESSED_CODEC`: enable support for uncompressed images according to ISO/IEC 23001-17:2024. This is *experimental*
and not available as a dynamic plugin. When enabled, it adds a dependency to `zlib`, and optionally will use `brotli`.
* `WITH_HEADER_COMPRESSION`: enables support for compressed metadata. When enabled, it adds a dependency to `zlib`.
Note that header compression is not widely supported yet.
* `WITH_LIBSHARPYUV`: enables high-quality YCbCr/RGB color space conversion algorithms (requires `libsharpyuv`,
e.g. from the `third-party` directory).
* `ENABLE_EXPERIMENTAL_FEATURES`: enables functions that are currently in development and for which the API is not stable yet.
When this is enabled, a header `heif_experimental.h` will be installed that contains this unstable API.
Distributions that rely on a stable API should not enable this.
* `ENABLE_MULTITHREADING_SUPPORT`: can be used to disable any multithreading support, e.g. for embedded platforms.
* `ENABLE_PARALLEL_TILE_DECODING`: when enabled, libheif will decode tiled images in parallel to speed up compilation.
* `PLUGIN_DIRECTORY`: the directory where libheif will search for dynamic plugins when the environment
variable `LIBHEIF_PLUGIN_PATH` is not set.
* `WITH_REDUCED_VISIBILITY`: only export those symbols into the library that are public API.
Has to be turned off for running some tests.
### macOS
1. Install dependencies with Homebrew
```sh
brew install cmake make pkg-config x265 libde265 libjpeg libtool
```
2. Configure and build project (--preset argument needs CMake >= 3.21):
```sh
mkdir build
cd build
cmake --preset=release ..
./configure
make
```
### Windows
You can build and install libheif using the [vcpkg](https://github.com/Microsoft/vcpkg/) dependency manager:
```sh
git clone https://github.com/Microsoft/vcpkg.git
cd vcpkg
./bootstrap-vcpkg.bat
./vcpkg integrate install
./vcpkg install libheif
```
The libheif port in vcpkg is kept up to date by Microsoft team members and community contributors. If the version is out of date, please [create an issue or pull request](https://github.com/Microsoft/vcpkg) on the vcpkg repository.
### Adding libaom encoder/decoder for AVIF
* Run the `aom.cmd` script in the `third-party` directory to download libaom and
compile it.
When running `cmake` or `configure`, make sure that the environment variable
`PKG_CONFIG_PATH` includes the absolute path to `third-party/aom/dist/lib/pkgconfig`.
### Adding rav1e encoder for AVIF
* Install `cargo`.
* Install `cargo-c` by executing
```sh
cargo install --force cargo-c
```
* Run the `rav1e.cmd` script in the `third-party` directory to download rav1e
and compile it.
When running `cmake`, make sure that the environment variable
`PKG_CONFIG_PATH` includes the absolute path to `third-party/rav1e/dist/lib/pkgconfig`.
### Adding dav1d decoder for AVIF
* Install [`meson`](https://mesonbuild.com/).
* Run the `dav1d.cmd` script in the `third-party` directory to download dav1d
and compile it.
When running `cmake`, make sure that the environment variable
`PKG_CONFIG_PATH` includes the absolute path to `third-party/dav1d/dist/lib/x86_64-linux-gnu/pkgconfig`.
### Adding SVT-AV1 encoder for AVIF
You can either use the SVT-AV1 encoder libraries installed in the system or use a self-compiled current version.
If you want to compile SVT-AV1 yourself,
* Run the `svt.cmd` script in the `third-party` directory to download SVT-AV1
and compile it.
When running `cmake` or `configure`, make sure that the environment variable
`PKG_CONFIG_PATH` includes the absolute path to `third-party/SVT-AV1/Build/linux/install/lib/pkgconfig`.
You may have to replace `linux` in this path with your system's identifier.
You have to enable SVT-AV1 with CMake.
## Codec plugins
Starting with v1.14.0, each codec backend can be compiled statically into libheif or as a dynamically loaded plugin.
You can choose this individually for each codec backend in the CMake settings.
Compiling a codec backend as dynamic plugin will generate a shared library that is installed in the system together with libheif.
The advantage is that only the required plugins have to be installed and libheif has fewer dependencies.
The plugins are loaded from the colon-separated (semicolon-separated on Windows) list of directories stored in the environment variable `LIBHEIF_PLUGIN_PATH`.
If this variable is empty, they are loaded from a directory specified in the CMake configuration.
You can also add plugin directories programmatically.
### Codec specific notes
* the FFMPEG decoding plugin can make use of h265 hardware decoders. However, it currently (v1.17.0, ffmpeg v4.4.2) does not work
correctly with all streams. Thus, libheif still prefers the libde265 decoder if it is available.
## Encoder benchmark
A current benchmark of the AVIF encoders (as of 14 Oct 2022) can be found on the Wiki page
[AVIF encoding benchmark](https://github.com/strukturag/libheif/wiki/AVIF-Encoder-Benchmark).
## Language bindings
* .NET Platform (C#, F#, and other languages): [libheif-sharp](https://github.com/0xC0000054/libheif-sharp)
* C++: part of libheif
* Go: [libheif-go](https://github.com/strukturag/libheif-go), the wrapper distributed with libheif is deprecated
* JavaScript: by compilation with emscripten (see below)
* NodeJS module: [libheif-js](https://www.npmjs.com/package/libheif-js)
* Python: [pyheif](https://pypi.org/project/pyheif/), [pillow_heif](https://pypi.org/project/pillow-heif/)
* Rust: [libheif-sys](https://github.com/Cykooz/libheif-sys)
* Swift: [libheif-Xcode](https://swiftpackageregistry.com/SDWebImage/libheif-Xcode)
* JavaFX: [LibHeifFx](https://github.com/lanthale/LibHeifFX)
Languages that can directly interface with C libraries (e.g., Swift, C#) should work out of the box.
## Compiling to JavaScript / WASM
libheif can also be compiled to JavaScript using
[emscripten](http://kripken.github.io/emscripten-site/).
It can be built like this (in the libheif directory):
````
mkdir buildjs
cd buildjs
USE_WASM=0 ../build-emscripten.sh ..
````
Set `USE_WASM=1` to build with WASM output.
See the `build-emscripten.sh` script for further options.
## Online demo
Check out this [online demo](https://strukturag.github.io/libheif/).
This is `libheif` running in JavaScript in your browser.
## Example programs
Some example programs are provided in the `examples` directory.
The program `heif-dec` converts all images stored in an HEIF/AVIF file to JPEG or PNG.
`heif-enc` lets you convert JPEG files to HEIF/AVIF.
The program `heif-info` is a simple, minimal decoder that dumps the file structure to the console.
For example convert `example.heic` to JPEGs and one of the JPEGs back to HEIF:
```sh
cd examples/
./heif-dec example.heic example.jpeg
./heif-enc example-1.jpeg -o example.heif
```
In order to convert `example-1.jpeg` to AVIF use:
```sh
./heif-enc example-1.jpeg -A -o example.avif
```
There is also a GIMP plugin using libheif [here](https://github.com/strukturag/heif-gimp-plugin).
## HEIF/AVIF thumbnails for the Gnome desktop
The program `heif-thumbnailer` can be used as an HEIF/AVIF thumbnailer for the Gnome desktop.
The matching Gnome configuration files are in the `gnome` directory.
Place the files `heif.xml` and `avif.xml` into `/usr/share/mime/packages` and `heif.thumbnailer` into `/usr/share/thumbnailers`.
You may have to run `update-mime-database /usr/share/mime` to update the list of known MIME types.
## gdk-pixbuf loader
libheif also includes a gdk-pixbuf loader for HEIF/AVIF images. 'make install' will copy the plugin
into the system directories. However, you will still have to run `gdk-pixbuf-query-loaders --update-cache`
to update the gdk-pixbuf loader database.
## Software using libheif
* [GIMP](https://www.gimp.org/)
* [Krita](https://krita.org)
* [ImageMagick](https://imagemagick.org/)
* [GraphicsMagick](http://www.graphicsmagick.org/)
* [darktable](https://www.darktable.org)
* [digiKam 7.0.0](https://www.digikam.org/)
* [libvips](https://github.com/libvips/libvips)
* [kImageFormats](https://api.kde.org/frameworks/kimageformats/html/index.html)
* [libGD](https://libgd.github.io/)
* [Kodi HEIF image decoder plugin](https://kodi.wiki/view/Add-on:HEIF_image_decoder)
* [bimg](https://github.com/h2non/bimg)
* [GDAL](https://gdal.org/drivers/raster/heif.html)
* [OpenImageIO](https://sites.google.com/site/openimageio/)
* [XnView](https://www.xnview.com)
## Packaging status
[](https://repology.org/project/libheif/versions)
## Sponsors
Since I work as an independent developer, I need your support to be able to allocate time for libheif.
You can [sponsor](https://github.com/sponsors/farindk) the development using the link in the right hand column.
A big thank you goes to these major sponsors for supporting the development of libheif:
* Pinterest
* Shopify <img src="logos/sponsors/shopify.svg" alt="shopify-logo" height="20"/>
* StrukturAG
## License
The libheif is distributed under the terms of the GNU Lesser General Public License.
The sample applications are distributed under the terms of the MIT License.
See COPYING for more details.
Copyright (c) 2017-2020 Struktur AG</br>
Copyright (c) 2017-2025 Dirk Farin</br>
Contact: Dirk Farin <dirk.farin@gmail.com>
doc/alt-libheif/COPYING 0000644 00000126516 15154541150 0010540 0 ustar 00 * The library `libheif` is distributed under the terms of the GNU Lesser General Public License.
* The sample applications and the Go and C++ wrappers are distributed under the terms of the MIT License.
License texts below and in the `COPYING` files of the corresponding subfolders.
----------------------------------------------------------------------
GNU LESSER GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
This version of the GNU Lesser General Public License incorporates
the terms and conditions of version 3 of the GNU General Public
License, supplemented by the additional permissions listed below.
0. Additional Definitions.
As used herein, "this License" refers to version 3 of the GNU Lesser
General Public License, and the "GNU GPL" refers to version 3 of the GNU
General Public License.
"The Library" refers to a covered work governed by this License,
other than an Application or a Combined Work as defined below.
An "Application" is any work that makes use of an interface provided
by the Library, but which is not otherwise based on the Library.
Defining a subclass of a class defined by the Library is deemed a mode
of using an interface provided by the Library.
A "Combined Work" is a work produced by combining or linking an
Application with the Library. The particular version of the Library
with which the Combined Work was made is also called the "Linked
Version".
The "Minimal Corresponding Source" for a Combined Work means the
Corresponding Source for the Combined Work, excluding any source code
for portions of the Combined Work that, considered in isolation, are
based on the Application, and not on the Linked Version.
The "Corresponding Application Code" for a Combined Work means the
object code and/or source code for the Application, including any data
and utility programs needed for reproducing the Combined Work from the
Application, but excluding the System Libraries of the Combined Work.
1. Exception to Section 3 of the GNU GPL.
You may convey a covered work under sections 3 and 4 of this License
without being bound by section 3 of the GNU GPL.
2. Conveying Modified Versions.
If you modify a copy of the Library, and, in your modifications, a
facility refers to a function or data to be supplied by an Application
that uses the facility (other than as an argument passed when the
facility is invoked), then you may convey a copy of the modified
version:
a) under this License, provided that you make a good faith effort to
ensure that, in the event an Application does not supply the
function or data, the facility still operates, and performs
whatever part of its purpose remains meaningful, or
b) under the GNU GPL, with none of the additional permissions of
this License applicable to that copy.
3. Object Code Incorporating Material from Library Header Files.
The object code form of an Application may incorporate material from
a header file that is part of the Library. You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:
a) Give prominent notice with each copy of the object code that the
Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the object code with a copy of the GNU GPL and this license
document.
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the Combined Work with a copy of the GNU GPL and this license
document.
c) For a Combined Work that displays copyright notices during
execution, include the copyright notice for the Library among
these notices, as well as a reference directing the user to the
copies of the GNU GPL and this license document.
d) Do one of the following:
0) Convey the Minimal Corresponding Source under the terms of this
License, and the Corresponding Application Code in a form
suitable for, and under terms that permit, the user to
recombine or relink the Application with a modified version of
the Linked Version to produce a modified Combined Work, in the
manner specified by section 6 of the GNU GPL for conveying
Corresponding Source.
1) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (a) uses at run time
a copy of the Library already present on the user's computer
system, and (b) will operate properly with a modified version
of the Library that is interface-compatible with the Linked
Version.
e) Provide Installation Information, but only if you would otherwise
be required to provide such information under section 6 of the
GNU GPL, and only to the extent that such information is
necessary to install and execute a modified version of the
Combined Work produced by recombining or relinking the
Application with a modified version of the Linked Version. (If
you use option 4d0, the Installation Information must accompany
the Minimal Corresponding Source and Corresponding Application
Code. If you use option 4d1, you must provide the Installation
Information in the manner specified by section 6 of the GNU GPL
for conveying Corresponding Source.)
5. Combined Libraries.
You may place library facilities that are a work based on the
Library side by side in a single library together with other library
facilities that are not Applications and are not covered by this
License, and convey such a combined library under terms of your
choice, if you do both of the following:
a) Accompany the combined library with a copy of the same work based
on the Library, uncombined with any other library facilities,
conveyed under the terms of this License.
b) Give prominent notice with the combined library that part of it
is a work based on the Library, and explaining where to find the
accompanying uncombined form of the same work.
6. Revised Versions of the GNU Lesser General Public License.
The Free Software Foundation may publish revised and/or new versions
of the GNU Lesser General Public License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the
Library as you received it specifies that a certain numbered version
of the GNU Lesser General Public License "or any later version"
applies to it, you have the option of following the terms and
conditions either of that published version or of any later version
published by the Free Software Foundation. If the Library as you
received it does not specify a version number of the GNU Lesser
General Public License, you may choose any version of the GNU Lesser
General Public License ever published by the Free Software Foundation.
If the Library as you received it specifies that a proxy can decide
whether future versions of the GNU Lesser General Public License shall
apply, that proxy's public statement of acceptance of any version is
permanent authorization for you to choose that version for the
Library.
----------------------------------------------------------------------
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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 3 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, see <http://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program 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, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.
----------------------------------------------------------------------
MIT License
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
thumbnailers/heif.thumbnailer 0000644 00000000157 15154541162 0012417 0 ustar 00 [Thumbnailer Entry]
TryExec=heif-thumbnailer
Exec=heif-thumbnailer -s %s %i %o
MimeType=image/heif;image/avif;
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-SAX-1.02/MYMETA.json 0000444 00000002165 15157553725 0017235 0 ustar 00 {
"abstract" : "unknown",
"author" : [
"unknown"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150005, CPAN::Meta::Converter version 2.150010",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-SAX",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"File::Temp" : "0",
"XML::NamespaceSupport" : "0.03",
"XML::SAX::Base" : "1.05"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"type" : "git",
"web" : "https://github.com/grantm/xml-sax"
}
},
"version" : "1.02",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-SAX-1.02/install.json 0000444 00000001714 15157553732 0017704 0 ustar 00 {"dist":"XML-SAX-1.02","pathname":"G/GR/GRANTM/XML-SAX-1.02.tar.gz","target":"XML::SAX","provides":{"XML::SAX::PurePerl::Productions":{"file":"lib/XML/SAX/PurePerl/Productions.pm"},"XML::SAX::PurePerl::Exception":{"file":"lib/XML/SAX/PurePerl/Exception.pm"},"XML::SAX::PurePerl::Reader::URI":{"file":"lib/XML/SAX/PurePerl/Reader/URI.pm"},"XML::SAX::DocumentLocator":{"file":"lib/XML/SAX/DocumentLocator.pm"},"XML::SAX":{"version":1.02,"file":"lib/XML/SAX.pm"},"XML::SAX::PurePerl::Reader":{"file":"lib/XML/SAX/PurePerl/Reader.pm"},"XML::SAX::ParserFactory":{"file":"lib/XML/SAX/ParserFactory.pm","version":1.02},"XML::SAX::PurePerl::Reader::String":{"file":"lib/XML/SAX/PurePerl/Reader/String.pm"},"XML::SAX::PurePerl::Reader::Stream":{"file":"lib/XML/SAX/PurePerl/Reader/Stream.pm"},"XML::SAX::PurePerl::DebugHandler":{"file":"lib/XML/SAX/PurePerl/DebugHandler.pm"},"XML::SAX::PurePerl":{"version":1.02,"file":"lib/XML/SAX/PurePerl.pm"}},"version":1.02,"name":"XML::SAX"} perl5/5.32/x86_64-linux-thread-multi/.meta/Capture-Tiny-0.50/MYMETA.json 0000444 00000007072 15157553744 0020475 0 ustar 00 {
"abstract" : "Capture STDOUT and STDERR from Perl, XS or external programs",
"author" : [
"David Golden <dagolden@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010",
"license" : [
"apache_2_0"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Capture-Tiny",
"no_index" : {
"directory" : [
"corpus",
"examples",
"t",
"xt"
],
"package" : [
"DB"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "6.17"
}
},
"develop" : {
"requires" : {
"Dist::Zilla" : "5",
"Dist::Zilla::Plugin::OSPrereqs" : "0",
"Dist::Zilla::Plugin::Prereqs" : "0",
"Dist::Zilla::Plugin::ReleaseStatus::FromVersion" : "0",
"Dist::Zilla::Plugin::RemovePrereqs" : "0",
"Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072",
"File::Spec" : "0",
"File::Temp" : "0",
"IO::Handle" : "0",
"IPC::Open3" : "0",
"Pod::Coverage::TrustPod" : "0",
"Pod::Wordlist" : "0",
"Software::License::Apache_2_0" : "0",
"Test::CPAN::Meta" : "0",
"Test::MinimumVersion" : "0",
"Test::More" : "0",
"Test::Perl::Critic" : "0",
"Test::Pod" : "1.41",
"Test::Pod::Coverage" : "1.08",
"Test::Portability::Files" : "0",
"Test::Spelling" : "0.17",
"Test::Version" : "1"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Exporter" : "0",
"File::Spec" : "0",
"File::Temp" : "0",
"IO::Handle" : "0",
"Scalar::Util" : "0",
"perl" : "5.006",
"strict" : "0",
"warnings" : "0"
}
},
"test" : {
"recommends" : {
"CPAN::Meta" : "2.120900"
},
"requires" : {
"ExtUtils::MakeMaker" : "0",
"File::Spec" : "0",
"IO::File" : "0",
"Test::More" : "0.62",
"lib" : "0"
}
}
},
"provides" : {
"Capture::Tiny" : {
"file" : "lib/Capture/Tiny.pm",
"version" : "0.50"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/dagolden/Capture-Tiny/issues"
},
"homepage" : "https://github.com/dagolden/Capture-Tiny",
"repository" : {
"type" : "git",
"url" : "https://github.com/dagolden/Capture-Tiny.git",
"web" : "https://github.com/dagolden/Capture-Tiny"
}
},
"version" : "0.50",
"x_authority" : "cpan:DAGOLDEN",
"x_contributors" : [
"Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>",
"David E. Wheeler <david@justatheory.com>",
"Ed Sabol <esabol@users.noreply.github.com>",
"fecundf <not.com+github@gmail.com>",
"Graham Knop <haarg@haarg.org>",
"Karen Etheridge <ether@cpan.org>",
"Mohammad S Anwar <mohammad.anwar@yahoo.com>",
"Peter Rabbitson <ribasushi@cpan.org>",
"Sven Kirmess <sven.kirmess@kzone.ch>"
],
"x_generated_by_perl" : "v5.36.0",
"x_serialization_backend" : "JSON::PP version 4.06",
"x_spdx_expression" : "Apache-2.0"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/Capture-Tiny-0.50/install.json 0000444 00000000336 15157553751 0021141 0 ustar 00 {"version":"0.50","pathname":"D/DA/DAGOLDEN/Capture-Tiny-0.50.tar.gz","name":"Capture::Tiny","target":"Capture::Tiny","dist":"Capture-Tiny-0.50","provides":{"Capture::Tiny":{"version":"0.50","file":"lib/Capture/Tiny.pm"}}} perl5/5.32/x86_64-linux-thread-multi/.meta/XML-NamespaceSupport-1.12/MYMETA.json 0000444 00000010424 15157553770 0022071 0 ustar 00 {
"abstract" : "A simple generic namespace processor",
"author" : [
"Robin Berjon <robin@knowscape.com>",
"Chris Prather <chris@prather.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.009, CPAN::Meta::Converter version 2.150005, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-NamespaceSupport",
"no_index" : {
"directory" : [
"corpus",
"examples",
"t",
"xt"
],
"package" : [
"DB"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "6.17"
}
},
"develop" : {
"requires" : {
"Dist::Zilla" : "5",
"Dist::Zilla::Plugin::Authority" : "0",
"Dist::Zilla::Plugin::AutoPrereqs" : "0",
"Dist::Zilla::Plugin::CPANFile" : "0",
"Dist::Zilla::Plugin::CheckChangesHasContent" : "0",
"Dist::Zilla::Plugin::CheckMetaResources" : "0",
"Dist::Zilla::Plugin::CheckPrereqsIndexed" : "0",
"Dist::Zilla::Plugin::ConfirmRelease" : "0",
"Dist::Zilla::Plugin::CopyFilesFromBuild" : "0",
"Dist::Zilla::Plugin::ExecDir" : "0",
"Dist::Zilla::Plugin::Git::Check" : "0",
"Dist::Zilla::Plugin::Git::CheckFor::CorrectBranch" : "0",
"Dist::Zilla::Plugin::Git::Commit" : "0",
"Dist::Zilla::Plugin::Git::Contributors" : "0",
"Dist::Zilla::Plugin::Git::GatherDir" : "0",
"Dist::Zilla::Plugin::Git::NextVersion" : "0",
"Dist::Zilla::Plugin::Git::Push" : "0",
"Dist::Zilla::Plugin::Git::Tag" : "0",
"Dist::Zilla::Plugin::GithubMeta" : "0",
"Dist::Zilla::Plugin::InsertCopyright" : "0",
"Dist::Zilla::Plugin::License" : "0",
"Dist::Zilla::Plugin::MakeMaker" : "0",
"Dist::Zilla::Plugin::Manifest" : "0",
"Dist::Zilla::Plugin::ManifestSkip" : "0",
"Dist::Zilla::Plugin::MetaJSON" : "0",
"Dist::Zilla::Plugin::MetaNoIndex" : "0",
"Dist::Zilla::Plugin::MetaProvides::Package" : "0",
"Dist::Zilla::Plugin::MetaYAML" : "0",
"Dist::Zilla::Plugin::MinimumPerl" : "0",
"Dist::Zilla::Plugin::NextRelease" : "0",
"Dist::Zilla::Plugin::OurPkgVersion" : "0",
"Dist::Zilla::Plugin::PodWeaver" : "0",
"Dist::Zilla::Plugin::Prereqs::AuthorDeps" : "0",
"Dist::Zilla::Plugin::PromptIfStale" : "0",
"Dist::Zilla::Plugin::PruneCruft" : "0",
"Dist::Zilla::Plugin::RunExtraTests" : "0",
"Dist::Zilla::Plugin::ShareDir" : "0",
"Dist::Zilla::Plugin::TestRelease" : "0",
"Dist::Zilla::Plugin::UploadToCPAN" : "0",
"Software::License::Perl_5" : "0"
}
},
"runtime" : {
"requires" : {
"constant" : "0",
"perl" : "5.006",
"strict" : "0",
"vars" : "0",
"warnings" : "0"
}
},
"test" : {
"requires" : {
"Test::More" : "0"
}
}
},
"provides" : {
"XML::NamespaceSupport" : {
"file" : "lib/XML/NamespaceSupport.pm",
"version" : "1.12"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/perigrin/xml-namespacesupport/issues"
},
"homepage" : "https://github.com/perigrin/xml-namespacesupport",
"repository" : {
"type" : "git",
"url" : "https://github.com/perigrin/xml-namespacesupport.git",
"web" : "https://github.com/perigrin/xml-namespacesupport"
}
},
"version" : "1.12",
"x_authority" : "cpan:PERIGRIN",
"x_contributors" : [
"Chris Prather <cprather@hdpublishing.com>",
"David Steinbrunner <dsteinbrunner@pobox.com>",
"Paul Cochrane <paul@liekut.de>",
"Paulo Custodio <pauloscustodio@gmail.com>"
],
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-NamespaceSupport-1.12/install.json 0000444 00000000416 15157553776 0022551 0 ustar 00 {"pathname":"P/PE/PERIGRIN/XML-NamespaceSupport-1.12.tar.gz","target":"XML::NamespaceSupport","dist":"XML-NamespaceSupport-1.12","name":"XML::NamespaceSupport","version":"1.12","provides":{"XML::NamespaceSupport":{"version":"1.12","file":"lib/XML/NamespaceSupport.pm"}}} perl5/5.32/x86_64-linux-thread-multi/.meta/XML-LibXML-2.0210/MYMETA.json 0000444 00000004661 15157554022 0020025 0 ustar 00 {
"abstract" : "Interface to Gnome libxml2 xml parsing and DOM library",
"author" : [
"Petr Pajas <PAJAS@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010",
"keywords" : [
"dom",
"html",
"libxml",
"object oriented",
"oop",
"parse",
"parser",
"parsing",
"pullparser",
"sax",
"sgml",
"xml",
"xpath",
"XPath",
"xs"
],
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-LibXML",
"no_index" : {
"directory" : [
"t",
"inc",
"xt"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"Alien::Base::Wrapper" : "0",
"Alien::Libxml2" : "0.14",
"Config" : "0",
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"DynaLoader" : "0",
"Encode" : "0",
"Exporter" : "5.57",
"IO::Handle" : "0",
"Scalar::Util" : "0",
"Tie::Hash" : "0",
"XML::NamespaceSupport" : "1.07",
"XML::SAX" : "0.11",
"XML::SAX::Base" : "0",
"XML::SAX::DocumentLocator" : "0",
"XML::SAX::Exception" : "0",
"base" : "0",
"constant" : "0",
"overload" : "0",
"parent" : "0",
"perl" : "5.008001",
"strict" : "0",
"vars" : "0",
"warnings" : "0"
}
},
"test" : {
"requires" : {
"Config" : "0",
"Errno" : "0",
"IO::File" : "0",
"IO::Handle" : "0",
"POSIX" : "0",
"Scalar::Util" : "0",
"Test::More" : "0",
"locale" : "0",
"utf8" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"type" : "git",
"url" : "https://github.com/shlomif/perl-XML-LibXML.git",
"web" : "https://github.com/shlomif/perl-XML-LibXML"
}
},
"version" : "2.0210",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-LibXML-2.0210/install.json 0000444 00000005255 15157554027 0020504 0 ustar 00 {"provides":{"XML::LibXML::NodeList":{"version":"2.0210","file":"lib/XML/LibXML/NodeList.pm"},"XML::LibXML::Devel":{"version":"2.0210","file":"lib/XML/LibXML/Devel.pm"},"XML::LibXML::_SAXParser":{"version":"2.0210","file":"LibXML.pm"},"XML::LibXML":{"version":"2.0210","file":"LibXML.pm"},"XML::LibXML::Literal":{"version":"2.0210","file":"lib/XML/LibXML/Literal.pm"},"XML::LibXML::CDATASection":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::XPathExpression":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::NamedNodeMap":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::Attr":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::RegExp":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::Node":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::Error":{"version":"2.0210","file":"lib/XML/LibXML/Error.pm"},"XML::LibXML::SAX::Builder":{"version":"2.0210","file":"lib/XML/LibXML/SAX/Builder.pm"},"XML::LibXML::Comment":{"version":"2.0210","file":"LibXML.pm"},"XML::LibXML::Reader":{"version":"2.0210","file":"lib/XML/LibXML/Reader.pm"},"XML::LibXML::Boolean":{"version":"2.0210","file":"lib/XML/LibXML/Boolean.pm"},"XML::LibXML::XPathContext":{"file":"lib/XML/LibXML/XPathContext.pm","version":"2.0210"},"XML::LibXML::AttributeHash":{"version":"2.0210","file":"lib/XML/LibXML/AttributeHash.pm"},"XML::LibXML::Schema":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::SAX":{"version":"2.0210","file":"lib/XML/LibXML/SAX.pm"},"XML::LibXML::Document":{"version":"2.0210","file":"LibXML.pm"},"XML::LibXML::ErrNo":{"version":"2.0210","file":"lib/XML/LibXML/ErrNo.pm"},"XML::LibXML::Dtd":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::Number":{"file":"lib/XML/LibXML/Number.pm","version":"2.0210"},"XML::LibXML::Pattern":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::RelaxNG":{"version":"2.0210","file":"LibXML.pm"},"XML::LibXML::PI":{"version":"2.0210","file":"LibXML.pm"},"XML::LibXML::SAX::Generator":{"version":"2.0210","file":"lib/XML/LibXML/SAX/Generator.pm"},"XML::LibXML::InputCallback":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::Element":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::SAX::Parser":{"version":"2.0210","file":"lib/XML/LibXML/SAX/Parser.pm"},"XML::LibXML::Text":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::SAX::AttributeNode":{"file":"lib/XML/LibXML/SAX/Generator.pm","version":"2.0210"},"XML::LibXML::Common":{"version":"2.0210","file":"lib/XML/LibXML/Common.pm"},"XML::LibXML::DocumentFragment":{"file":"LibXML.pm","version":"2.0210"},"XML::LibXML::Namespace":{"version":"2.0210","file":"LibXML.pm"}},"dist":"XML-LibXML-2.0210","target":"XML::LibXML","version":"2.0210","pathname":"S/SH/SHLOMIF/XML-LibXML-2.0210.tar.gz","name":"XML::LibXML"} perl5/5.32/x86_64-linux-thread-multi/.meta/Template-Toolkit-3.102/MYMETA.json 0000444 00000002712 15157554047 0021421 0 ustar 00 {
"abstract" : "comprehensive template processing system",
"author" : [
"Andy Wardley <abw@wardley.org>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Template-Toolkit",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"AppConfig" : "1.56",
"File::Spec" : "0.8",
"File::Temp" : "0.12",
"Scalar::Util" : "0"
}
},
"test" : {
"requires" : {
"Test::LeakTrace" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/abw/Template2/issues"
},
"homepage" : "http://www.template-toolkit.org",
"repository" : {
"type" : "git",
"url" : "https://github.com/abw/Template2.git",
"web" : "https://github.com/abw/Template2"
}
},
"version" : "3.102",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/Template-Toolkit-3.102/install.json 0000444 00000010125 15157554054 0022066 0 ustar 00 {"provides":{"Template::Plugin::File":{"version":"3.100","file":"lib/Template/Plugin/File.pm"},"Template::Plugin::Wrap":{"version":"3.100","file":"lib/Template/Plugin/Wrap.pm"},"Template::Plugin::Pod":{"version":"3.100","file":"lib/Template/Plugin/Pod.pm"},"Template::Plugin::Assert":{"version":"3.100","file":"lib/Template/Plugin/Assert.pm"},"Template::Plugin::Table":{"file":"lib/Template/Plugin/Table.pm","version":"3.100"},"Template::VMethods":{"version":"3.100","file":"lib/Template/VMethods.pm"},"Template::Plugin::Procedural":{"file":"lib/Template/Plugin/Procedural.pm","version":"3.100"},"Template::Iterator":{"file":"lib/Template/Iterator.pm","version":"3.100"},"Template::Plugin::Math":{"file":"lib/Template/Plugin/Math.pm","version":"3.100"},"Template::Context":{"version":"3.100","file":"lib/Template/Context.pm"},"Template::Monad::Assert":{"file":"lib/Template/Plugin/Assert.pm","version":"3.100"},"Template::Plugin::HTML":{"file":"lib/Template/Plugin/HTML.pm","version":"3.100"},"Template::Plugin":{"version":"3.100","file":"lib/Template/Plugin.pm"},"Template::Plugin::Directory":{"file":"lib/Template/Plugin/Directory.pm","version":"3.100"},"Template::Plugin::Date::Calc":{"version":"3.100","file":"lib/Template/Plugin/Date.pm"},"Template::Stash":{"file":"lib/Template/Stash.pm","version":"3.100"},"Template::Plugin::Scalar":{"file":"lib/Template/Plugin/Scalar.pm","version":"3.100"},"Template::Test":{"file":"lib/Template/Test.pm","version":"3.100"},"Template::Plugin::Dumper":{"version":"3.100","file":"lib/Template/Plugin/Dumper.pm"},"Template::Plugin::URL":{"version":"3.100","file":"lib/Template/Plugin/URL.pm"},"Template::Service":{"file":"lib/Template/Service.pm","version":"3.100"},"Template::TieString":{"file":"lib/Template/Config.pm","version":"3.100"},"Template::Toolkit":{"version":"3.100","file":"lib/Template/Toolkit.pm"},"Template::Monad::Scalar":{"file":"lib/Template/Plugin/Scalar.pm","version":"3.100"},"Template::Plugin::Image":{"file":"lib/Template/Plugin/Image.pm","version":"3.100"},"Template::Constants":{"version":"3.100","file":"lib/Template/Constants.pm"},"Template::Plugin::Filter":{"version":"3.100","file":"lib/Template/Plugin/Filter.pm"},"Template::Provider":{"file":"lib/Template/Provider.pm","version":"3.100"},"Template::Plugin::Iterator":{"file":"lib/Template/Plugin/Iterator.pm","version":"3.100"},"Template::Plugin::Datafile":{"version":"3.100","file":"lib/Template/Plugin/Datafile.pm"},"Template::Grammar":{"file":"lib/Template/Grammar.pm","version":"3.100"},"Template::Namespace::Constants":{"file":"lib/Template/Namespace/Constants.pm","version":"3.100"},"Template::Plugin::String":{"version":"3.100","file":"lib/Template/Plugin/String.pm"},"Template::Stash::XS":{"file":"lib/Template/Stash/XS.pm"},"Template::View":{"version":"3.100","file":"lib/Template/View.pm"},"Template::Document":{"version":"3.100","file":"lib/Template/Document.pm"},"Template::Directive":{"file":"lib/Template/Directive.pm","version":"3.100"},"Template::Plugins":{"file":"lib/Template/Plugins.pm","version":"3.100"},"Template::Base":{"file":"lib/Template/Base.pm","version":"3.100"},"Template::Exception":{"file":"lib/Template/Exception.pm","version":"3.100"},"Template::Plugin::View":{"version":"3.100","file":"lib/Template/Plugin/View.pm"},"Template::Plugin::Format":{"version":"3.100","file":"lib/Template/Plugin/Format.pm"},"Template::Plugin::Date::Manip":{"version":"3.100","file":"lib/Template/Plugin/Date.pm"},"Template::Perl":{"file":"lib/Template/Filters.pm","version":"3.100"},"Template::Stash::Context":{"file":"lib/Template/Stash/Context.pm","version":"3.100"},"Template::Parser":{"file":"lib/Template/Parser.pm","version":"3.100"},"Template::Filters":{"file":"lib/Template/Filters.pm","version":"3.100"},"Template::Config":{"version":"3.100","file":"lib/Template/Config.pm"},"Template":{"version":3.102,"file":"lib/Template.pm"},"Template::Plugin::Date":{"version":"3.100","file":"lib/Template/Plugin/Date.pm"},"Template::App::ttree":{"file":"lib/Template/App/ttree.pm","version":2.91}},"dist":"Template-Toolkit-3.102","version":3.102,"name":"Template","target":"Template::Constants","pathname":"T/TO/TODDR/Template-Toolkit-3.102.tar.gz"} perl5/5.32/x86_64-linux-thread-multi/.meta/IO-Stringy-2.113/MYMETA.json 0000444 00000046275 15157554066 0020205 0 ustar 00 {
"abstract" : "I/O on in-core objects like strings and arrays",
"author" : [
"Erik Dorfman <eryq@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "IO-Stringy",
"no_index" : {
"directory" : [
"eg",
"examples",
"inc",
"share",
"t",
"xt"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"develop" : {
"requires" : {
"Dist::Zilla" : "0",
"File::Spec" : "0",
"IO::Handle" : "0",
"IPC::Open3" : "0",
"Pod::Coverage::TrustPod" : "0",
"Test::CPAN::Changes" : "0.4",
"Test::CheckManifest" : "1.29",
"Test::Kwalitee" : "1.22",
"Test::More" : "0.88",
"Test::Pod" : "1.41",
"Test::Pod::Coverage" : "1.08",
"Test::Pod::Spelling::CommonMistakes" : "1.000",
"Test::Spelling" : "0.12",
"Test::TrailingSpace" : "0",
"Test::Version" : "1"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Exporter" : "5.57",
"File::Spec" : "0",
"FileHandle" : "0",
"IO::File" : "0",
"IO::Handle" : "0",
"Symbol" : "0",
"overload" : "0",
"parent" : "0",
"strict" : "0",
"warnings" : "0"
}
},
"test" : {
"recommends" : {
"CPAN::Meta" : "2.120900"
},
"requires" : {
"ExtUtils::MakeMaker" : "0",
"File::Basename" : "0",
"File::Spec" : "0",
"File::Temp" : "0",
"FileHandle" : "0",
"IO::File" : "0",
"IO::Handle" : "0",
"Symbol" : "0",
"Test::More" : "0.88",
"Test::Tester" : "0",
"strict" : "0",
"warnings" : "0"
}
}
},
"provides" : {
"IO::AtomicFile" : {
"file" : "lib/IO/AtomicFile.pm",
"version" : "2.113"
},
"IO::InnerFile" : {
"file" : "lib/IO/InnerFile.pm",
"version" : "2.113"
},
"IO::Lines" : {
"file" : "lib/IO/Lines.pm",
"version" : "2.113"
},
"IO::Scalar" : {
"file" : "lib/IO/Scalar.pm",
"version" : "2.113"
},
"IO::ScalarArray" : {
"file" : "lib/IO/ScalarArray.pm",
"version" : "2.113"
},
"IO::Stringy" : {
"file" : "lib/IO/Stringy.pm",
"version" : "2.113"
},
"IO::Wrap" : {
"file" : "lib/IO/Wrap.pm",
"version" : "2.113"
},
"IO::WrapTie" : {
"file" : "lib/IO/WrapTie.pm",
"version" : "2.113"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/genio/IO-Stringy/issues"
},
"homepage" : "https://github.com/genio/IO-Stringy",
"repository" : {
"type" : "git",
"url" : "https://github.com/genio/IO-Stringy.git",
"web" : "https://github.com/genio/IO-Stringy"
}
},
"version" : "2.113",
"x_Dist_Zilla" : {
"perl" : {
"version" : "5.030000"
},
"plugins" : [
{
"class" : "Dist::Zilla::Plugin::Git::GatherDir",
"config" : {
"Dist::Zilla::Plugin::GatherDir" : {
"exclude_filename" : [
"LICENSE",
"META.json",
"Makefile.PL",
"README.md",
"t/00-report-prereqs.t"
],
"exclude_match" : [],
"follow_symlinks" : 0,
"include_dotfiles" : 0,
"prefix" : "",
"prune_directory" : [],
"root" : "."
},
"Dist::Zilla::Plugin::Git::GatherDir" : {
"include_untracked" : 0
}
},
"name" : "Git::GatherDir",
"version" : "2.046"
},
{
"class" : "Dist::Zilla::Plugin::MetaYAML",
"name" : "@Starter/MetaYAML",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::MetaJSON",
"name" : "@Starter/MetaJSON",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::License",
"name" : "@Starter/License",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::Pod2Readme",
"name" : "@Starter/Pod2Readme",
"version" : "0.004"
},
{
"class" : "Dist::Zilla::Plugin::PodSyntaxTests",
"name" : "@Starter/PodSyntaxTests",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::Test::ReportPrereqs",
"name" : "@Starter/Test::ReportPrereqs",
"version" : "0.027"
},
{
"class" : "Dist::Zilla::Plugin::Test::Compile",
"config" : {
"Dist::Zilla::Plugin::Test::Compile" : {
"bail_out_on_fail" : 0,
"fail_on_warning" : "author",
"fake_home" : 0,
"filename" : "xt/author/00-compile.t",
"module_finder" : [
":InstallModules"
],
"needs_display" : 0,
"phase" : "develop",
"script_finder" : [
":PerlExecFiles"
],
"skips" : [],
"switch" : []
}
},
"name" : "@Starter/Test::Compile",
"version" : "2.058"
},
{
"class" : "Dist::Zilla::Plugin::MakeMaker::Awesome",
"config" : {
"Dist::Zilla::Plugin::MakeMaker" : {
"make_path" : "gmake",
"version" : "6.012"
},
"Dist::Zilla::Role::TestRunner" : {
"default_jobs" : 1,
"version" : "6.012"
}
},
"name" : "@Starter/MakeMaker::Awesome",
"version" : "0.48"
},
{
"class" : "Dist::Zilla::Plugin::Manifest",
"name" : "@Starter/Manifest",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::PruneCruft",
"name" : "@Starter/PruneCruft",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::ManifestSkip",
"name" : "@Starter/ManifestSkip",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::RunExtraTests",
"config" : {
"Dist::Zilla::Role::TestRunner" : {
"default_jobs" : 1
}
},
"name" : "@Starter/RunExtraTests",
"version" : "0.029"
},
{
"class" : "Dist::Zilla::Plugin::RewriteVersion",
"config" : {
"Dist::Zilla::Plugin::RewriteVersion" : {
"add_tarball_name" : 0,
"finders" : [
":ExecFiles",
":InstallModules"
],
"global" : 1,
"skip_version_provider" : 0
}
},
"name" : "@Starter/RewriteVersion",
"version" : "0.018"
},
{
"class" : "Dist::Zilla::Plugin::NextRelease",
"name" : "@Starter/NextRelease",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::BumpVersionAfterRelease",
"config" : {
"Dist::Zilla::Plugin::BumpVersionAfterRelease" : {
"finders" : [
":ExecFiles",
":InstallModules"
],
"global" : 0,
"munge_makefile_pl" : 1
}
},
"name" : "@Starter/BumpVersionAfterRelease",
"version" : "0.018"
},
{
"class" : "Dist::Zilla::Plugin::TestRelease",
"name" : "@Starter/TestRelease",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::ConfirmRelease",
"name" : "@Starter/ConfirmRelease",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::UploadToCPAN",
"name" : "@Starter/UploadToCPAN",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::MetaConfig",
"name" : "@Starter/MetaConfig",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::MetaNoIndex",
"name" : "@Starter/MetaNoIndex",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::MetaProvides::Package",
"config" : {
"Dist::Zilla::Plugin::MetaProvides::Package" : {
"finder_objects" : [
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : "@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM",
"version" : "6.012"
}
],
"include_underscores" : 0
},
"Dist::Zilla::Role::MetaProvider::Provider" : {
"$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002004",
"inherit_missing" : 1,
"inherit_version" : 1,
"meta_noindex" : 1
},
"Dist::Zilla::Role::ModuleMetadata" : {
"Module::Metadata" : "1.000036",
"version" : "0.006"
}
},
"name" : "@Starter/MetaProvides::Package",
"version" : "2.004003"
},
{
"class" : "Dist::Zilla::Plugin::ShareDir",
"name" : "@Starter/ShareDir",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::ExecDir",
"name" : "@Starter/ExecDir",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod",
"config" : {
"Dist::Zilla::Role::FileWatcher" : {
"version" : "0.006"
}
},
"name" : "Markdown_Readme",
"version" : "0.163250"
},
{
"class" : "Dist::Zilla::Plugin::Prereqs::FromCPANfile",
"name" : "Prereqs::FromCPANfile",
"version" : "0.08"
},
{
"class" : "Dist::Zilla::Plugin::Git::Contributors",
"config" : {
"Dist::Zilla::Plugin::Git::Contributors" : {
"git_version" : "2.16.1.windows.1",
"include_authors" : 0,
"include_releaser" : 1,
"order_by" : "name",
"paths" : []
}
},
"name" : "Git::Contributors",
"version" : "0.035"
},
{
"class" : "Dist::Zilla::Plugin::GithubMeta",
"name" : "GithubMeta",
"version" : "0.58"
},
{
"class" : "Dist::Zilla::Plugin::Git::Check",
"config" : {
"Dist::Zilla::Plugin::Git::Check" : {
"untracked_files" : "die"
},
"Dist::Zilla::Role::Git::DirtyFiles" : {
"allow_dirty" : [
"Changes",
"dist.ini"
],
"allow_dirty_match" : [],
"changelog" : "Changes"
},
"Dist::Zilla::Role::Git::Repo" : {
"git_version" : "2.16.1.windows.1",
"repo_root" : "."
}
},
"name" : "@Git/Check",
"version" : "2.046"
},
{
"class" : "Dist::Zilla::Plugin::Git::Commit",
"config" : {
"Dist::Zilla::Plugin::Git::Commit" : {
"add_files_in" : [],
"commit_msg" : "v%V%n%n%c"
},
"Dist::Zilla::Role::Git::DirtyFiles" : {
"allow_dirty" : [
"Changes",
"dist.ini"
],
"allow_dirty_match" : [],
"changelog" : "Changes"
},
"Dist::Zilla::Role::Git::Repo" : {
"git_version" : "2.16.1.windows.1",
"repo_root" : "."
},
"Dist::Zilla::Role::Git::StringFormatter" : {
"time_zone" : "local"
}
},
"name" : "@Git/Commit",
"version" : "2.046"
},
{
"class" : "Dist::Zilla::Plugin::Git::Tag",
"config" : {
"Dist::Zilla::Plugin::Git::Tag" : {
"branch" : null,
"changelog" : "Changes",
"signed" : 0,
"tag" : "v2.113",
"tag_format" : "v%V",
"tag_message" : "v%V"
},
"Dist::Zilla::Role::Git::Repo" : {
"git_version" : "2.16.1.windows.1",
"repo_root" : "."
},
"Dist::Zilla::Role::Git::StringFormatter" : {
"time_zone" : "local"
}
},
"name" : "@Git/Tag",
"version" : "2.046"
},
{
"class" : "Dist::Zilla::Plugin::Git::Push",
"config" : {
"Dist::Zilla::Plugin::Git::Push" : {
"push_to" : [
"origin"
],
"remotes_must_exist" : 1
},
"Dist::Zilla::Role::Git::Repo" : {
"git_version" : "2.16.1.windows.1",
"repo_root" : "."
}
},
"name" : "@Git/Push",
"version" : "2.046"
},
{
"class" : "Dist::Zilla::Plugin::CheckChangeLog",
"name" : "CheckChangeLog",
"version" : "0.05"
},
{
"class" : "Dist::Zilla::Plugin::CheckChangesHasContent",
"name" : "CheckChangesHasContent",
"version" : "0.011"
},
{
"class" : "Dist::Zilla::Plugin::Test::ChangesHasContent",
"name" : "Test::ChangesHasContent",
"version" : "0.011"
},
{
"class" : "Dist::Zilla::Plugin::Test::Kwalitee",
"config" : {
"Dist::Zilla::Plugin::Test::Kwalitee" : {
"filename" : "xt/release/kwalitee.t",
"skiptest" : [
"no_symlinks"
]
}
},
"name" : "Test::Kwalitee",
"version" : "2.12"
},
{
"class" : "Dist::Zilla::Plugin::Test::Version",
"name" : "Test::Version",
"version" : "1.09"
},
{
"class" : "Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable",
"name" : "Test::Pod::Coverage::Configurable",
"version" : "0.07"
},
{
"class" : "Dist::Zilla::Plugin::Test::PodSpelling",
"config" : {
"Dist::Zilla::Plugin::Test::PodSpelling" : {
"directories" : [
"bin",
"lib"
],
"spell_cmd" : "",
"stopwords" : [
"BUF",
"Doru",
"FOO",
"Foo",
"NBYTES",
"POS",
"SCALARREF",
"SLAVECLASS",
"ZeeGee",
"aref",
"dfs",
"getline",
"getlines",
"getpos",
"ing",
"reblessed",
"setpos",
"sref",
"tieable",
"wraphandle"
],
"wordlist" : "Pod::Wordlist"
}
},
"name" : "Test::PodSpelling",
"version" : "2.007005"
},
{
"class" : "Dist::Zilla::Plugin::CopyFilesFromBuild",
"name" : "CopyFilesFromBuild",
"version" : "0.170880"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":InstallModules",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":IncModules",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":TestFiles",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ExtraTestFiles",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ExecFiles",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":PerlExecFiles",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":ShareFiles",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":MainModule",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":AllFiles",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : ":NoFiles",
"version" : "6.012"
},
{
"class" : "Dist::Zilla::Plugin::FinderCode",
"name" : "@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM",
"version" : "6.012"
}
],
"zilla" : {
"class" : "Dist::Zilla::Dist::Builder",
"config" : {
"is_trial" : 0
},
"version" : "6.012"
}
},
"x_contributors" : [
"Chase Whitener <capoeirab@cpan.org>",
"Dianne Skoll <dskoll@cpan.org>"
],
"x_generated_by_perl" : "v5.30.0",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/IO-Stringy-2.113/install.json 0000444 00000001207 15157554073 0020637 0 ustar 00 {"pathname":"C/CA/CAPOEIRAB/IO-Stringy-2.113.tar.gz","name":"IO::Stringy","version":"2.113","target":"IO::Scalar","provides":{"IO::ScalarArray":{"version":"2.113","file":"lib/IO/ScalarArray.pm"},"IO::AtomicFile":{"file":"lib/IO/AtomicFile.pm","version":"2.113"},"IO::InnerFile":{"file":"lib/IO/InnerFile.pm","version":"2.113"},"IO::Wrap":{"version":"2.113","file":"lib/IO/Wrap.pm"},"IO::Scalar":{"file":"lib/IO/Scalar.pm","version":"2.113"},"IO::Lines":{"version":"2.113","file":"lib/IO/Lines.pm"},"IO::WrapTie":{"version":"2.113","file":"lib/IO/WrapTie.pm"},"IO::Stringy":{"file":"lib/IO/Stringy.pm","version":"2.113"}},"dist":"IO-Stringy-2.113"} perl5/5.32/x86_64-linux-thread-multi/.meta/AppConfig-1.71/MYMETA.json 0000444 00000002533 15157554105 0020010 0 ustar 00 {
"abstract" : "AppConfig is a bundle of Perl5 modules for reading configuration files and parsing command line arguments.",
"author" : [
"Andy Wardley <abw@wardley.org>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.143240, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "AppConfig",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Test::More" : "0",
"perl" : "5.008008"
}
},
"test" : {
"requires" : {
"Test::Pod" : "1.0"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"type" : "git",
"url" : "git://github.com/neilbowers/AppConfig.git",
"web" : "https://github.com/neilbowers/AppConfig"
}
},
"version" : "1.71",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/AppConfig-1.71/install.json 0000444 00000001121 15157554112 0020450 0 ustar 00 {"pathname":"N/NE/NEILB/AppConfig-1.71.tar.gz","target":"AppConfig","name":"AppConfig","version":1.71,"provides":{"AppConfig::CGI":{"file":"lib/AppConfig/CGI.pm","version":1.71},"AppConfig":{"file":"lib/AppConfig.pm","version":1.71},"AppConfig::Args":{"file":"lib/AppConfig/Args.pm","version":1.71},"AppConfig::Getopt":{"version":1.71,"file":"lib/AppConfig/Getopt.pm"},"AppConfig::State":{"version":1.71,"file":"lib/AppConfig/Getopt.pm"},"AppConfig::File":{"file":"lib/AppConfig/File.pm","version":1.71},"AppConfig::Sys":{"version":1.71,"file":"lib/AppConfig/Sys.pm"}},"dist":"AppConfig-1.71"} perl5/5.32/x86_64-linux-thread-multi/.meta/YAML-Syck-1.36/MYMETA.json 0000444 00000002342 15157554132 0017612 0 ustar 00 {
"abstract" : "Fast, lightweight YAML loader and dumper",
"author" : [
"Todd Rinaldo <toddr@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010",
"license" : [
"mit"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "YAML-Syck",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"Test::More" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"perl" : "5.006"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/toddr/YAML-Syck/issues"
},
"homepage" : "http://github.com/toddr/YAML-Syck",
"license" : [
"http://dev.perl.org/licenses/"
],
"repository" : {
"url" : "http://github.com/toddr/YAML-Syck"
}
},
"version" : "1.36",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/YAML-Syck-1.36/install.json 0000444 00000000555 15157554137 0020275 0 ustar 00 {"pathname":"T/TO/TODDR/YAML-Syck-1.36.tar.gz","dist":"YAML-Syck-1.36","version":1.36,"target":"YAML::Syck","name":"YAML::Syck","provides":{"YAML::Syck":{"file":"lib/YAML/Syck.pm","version":1.36},"YAML::Loader::Syck":{"file":"lib/YAML/Loader/Syck.pm"},"JSON::Syck":{"version":1.36,"file":"lib/JSON/Syck.pm"},"YAML::Dumper::Syck":{"file":"lib/YAML/Dumper/Syck.pm"}}} perl5/5.32/x86_64-linux-thread-multi/.meta/File-chdir-0.1011/MYMETA.json 0000444 00000006223 15157554151 0020243 0 ustar 00 {
"abstract" : "a more sensible way to change directories",
"author" : [
"David Golden <dagolden@cpan.org>",
"Michael G. Schwern <schwern@pobox.com>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "File-chdir",
"no_index" : {
"directory" : [
"corpus",
"examples",
"t",
"xt"
],
"package" : [
"DB"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "6.17"
}
},
"develop" : {
"requires" : {
"Dist::Zilla" : "5",
"Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072",
"English" : "0",
"File::Spec" : "0",
"File::Temp" : "0",
"IO::Handle" : "0",
"IPC::Open3" : "0",
"Pod::Coverage::TrustPod" : "0",
"Pod::Wordlist" : "0",
"Software::License::Perl_5" : "0",
"Test::CPAN::Meta" : "0",
"Test::More" : "0",
"Test::Pod" : "1.41",
"Test::Pod::Coverage" : "1.08",
"Test::Portability::Files" : "0",
"Test::Spelling" : "0.12",
"Test::Version" : "1",
"blib" : "1.01",
"perl" : "5.006",
"warnings" : "0"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Cwd" : "3.16",
"Exporter" : "0",
"File::Spec::Functions" : "3.27",
"perl" : "5.006",
"strict" : "0",
"vars" : "0"
}
},
"test" : {
"recommends" : {
"CPAN::Meta" : "2.120900"
},
"requires" : {
"ExtUtils::MakeMaker" : "0",
"File::Spec" : "0",
"Test::More" : "0",
"warnings" : "0"
}
}
},
"provides" : {
"File::chdir" : {
"file" : "lib/File/chdir.pm",
"version" : "0.1011"
},
"File::chdir::ARRAY" : {
"file" : "lib/File/chdir.pm",
"version" : "0.1011"
},
"File::chdir::SCALAR" : {
"file" : "lib/File/chdir.pm",
"version" : "0.1011"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/dagolden/File-chdir/issues"
},
"homepage" : "https://github.com/dagolden/File-chdir",
"repository" : {
"type" : "git",
"url" : "https://github.com/dagolden/File-chdir.git",
"web" : "https://github.com/dagolden/File-chdir"
}
},
"version" : "0.1011",
"x_authority" : "cpan:DAGOLDEN",
"x_contributors" : [
"David Golden <xdg@xdg.me>",
"Joel Berger <joel.a.berger@gmail.com>",
"Philippe Bruhat (BooK) <book@cpan.org>"
],
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/File-chdir-0.1011/install.json 0000444 00000000545 15157554156 0020723 0 ustar 00 {"pathname":"D/DA/DAGOLDEN/File-chdir-0.1011.tar.gz","name":"File::chdir","version":"0.1011","provides":{"File::chdir::SCALAR":{"file":"lib/File/chdir.pm","version":"0.1011"},"File::chdir":{"file":"lib/File/chdir.pm","version":"0.1011"},"File::chdir::ARRAY":{"version":"0.1011","file":"lib/File/chdir.pm"}},"dist":"File-chdir-0.1011","target":"File::chdir"} perl5/5.32/x86_64-linux-thread-multi/.meta/XML-SAX-Expat-0.51/MYMETA.json 0000444 00000002241 15157554171 0020306 0 ustar 00 {
"abstract" : "SAX Driver for Expat",
"author" : [
"Robin Berjon"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.132830, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-SAX-Expat",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"XML::NamespaceSupport" : "0.03",
"XML::Parser" : "2.27",
"XML::SAX" : "0.03",
"XML::SAX::Base" : "1.00"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"url" : "https://github.com/hoehrmann/XML-SAX-Expat"
}
},
"version" : "0.51",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-SAX-Expat-0.51/install.json 0000444 00000000325 15157554176 0020766 0 ustar 00 {"pathname":"B/BJ/BJOERN/XML-SAX-Expat-0.51.tar.gz","target":"XML::SAX::Expat","dist":"XML-SAX-Expat-0.51","version":0.51,"name":"XML::SAX::Expat","provides":{"XML::SAX::Expat":{"version":0.51,"file":"Expat.pm"}}} perl5/5.32/x86_64-linux-thread-multi/.meta/FFI-CheckLib-0.31/MYMETA.json 0000444 00000015634 15157554210 0020206 0 ustar 00 {
"abstract" : "Check that a library is available for FFI",
"author" : [
"Graham Ollis <plicease@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.025, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "FFI-CheckLib",
"no_index" : {
"directory" : [
"corpus"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"develop" : {
"recommends" : {
"Dist::Zilla::Plugin::Author::Plicease::Thanks" : "0",
"Dist::Zilla::Plugin::Author::Plicease::Upload" : "0",
"Dist::Zilla::Plugin::MetaNoIndex" : "0",
"Dist::Zilla::Plugin::RemovePrereqs" : "0",
"Dist::Zilla::PluginBundle::Author::Plicease" : "2.72",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitHardTabs" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace" : "0",
"Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode" : "0",
"Perl::Critic::Policy::Freenode::ArrayAssignAref" : "0",
"Perl::Critic::Policy::Freenode::BarewordFilehandles" : "0",
"Perl::Critic::Policy::Freenode::ConditionalDeclarations" : "0",
"Perl::Critic::Policy::Freenode::ConditionalImplicitReturn" : "0",
"Perl::Critic::Policy::Freenode::DeprecatedFeatures" : "0",
"Perl::Critic::Policy::Freenode::DiscouragedModules" : "0",
"Perl::Critic::Policy::Freenode::DollarAB" : "0",
"Perl::Critic::Policy::Freenode::Each" : "0",
"Perl::Critic::Policy::Freenode::IndirectObjectNotation" : "0",
"Perl::Critic::Policy::Freenode::LexicalForeachIterator" : "0",
"Perl::Critic::Policy::Freenode::LoopOnHash" : "0",
"Perl::Critic::Policy::Freenode::ModPerl" : "0",
"Perl::Critic::Policy::Freenode::OpenArgs" : "0",
"Perl::Critic::Policy::Freenode::OverloadOptions" : "0",
"Perl::Critic::Policy::Freenode::POSIXImports" : "0",
"Perl::Critic::Policy::Freenode::PackageMatchesFilename" : "0",
"Perl::Critic::Policy::Freenode::PreferredAlternatives" : "0",
"Perl::Critic::Policy::Freenode::StrictWarnings" : "0",
"Perl::Critic::Policy::Freenode::Threads" : "0",
"Perl::Critic::Policy::Freenode::WarningsSwitch" : "0",
"Perl::Critic::Policy::Freenode::WhileDiamondDefaultAssignment" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitFormats" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic" : "0",
"Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements" : "0",
"Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish" : "0",
"Perl::Critic::Policy::Objects::ProhibitIndirectSyntax" : "0",
"Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic" : "0",
"Perl::Critic::Policy::Subroutines::ProhibitNestedSubs" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator" : "0",
"Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames" : "0",
"Perl::Critic::Policy::Variables::ProhibitUnusedVariables" : "0",
"Software::License::Perl_5" : "0"
},
"requires" : {
"FindBin" : "0",
"Perl::Critic" : "0",
"Test2::Require::EnvVar" : "0.000121",
"Test2::Require::Module" : "0.000121",
"Test2::Tools::PerlCritic" : "0",
"Test2::V0" : "0.000121",
"Test::CPAN::Changes" : "0",
"Test::EOL" : "0",
"Test::Fixme" : "0.07",
"Test::More" : "0.98",
"Test::NoTabs" : "0",
"Test::Pod" : "0",
"Test::Pod::Coverage" : "0",
"Test::Pod::LinkCheck::Lite" : "0",
"Test::Pod::Spelling::CommonMistakes" : "0",
"Test::Spelling" : "0",
"Test::Strict" : "0",
"YAML" : "0"
}
},
"runtime" : {
"requires" : {
"File::Which" : "0",
"List::Util" : "1.33",
"perl" : "5.006"
}
},
"test" : {
"requires" : {
"Test2::API" : "1.302015",
"Test2::Require::EnvVar" : "0.000121",
"Test2::Require::Module" : "0.000121",
"Test2::V0" : "0.000121"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/PerlFFI/FFI-CheckLib/issues"
},
"homepage" : "https://metacpan.org/pod/FFI::CheckLib",
"repository" : {
"type" : "git",
"url" : "git://github.com/PerlFFI/FFI-CheckLib.git",
"web" : "https://github.com/PerlFFI/FFI-CheckLib"
},
"x_IRC" : "irc://irc.perl.org/#native"
},
"version" : "0.31",
"x_contributors" : [
"Graham Ollis <plicease@cpan.org>",
"Bakkiaraj Murugesan (bakkiaraj)",
"Dan Book (grinnz, DBOOK)",
"Ilya Pavlov (Ilya, ILUX)",
"Shawn Laffan (SLAFFAN)",
"Petr Písař (ppisar)",
"Michael R. Davis (MRDVT)",
"Shawn Laffan (SLAFFAN)",
"Carlos D. Álvaro (cdalvaro)"
],
"x_generated_by_perl" : "v5.36.0",
"x_serialization_backend" : "JSON::PP version 4.06",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later",
"x_use_unsafe_inc" : 0
}
perl5/5.32/x86_64-linux-thread-multi/.meta/FFI-CheckLib-0.31/install.json 0000444 00000000332 15157554215 0020652 0 ustar 00 {"dist":"FFI-CheckLib-0.31","provides":{"FFI::CheckLib":{"file":"lib/FFI/CheckLib.pm","version":0.31}},"target":"FFI::CheckLib","name":"FFI::CheckLib","pathname":"P/PL/PLICEASE/FFI-CheckLib-0.31.tar.gz","version":0.31} perl5/5.32/x86_64-linux-thread-multi/.meta/Path-Tiny-0.146/MYMETA.json 0000444 00000013212 15157554227 0020042 0 ustar 00 {
"abstract" : "File path utility",
"author" : [
"David Golden <dagolden@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.031, CPAN::Meta::Converter version 2.150010",
"license" : [
"apache_2_0"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Path-Tiny",
"no_index" : {
"directory" : [
"corpus",
"examples",
"t",
"xt"
],
"package" : [
"DB",
"flock"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "6.17"
},
"suggests" : {
"JSON::PP" : "2.27300"
}
},
"develop" : {
"requires" : {
"Dist::Zilla" : "5",
"Dist::Zilla::Plugin::MinimumPerl" : "0",
"Dist::Zilla::Plugin::OnlyCorePrereqs" : "0",
"Dist::Zilla::Plugin::Prereqs" : "0",
"Dist::Zilla::Plugin::ReleaseStatus::FromVersion" : "0",
"Dist::Zilla::Plugin::RemovePrereqs" : "0",
"Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072",
"File::Spec" : "0",
"File::Temp" : "0",
"IO::Handle" : "0",
"IPC::Open3" : "0",
"Pod::Coverage::TrustPod" : "0",
"Pod::Wordlist" : "0",
"Software::License::Apache_2_0" : "0",
"Test::CPAN::Meta" : "0",
"Test::MinimumVersion" : "0",
"Test::More" : "0",
"Test::Perl::Critic" : "0",
"Test::Pod" : "1.41",
"Test::Pod::Coverage" : "1.08",
"Test::Portability::Files" : "0",
"Test::Spelling" : "0.12",
"Test::Version" : "1"
}
},
"runtime" : {
"recommends" : {
"Unicode::UTF8" : "0.58"
},
"requires" : {
"Carp" : "0",
"Cwd" : "0",
"Digest" : "1.03",
"Digest::SHA" : "5.45",
"Encode" : "0",
"Exporter" : "5.57",
"Fcntl" : "0",
"File::Compare" : "0",
"File::Copy" : "0",
"File::Glob" : "0",
"File::Path" : "2.07",
"File::Spec" : "0.86",
"File::Temp" : "0.19",
"File::stat" : "0",
"constant" : "0",
"overload" : "0",
"perl" : "5.008001",
"strict" : "0",
"warnings" : "0",
"warnings::register" : "0"
}
},
"test" : {
"recommends" : {
"CPAN::Meta" : "2.120900",
"Test::FailWarnings" : "0",
"Test::MockRandom" : "0"
},
"requires" : {
"Digest::MD5" : "0",
"ExtUtils::MakeMaker" : "0",
"File::Basename" : "0",
"File::Spec" : "0.86",
"File::Spec::Functions" : "0",
"File::Spec::Unix" : "0",
"File::Temp" : "0.19",
"Test::More" : "0.96",
"lib" : "0",
"open" : "0"
}
}
},
"provides" : {
"Path::Tiny" : {
"file" : "lib/Path/Tiny.pm",
"version" : "0.146"
},
"Path::Tiny::Error" : {
"file" : "lib/Path/Tiny.pm",
"version" : "0.146"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/dagolden/Path-Tiny/issues"
},
"homepage" : "https://github.com/dagolden/Path-Tiny",
"repository" : {
"type" : "git",
"url" : "https://github.com/dagolden/Path-Tiny.git",
"web" : "https://github.com/dagolden/Path-Tiny"
}
},
"version" : "0.146",
"x_authority" : "cpan:DAGOLDEN",
"x_contributors" : [
"Alex Efros <powerman@powerman.name>",
"Aristotle Pagaltzis <pagaltzis@gmx.de>",
"Chris Williams <bingos@cpan.org>",
"Dan Book <grinnz@grinnz.com>",
"Dave Rolsky <autarch@urth.org>",
"David Steinbrunner <dsteinbrunner@pobox.com>",
"Doug Bell <madcityzen@gmail.com>",
"Elvin Aslanov <rwp.primary@gmail.com>",
"Flavio Poletti <flavio@polettix.it>",
"Gabor Szabo <szabgab@cpan.org>",
"Gabriel Andrade <gabiruh@gmail.com>",
"George Hartzell <hartzell@cpan.org>",
"Geraud Continsouzas <geraud@scsi.nc>",
"Goro Fuji <gfuji@cpan.org>",
"Graham Knop <haarg@haarg.org>",
"Graham Ollis <plicease@cpan.org>",
"Ian Sillitoe <ian@sillit.com>",
"James Hunt <james@niftylogic.com>",
"John Karr <brainbuz@brainbuz.org>",
"Karen Etheridge <ether@cpan.org>",
"Mark Ellis <mark.ellis@cartridgesave.co.uk>",
"Martin H. Sluka <fany@cpan.org>",
"Martin Kjeldsen <mk@bluepipe.dk>",
"Mary Ehlers <regina.verb.ae@gmail.com>",
"Michael G. Schwern <mschwern@cpan.org>",
"Nicolas R <nicolas@atoomic.org>",
"Nicolas Rochelemagne <rochelemagne@cpanel.net>",
"Nigel Gregoire <nigelgregoire@gmail.com>",
"Philippe Bruhat (BooK) <book@cpan.org>",
"regina-verbae <regina-verbae@users.noreply.github.com>",
"Roy Ivy III <rivy@cpan.org>",
"Shlomi Fish <shlomif@shlomifish.org>",
"Smylers <Smylers@stripey.com>",
"Tatsuhiko Miyagawa <miyagawa@bulknews.net>",
"Toby Inkster <tobyink@cpan.org>",
"Yanick Champoux <yanick@babyl.dyndns.org>",
"김도형 - Keedi Kim <keedi@cpan.org>"
],
"x_generated_by_perl" : "v5.36.0",
"x_serialization_backend" : "JSON::PP version 4.06",
"x_spdx_expression" : "Apache-2.0"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/Path-Tiny-0.146/install.json 0000444 00000000422 15157554234 0020511 0 ustar 00 {"dist":"Path-Tiny-0.146","provides":{"Path::Tiny::Error":{"file":"lib/Path/Tiny.pm","version":"0.146"},"Path::Tiny":{"file":"lib/Path/Tiny.pm","version":"0.146"}},"target":"Path::Tiny","name":"Path::Tiny","pathname":"D/DA/DAGOLDEN/Path-Tiny-0.146.tar.gz","version":"0.146"} perl5/5.32/x86_64-linux-thread-multi/.meta/Alien-Build-Plugin-Download-GitLab-0.01/MYMETA.json 0000444 00000015174 15157554247 0024374 0 ustar 00 {
"abstract" : "Alien::Build plugin to download from GitLab",
"author" : [
"Graham Ollis <plicease@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.025, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Alien-Build-Plugin-Download-GitLab",
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"develop" : {
"recommends" : {
"Dist::Zilla::Plugin::Author::Plicease::Core" : "0",
"Dist::Zilla::Plugin::Author::Plicease::Upload" : "0",
"Dist::Zilla::PluginBundle::Author::Plicease" : "2.71",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitHardTabs" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace" : "0",
"Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines" : "0",
"Perl::Critic::Policy::Community::ArrayAssignAref" : "0",
"Perl::Critic::Policy::Community::BarewordFilehandles" : "0",
"Perl::Critic::Policy::Community::ConditionalDeclarations" : "0",
"Perl::Critic::Policy::Community::ConditionalImplicitReturn" : "0",
"Perl::Critic::Policy::Community::DeprecatedFeatures" : "0",
"Perl::Critic::Policy::Community::DiscouragedModules" : "0",
"Perl::Critic::Policy::Community::DollarAB" : "0",
"Perl::Critic::Policy::Community::Each" : "0",
"Perl::Critic::Policy::Community::EmptyReturn" : "0",
"Perl::Critic::Policy::Community::IndirectObjectNotation" : "0",
"Perl::Critic::Policy::Community::LexicalForeachIterator" : "0",
"Perl::Critic::Policy::Community::LoopOnHash" : "0",
"Perl::Critic::Policy::Community::ModPerl" : "0",
"Perl::Critic::Policy::Community::OpenArgs" : "0",
"Perl::Critic::Policy::Community::OverloadOptions" : "0",
"Perl::Critic::Policy::Community::POSIXImports" : "0",
"Perl::Critic::Policy::Community::PackageMatchesFilename" : "0",
"Perl::Critic::Policy::Community::PreferredAlternatives" : "0",
"Perl::Critic::Policy::Community::StrictWarnings" : "0",
"Perl::Critic::Policy::Community::Threads" : "0",
"Perl::Critic::Policy::Community::Wantarray" : "0",
"Perl::Critic::Policy::Community::WarningsSwitch" : "0",
"Perl::Critic::Policy::Community::WhileDiamondDefaultAssignment" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitFormats" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic" : "0",
"Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements" : "0",
"Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish" : "0",
"Perl::Critic::Policy::Objects::ProhibitIndirectSyntax" : "0",
"Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic" : "0",
"Perl::Critic::Policy::Subroutines::ProhibitNestedSubs" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator" : "0",
"Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames" : "0",
"Perl::Critic::Policy::Variables::ProhibitUnusedVariables" : "0",
"Software::License::Perl_5" : "0"
},
"requires" : {
"File::Spec" : "0",
"FindBin" : "0",
"Perl::Critic" : "0",
"Test2::Require::Module" : "0.000121",
"Test2::Tools::PerlCritic" : "0",
"Test2::V0" : "0.000121",
"Test::CPAN::Changes" : "0",
"Test::EOL" : "0",
"Test::Fixme" : "0.07",
"Test::More" : "0.98",
"Test::NoTabs" : "0",
"Test::Pod" : "0",
"Test::Pod::Coverage" : "0",
"Test::Pod::Spelling::CommonMistakes" : "0",
"Test::Spelling" : "0",
"Test::Strict" : "0",
"YAML" : "0"
}
},
"runtime" : {
"requires" : {
"Alien::Build::Plugin" : "0",
"JSON::PP" : "0",
"Path::Tiny" : "0",
"URI" : "0",
"URI::Escape" : "0",
"perl" : "5.008004"
}
},
"test" : {
"requires" : {
"Test2::V0" : "0.000121"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/PerlAlien/Alien-Build-Plugin-Download-GitLab/issues"
},
"homepage" : "https://metacpan.org/pod/Alien::Build::Plugin::Download::GitLab",
"repository" : {
"type" : "git",
"url" : "git://github.com/PerlAlien/Alien-Build-Plugin-Download-GitLab.git",
"web" : "https://github.com/PerlAlien/Alien-Build-Plugin-Download-GitLab"
},
"x_IRC" : "irc://irc.perl.org/#native"
},
"version" : "0.01",
"x_generated_by_perl" : "v5.35.10",
"x_serialization_backend" : "JSON::PP version 4.06",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later",
"x_use_unsafe_inc" : 0
}
perl5/5.32/x86_64-linux-thread-multi/.meta/Alien-Build-Plugin-Download-GitLab-0.01/install.json 0000444 00000000547 15157554254 0025042 0 ustar 00 {"version":0.01,"pathname":"P/PL/PLICEASE/Alien-Build-Plugin-Download-GitLab-0.01.tar.gz","name":"Alien::Build::Plugin::Download::GitLab","dist":"Alien-Build-Plugin-Download-GitLab-0.01","provides":{"Alien::Build::Plugin::Download::GitLab":{"version":0.01,"file":"lib/Alien/Build/Plugin/Download/GitLab.pm"}},"target":"Alien::Build::Plugin::Download::GitLab"} perl5/5.32/x86_64-linux-thread-multi/.meta/XML-Parser-2.47/MYMETA.json 0000444 00000002433 15157554267 0020050 0 ustar 00 {
"abstract" : "A perl module for parsing XML documents",
"author" : [
"Clark Cooper (coopercc@netheaven.com)"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-Parser",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"LWP::UserAgent" : "0",
"perl" : "5.004050"
}
},
"test" : {
"requires" : {
"Test::More" : "0",
"warnings" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/toddr/XML-Parser/issues"
},
"repository" : {
"url" : "http://github.com/toddr/XML-Parser"
}
},
"version" : "2.47",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-Parser-2.47/install.json 0000444 00000001064 15157554274 0020517 0 ustar 00 {"pathname":"T/TO/TODDR/XML-Parser-2.47.tar.gz","target":"XML::Parser","dist":"XML-Parser-2.47","version":2.47,"name":"XML::Parser","provides":{"XML::Parser::Style::Objects":{"file":"Parser/Style/Objects.pm"},"XML::Parser::Style::Debug":{"file":"Parser/Style/Debug.pm"},"XML::Parser":{"version":2.47,"file":"Parser.pm"},"XML::Parser::Style::Stream":{"file":"Parser/Style/Stream.pm"},"XML::Parser::Style::Tree":{"file":"Parser/Style/Tree.pm"},"XML::Parser::Style::Subs":{"file":"Parser/Style/Subs.pm"},"XML::Parser::Expat":{"file":"Expat/Expat.pm","version":2.47}}} perl5/5.32/x86_64-linux-thread-multi/.meta/XML-Simple-2.25/MYMETA.json 0000444 00000002601 15157554306 0020030 0 ustar 00 {
"abstract" : "An API for simple XML files",
"author" : [
"Grant McLean <grantm@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 5.043, CPAN::Meta::Converter version 2.150005, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-Simple",
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"develop" : {
"requires" : {
"Test::Pod" : "1.41"
}
},
"runtime" : {
"requires" : {
"XML::NamespaceSupport" : "1.04",
"XML::SAX" : "0.15",
"XML::SAX::Expat" : "0",
"perl" : "5.008"
}
},
"test" : {
"requires" : {
"File::Temp" : "0",
"Test::More" : "0.88"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"type" : "git",
"url" : "git://github.com/grantm/xml-simple.git",
"web" : "https://github.com/grantm/xml-simple"
}
},
"version" : "2.25",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-Simple-2.25/install.json 0000444 00000000314 15157554313 0020477 0 ustar 00 {"version":2.25,"name":"XML::Simple","provides":{"XML::Simple":{"file":"lib/XML/Simple.pm","version":2.25}},"pathname":"G/GR/GRANTM/XML-Simple-2.25.tar.gz","target":"XML::Simple","dist":"XML-Simple-2.25"} perl5/5.32/x86_64-linux-thread-multi/.meta/Alien-Build-2.84/MYMETA.json 0000444 00000021144 15157554326 0020240 0 ustar 00 {
"abstract" : "Build external dependencies for use in CPAN",
"author" : [
"Graham Ollis <plicease@cpan.org>",
"Joel Berger <joel.a.berger@gmail.com>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Alien-Build",
"no_index" : {
"directory" : [
"corpus",
"example",
"maint"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "6.64"
}
},
"configure" : {
"requires" : {
"ExtUtils::CBuilder" : "0",
"ExtUtils::MakeMaker" : "6.64",
"ExtUtils::ParseXS" : "3.30",
"File::Which" : "0"
}
},
"develop" : {
"recommends" : {
"Dist::Zilla::Plugin::Author::Plicease::Thanks" : "0",
"Dist::Zilla::Plugin::Author::Plicease::Upload" : "0",
"Dist::Zilla::Plugin::DynamicPrereqs" : "0",
"Dist::Zilla::Plugin::GatherFile" : "0",
"Dist::Zilla::Plugin::MetaNoIndex" : "0",
"Dist::Zilla::Plugin::Prereqs" : "0",
"Dist::Zilla::Plugin::PruneFiles" : "0",
"Dist::Zilla::Plugin::RemovePrereqs" : "0",
"Dist::Zilla::PluginBundle::Author::Plicease" : "2.75",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitHardTabs" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace" : "0",
"Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines" : "0",
"Perl::Critic::Policy::Community::ArrayAssignAref" : "0",
"Perl::Critic::Policy::Community::BarewordFilehandles" : "0",
"Perl::Critic::Policy::Community::ConditionalDeclarations" : "0",
"Perl::Critic::Policy::Community::ConditionalImplicitReturn" : "0",
"Perl::Critic::Policy::Community::DeprecatedFeatures" : "0",
"Perl::Critic::Policy::Community::DiscouragedModules" : "0",
"Perl::Critic::Policy::Community::DollarAB" : "0",
"Perl::Critic::Policy::Community::Each" : "0",
"Perl::Critic::Policy::Community::EmptyReturn" : "0",
"Perl::Critic::Policy::Community::IndirectObjectNotation" : "0",
"Perl::Critic::Policy::Community::LexicalForeachIterator" : "0",
"Perl::Critic::Policy::Community::LoopOnHash" : "0",
"Perl::Critic::Policy::Community::ModPerl" : "0",
"Perl::Critic::Policy::Community::OpenArgs" : "0",
"Perl::Critic::Policy::Community::OverloadOptions" : "0",
"Perl::Critic::Policy::Community::POSIXImports" : "0",
"Perl::Critic::Policy::Community::PackageMatchesFilename" : "0",
"Perl::Critic::Policy::Community::PreferredAlternatives" : "0",
"Perl::Critic::Policy::Community::StrictWarnings" : "0",
"Perl::Critic::Policy::Community::Threads" : "0",
"Perl::Critic::Policy::Community::Wantarray" : "0",
"Perl::Critic::Policy::Community::WarningsSwitch" : "0",
"Perl::Critic::Policy::Community::WhileDiamondDefaultAssignment" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitFormats" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic" : "0",
"Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements" : "0",
"Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish" : "0",
"Perl::Critic::Policy::Objects::ProhibitIndirectSyntax" : "0",
"Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic" : "0",
"Perl::Critic::Policy::Subroutines::ProhibitNestedSubs" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator" : "0",
"Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames" : "0",
"Perl::Critic::Policy::Variables::ProhibitUnusedVariables" : "0",
"Software::License::Perl_5" : "0"
},
"requires" : {
"FindBin" : "0",
"Perl::Critic" : "0",
"Test2::Require::EnvVar" : "0.000121",
"Test2::Require::Module" : "0.000121",
"Test2::Tools::PerlCritic" : "0",
"Test2::V0" : "0.000121",
"Test::CPAN::Changes" : "0",
"Test::EOL" : "0",
"Test::Fixme" : "0.07",
"Test::More" : "0.98",
"Test::NoTabs" : "0",
"Test::Pod" : "0",
"Test::Pod::Coverage" : "0",
"Test::Pod::LinkCheck::Lite" : "0",
"Test::Spelling" : "0"
}
},
"runtime" : {
"requires" : {
"Capture::Tiny" : "0.17",
"Digest::SHA" : "0",
"ExtUtils::CBuilder" : "0",
"ExtUtils::MakeMaker" : "6.64",
"ExtUtils::ParseXS" : "3.30",
"FFI::CheckLib" : "0.11",
"File::Which" : "1.10",
"File::chdir" : "0",
"JSON::PP" : "0",
"List::Util" : "1.33",
"Path::Tiny" : "0.077",
"Test2::API" : "1.302096",
"Text::ParseWords" : "3.26",
"parent" : "0",
"perl" : "5.008004"
},
"suggests" : {
"Archive::Tar" : "0"
}
},
"test" : {
"requires" : {
"Test2::API" : "1.302096",
"Test2::V0" : "0.000121"
},
"suggests" : {
"Devel::Hide" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/PerlAlien/Alien-Build/issues"
},
"homepage" : "https://metacpan.org/pod/Alien::Build",
"repository" : {
"type" : "git",
"url" : "git://github.com/PerlAlien/Alien-Build.git",
"web" : "https://github.com/PerlAlien/Alien-Build"
},
"x_IRC" : "irc://irc.perl.org/#native"
},
"version" : "2.84",
"x_contributors" : [
"Graham Ollis <plicease@cpan.org>",
"Diab Jerius (DJERIUS)",
"Roy Storey (KIWIROY)",
"Ilya Pavlov",
"David Mertens (run4flat)",
"Mark Nunberg (mordy, mnunberg)",
"Christian Walde (Mithaldu)",
"Brian Wightman (MidLifeXis)",
"Zaki Mughal (zmughal)",
"mohawk (mohawk2, ETJ)",
"Vikas N Kumar (vikasnkumar)",
"Flavio Poletti (polettix)",
"Salvador Fandiño (salva)",
"Gianni Ceccarelli (dakkar)",
"Pavel Shaydo (zwon, trinitum)",
"Kang-min Liu (劉康民, gugod)",
"Nicholas Shipp (nshp)",
"Juan Julián Merelo Guervós (JJ)",
"Joel Berger (JBERGER)",
"Petr Písař (ppisar)",
"Lance Wicks (LANCEW)",
"Ahmad Fatoum (a3f, ATHREEF)",
"José Joaquín Atria (JJATRIA)",
"Duke Leto (LETO)",
"Shoichi Kaji (SKAJI)",
"Shawn Laffan (SLAFFAN)",
"Paul Evans (leonerd, PEVANS)",
"Håkon Hægland (hakonhagland, HAKONH)",
"nick nauwelaerts (INPHOBIA)",
"Florian Weimer"
],
"x_generated_by_perl" : "v5.40.0",
"x_serialization_backend" : "JSON::PP version 4.06",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later",
"x_use_unsafe_inc" : 0
}
perl5/5.32/x86_64-linux-thread-multi/.meta/Alien-Build-2.84/install.json 0000444 00000016715 15157554333 0020720 0 ustar 00 {"version":2.84,"pathname":"P/PL/PLICEASE/Alien-Build-2.84.tar.gz","name":"Alien::Build","provides":{"Alien::Build::Plugin::Extract::CommandLine":{"file":"lib/Alien/Build/Plugin/Extract/CommandLine.pm","version":2.84},"Alien::Build::Plugin::Decode::HTML":{"file":"lib/Alien/Build/Plugin/Decode/HTML.pm","version":2.84},"Alien::Build::Helper":{"file":"lib/Alien/Build/Interpolate.pm","version":2.84},"Alien::Base::PkgConfig":{"file":"lib/Alien/Base/PkgConfig.pm","version":2.84},"Alien::Build::Plugin::PkgConfig::LibPkgConf":{"version":2.84,"file":"lib/Alien/Build/Plugin/PkgConfig/LibPkgConf.pm"},"Test::Alien::Run":{"file":"lib/Test/Alien/Run.pm","version":2.84},"Alien::Build::Plugin::Core::Legacy":{"file":"lib/Alien/Build/Plugin/Core/Legacy.pm","version":2.84},"Alien::Build::Log::Abbreviate":{"version":2.84,"file":"lib/Alien/Build/Log/Abbreviate.pm"},"Alien::Build::Plugin::PkgConfig::CommandLine":{"version":2.84,"file":"lib/Alien/Build/Plugin/PkgConfig/CommandLine.pm"},"Alien::Build::Plugin::Fetch::NetFTP":{"version":2.84,"file":"lib/Alien/Build/Plugin/Fetch/NetFTP.pm"},"Alien::Build::Plugin::Extract::Directory":{"file":"lib/Alien/Build/Plugin/Extract/Directory.pm","version":2.84},"Test::Alien::CanPlatypus":{"file":"lib/Test/Alien/CanPlatypus.pm","version":2.84},"Alien::Build::Plugin::Build::Make":{"version":2.84,"file":"lib/Alien/Build/Plugin/Build/Make.pm"},"Alien::Build::Plugin::Fetch::HTTPTiny":{"version":2.84,"file":"lib/Alien/Build/Plugin/Fetch/HTTPTiny.pm"},"Alien::Build::Plugin::Build::MSYS":{"version":2.84,"file":"lib/Alien/Build/Plugin/Build/MSYS.pm"},"Alien::Build::Plugin::Test::Mock":{"file":"lib/Alien/Build/Plugin/Test/Mock.pm","version":2.84},"Alien::Build::Plugin::Decode::Mojo":{"version":2.84,"file":"lib/Alien/Build/Plugin/Decode/Mojo.pm"},"Alien::Base":{"file":"lib/Alien/Base.pm","version":2.84},"Alien::Build::Interpolate::Default":{"file":"lib/Alien/Build/Interpolate/Default.pm","version":2.84},"Alien::Build::Meta":{"version":2.84,"file":"lib/Alien/Build.pm"},"Alien::Build::Plugin::Prefer::GoodVersion":{"file":"lib/Alien/Build/Plugin/Prefer/GoodVersion.pm","version":2.84},"Test::Alien::Build":{"version":2.84,"file":"lib/Test/Alien/Build.pm"},"Alien::Build::Plugin::Core::CleanInstall":{"version":2.84,"file":"lib/Alien/Build/Plugin/Core/CleanInstall.pm"},"Alien::Build::Plugin::PkgConfig::Negotiate":{"file":"lib/Alien/Build/Plugin/PkgConfig/Negotiate.pm","version":2.84},"Alien::Build::Plugin::Fetch::CurlCommand":{"version":2.84,"file":"lib/Alien/Build/Plugin/Fetch/CurlCommand.pm"},"Alien::Build::Plugin::Decode::DirListing":{"version":2.84,"file":"lib/Alien/Build/Plugin/Decode/DirListing.pm"},"Alien::Build::Plugin::PkgConfig::MakeStatic":{"file":"lib/Alien/Build/Plugin/PkgConfig/MakeStatic.pm","version":2.84},"Alien::Build::Plugin::Build::CMake":{"version":2.84,"file":"lib/Alien/Build/Plugin/Build/CMake.pm"},"Alien::Build::Version::Basic":{"version":2.84,"file":"lib/Alien/Build/Version/Basic.pm"},"Alien::Build::Plugin::Digest::Negotiate":{"file":"lib/Alien/Build/Plugin/Digest/Negotiate.pm","version":2.84},"Alien::Build::rc":{"version":2.84,"file":"lib/Alien/Build.pm"},"Alien::Build::Interpolate":{"version":2.84,"file":"lib/Alien/Build/Interpolate.pm"},"Alien::Build::Plugin::Extract::File":{"version":2.84,"file":"lib/Alien/Build/Plugin/Extract/File.pm"},"Alien::Build::Plugin::Core::Download":{"version":2.84,"file":"lib/Alien/Build/Plugin/Core/Download.pm"},"Alien::Build::Log::Default":{"file":"lib/Alien/Build/Log/Default.pm","version":2.84},"Alien::Build::Plugin::Build::Copy":{"file":"lib/Alien/Build/Plugin/Build/Copy.pm","version":2.84},"Alien::Build::Plugin::Fetch::Local":{"file":"lib/Alien/Build/Plugin/Fetch/Local.pm","version":2.84},"Alien::Build::Plugin::Prefer::BadVersion":{"file":"lib/Alien/Build/Plugin/Prefer/BadVersion.pm","version":2.84},"Alien::Build::Plugin::Core::Gather":{"file":"lib/Alien/Build/Plugin/Core/Gather.pm","version":2.84},"Alien::Build::PluginMeta":{"file":"lib/Alien/Build/Plugin.pm","version":2.84},"Alien::Build":{"version":2.84,"file":"lib/Alien/Build.pm"},"Alien::Build::Plugin::Extract::Negotiate":{"version":2.84,"file":"lib/Alien/Build/Plugin/Extract/Negotiate.pm"},"Test::Alien::CanCompile":{"version":2.84,"file":"lib/Test/Alien/CanCompile.pm"},"Alien::Build::Plugin::Fetch::LocalDir":{"version":2.84,"file":"lib/Alien/Build/Plugin/Fetch/LocalDir.pm"},"Alien::Build::Plugin::Extract::ArchiveTar":{"version":2.84,"file":"lib/Alien/Build/Plugin/Extract/ArchiveTar.pm"},"Alien::Build::Plugin::Core::Tail":{"version":2.84,"file":"lib/Alien/Build/Plugin/Core/Tail.pm"},"Alien::Build::Plugin::Fetch::Wget":{"version":2.84,"file":"lib/Alien/Build/Plugin/Fetch/Wget.pm"},"Alien::Build::Plugin::Probe::CommandLine":{"version":2.84,"file":"lib/Alien/Build/Plugin/Probe/CommandLine.pm"},"Alien::Build::Plugin::PkgConfig::PP":{"file":"lib/Alien/Build/Plugin/PkgConfig/PP.pm","version":2.84},"Alien::Build::Plugin::Core::Override":{"file":"lib/Alien/Build/Plugin/Core/Override.pm","version":2.84},"Alien::Build::Plugin::Core::Setup":{"version":2.84,"file":"lib/Alien/Build/Plugin/Core/Setup.pm"},"Alien::Build::Util":{"file":"lib/Alien/Build/Util.pm","version":2.84},"Alien::Build::Plugin::Digest::SHAPP":{"version":2.84,"file":"lib/Alien/Build/Plugin/Digest/SHAPP.pm"},"Alien::Build::Plugin::Digest::SHA":{"version":2.84,"file":"lib/Alien/Build/Plugin/Digest/SHA.pm"},"Alien::Build::Plugin::Download::Negotiate":{"file":"lib/Alien/Build/Plugin/Download/Negotiate.pm","version":2.84},"Alien::Build::Plugin::Extract::ArchiveZip":{"version":2.84,"file":"lib/Alien/Build/Plugin/Extract/ArchiveZip.pm"},"Alien::Build::Plugin::Fetch::LWP":{"version":2.84,"file":"lib/Alien/Build/Plugin/Fetch/LWP.pm"},"Alien::Build::MM":{"version":2.84,"file":"lib/Alien/Build/MM.pm"},"Alien::Util":{"file":"lib/Alien/Util.pm","version":2.84},"Alien::Build::Plugin::Prefer::SortVersions":{"version":2.84,"file":"lib/Alien/Build/Plugin/Prefer/SortVersions.pm"},"Alien::Build::Plugin::Decode::DirListingFtpcopy":{"file":"lib/Alien/Build/Plugin/Decode/DirListingFtpcopy.pm","version":2.84},"Alien::Build::Plugin::Build::SearchDep":{"file":"lib/Alien/Build/Plugin/Build/SearchDep.pm","version":2.84},"Alien::Role":{"version":2.84,"file":"lib/Alien/Role.pm"},"Alien::Base::Wrapper":{"file":"lib/Alien/Base/Wrapper.pm","version":2.84},"Alien::Build::CommandSequence":{"version":2.84,"file":"lib/Alien/Build/CommandSequence.pm"},"Alien::Build::Plugin::Gather::IsolateDynamic":{"file":"lib/Alien/Build/Plugin/Gather/IsolateDynamic.pm","version":2.84},"Alien::Build::TempDir":{"version":2.84,"file":"lib/Alien/Build.pm"},"alienfile":{"file":"lib/alienfile.pm","version":2.84},"Alien::Build::Interpolate::Helper":{"version":2.84,"file":"lib/Alien/Build/Interpolate.pm"},"Alien::Build::Temp":{"version":2.84,"file":"lib/Alien/Build/Temp.pm"},"Test::Alien":{"version":2.84,"file":"lib/Test/Alien.pm"},"Test::Alien::Synthetic":{"version":2.84,"file":"lib/Test/Alien/Synthetic.pm"},"Alien::Build::Plugin::Probe::Vcpkg":{"file":"lib/Alien/Build/Plugin/Probe/Vcpkg.pm","version":2.84},"Test::Alien::Diag":{"version":2.84,"file":"lib/Test/Alien/Diag.pm"},"Alien::Build::Plugin::Core::FFI":{"version":2.84,"file":"lib/Alien/Build/Plugin/Core/FFI.pm"},"Alien::Build::Plugin::Probe::CBuilder":{"version":2.84,"file":"lib/Alien/Build/Plugin/Probe/CBuilder.pm"},"Alien::Build::Log":{"version":2.84,"file":"lib/Alien/Build/Log.pm"},"Alien::Build::Plugin":{"version":2.84,"file":"lib/Alien/Build/Plugin.pm"},"Alien::Build::Plugin::Build::Autoconf":{"file":"lib/Alien/Build/Plugin/Build/Autoconf.pm","version":2.84}},"dist":"Alien-Build-2.84","target":"Alien::Base::Wrapper"} perl5/5.32/x86_64-linux-thread-multi/.meta/Alien-Libxml2-0.19/MYMETA.json 0000444 00000017250 15157554345 0020512 0 ustar 00 {
"abstract" : "Install the C libxml2 library on your system",
"author" : [
"Graham Ollis <plicease@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 6.025, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Alien-Libxml2",
"prereqs" : {
"build" : {
"requires" : {
"Alien::Build" : "2.37",
"Alien::Build::MM" : "0.32",
"ExtUtils::MakeMaker" : "6.52"
}
},
"configure" : {
"requires" : {
"Alien::Build" : "2.37",
"Alien::Build::MM" : "2.37",
"Alien::Build::Plugin::Build::SearchDep" : "0.35",
"Alien::Build::Plugin::Download::GitLab" : "0",
"Alien::Build::Plugin::Prefer::BadVersion" : "1.05",
"Alien::Build::Plugin::Probe::Vcpkg" : "0",
"ExtUtils::CBuilder" : "0",
"ExtUtils::MakeMaker" : "6.52"
}
},
"develop" : {
"recommends" : {
"Alien::Build::Plugin::Probe::Vcpkg" : "0",
"Dist::Zilla::Plugin::AlienBase::Doc" : "0",
"Dist::Zilla::Plugin::AlienBuild" : "0.11",
"Dist::Zilla::Plugin::Author::Plicease::Thanks" : "0",
"Dist::Zilla::Plugin::Author::Plicease::Upload" : "0",
"Dist::Zilla::Plugin::Prereqs" : "0",
"Dist::Zilla::Plugin::PruneFiles" : "0",
"Dist::Zilla::Plugin::RemovePrereqs" : "0",
"Dist::Zilla::PluginBundle::Author::Plicease" : "2.69",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitBooleanGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep" : "0",
"Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA" : "0",
"Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitHardTabs" : "0",
"Perl::Critic::Policy::CodeLayout::ProhibitTrailingWhitespace" : "0",
"Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions" : "0",
"Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode" : "0",
"Perl::Critic::Policy::Freenode::ArrayAssignAref" : "0",
"Perl::Critic::Policy::Freenode::BarewordFilehandles" : "0",
"Perl::Critic::Policy::Freenode::ConditionalDeclarations" : "0",
"Perl::Critic::Policy::Freenode::ConditionalImplicitReturn" : "0",
"Perl::Critic::Policy::Freenode::DeprecatedFeatures" : "0",
"Perl::Critic::Policy::Freenode::DiscouragedModules" : "0",
"Perl::Critic::Policy::Freenode::DollarAB" : "0",
"Perl::Critic::Policy::Freenode::Each" : "0",
"Perl::Critic::Policy::Freenode::EmptyReturn" : "0",
"Perl::Critic::Policy::Freenode::IndirectObjectNotation" : "0",
"Perl::Critic::Policy::Freenode::LexicalForeachIterator" : "0",
"Perl::Critic::Policy::Freenode::LoopOnHash" : "0",
"Perl::Critic::Policy::Freenode::ModPerl" : "0",
"Perl::Critic::Policy::Freenode::OpenArgs" : "0",
"Perl::Critic::Policy::Freenode::OverloadOptions" : "0",
"Perl::Critic::Policy::Freenode::POSIXImports" : "0",
"Perl::Critic::Policy::Freenode::PackageMatchesFilename" : "0",
"Perl::Critic::Policy::Freenode::PreferredAlternatives" : "0",
"Perl::Critic::Policy::Freenode::StrictWarnings" : "0",
"Perl::Critic::Policy::Freenode::Threads" : "0",
"Perl::Critic::Policy::Freenode::Wantarray" : "0",
"Perl::Critic::Policy::Freenode::WarningsSwitch" : "0",
"Perl::Critic::Policy::Freenode::WhileDiamondDefaultAssignment" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitJoinedReadline" : "0",
"Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitFormats" : "0",
"Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic" : "0",
"Perl::Critic::Policy::Modules::ProhibitConditionalUseStatements" : "0",
"Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish" : "0",
"Perl::Critic::Policy::Objects::ProhibitIndirectSyntax" : "0",
"Perl::Critic::Policy::RegularExpressions::ProhibitUselessTopic" : "0",
"Perl::Critic::Policy::Subroutines::ProhibitNestedSubs" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator" : "0",
"Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator" : "0",
"Perl::Critic::Policy::Variables::ProhibitPerl4PackageNames" : "0",
"Perl::Critic::Policy::Variables::ProhibitUnusedVariables" : "0",
"Software::License::Perl_5" : "0"
},
"requires" : {
"File::Spec" : "0",
"FindBin" : "0",
"Perl::Critic" : "0",
"Test2::Require::Module" : "0.000121",
"Test2::Tools::PerlCritic" : "0",
"Test2::V0" : "0.000121",
"Test::CPAN::Changes" : "0",
"Test::EOL" : "0",
"Test::Fixme" : "0.07",
"Test::More" : "0.98",
"Test::NoTabs" : "0",
"Test::Pod" : "0",
"Test::Pod::Coverage" : "0",
"Test::Pod::Spelling::CommonMistakes" : "0",
"Test::Spelling" : "0",
"Test::Strict" : "0",
"YAML" : "0"
}
},
"runtime" : {
"requires" : {
"Alien::Base" : "2.37",
"Alien::Build" : "0.25",
"perl" : "5.006"
}
},
"test" : {
"requires" : {
"Test2::V0" : "0.000121",
"Test::Alien" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/PerlAlien/Alien-Libxml2/issues"
},
"homepage" : "https://metacpan.org/pod/Alien::Libxml2",
"repository" : {
"type" : "git",
"url" : "git://github.com/PerlAlien/Alien-Libxml2.git",
"web" : "https://github.com/PerlAlien/Alien-Libxml2"
},
"x_IRC" : "irc://irc.perl.org/#native"
},
"version" : "0.19",
"x_alienfile" : {
"generated_by" : "Dist::Zilla::Plugin::AlienBuild version 0.32",
"requires" : {
"share" : {
"Config" : "0",
"HTTP::Tiny" : "0.044",
"IO::Socket::SSL" : "1.56",
"Mozilla::CA" : "0",
"Net::SSLeay" : "1.49",
"URI" : "0"
},
"system" : {}
}
},
"x_contributors" : [
"Graham Ollis <plicease@cpan.org>",
"Shlomi Fish (shlomif)"
],
"x_generated_by_perl" : "v5.36.0",
"x_serialization_backend" : "JSON::PP version 4.06",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later",
"x_use_unsafe_inc" : 0
}
perl5/5.32/x86_64-linux-thread-multi/.meta/Alien-Libxml2-0.19/install.json 0000444 00000000340 15157554352 0021152 0 ustar 00 {"target":"Alien::Libxml2","dist":"Alien-Libxml2-0.19","provides":{"Alien::Libxml2":{"file":"lib/Alien/Libxml2.pm","version":0.19}},"version":0.19,"pathname":"P/PL/PLICEASE/Alien-Libxml2-0.19.tar.gz","name":"Alien::Libxml2"} perl5/5.32/x86_64-linux-thread-multi/.meta/XML-SAX-Base-1.09/MYMETA.json 0000444 00000002376 15157554370 0020115 0 ustar 00 {
"abstract" : "Base class for SAX Drivers and Filters",
"author" : [
"Grant McLean <grantm@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 5.022, CPAN::Meta::Converter version 2.142690, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "XML-SAX-Base",
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"develop" : {
"requires" : {
"Test::Pod" : "1.41"
}
},
"runtime" : {
"requires" : {
"perl" : "5.008"
}
},
"test" : {
"requires" : {
"Test::More" : "0.88"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"type" : "git",
"url" : "git://github.com/grantm/XML-SAX-Base.git",
"web" : "https://github.com/grantm/XML-SAX-Base"
}
},
"version" : "1.09",
"x_serialization_backend" : "JSON::PP version 4.06"
}
perl5/5.32/x86_64-linux-thread-multi/.meta/XML-SAX-Base-1.09/install.json 0000444 00000000556 15157554402 0020561 0 ustar 00 {"target":"XML::SAX::Base","pathname":"G/GR/GRANTM/XML-SAX-Base-1.09.tar.gz","dist":"XML-SAX-Base-1.09","name":"XML::SAX::Base","version":1.09,"provides":{"XML::SAX::Base::NoHandler":{"file":"lib/XML/SAX/Base.pm","version":1.09},"XML::SAX::Base":{"file":"lib/XML/SAX/Base.pm","version":1.09},"XML::SAX::Exception":{"file":"lib/XML/SAX/Exception.pm","version":1.09}}} perl5/5.32/File/chdir.pm 0000444 00000025372 15157554415 0010513 0 ustar 00 package File::chdir;
use 5.004;
use strict;
use vars qw($VERSION @ISA @EXPORT $CWD @CWD);
# ABSTRACT: a more sensible way to change directories
our $VERSION = '0.1011';
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(*CWD);
use Carp;
use Cwd 3.16;
use File::Spec::Functions 3.27 qw/canonpath splitpath catpath splitdir catdir/;
tie $CWD, 'File::chdir::SCALAR' or die "Can't tie \$CWD";
tie @CWD, 'File::chdir::ARRAY' or die "Can't tie \@CWD";
sub _abs_path {
# Otherwise we'll never work under taint mode.
my($cwd) = Cwd::getcwd =~ /(.*)/s;
# Run through File::Spec, since everything else uses it
return canonpath($cwd);
}
# splitpath but also split directory
sub _split_cwd {
my ($vol, $dir) = splitpath(_abs_path, 1);
my @dirs = splitdir( $dir );
shift @dirs; # get rid of leading empty "root" directory
return ($vol, @dirs);
}
# catpath, but take list of directories
# restore the empty root dir and provide an empty file to avoid warnings
sub _catpath {
my ($vol, @dirs) = @_;
return catpath($vol, catdir(q{}, @dirs), q{});
}
sub _chdir {
# Untaint target directory
my ($new_dir) = $_[0] =~ /(.*)/s;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
if ( ! CORE::chdir($new_dir) ) {
croak "Failed to change directory to '$new_dir': $!";
};
return 1;
}
{
package File::chdir::SCALAR;
use Carp;
BEGIN {
*_abs_path = \&File::chdir::_abs_path;
*_chdir = \&File::chdir::_chdir;
*_split_cwd = \&File::chdir::_split_cwd;
*_catpath = \&File::chdir::_catpath;
}
sub TIESCALAR {
bless [], $_[0];
}
# To be safe, in case someone chdir'd out from under us, we always
# check the Cwd explicitly.
sub FETCH {
return _abs_path;
}
sub STORE {
return unless defined $_[1];
_chdir($_[1]);
}
}
{
package File::chdir::ARRAY;
use Carp;
BEGIN {
*_abs_path = \&File::chdir::_abs_path;
*_chdir = \&File::chdir::_chdir;
*_split_cwd = \&File::chdir::_split_cwd;
*_catpath = \&File::chdir::_catpath;
}
sub TIEARRAY {
bless {}, $_[0];
}
sub FETCH {
my($self, $idx) = @_;
my ($vol, @cwd) = _split_cwd;
return $cwd[$idx];
}
sub STORE {
my($self, $idx, $val) = @_;
my ($vol, @cwd) = _split_cwd;
if( $self->{Cleared} ) {
@cwd = ();
$self->{Cleared} = 0;
}
$cwd[$idx] = $val;
my $dir = _catpath($vol,@cwd);
_chdir($dir);
return $cwd[$idx];
}
sub FETCHSIZE {
my ($vol, @cwd) = _split_cwd;
return scalar @cwd;
}
sub STORESIZE {}
sub PUSH {
my($self) = shift;
my $dir = _catpath(_split_cwd, @_);
_chdir($dir);
return $self->FETCHSIZE;
}
sub POP {
my($self) = shift;
my ($vol, @cwd) = _split_cwd;
my $popped = pop @cwd;
my $dir = _catpath($vol,@cwd);
_chdir($dir);
return $popped;
}
sub SHIFT {
my($self) = shift;
my ($vol, @cwd) = _split_cwd;
my $shifted = shift @cwd;
my $dir = _catpath($vol,@cwd);
_chdir($dir);
return $shifted;
}
sub UNSHIFT {
my($self) = shift;
my ($vol, @cwd) = _split_cwd;
my $dir = _catpath($vol, @_, @cwd);
_chdir($dir);
return $self->FETCHSIZE;
}
sub CLEAR {
my($self) = shift;
$self->{Cleared} = 1;
}
sub SPLICE {
my $self = shift;
my $offset = shift || 0;
my $len = shift || $self->FETCHSIZE - $offset;
my @new_dirs = @_;
my ($vol, @cwd) = _split_cwd;
my @orig_dirs = splice @cwd, $offset, $len, @new_dirs;
my $dir = _catpath($vol, @cwd);
_chdir($dir);
return @orig_dirs;
}
sub EXTEND { }
sub EXISTS {
my($self, $idx) = @_;
return $self->FETCHSIZE >= $idx ? 1 : 0;
}
sub DELETE {
my($self, $idx) = @_;
croak "Can't delete except at the end of \@CWD"
if $idx < $self->FETCHSIZE - 1;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
$self->POP;
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
File::chdir - a more sensible way to change directories
=head1 VERSION
version 0.1011
=head1 SYNOPSIS
use File::chdir;
$CWD = "/foo/bar"; # now in /foo/bar
{
local $CWD = "/moo/baz"; # now in /moo/baz
...
}
# still in /foo/bar!
=head1 DESCRIPTION
Perl's C<chdir()> has the unfortunate problem of being very, very, very
global. If any part of your program calls C<chdir()> or if any library
you use calls C<chdir()>, it changes the current working directory for
the *whole* program.
This sucks.
File::chdir gives you an alternative, C<$CWD> and C<@CWD>. These two
variables combine all the power of C<chdir()>, L<File::Spec> and L<Cwd>.
=head1 $CWD
Use the C<$CWD> variable instead of C<chdir()> and Cwd.
use File::chdir;
$CWD = $dir; # just like chdir($dir)!
print $CWD; # prints the current working directory
It can be localized, and it does the right thing.
$CWD = "/foo"; # it's /foo out here.
{
local $CWD = "/bar"; # /bar in here
}
# still /foo out here!
C<$CWD> always returns the absolute path in the native form for the
operating system.
C<$CWD> and normal C<chdir()> work together just fine.
=head1 @CWD
C<@CWD> represents the current working directory as an array, each
directory in the path is an element of the array. This can often make
the directory easier to manipulate, and you don't have to fumble with
C<< File::Spec->splitpath >> and C<< File::Spec->catdir >> to make portable code.
# Similar to chdir("/usr/local/src/perl")
@CWD = qw(usr local src perl);
pop, push, shift, unshift and splice all work. pop and push are
probably the most useful.
pop @CWD; # same as chdir(File::Spec->updir)
push @CWD, 'some_dir' # same as chdir('some_dir')
C<@CWD> and C<$CWD> both work fine together.
*NOTE* Due to a perl bug you can't localize C<@CWD>. See L</CAVEATS> for a work around.
=head1 EXAMPLES
(We omit the C<use File::chdir> from these examples for terseness)
Here's C<$CWD> instead of C<chdir()>:
$CWD = 'foo'; # chdir('foo')
and now instead of Cwd.
print $CWD; # use Cwd; print Cwd::abs_path
you can even do zsh style C<cd foo bar>
$CWD = '/usr/local/foo';
$CWD =~ s/usr/var/;
if you want to localize that, make sure you get the parens right
{
(local $CWD) =~ s/usr/var/;
...
}
It's most useful for writing polite subroutines which don't leave the
program in some strange directory:
sub foo {
local $CWD = 'some/other/dir';
...do your work...
}
which is much simpler than the equivalent:
sub foo {
use Cwd;
my $orig_dir = Cwd::getcwd;
chdir('some/other/dir');
...do your work...
chdir($orig_dir);
}
C<@CWD> comes in handy when you want to start moving up and down the
directory hierarchy in a cross-platform manner without having to use
File::Spec.
pop @CWD; # chdir(File::Spec->updir);
push @CWD, 'some', 'dir' # chdir(File::Spec->catdir(qw(some dir)));
You can easily change your parent directory:
# chdir from /some/dir/bar/moo to /some/dir/foo/moo
$CWD[-2] = 'foo';
=head1 CAVEATS
=head2 C<local @CWD> does not work.
C<local @CWD> will not localize C<@CWD>. This is a bug in Perl, you
can't localize tied arrays. As a work around localizing $CWD will
effectively localize @CWD.
{
local $CWD;
pop @CWD;
...
}
=head2 Assigning to C<@CWD> calls C<chdir()> for each element
@CWD = qw/a b c d/;
Internally, Perl clears C<@CWD> and assigns each element in turn. Thus, this
code above will do this:
chdir 'a';
chdir 'a/b';
chdir 'a/b/c';
chdir 'a/b/c/d';
Generally, avoid assigning to C<@CWD> and just use push and pop instead.
=head2 Volumes not handled
There is currently no way to change the current volume via File::chdir.
=head1 NOTES
C<$CWD> returns the current directory using native path separators, i.e. C<\>
on Win32. This ensures that C<$CWD> will compare correctly with directories
created using File::Spec. For example:
my $working_dir = File::Spec->catdir( $CWD, "foo" );
$CWD = $working_dir;
doing_stuff_might_chdir();
is( $CWD, $working_dir, "back to original working_dir?" );
Deleting the last item of C<@CWD> will act like a pop. Deleting from the
middle will throw an exception.
delete @CWD[-1]; # OK
delete @CWD[-2]; # Dies
What should %CWD do? Something with volumes?
# chdir to C:\Program Files\Sierra\Half Life ?
$CWD{C} = '\\Program Files\\Sierra\\Half Life';
=head1 DIAGNOSTICS
If an error is encountered when changing C<$CWD> or C<@CWD>, one of
the following exceptions will be thrown:
* ~Can't delete except at the end of @CWD~
* ~Failed to change directory to '$dir'~
=head1 HISTORY
Michael wanted C<local chdir> to work. p5p didn't. But it wasn't over!
Was it over when the Germans bombed Pearl Harbor? Hell, no!
Abigail and/or Bryan Warnock suggested the C<$CWD> thing (Michael forgets
which). They were right.
The C<chdir()> override was eliminated in 0.04.
David became co-maintainer with 0.06_01 to fix some chronic
Win32 path bugs.
As of 0.08, if changing C<$CWD> or C<@CWD> fails to change the directory, an
error will be thrown.
=head1 SEE ALSO
L<File::pushd>, L<File::Spec>, L<Cwd>, L<perlfunc/chdir>,
"Animal House" L<http://www.imdb.com/title/tt0077975/quotes>
=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/dagolden/File-chdir/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
L<https://github.com/dagolden/File-chdir>
git clone https://github.com/dagolden/File-chdir.git
=head1 AUTHORS
=over 4
=item *
David Golden <dagolden@cpan.org>
=item *
Michael G. Schwern <schwern@pobox.com>
=back
=head1 CONTRIBUTORS
=for stopwords David Golden Joel Berger Philippe Bruhat (BooK)
=over 4
=item *
David Golden <xdg@xdg.me>
=item *
Joel Berger <joel.a.berger@gmail.com>
=item *
Philippe Bruhat (BooK) <book@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2016 by Michael G. Schwern and David Golden.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Capture/Tiny.pm 0000444 00000072306 15157554427 0011073 0 ustar 00 use 5.006;
use strict;
use warnings;
package Capture::Tiny;
# ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs
our $VERSION = '0.50';
use Carp ();
use Exporter ();
use IO::Handle ();
use File::Spec ();
use File::Temp qw/tempfile tmpnam/;
use Scalar::Util qw/reftype blessed/;
# Get PerlIO or fake it
BEGIN {
local $@;
eval { require PerlIO; PerlIO->can('get_layers') }
or *PerlIO::get_layers = sub { return () };
}
#--------------------------------------------------------------------------#
# create API subroutines and export them
# [do STDOUT flag, do STDERR flag, do merge flag, do tee flag]
#--------------------------------------------------------------------------#
my %api = (
capture => [1,1,0,0],
capture_stdout => [1,0,0,0],
capture_stderr => [0,1,0,0],
capture_merged => [1,1,1,0],
tee => [1,1,0,1],
tee_stdout => [1,0,0,1],
tee_stderr => [0,1,0,1],
tee_merged => [1,1,1,1],
);
for my $sub ( keys %api ) {
my $args = join q{, }, @{$api{$sub}};
eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
}
our @ISA = qw/Exporter/;
our @EXPORT_OK = keys %api;
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
#--------------------------------------------------------------------------#
# constants and fixtures
#--------------------------------------------------------------------------#
my $IS_WIN32 = $^O eq 'MSWin32';
##our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
##
##my $DEBUGFH;
##open $DEBUGFH, "> DEBUG" if $DEBUG;
##
##*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
our $TIMEOUT = 30;
#--------------------------------------------------------------------------#
# command to tee output -- the argument is a filename that must
# be opened to signal that the process is ready to receive input.
# This is annoying, but seems to be the best that can be done
# as a simple, portable IPC technique
#--------------------------------------------------------------------------#
my @cmd = ($^X, '-C0', '-e', <<'HERE');
use Fcntl;
$SIG{HUP}=sub{exit};
if ( my $fn=shift ) {
sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!;
print {$fh} $$;
close $fh;
}
my $buf; while (sysread(STDIN, $buf, 2048)) {
syswrite(STDOUT, $buf); syswrite(STDERR, $buf);
}
HERE
#--------------------------------------------------------------------------#
# filehandle manipulation
#--------------------------------------------------------------------------#
sub _relayer {
my ($fh, $apply_layers) = @_;
# _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
# eliminate pseudo-layers
binmode( $fh, ":raw" );
# strip off real layers until only :unix is left
while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
binmode( $fh, ":pop" );
}
# apply other layers
my @to_apply = @$apply_layers;
shift @to_apply; # eliminate initial :unix
# _debug("# applying layers (unix @to_apply) to @{[fileno $fh]}\n");
binmode($fh, ":" . join(":",@to_apply));
}
sub _name {
my $glob = shift;
no strict 'refs'; ## no critic
return *{$glob}{NAME};
}
sub _open {
open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
# _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}
sub _close {
# _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" );
close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
}
my %dup; # cache this so STDIN stays fd0
my %proxy_count;
sub _proxy_std {
my %proxies;
if ( ! defined fileno STDIN ) {
$proxy_count{stdin}++;
if (defined $dup{stdin}) {
_open \*STDIN, "<&=" . fileno($dup{stdin});
# _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
}
else {
_open \*STDIN, "<" . File::Spec->devnull;
# _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
_open $dup{stdin} = IO::Handle->new, "<&=STDIN";
}
$proxies{stdin} = \*STDIN;
binmode(STDIN, ':utf8') if $] >= 5.008; ## no critic
}
if ( ! defined fileno STDOUT ) {
$proxy_count{stdout}++;
if (defined $dup{stdout}) {
_open \*STDOUT, ">&=" . fileno($dup{stdout});
# _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
}
else {
_open \*STDOUT, ">" . File::Spec->devnull;
# _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
_open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
}
$proxies{stdout} = \*STDOUT;
binmode(STDOUT, ':utf8') if $] >= 5.008; ## no critic
}
if ( ! defined fileno STDERR ) {
$proxy_count{stderr}++;
if (defined $dup{stderr}) {
_open \*STDERR, ">&=" . fileno($dup{stderr});
# _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
}
else {
_open \*STDERR, ">" . File::Spec->devnull;
# _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
_open $dup{stderr} = IO::Handle->new, ">&=STDERR";
}
$proxies{stderr} = \*STDERR;
binmode(STDERR, ':utf8') if $] >= 5.008; ## no critic
}
return %proxies;
}
sub _unproxy {
my (%proxies) = @_;
# _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
for my $p ( keys %proxies ) {
$proxy_count{$p}--;
# _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
if ( ! $proxy_count{$p} ) {
_close $proxies{$p};
_close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
delete $dup{$p};
}
}
}
sub _copy_std {
my %handles;
for my $h ( qw/stdout stderr stdin/ ) {
next if $h eq 'stdin' && ! $IS_WIN32; # WIN32 hangs on tee without STDIN copied
my $redir = $h eq 'stdin' ? "<&" : ">&";
_open $handles{$h} = IO::Handle->new(), $redir . uc($h); # ">&STDOUT" or "<&STDIN"
}
return \%handles;
}
# In some cases we open all (prior to forking) and in others we only open
# the output handles (setting up redirection)
sub _open_std {
my ($handles) = @_;
_open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin};
_open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout};
_open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr};
}
#--------------------------------------------------------------------------#
# private subs
#--------------------------------------------------------------------------#
sub _start_tee {
my ($which, $stash) = @_; # $which is "stdout" or "stderr"
# setup pipes
$stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
pipe $stash->{reader}{$which}, $stash->{tee}{$which};
# _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
# setup desired redirection for parent and child
$stash->{new}{$which} = $stash->{tee}{$which};
$stash->{child}{$which} = {
stdin => $stash->{reader}{$which},
stdout => $stash->{old}{$which},
stderr => $stash->{capture}{$which},
};
# flag file is used to signal the child is ready
$stash->{flag_files}{$which} = scalar( tmpnam() ) . $$;
# execute @cmd as a separate process
if ( $IS_WIN32 ) {
my $old_eval_err=$@;
undef $@;
eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
# _debug( "# Win32API::File loaded\n") unless $@;
my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
# _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE();
my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
# _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n"));
_open_std( $stash->{child}{$which} );
$stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
# not restoring std here as it all gets redirected again shortly anyway
$@=$old_eval_err;
}
else { # use fork
_fork_exec( $which, $stash );
}
}
sub _fork_exec {
my ($which, $stash) = @_; # $which is "stdout" or "stderr"
my $pid = fork;
if ( not defined $pid ) {
Carp::confess "Couldn't fork(): $!";
}
elsif ($pid == 0) { # child
# _debug( "# in child process ...\n" );
untie *STDIN; untie *STDOUT; untie *STDERR;
_close $stash->{tee}{$which};
# _debug( "# redirecting handles in child ...\n" );
_open_std( $stash->{child}{$which} );
# _debug( "# calling exec on command ...\n" );
exec @cmd, $stash->{flag_files}{$which};
}
$stash->{pid}{$which} = $pid
}
my $have_usleep = eval "use Time::HiRes 'usleep'; 1";
sub _files_exist {
return 1 if @_ == grep { -f } @_;
Time::HiRes::usleep(1000) if $have_usleep;
return 0;
}
sub _wait_for_tees {
my ($stash) = @_;
my $start = time;
my @files = values %{$stash->{flag_files}};
my $timeout = defined $ENV{PERL_CAPTURE_TINY_TIMEOUT}
? $ENV{PERL_CAPTURE_TINY_TIMEOUT} : $TIMEOUT;
1 until _files_exist(@files) || ($timeout && (time - $start > $timeout));
Carp::confess "Timed out waiting for subprocesses to start" if ! _files_exist(@files);
unlink $_ for @files;
}
sub _kill_tees {
my ($stash) = @_;
if ( $IS_WIN32 ) {
# _debug( "# closing handles\n");
close($_) for values %{ $stash->{tee} };
# _debug( "# waiting for subprocesses to finish\n");
my $start = time;
1 until wait == -1 || (time - $start > 30);
}
else {
_close $_ for values %{ $stash->{tee} };
waitpid $_, 0 for values %{ $stash->{pid} };
}
}
sub _slurp {
my ($name, $stash) = @_;
my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
# _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
my $text = do { local $/; scalar readline $fh };
return defined($text) ? $text : "";
}
#--------------------------------------------------------------------------#
# _capture_tee() -- generic main sub for capturing or teeing
#--------------------------------------------------------------------------#
sub _capture_tee {
# _debug( "# starting _capture_tee with (@_)...\n" );
my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ());
Carp::confess("Custom capture options must be given as key/value pairs\n")
unless @opts % 2 == 0;
my $stash = { capture => { @opts } };
for ( keys %{$stash->{capture}} ) {
my $fh = $stash->{capture}{$_};
Carp::confess "Custom handle for $_ must be seekable\n"
unless ref($fh) eq 'GLOB' || (blessed($fh) && $fh->isa("IO::Seekable"));
}
# save existing filehandles and setup captures
local *CT_ORIG_STDIN = *STDIN ;
local *CT_ORIG_STDOUT = *STDOUT;
local *CT_ORIG_STDERR = *STDERR;
# find initial layers
my %layers = (
stdin => [PerlIO::get_layers(\*STDIN) ],
stdout => [PerlIO::get_layers(\*STDOUT, output => 1)],
stderr => [PerlIO::get_layers(\*STDERR, output => 1)],
);
# _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# get layers from underlying glob of tied filehandles if we can
# (this only works for things that work like Tie::StdHandle)
$layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
$layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
# _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# bypass scalar filehandles and tied handles
# localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
my %localize;
$localize{stdin}++, local(*STDIN)
if grep { $_ eq 'scalar' } @{$layers{stdin}};
$localize{stdout}++, local(*STDOUT)
if $do_stdout && grep { $_ eq 'scalar' } @{$layers{stdout}};
$localize{stderr}++, local(*STDERR)
if ($do_stderr || $do_merge) && grep { $_ eq 'scalar' } @{$layers{stderr}};
$localize{stdin}++, local(*STDIN), _open( \*STDIN, "<&=0")
if tied *STDIN && $] >= 5.008;
$localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
if $do_stdout && tied *STDOUT && $] >= 5.008;
$localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
# _debug( "# localized $_\n" ) for keys %localize;
# proxy any closed/localized handles so we don't use fds 0, 1 or 2
my %proxy_std = _proxy_std();
# _debug( "# proxy std: @{ [%proxy_std] }\n" );
# update layers after any proxying
$layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
$layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
# _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# store old handles and setup handles for capture
$stash->{old} = _copy_std();
$stash->{new} = { %{$stash->{old}} }; # default to originals
for ( keys %do ) {
$stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
$stash->{pos}{$_} = tell $stash->{capture}{$_};
# _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
_start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
}
_wait_for_tees( $stash ) if $do_tee;
# finalize redirection
$stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
# _debug( "# redirecting in parent ...\n" );
_open_std( $stash->{new} );
# execute user provided code
my ($exit_code, $inner_error, $outer_error, $orig_pid, @result);
{
$orig_pid = $$;
local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
# _debug( "# finalizing layers ...\n" );
_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
# _debug( "# running code $code ...\n" );
my $old_eval_err=$@;
undef $@;
eval { @result = $code->(); $inner_error = $@ };
$exit_code = $?; # save this for later
$outer_error = $@; # save this for later
STDOUT->flush if $do_stdout;
STDERR->flush if $do_stderr;
$@ = $old_eval_err;
}
# restore prior filehandles and shut down tees
# _debug( "# restoring filehandles ...\n" );
_open_std( $stash->{old} );
_close( $_ ) for values %{$stash->{old}}; # don't leak fds
# shouldn't need relayering originals, but see rt.perl.org #114404
_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
_unproxy( %proxy_std );
# _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
_kill_tees( $stash ) if $do_tee;
# return captured output, but shortcut in void context
# unless we have to echo output to tied/scalar handles;
my %got;
if ( $orig_pid == $$ and ( defined wantarray or ($do_tee && keys %localize) ) ) {
for ( keys %do ) {
_relayer($stash->{capture}{$_}, $layers{$_});
$got{$_} = _slurp($_, $stash);
# _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
}
print CT_ORIG_STDOUT $got{stdout}
if $do_stdout && $do_tee && $localize{stdout};
print CT_ORIG_STDERR $got{stderr}
if $do_stderr && $do_tee && $localize{stderr};
}
$? = $exit_code;
$@ = $inner_error if $inner_error;
die $outer_error if $outer_error;
# _debug( "# ending _capture_tee with (@_)...\n" );
return unless defined wantarray;
my @return;
push @return, $got{stdout} if $do_stdout;
push @return, $got{stderr} if $do_stderr && ! $do_merge;
push @return, @result;
return wantarray ? @return : $return[0];
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Capture::Tiny - Capture STDOUT and STDERR from Perl, XS or external programs
=head1 VERSION
version 0.50
=head1 SYNOPSIS
use Capture::Tiny ':all';
# capture from external command
($stdout, $stderr, $exit) = capture {
system( $cmd, @args );
};
# capture from arbitrary code (Perl or external)
($stdout, $stderr, @result) = capture {
# your code here
};
# capture partial or merged output
$stdout = capture_stdout { ... };
$stderr = capture_stderr { ... };
$merged = capture_merged { ... };
# tee output
($stdout, $stderr) = tee {
# your code here
};
$stdout = tee_stdout { ... };
$stderr = tee_stderr { ... };
$merged = tee_merged { ... };
=head1 DESCRIPTION
Capture::Tiny provides a simple, portable way to capture almost anything sent
to STDOUT or STDERR, regardless of whether it comes from Perl, from XS code or
from an external program. Optionally, output can be teed so that it is
captured while being passed through to the original filehandles. Yes, it even
works on Windows (usually). Stop guessing which of a dozen capturing modules
to use in any particular situation and just use this one.
=head1 USAGE
The following functions are available. None are exported by default.
=head2 capture
($stdout, $stderr, @result) = capture \&code;
$stdout = capture \&code;
The C<capture> function takes a code reference and returns what is sent to
STDOUT and STDERR as well as any return values from the code reference. In
scalar context, it returns only STDOUT. If no output was received for a
filehandle, it returns an empty string for that filehandle. Regardless of calling
context, all output is captured -- nothing is passed to the existing filehandles.
It is prototyped to take a subroutine reference as an argument. Thus, it
can be called in block form:
($stdout, $stderr) = capture {
# your code here ...
};
Note that the coderef is evaluated in list context. If you wish to force
scalar context on the return value, you must use the C<scalar> keyword.
($stdout, $stderr, $count) = capture {
my @list = qw/one two three/;
return scalar @list; # $count will be 3
};
Also note that within the coderef, the C<@_> variable will be empty. So don't
use arguments from a surrounding subroutine without copying them to an array
first:
sub wont_work {
my ($stdout, $stderr) = capture { do_stuff( @_ ) }; # WRONG
...
}
sub will_work {
my @args = @_;
my ($stdout, $stderr) = capture { do_stuff( @args ) }; # RIGHT
...
}
Captures are normally done to an anonymous temporary filehandle. To
capture via a named file (e.g. to externally monitor a long-running capture),
provide custom filehandles as a trailing list of option pairs:
my $out_fh = IO::File->new("out.txt", "w+");
my $err_fh = IO::File->new("err.txt", "w+");
capture { ... } stdout => $out_fh, stderr => $err_fh;
The filehandles must be read/write and seekable. Modifying the files or
filehandles during a capture operation will give unpredictable results.
Existing IO layers on them may be changed by the capture.
When called in void context, C<capture> saves memory and time by
not reading back from the capture handles.
=head2 capture_stdout
($stdout, @result) = capture_stdout \&code;
$stdout = capture_stdout \&code;
The C<capture_stdout> function works just like C<capture> except only
STDOUT is captured. STDERR is not captured.
=head2 capture_stderr
($stderr, @result) = capture_stderr \&code;
$stderr = capture_stderr \&code;
The C<capture_stderr> function works just like C<capture> except only
STDERR is captured. STDOUT is not captured.
=head2 capture_merged
($merged, @result) = capture_merged \&code;
$merged = capture_merged \&code;
The C<capture_merged> function works just like C<capture> except STDOUT and
STDERR are merged. (Technically, STDERR is redirected to the same capturing
handle as STDOUT before executing the function.)
Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
properly ordered due to buffering.
=head2 tee
($stdout, $stderr, @result) = tee \&code;
$stdout = tee \&code;
The C<tee> function works just like C<capture>, except that output is captured
as well as passed on to the original STDOUT and STDERR.
When called in void context, C<tee> saves memory and time by
not reading back from the capture handles, except when the
original STDOUT or STDERR were tied or opened to a scalar
handle.
=head2 tee_stdout
($stdout, @result) = tee_stdout \&code;
$stdout = tee_stdout \&code;
The C<tee_stdout> function works just like C<tee> except only
STDOUT is teed. STDERR is not teed (output goes to STDERR as usual).
=head2 tee_stderr
($stderr, @result) = tee_stderr \&code;
$stderr = tee_stderr \&code;
The C<tee_stderr> function works just like C<tee> except only
STDERR is teed. STDOUT is not teed (output goes to STDOUT as usual).
=head2 tee_merged
($merged, @result) = tee_merged \&code;
$merged = tee_merged \&code;
The C<tee_merged> function works just like C<capture_merged> except that output
is captured as well as passed on to STDOUT.
Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
properly ordered due to buffering.
=head1 LIMITATIONS
=head2 Portability
Portability is a goal, not a guarantee. C<tee> requires fork, except on
Windows where C<system(1, @cmd)> is used instead. Not tested on any
particularly esoteric platforms yet. See the
L<CPAN Testers Matrix|http://matrix.cpantesters.org/?dist=Capture-Tiny>
for test result by platform.
=head2 PerlIO layers
Capture::Tiny does its best to preserve PerlIO layers such as ':utf8' or
':crlf' when capturing (only for Perl 5.8.1+) . Layers should be applied to
STDOUT or STDERR I<before> the call to C<capture> or C<tee>. This may not work
for tied filehandles (see below).
=head2 Modifying filehandles before capturing
Generally speaking, you should do little or no manipulation of the standard IO
filehandles prior to using Capture::Tiny. In particular, closing, reopening,
localizing or tying standard filehandles prior to capture may cause a variety of
unexpected, undesirable and/or unreliable behaviors, as described below.
Capture::Tiny does its best to compensate for these situations, but the
results may not be what you desire.
=head3 Closed filehandles
Capture::Tiny will work even if STDIN, STDOUT or STDERR have been previously
closed. However, since they will be reopened to capture or tee output, any
code within the captured block that depends on finding them closed will, of
course, not find them to be closed. If they started closed, Capture::Tiny will
close them again when the capture block finishes.
Note that this reopening will happen even for STDIN or a filehandle not being
captured to ensure that the filehandle used for capture is not opened to file
descriptor 0, as this causes problems on various platforms.
Prior to Perl 5.12, closed STDIN combined with PERL_UNICODE=D leaks filehandles
and also breaks tee() for undiagnosed reasons. So don't do that.
=head3 Localized filehandles
If code localizes any of Perl's standard filehandles before capturing, the capture
will affect the localized filehandles and not the original ones. External system
calls are not affected by localizing a filehandle in Perl and will continue
to send output to the original filehandles (which will thus not be captured).
=head3 Scalar filehandles
If STDOUT or STDERR are reopened to scalar filehandles prior to the call to
C<capture> or C<tee>, then Capture::Tiny will override the output filehandle for
the duration of the C<capture> or C<tee> call and then, for C<tee>, send captured
output to the output filehandle after the capture is complete. (Requires Perl
5.8)
Capture::Tiny attempts to preserve the semantics of STDIN opened to a scalar
reference, but note that external processes will not be able to read from such
a handle. Capture::Tiny tries to ensure that external processes will read from
the null device instead, but this is not guaranteed.
=head3 Tied output filehandles
If STDOUT or STDERR are tied prior to the call to C<capture> or C<tee>, then
Capture::Tiny will attempt to override the tie for the duration of the
C<capture> or C<tee> call and then send captured output to the tied filehandle after
the capture is complete. (Requires Perl 5.8)
Capture::Tiny may not succeed resending UTF-8 encoded data to a tied
STDOUT or STDERR filehandle. Characters may appear as bytes. If the tied filehandle
is based on L<Tie::StdHandle>, then Capture::Tiny will attempt to determine
appropriate layers like C<:utf8> from the underlying filehandle and do the right
thing.
=head3 Tied input filehandle
Capture::Tiny attempts to preserve the semantics of tied STDIN, but this
requires Perl 5.8 and is not entirely predictable. External processes
will not be able to read from such a handle.
Unless having STDIN tied is crucial, it may be safest to localize STDIN when
capturing:
my ($out, $err) = do { local *STDIN; capture { ... } };
=head2 Modifying filehandles during a capture
Attempting to modify STDIN, STDOUT or STDERR I<during> C<capture> or C<tee> is
almost certainly going to cause problems. Don't do that.
=head3 Forking inside a capture
Forks aren't portable. The behavior of filehandles during a fork is even
less so. If Capture::Tiny detects that a fork has occurred within a
capture, it will shortcut in the child process and return empty strings for
captures. Other problems may occur in the child or parent, as well.
Forking in a capture block is not recommended.
=head3 Using threads
Filehandles are global. Mixing up I/O and captures in different threads
without coordination is going to cause problems. Besides, threads are
officially discouraged.
=head3 Dropping privileges during a capture
If you drop privileges during a capture, temporary files created to
facilitate the capture may not be cleaned up afterwards.
=head2 No support for Perl 5.8.0
It's just too buggy when it comes to layers and UTF-8. Perl 5.8.1 or later
is recommended.
=head2 Limited support for Perl 5.6
Perl 5.6 predates PerlIO. UTF-8 data may not be captured correctly.
=head1 ENVIRONMENT
=head2 PERL_CAPTURE_TINY_TIMEOUT
Capture::Tiny uses subprocesses internally for C<tee>. By default,
Capture::Tiny will timeout with an error if such subprocesses are not ready to
receive data within 30 seconds (or whatever is the value of
C<$Capture::Tiny::TIMEOUT>). An alternate timeout may be specified by setting
the C<PERL_CAPTURE_TINY_TIMEOUT> environment variable. Setting it to zero will
disable timeouts. B<NOTE>, this does not timeout the code reference being
captured -- this only prevents Capture::Tiny itself from hanging your process
waiting for its child processes to be ready to proceed.
=head1 SEE ALSO
This module was inspired by L<IO::CaptureOutput>, which provides
similar functionality without the ability to tee output and with more
complicated code and API. L<IO::CaptureOutput> does not handle layers
or most of the unusual cases described in the L</LIMITATIONS> section and
I no longer recommend it.
There are many other CPAN modules that provide some sort of output capture,
albeit with various limitations that make them appropriate only in particular
circumstances. I'm probably missing some. The long list is provided to show
why I felt Capture::Tiny was necessary.
=over 4
=item *
L<IO::Capture>
=item *
L<IO::Capture::Extended>
=item *
L<IO::CaptureOutput>
=item *
L<IPC::Capture>
=item *
L<IPC::Cmd>
=item *
L<IPC::Open2>
=item *
L<IPC::Open3>
=item *
L<IPC::Open3::Simple>
=item *
L<IPC::Open3::Utils>
=item *
L<IPC::Run>
=item *
L<IPC::Run::SafeHandles>
=item *
L<IPC::Run::Simple>
=item *
L<IPC::Run3>
=item *
L<IPC::System::Simple>
=item *
L<Tee>
=item *
L<IO::Tee>
=item *
L<File::Tee>
=item *
L<Filter::Handle>
=item *
L<Tie::STDERR>
=item *
L<Tie::STDOUT>
=item *
L<Test::Output>
=back
=for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/dagolden/Capture-Tiny/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
L<https://github.com/dagolden/Capture-Tiny>
git clone https://github.com/dagolden/Capture-Tiny.git
=head1 AUTHOR
David Golden <dagolden@cpan.org>
=head1 CONTRIBUTORS
=for stopwords Dagfinn Ilmari Mannsåker David E. Wheeler Ed Sabol fecundf Graham Knop Karen Etheridge Mohammad S Anwar Peter Rabbitson Sven Kirmess
=over 4
=item *
Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
=item *
David E. Wheeler <david@justatheory.com>
=item *
Ed Sabol <esabol@users.noreply.github.com>
=item *
fecundf <not.com+github@gmail.com>
=item *
Graham Knop <haarg@haarg.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Mohammad S Anwar <mohammad.anwar@yahoo.com>
=item *
Peter Rabbitson <ribasushi@cpan.org>
=item *
Sven Kirmess <sven.kirmess@kzone.ch>
=back
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2009 by David Golden.
This is free software, licensed under:
The Apache License, Version 2.0, January 2004
=cut
perl5/5.32/Test/Alien.pm 0000444 00000072367 15157554441 0010517 0 ustar 00 package Test::Alien;
use strict;
use warnings;
use 5.008004;
use Env qw( @PATH );
use File::Which 1.10 qw( which );
use Capture::Tiny qw( capture capture_merged );
use Alien::Build::Temp;
use File::Copy qw( move );
use Text::ParseWords qw( shellwords );
use Test2::API qw( context run_subtest );
use Exporter qw( import );
use Path::Tiny qw( path );
use Alien::Build::Util qw( _dump );
use Config;
our @EXPORT = qw( alien_ok run_ok xs_ok ffi_ok with_subtest synthetic helper_ok interpolate_template_is interpolate_run_ok plugin_ok );
# ABSTRACT: Testing tools for Alien modules
our $VERSION = '2.84'; # VERSION
our @aliens;
sub alien_ok ($;$)
{
my($alien, $message) = @_;
my $name = ref $alien ? ref($alien) . '[instance]' : $alien;
$name = 'undef' unless defined $name;
my @methods = qw( cflags libs dynamic_libs bin_dir );
$message ||= "$name responds to: @methods";
my $ok;
my @diag;
if(defined $alien)
{
my @missing = grep { ! $alien->can($_) } @methods;
$ok = !@missing;
push @diag, map { " missing method $_" } @missing;
if($ok)
{
push @aliens, $alien;
if($^O eq 'MSWin32' && $alien->isa('Alien::MSYS'))
{
unshift @PATH, Alien::MSYS::msys_path();
}
else
{
unshift @PATH, $alien->bin_dir;
}
}
if($alien->can('alien_helper'))
{
my($intr) = _interpolator();
my $help = eval { $alien->alien_helper };
if(my $error = $@)
{
$ok = 0;
push @diag, " error getting helpers: $error";
}
foreach my $name (keys %$help)
{
my $code = $help->{$name};
$intr->replace_helper($name, $code);
}
}
}
else
{
$ok = 0;
push @diag, " undefined alien";
}
my $ctx = context();
$ctx->ok($ok, $message);
$ctx->diag($_) for @diag;
$ctx->release;
$ok;
}
sub synthetic
{
my($opt) = @_;
$opt ||= {};
my %alien = %$opt;
require Test::Alien::Synthetic;
bless \%alien, 'Test::Alien::Synthetic',
}
sub run_ok
{
my($command, $message) = @_;
my(@command) = ref $command ? @$command : (do {
my $command = $command; # make a copy
# Double the backslashes so that when they are unescaped by shellwords(),
# they become a single backslash. This should be fine on Windows since
# backslashes are not used to escape metacharacters in cmd.exe.
$command =~ s/\\/\\\\/g if $^O eq 'MSWin32';
shellwords $command;
});
$message ||= ref $command ? "run @command" : "run $command";
require Test::Alien::Run;
my $run = bless {
out => '',
err => '',
exit => 0,
sig => 0,
cmd => [@command],
}, 'Test::Alien::Run';
my $ctx = context();
my $exe = which $command[0];
if(defined $exe)
{
if(ref $command)
{
shift @command;
$run->{cmd} = [$exe, @command];
}
else
{
$run->{cmd} = [$command];
}
my @diag;
my $ok = 1;
my($exit, $errno);
($run->{out}, $run->{err}, $exit, $errno) = capture {
if(ref $command)
{
system $exe, @command;
}
else
{
system $command;
}
($?,$!);
};
if($exit == -1)
{
$ok = 0;
$run->{fail} = "failed to execute: $errno";
push @diag, " failed to execute: $errno";
}
elsif($exit & 127)
{
$ok = 0;
push @diag, " killed with signal: @{[ $exit & 127 ]}";
$run->{sig} = $exit & 127;
}
else
{
$run->{exit} = $exit >> 8;
}
$ctx->ok($ok, $message);
$ok
? $ctx->note(" using $exe")
: $ctx->diag(" using $exe");
$ctx->diag(@diag) for @diag;
}
else
{
$ctx->ok(0, $message);
$ctx->diag(" command not found");
$run->{fail} = 'command not found';
}
unless(@aliens || $ENV{TEST_ALIEN_ALIENS_MISSING})
{
$ctx->diag("run_ok called without any aliens, you may want to call alien_ok");
}
$ctx->release;
$run;
}
sub _flags
{
my($class, $method) = @_;
my $static = "${method}_static";
$class->can($static) && $class->can('install_type') && $class->install_type eq 'share' && (!$class->can('xs_load'))
? $class->$static
: $class->$method;
}
sub xs_ok
{
my $cb;
$cb = pop if defined $_[-1] && ref $_[-1] eq 'CODE';
my($xs, $message) = @_;
$message ||= 'xs';
$xs = { xs => $xs } unless ref $xs;
# make sure this is a copy because we may
# modify it.
$xs->{xs} = "@{[ $xs->{xs} ]}";
$xs->{pxs} ||= {};
$xs->{cbuilder_check} ||= 'have_compiler';
$xs->{cbuilder_config} ||= {};
$xs->{cbuilder_compile} ||= {};
$xs->{cbuilder_link} ||= {};
require ExtUtils::CBuilder;
my $skip = do {
my $have_compiler = $xs->{cbuilder_check};
my %config = %{ $xs->{cbuilder_config} };
!ExtUtils::CBuilder->new( config => \%config )->$have_compiler;
};
if($skip)
{
my $ctx = context();
$ctx->skip($message, 'test requires a compiler');
$ctx->skip("$message subtest", 'test requires a compiler') if $cb;
$ctx->release;
return;
}
if($xs->{cpp} || $xs->{'C++'})
{
my $ctx = context();
$ctx->bail("The cpp and C++ options have been removed from xs_ok");
}
else
{
$xs->{c_ext} ||= 'c';
}
my $verbose = $xs->{verbose} || 0;
my $ok = 1;
my @diag;
my $dir = Alien::Build::Temp->newdir(
TEMPLATE => 'test-alien-XXXXXX',
CLEANUP => $^O =~ /^(MSWin32|cygwin|msys)$/ ? 0 : 1,
);
my $xs_filename = path($dir)->child('test.xs')->stringify;
my $c_filename = path($dir)->child("test.@{[ $xs->{c_ext} ]}")->stringify;
my $ctx = context();
my $module;
if($ENV{TEST_ALIEN_ALWAYS_KEEP})
{
$dir->unlink_on_destroy(0);
$ctx->note("keeping XS temporary directory $dir at user request");
}
if($xs->{xs} =~ /\bTA_MODULE\b/)
{
our $count;
$count = 0 unless defined $count;
my $name = sprintf "Test::Alien::XS::Mod%s%s", $count, chr(65 + $count % 26 ) x 4;
$count++;
my $code = $xs->{xs};
$code =~ s{\bTA_MODULE\b}{$name}g;
$xs->{xs} = $code;
}
# this regex copied shamefully from ExtUtils::ParseXS
# in part because we need the module name to do the bootstrap
# and also because if this regex doesn't match then ParseXS
# does an exit() which we don't want.
if($xs->{xs} =~ /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/m)
{
$module = $1;
$ctx->note("detect module name $module") if $verbose;
}
else
{
$ok = 0;
push @diag, ' XS does not have a module decleration that we could find';
}
if($ok)
{
open my $fh, '>', $xs_filename;
print $fh $xs->{xs};
close $fh;
require ExtUtils::ParseXS;
my $pxs = ExtUtils::ParseXS->new;
my($out, $err) = capture_merged {
eval {
$pxs->process_file(
filename => $xs_filename,
output => $c_filename,
versioncheck => 0,
prototypes => 0,
%{ $xs->{pxs} },
);
};
$@;
};
$ctx->note("parse xs $xs_filename => $c_filename") if $verbose;
$ctx->note($out) if $verbose;
$ctx->note("error: $err") if $verbose && $err;
unless($pxs->report_error_count == 0)
{
$ok = 0;
push @diag, ' ExtUtils::ParseXS failed:';
push @diag, " $err" if $err;
push @diag, " $_" for split /\r?\n/, $out;
}
}
push @diag, "xs_ok called without any aliens, you may want to call alien_ok" unless @aliens || $ENV{TEST_ALIEN_ALIENS_MISSING};
if($ok)
{
my $cb = ExtUtils::CBuilder->new(
config => do {
my %config = %{ $xs->{cbuilder_config} };
my $lddlflags = join(' ', grep !/^-l/, shellwords map { _flags $_, 'libs' } @aliens) . " $Config{lddlflags}";
$config{lddlflags} = defined $config{lddlflags} ? "$lddlflags $config{lddlflags}" : $lddlflags;
\%config;
},
);
my %compile_options = (
source => $c_filename,
%{ $xs->{cbuilder_compile} },
);
if(defined $compile_options{extra_compiler_flags} && ref($compile_options{extra_compiler_flags}) eq '')
{
$compile_options{extra_compiler_flags} = [ shellwords $compile_options{extra_compiler_flags} ];
}
push @{ $compile_options{extra_compiler_flags} }, shellwords map { _flags $_, 'cflags' } @aliens;
my($out, $obj, $err) = capture_merged {
my $obj = eval {
$cb->compile(%compile_options);
};
($obj, $@);
};
$ctx->note("compile $c_filename") if $verbose;
$ctx->note($out) if $verbose;
$ctx->note($err) if $verbose && $err;
if($verbose > 1)
{
$ctx->note(_dump({ compile_options => \%compile_options }));
}
unless($obj)
{
$ok = 0;
push @diag, ' ExtUtils::CBuilder->compile failed';
push @diag, " $err" if $err;
push @diag, " $_" for split /\r?\n/, $out;
}
if($ok)
{
my %link_options = (
objects => [$obj],
module_name => $module,
%{ $xs->{cbuilder_link} },
);
if(defined $link_options{extra_linker_flags} && ref($link_options{extra_linker_flags}) eq '')
{
$link_options{extra_linker_flags} = [ shellwords $link_options{extra_linker_flags} ];
}
unshift @{ $link_options{extra_linker_flags} }, grep /^-l/, shellwords map { _flags $_, 'libs' } @aliens;
my($out, $lib, $err) = capture_merged {
my $lib = eval {
$cb->link(%link_options);
};
($lib, $@);
};
$ctx->note("link $obj") if $verbose;
$ctx->note($out) if $verbose;
$ctx->note($err) if $verbose && $err;
if($verbose > 1)
{
$ctx->note(_dump({ link_options => \%link_options }));
}
if($lib && -f $lib)
{
$ctx->note("created lib $lib") if $xs->{verbose};
}
else
{
$ok = 0;
push @diag, ' ExtUtils::CBuilder->link failed';
push @diag, " $err" if $err;
push @diag, " $_" for split /\r?\n/, $out;
}
if($ok)
{
my @modparts = split(/::/,$module);
my $dl_dlext = $Config{dlext};
my $modfname = $modparts[-1];
my $libpath = path($dir)->child('auto', @modparts, "$modfname.$dl_dlext");
$libpath->parent->mkpath;
move($lib, "$libpath") || die "unable to copy $lib => $libpath $!";
pop @modparts;
my $pmpath = path($dir)->child(@modparts, "$modfname.pm");
$pmpath->parent->mkpath;
open my $fh, '>', "$pmpath";
my($alien_with_xs_load, @rest) = grep { $_->can('xs_load') } @aliens;
if($alien_with_xs_load)
{
{
no strict 'refs';
@{join '::', $module, 'rest'} = @rest;
${join '::', $module, 'alien_with_xs_load'} = $alien_with_xs_load;
}
print $fh '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) . qq{
package $module;
use strict;
use warnings;
our \$VERSION = '0.01';
our \@rest;
our \$alien_with_xs_load;
\$alien_with_xs_load->xs_load('$module', \$VERSION, \@rest);
1;
};
}
else
{
print $fh '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) . qq{
package $module;
use strict;
use warnings;
require XSLoader;
our \$VERSION = '0.01';
XSLoader::load('$module',\$VERSION);
1;
};
}
close $fh;
{
local @INC = @INC;
unshift @INC, "$dir";
## no critic
eval '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) . qq{
use $module;
};
## use critic
}
if(my $error = $@)
{
$ok = 0;
push @diag, ' XSLoader failed';
push @diag, " $error";
}
}
}
}
$ctx->ok($ok, $message);
$ctx->diag($_) for @diag;
$ctx->release;
unless($ok || defined $ENV{TEST_ALIEN_ALWAYS_KEEP})
{
$ctx->note("keeping XS temporary directory $dir due to failure");
$dir->unlink_on_destroy(0);
}
if($cb)
{
$cb = sub {
my $ctx = context();
$ctx->plan(0, 'SKIP', "subtest requires xs success");
$ctx->release;
} unless $ok;
@_ = ("$message subtest", $cb, 1, $module);
goto \&Test2::API::run_subtest;
}
$ok;
}
sub with_subtest (&)
{
my($code) = @_;
# it may be possible to catch a segmentation fault,
# but not with signal handlers apparently. See:
# https://feepingcreature.github.io/handling.html
return $code if $^O eq 'MSWin32';
# try to catch a segmentation fault and bail out
# with a useful diagnostic. prove test to swallow
# the diagnostic on such failures.
sub {
local $SIG{SEGV} = sub {
my $ctx = context();
$ctx->bail("Segmentation fault");
};
$code->(@_);
}
}
sub ffi_ok
{
my $cb;
$cb = pop if defined $_[-1] && ref $_[-1] eq 'CODE';
my($opt, $message) = @_;
$message ||= 'ffi';
my $ok = 1;
my $skip;
my $ffi;
my @diag;
{
my $min = '0.12'; # the first CPAN release
$min = '0.15' if $opt->{ignore_not_found};
$min = '0.18' if $opt->{lang};
$min = '0.99' if defined $opt->{api} && $opt->{api} > 0;
unless(eval { require FFI::Platypus; FFI::Platypus->VERSION($min) })
{
$ok = 0;
$skip = "Test requires FFI::Platypus $min";
}
}
if($ok && $opt->{lang})
{
my $class = "FFI::Platypus::Lang::@{[ $opt->{lang} ]}";
{
my $pm = "$class.pm";
$pm =~ s/::/\//g;
eval { require $pm };
}
if($@)
{
$ok = 0;
$skip = "Test requires FFI::Platypus::Lang::@{[ $opt->{lang} ]}";
}
}
unless(@aliens || $ENV{TEST_ALIEN_ALIENS_MISSING})
{
push @diag, 'ffi_ok called without any aliens, you may want to call alien_ok';
}
if($ok)
{
$ffi = FFI::Platypus->new(
do {
my @args = (
lib => [map { $_->dynamic_libs } @aliens],
ignore_not_found => $opt->{ignore_not_found},
lang => $opt->{lang},
);
push @args, api => $opt->{api} if defined $opt->{api};
@args;
}
);
foreach my $symbol (@{ $opt->{symbols} || [] })
{
unless($ffi->find_symbol($symbol))
{
$ok = 0;
push @diag, " $symbol not found"
}
}
}
my $ctx = context();
if($skip)
{
$ctx->skip($message, $skip);
}
else
{
$ctx->ok($ok, $message);
}
$ctx->diag($_) for @diag;
$ctx->release;
if($cb)
{
$cb = sub {
my $ctx = context();
$ctx->plan(0, 'SKIP', "subtest requires ffi success");
$ctx->release;
} unless $ok;
@_ = ("$message subtest", $cb, 1, $ffi);
goto \&Test2::API::run_subtest;
}
$ok;
}
{
my @ret;
sub _interpolator
{
return @ret if @ret;
require Alien::Build::Interpolate::Default;
my $intr = Alien::Build::Interpolate::Default->new;
require Alien::Build;
my $build = Alien::Build->new;
$build->meta->interpolator($intr);
@ret = ($intr, $build);
}
}
sub helper_ok
{
my($name, $message) = @_;
$message ||= "helper $name exists";
my($intr) = _interpolator;
my $code = $intr->has_helper($name);
my $ok = defined $code;
my $ctx = context();
$ctx->ok($ok, $message);
$ctx->diag("helper_ok called without any aliens, you may want to call alien_ok") unless @aliens || $ENV{TEST_ALIEN_ALIENS_MISSING};
$ctx->release;
$ok;
}
sub plugin_ok
{
my($name, $message) = @_;
my @args;
($name, @args) = @$name if ref $name;
$message ||= "plugin $name";
my($intr, $build) = _interpolator;
my $class = "Alien::Build::Plugin::$name";
my $pm = "$class.pm";
$pm =~ s/::/\//g;
my $ctx = context();
my $plugin = eval {
require $pm unless $class->can('new');
$class->new(@args);
};
if(my $error = $@)
{
$ctx->ok(0, $message, ['unable to create $name plugin', $error]);
$ctx->release;
return 0;
}
eval {
$plugin->init($build->meta);
};
if($^O eq 'MSWin32' && ($plugin->isa('Alien::Build::Plugin::Build::MSYS') || $plugin->isa('Alien::Build::Plugin::Build::Autoconf')))
{
require Alien::MSYS;
unshift @PATH, Alien::MSYS::msys_path();
}
if(my $error = $@)
{
$ctx->ok(0, $message, ['unable to initiate $name plugin', $error]);
$ctx->release;
return 0;
}
else
{
$ctx->ok(1, $message);
$ctx->release;
return 1;
}
}
sub interpolate_template_is
{
my($template, $pattern, $message) = @_;
$message ||= "template matches";
my($intr) = _interpolator;
my $value = eval { $intr->interpolate($template) };
my $error = $@;
my @diag;
my $ok;
if($error)
{
$ok = 0;
push @diag, "error in evaluation:";
push @diag, " $error";
}
elsif(ref($pattern) eq 'Regexp')
{
$ok = $value =~ $pattern;
push @diag, "value '$value' does not match $pattern'" unless $ok;
}
else
{
$ok = $value eq "$pattern";
push @diag, "value '$value' does not equal '$pattern'" unless $ok;
}
my $ctx = context();
$ctx->ok($ok, $message, [@diag]);
$ctx->diag('interpolate_template_is called without any aliens, you may want to call alien_ok') unless @aliens || $ENV{TEST_ALIEN_ALIENS_MISSING};
$ctx->release;
$ok;
}
sub interpolate_run_ok
{
my($template, $message) = @_;
my(@template) = ref $template ? @$template : ($template);
my($intr) = _interpolator;
my $ok = 1;
my @diag;
my @command;
foreach my $template (@template)
{
my $command = eval { $intr->interpolate($template) };
if(my $error = $@)
{
$ok = 0;
push @diag, "error in evaluation:";
push @diag, " $error";
}
else
{
push @command, $command;
}
}
my $ctx = context();
if($ok)
{
my $command = ref $template ? \@command : $command[0];
$ok = run_ok($command, $message);
}
else
{
$message ||= "run @template";
$ctx->ok($ok, $message, [@diag]);
$ctx->diag('interpolate_run_ok called without any aliens, you may want to call alien_ok') unless @aliens || $ENV{TEST_ALIEN_ALIENS_MISSING};
}
$ctx->release;
$ok;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Alien - Testing tools for Alien modules
=head1 VERSION
version 2.84
=head1 SYNOPSIS
Test commands that come with your Alien:
use Test2::V0;
use Test::Alien;
use Alien::patch;
alien_ok 'Alien::patch';
run_ok([ 'patch', '--version' ])
->success
# we only accept the version written
# by Larry ...
->out_like(qr{Larry Wall});
done_testing;
Test that your library works with C<XS>:
use Test2::V0;
use Test::Alien;
use Alien::Editline;
alien_ok 'Alien::Editline';
my $xs = do { local $/; <DATA> };
xs_ok $xs, with_subtest {
my($module) = @_;
ok $module->version;
};
done_testing;
__DATA__
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <editline/readline.h>
const char *
version(const char *class)
{
return rl_library_version;
}
MODULE = TA_MODULE PACKAGE = TA_MODULE
const char *version(class);
const char *class;
Test that your library works with L<FFI::Platypus>:
use Test2::V0;
use Test::Alien;
use Alien::LibYAML;
alien_ok 'Alien::LibYAML';
ffi_ok { symbols => ['yaml_get_version'] }, with_subtest {
my($ffi) = @_;
my $get_version = $ffi->function(yaml_get_version => ['int*','int*','int*'] => 'void');
$get_version->call(\my $major, \my $minor, \my $patch);
like $major, qr{[0-9]+};
like $minor, qr{[0-9]+};
like $patch, qr{[0-9]+};
};
done_testing;
=head1 DESCRIPTION
This module provides tools for testing L<Alien> modules. It has hooks
to work easily with L<Alien::Base> based modules, but can also be used
via the synthetic interface to test non L<Alien::Base> based L<Alien>
modules. It has very modest prerequisites.
Prior to this module the best way to test a L<Alien> module was via L<Test::CChecker>.
The main downside to that module is that it is heavily influenced by and uses
L<ExtUtils::CChecker>, which is a tool for checking at install time various things
about your compiler. It was also written before L<Alien::Base> became as stable as it
is today. In particular, L<Test::CChecker> does its testing by creating an executable
and running it. Unfortunately Perl uses extensions by creating dynamic libraries
and linking them into the Perl process, which is different in subtle and error prone
ways. This module attempts to test the libraries in the way that they will actually
be used, via either C<XS> or L<FFI::Platypus>. It also provides a mechanism for
testing binaries that are provided by the various L<Alien> modules (for example
L<Alien::gmake> and L<Alien::patch>).
L<Alien> modules can actually be usable without a compiler, or without L<FFI::Platypus>
(for example, if the library is provided by the system, and you are using L<FFI::Platypus>,
or if you are building from source and you are using C<XS>), so tests with missing
prerequisites are automatically skipped. For example, L</xs_ok> will automatically skip
itself if a compiler is not found, and L</ffi_ok> will automatically skip itself
if L<FFI::Platypus> is not installed.
=head1 FUNCTIONS
=head2 alien_ok
alien_ok $alien, $message;
alien_ok $alien;
Load the given L<Alien> instance or class. Checks that the instance or class conforms to the same
interface as L<Alien::Base>. Will be used by subsequent tests. The C<$alien> module only needs to
provide these methods in order to conform to the L<Alien::Base> interface:
=over 4
=item cflags
String containing the compiler flags
=item libs
String containing the linker and library flags
=item dynamic_libs
List of dynamic libraries. Returns empty list if the L<Alien> module does not provide this.
=item bin_dir
Directory containing tool binaries. Returns empty list if the L<Alien> module does not provide
this.
=back
If your L<Alien> module does not conform to this interface then you can create a synthetic L<Alien>
module using the L</synthetic> function.
=head2 synthetic
my $alien = synthetic \%config;
Create a synthetic L<Alien> module which can be passed into L</alien_ok>. C<\%config>
can contain these keys (all of which are optional):
=over 4
=item cflags
String containing the compiler flags.
=item cflags_static
String containing the static compiler flags (optional).
=item libs
String containing the linker and library flags.
=item libs_static
String containing the static linker flags (optional).
=item dynamic_libs
List reference containing the dynamic libraries.
=item bin_dir
Tool binary directory.
=item runtime_prop
Runtime properties.
=back
See L<Test::Alien::Synthetic> for more details.
=head2 run_ok
my $run = run_ok $command;
my $run = run_ok $command, $message;
Runs the given command, falling back on any C<Alien::Base#bin_dir> methods provided by L<Alien> modules
specified with L</alien_ok>.
C<$command> can be either a string or an array reference.
Only fails if the command cannot be found, or if it is killed by a signal! Returns a L<Test::Alien::Run>
object, which you can use to test the exit status, output and standard error.
Always returns an instance of L<Test::Alien::Run>, even if the command could not be found.
=head2 xs_ok
xs_ok $xs;
xs_ok $xs, $message;
Compiles, links the given C<XS> code and attaches to Perl.
If you use the special module name C<TA_MODULE> in your C<XS>
code, it will be replaced by an automatically generated
package name. This can be useful if you want to pass the same
C<XS> code to multiple calls to C<xs_ok> without subsequent
calls replacing previous ones.
C<$xs> may be either a string containing the C<XS> code,
or a hash reference with these keys:
=over 4
=item xs
The XS code. This is the only required element.
=item pxs
Extra L<ExtUtils::ParseXS> arguments passed in as a hash reference.
=item cbuilder_check
The compile check that should be done prior to attempting to build.
Should be one of C<have_compiler> or C<have_cplusplus>. Defaults
to C<have_compiler>.
=item cbuilder_config
Hash to override values normally provided by C<Config>.
=item cbuilder_compile
Extra The L<ExtUtils::CBuilder> arguments passed in as a hash reference.
=item cbuilder_link
Extra The L<ExtUtils::CBuilder> arguments passed in as a hash reference.
=item verbose
Spew copious debug information via test note.
=back
You can use the C<with_subtest> keyword to conditionally
run a subtest if the C<xs_ok> call succeeds. If C<xs_ok>
does not work, then the subtest will automatically be
skipped. Example:
xs_ok $xs, with_subtest {
# skipped if $xs fails for some reason
my($module) = @_;
is $module->foo, 1;
};
The module name detected during the XS parsing phase will
be passed in to the subtest. This is helpful when you are
using a generated module name.
If you need to test XS C++ interfaces, see L<Test::Alien::CPP>.
Caveats: C<xs_ok> uses L<ExtUtils::ParseXS>, which may call C<exit>
under certain error conditions. While this is not really good
thing to happen in the middle of a test, it usually indicates
a real failure condition, and it should return a failure condition
so the test should still fail overall.
[version 2.53]
As of version 2.53, C<xs_ok> will only remove temporary generated files
if the test is successful by default. You can force either always
or never removing the temporary generated files using the
C<TEST_ALIEN_ALWAYS_KEEP> environment variable (see L</ENVIRONMENT> below).
=head2 ffi_ok
ffi_ok;
ffi_ok \%opt;
ffi_ok \%opt, $message;
Test that L<FFI::Platypus> works.
C<\%opt> is a hash reference with these keys (all optional):
=over 4
=item symbols
List references of symbols that must be found for the test to succeed.
=item ignore_not_found
Ignores symbols that aren't found. This affects functions accessed via
L<FFI::Platypus#attach> and L<FFI::Platypus#function> methods, and does
not influence the C<symbols> key above.
=item lang
Set the language. Used primarily for language specific native types.
=item api
Set the API. C<api = 1> requires FFI::Platypus 0.99 or later. This
option was added with Test::Alien version 1.90, so your use line should
include this version as a safeguard to make sure it works:
use Test::Alien 1.90;
...
ffi_ok ...;
=back
As with L</xs_ok> above, you can use the C<with_subtest> keyword to specify
a subtest to be run if C<ffi_ok> succeeds (it will skip otherwise). The
L<FFI::Platypus> instance is passed into the subtest as the first argument.
For example:
ffi_ok with_subtest {
my($ffi) = @_;
is $ffi->function(foo => [] => 'void')->call, 42;
};
=head2 helper_ok
helper_ok $name;
helper_ok $name, $message;
Tests that the given helper has been defined.
=head2 plugin_ok
[version 2.52]
plugin_ok $plugin_name, $message;
plugin_ok [$plugin_name, @args], $message;
This applies an L<Alien::Build::Plugin> to the interpolator used by L</helper_ok>, L</interpolate_template_is>
and L</interpolate_run_ok> so that you can test with any helpers that plugin provides. Useful,
for example for getting C<%{configure}> from L<Alien::Build::Plugin::Build::Autoconf>.
=head2 interpolate_template_is
interpolate_template_is $template, $string;
interpolate_template_is $template, $string, $message;
interpolate_template_is $template, $regex;
interpolate_template_is $template, $regex, $message;
Tests that the given template when evaluated with the appropriate helpers will match
either the given string or regular expression.
=head2 interpolate_run_ok
[version 2.52]
my $run = interpolate_run_ok $command;
my $run = interpolate_run_ok $command, $message;
This is the same as L</run_ok> except it runs the command through the interpolator first.
=head1 ENVIRONMENT
=over 4
=item C<TEST_ALIEN_ALWAYS_KEEP>
If this is defined then it will override the built in logic that decides if
the temporary files generated by L</xs_ok> should be kept when the test file
terminates. If set to true the generated files will always be kept. If
set to false, then they will always be removed.
=item C<TEST_ALIEN_ALIENS_MISSING>
By default, this module will warn you if some tools are used without first
invoking L</alien_ok>. This is usually a mistake, but if you really do
want to use one of these tools with no aliens loaded, you can set this
environment variable to false.
=back
=head1 SEE ALSO
=over 4
=item L<Alien>
=item L<Alien::Base>
=item L<Alien::Build>
=item L<alienfile>
=item L<Test2>
=item L<Test::Alien::Run>
=item L<Test::Alien::CanCompile>
=item L<Test::Alien::CanPlatypus>
=item L<Test::Alien::Synthetic>
=item L<Test::Alien::CPP>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Test/Alien/Build.pm 0000444 00000042417 15157554460 0011550 0 ustar 00 package Test::Alien::Build;
use strict;
use warnings;
use 5.008004;
use Exporter qw( import );
use Path::Tiny qw( path );
use Carp qw( croak );
use Test2::API qw( context run_subtest );
use Capture::Tiny qw( capture_merged );
use Alien::Build::Util qw( _mirror );
use List::Util 1.33 qw( any );
use Alien::Build::Temp;
our @EXPORT = qw(
alienfile
alienfile_ok
alienfile_skip_if_missing_prereqs
alien_download_ok
alien_extract_ok
alien_build_ok
alien_build_clean
alien_clean_install
alien_install_type_is
alien_checkpoint_ok
alien_resume_ok
alien_subtest
alien_rc
);
# ABSTRACT: Tools for testing Alien::Build + alienfile
our $VERSION = '2.84'; # VERSION
my $build;
my $build_alienfile;
my $build_root;
my $build_targ;
sub alienfile::targ
{
$build_targ;
}
sub alienfile
{
my($package, $filename, $line) = caller;
($package, $filename, $line) = caller(2) if $package eq __PACKAGE__;
$filename = path($filename)->absolute;
my %args = @_ == 0 ? (filename => 'alienfile') : @_ % 2 ? ( source => do { '# line '. $line . ' "' . path($filename)->absolute . qq("\n) . $_[0] }) : @_;
require alienfile;
push @alienfile::EXPORT, 'targ' unless any { /^targ$/ } @alienfile::EXPORT;
my $temp = Alien::Build::Temp->newdir;
my $get_temp_root = do{
my $root; # may be undef;
sub {
$root ||= Path::Tiny->new($temp);
if(@_)
{
my $path = $root->child(@_);
$path->mkpath;
$path;
}
else
{
return $root;
}
};
};
if($args{source})
{
my $file = $get_temp_root->()->child('alienfile');
$file->spew_utf8($args{source});
$args{filename} = $file->stringify;
}
else
{
unless(defined $args{filename})
{
croak "You must specify at least one of filename or source";
}
$args{filename} = path($args{filename})->absolute->stringify;
}
$args{stage} ||= $get_temp_root->('stage')->stringify;
$args{prefix} ||= $get_temp_root->('prefix')->stringify;
$args{root} ||= $get_temp_root->('root')->stringify;
require Alien::Build;
_alienfile_clear();
my $out = capture_merged {
$build_targ = $args{targ};
$build = Alien::Build->load($args{filename}, root => $args{root});
$build->set_stage($args{stage});
$build->set_prefix($args{prefix});
};
my $ctx = context();
$ctx->note($out) if $out;
$ctx->release;
$build_alienfile = $args{filename};
$build_root = $temp;
$build
}
sub _alienfile_clear
{
eval { defined $build_root && -d $build_root && path($build_root)->remove_tree };
undef $build;
undef $build_alienfile;
undef $build_root;
undef $build_targ;
}
sub alienfile_ok
{
my $build;
my $name;
my $error;
if(@_ == 1 && ! defined $_[0])
{
$build = $_[0];
$error = 'no alienfile given';
$name = 'alienfile compiled';
}
elsif(@_ == 1 && eval { $_[0]->isa('Alien::Build') })
{
$build = $_[0];
$name = 'alienfile compiled';
}
else
{
$build = eval { alienfile(@_) };
$error = $@;
$name = 'alienfile compiles';
}
my $ok = !! $build;
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->diag("error: $error") if $error;
$ctx->release;
$build;
}
sub alienfile_skip_if_missing_prereqs
{
my($phase) = @_;
if($build)
{
eval { $build->load_requires('configure', 1) };
if(my $error = $@)
{
my $reason = "Missing configure prereq";
if($error =~ /Required (.*) (.*),/)
{
$reason .= ": $1 $2";
}
my $ctx = context();
$ctx->plan(0, SKIP => $reason);
$ctx->release;
return;
}
$phase ||= $build->install_type;
eval { $build->load_requires($phase, 1) };
if(my $error = $@)
{
my $reason = "Missing $phase prereq";
if($error =~ /Required (.*) (.*),/)
{
$reason .= ": $1 $2";
}
my $ctx = context();
$ctx->plan(0, SKIP => $reason);
$ctx->release;
return;
}
}
}
sub alien_install_type_is
{
my($type, $name) = @_;
croak "invalid install type" unless defined $type && $type =~ /^(system|share)$/;
$name ||= "alien install type is $type";
my $ok = 0;
my @diag;
if($build)
{
my($out, $actual) = capture_merged {
$build->load_requires('configure');
$build->install_type;
};
if($type eq $actual)
{
$ok = 1;
}
else
{
push @diag, "expected install type of $type, but got $actual";
}
}
else
{
push @diag, 'no alienfile'
}
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->diag($_) for @diag;
$ctx->release;
$ok;
}
sub alien_download_ok
{
my($name) = @_;
$name ||= 'alien download';
my $ok;
my $file;
my @diag;
my @note;
if($build)
{
my($out, $error) = capture_merged {
eval {
$build->load_requires('configure');
$build->load_requires($build->install_type);
$build->download;
};
$@;
};
if($error)
{
$ok = 0;
push @diag, $out if defined $out;
push @diag, "extract threw exception: $error";
}
else
{
$file = $build->install_prop->{download};
if(-d $file || -f $file)
{
$ok = 1;
push @note, $out if defined $out;
}
else
{
$ok = 0;
push @diag, $out if defined $out;
push @diag, 'no file or directory';
}
}
}
else
{
$ok = 0;
push @diag, 'no alienfile';
}
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->note($_) for @note;
$ctx->diag($_) for @diag;
$ctx->release;
$file;
}
sub alien_extract_ok
{
my($archive, $name) = @_;
$name ||= $archive ? "alien extraction of $archive" : 'alien extraction';
my $ok;
my $dir;
my @diag;
my @note;
if($build)
{
my($out, $error);
($out, $dir, $error) = capture_merged {
my $dir = eval {
$build->load_requires('configure');
$build->load_requires($build->install_type);
$build->download;
$build->extract($archive);
};
($dir, $@);
};
if($error)
{
$ok = 0;
push @diag, $out if defined $out;
push @diag, "extract threw exception: $error";
}
else
{
if(-d $dir)
{
$ok = 1;
push @note, $out if defined $out;
}
else
{
$ok = 0;
push @diag, $out if defined $out;
push @diag, 'no directory';
}
}
}
else
{
$ok = 0;
push @diag, 'no alienfile';
}
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->note($_) for @note;
$ctx->diag($_) for @diag;
$ctx->release;
$dir;
}
my $count = 1;
sub alien_build_ok
{
my $opt = defined $_[0] && ref($_[0]) eq 'HASH'
? shift : { class => 'Alien::Base' };
my($name) = @_;
$name ||= 'alien builds okay';
my $ok;
my @diag;
my @note;
my $alien;
if($build)
{
my($out,$error) = capture_merged {
eval {
$build->load_requires('configure');
$build->load_requires($build->install_type);
$build->download;
$build->build;
};
$@;
};
if($error)
{
$ok = 0;
push @diag, $out if defined $out;
push @diag, "build threw exception: $error";
}
else
{
$ok = 1;
push @note, $out if defined $out;
require Alien::Base;
my $prefix = $build->runtime_prop->{prefix};
my $stage = $build->install_prop->{stage};
my %prop = %{ $build->runtime_prop };
$prop{distdir} = $prefix;
_mirror $stage, $prefix;
my $dist_dir = sub {
$prefix;
};
my $runtime_prop = sub {
\%prop;
};
$alien = sprintf 'Test::Alien::Build::Faux%04d', $count++;
{
no strict 'refs';
@{ "${alien}::ISA" } = $opt->{class};
*{ "${alien}::dist_dir" } = $dist_dir;
*{ "${alien}::runtime_prop" } = $runtime_prop;
}
}
}
else
{
$ok = 0;
push @diag, 'no alienfile';
}
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->diag($_) for @diag;
$ctx->note($_) for @note;
$ctx->release;
$alien;
}
sub alien_build_clean
{
my $ctx = context();
if($build_root)
{
foreach my $child (path($build_root)->children)
{
next if $child->basename eq 'prefix';
$ctx->note("clean: rm: $child");
$child->remove_tree;
}
}
else
{
$ctx->note("no build to clean");
}
$ctx->release;
}
sub alien_clean_install
{
my($name) = @_;
$name ||= "run clean_install";
my $ok;
my @diag;
my @note;
if($build)
{
my($out,$error) = capture_merged {
eval {
$build->clean_install;
};
$@;
};
if($error)
{
$ok = 0;
push @diag, $out if defined $out && $out ne '';
push @diag, "build threw exception: $error";
}
else
{
$ok = 1;
push @note, $out if defined $out && $out ne '';
}
}
else
{
$ok = 0;
push @diag, 'no alienfile';
}
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->diag($_) for @diag;
$ctx->note($_) for @note;
$ctx->release;
}
sub alien_checkpoint_ok
{
my($name) = @_;
$name ||= "alien checkpoint ok";
my $ok;
my @diag;
if($build)
{
eval { $build->checkpoint };
if($@)
{
push @diag, "error in checkpoint: $@";
$ok = 0;
}
else
{
$ok = 1;
}
undef $build;
}
else
{
push @diag, "no build to checkpoint";
$ok = 0;
}
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->diag($_) for @diag;
$ctx->release;
$ok;
}
sub alien_resume_ok
{
my($name) = @_;
$name ||= "alien resume ok";
my $ok;
my @diag;
if($build_alienfile && $build_root && !defined $build)
{
$build = eval { Alien::Build->resume($build_alienfile, "$build_root/root") };
if($@)
{
push @diag, "error in resume: $@";
$ok = 0;
}
else
{
$ok = 1;
}
}
else
{
if($build)
{
push @diag, "build has not been checkpointed";
}
else
{
push @diag, "no build to resume";
}
$ok = 0;
}
my $ctx = context();
$ctx->ok($ok, $name);
$ctx->diag($_) for @diag;
$ctx->release;
($ok && $build) || $ok;
}
my $alien_rc_root;
sub alien_rc
{
my($code) = @_;
croak "passed in undef rc" unless defined $code;
croak "looks like you have already defined a rc.pl file" if $ENV{ALIEN_BUILD_RC} ne '-';
my(undef, $filename, $line) = caller;
my $code2 = "use strict; use warnings;\n" .
'# line ' . $line . ' "' . path($filename)->absolute . "\n$code";
$alien_rc_root ||= Alien::Build::Temp->newdir;
my $rc = path($alien_rc_root)->child('rc.pl');
$rc->spew_utf8($code2);
$ENV{ALIEN_BUILD_RC} = "$rc";
return 1;
}
sub alien_subtest
{
my($name, $code, @args) = @_;
_alienfile_clear;
my $ctx = context();
my $pass = run_subtest($name, $code, { buffered => 1 }, @args);
$ctx->release;
_alienfile_clear;
$pass;
}
delete $ENV{$_} for qw( ALIEN_BUILD_LOG ALIEN_BUILD_PRELOAD ALIEN_BUILD_POSTLOAD ALIEN_INSTALL_TYPE PKG_CONFIG_PATH ALIEN_BUILD_PKG_CONFIG );
$ENV{ALIEN_BUILD_RC} = '-';
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Alien::Build - Tools for testing Alien::Build + alienfile
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use Test2::V0;
use Test::Alien::Build;
# returns an instance of Alien::Build.
my $build = alienfile_ok q{
use alienfile;
plugin 'My::Plugin' => (
foo => 1,
bar => 'string',
...
);
};
alien_build_ok 'builds okay.';
done_testing;
=head1 DESCRIPTION
This module provides some tools for testing L<Alien::Build> and L<alienfile>. Outside of L<Alien::Build>
core development, It is probably most useful for L<Alien::Build::Plugin> developers.
This module also unsets a number of L<Alien::Build> specific environment variables, in order to make tests
reproducible even when overrides are set in different environments. So if you want to test those variables in
various states you should explicitly set them in your test script. These variables are unset if they defined:
C<ALIEN_BUILD_PRELOAD> C<ALIEN_BUILD_POSTLOAD> C<ALIEN_INSTALL_TYPE>.
=head1 FUNCTIONS
=head2 alienfile
my $build = alienfile;
my $build = alienfile q{ use alienfile ... };
my $build = alienfile filename => 'alienfile';
Create a Alien::Build instance from the given L<alienfile>. The first two forms are abbreviations.
my $build = alienfile;
# is the same as
my $build = alienfile filename => 'alienfile';
and
my $build = alienfile q{ use alienfile ... };
# is the same as
my $build = alienfile source => q{ use alienfile ... };
Except for the second abbreviated form sets the line number before feeding the source into L<Alien::Build>
so that you will get diagnostics with the correct line numbers.
=over 4
=item source
The source for the alienfile as a string. You must specify one of C<source> or C<filename>.
=item filename
The filename for the alienfile. You must specify one of C<source> or C<filename>.
=item root
The build root.
=item stage
The staging area for the build.
=item prefix
The install prefix for the build.
=back
=head2 alienfile_ok
my $build = alienfile_ok;
my $build = alienfile_ok q{ use alienfile ... };
my $build = alienfile_ok filename => 'alienfile';
my $build = alienfile_ok $build;
Same as C<alienfile> above, except that it runs as a test, and will not throw an exception
on failure (it will return undef instead).
[version 1.49]
As of version 1.49 you can also pass in an already formed instance of L<Alien::Build>. This
allows you to do something like this:
subtest 'a subtest' => sub {
my $build = alienfile q{ use alienfile; ... };
alienfile_skip_if_missing_prereqs; # skip if alienfile prereqs are missing
alienfile_ok $build; # delayed pass/fail for the compile of alienfile
};
=head2 alienfile_skip_if_missing_prereqs
alienfile_skip_if_missing_prereqs;
alienfile_skip_if_missing_prereqs $phase;
Skips the test or subtest if the prereqs for the alienfile are missing.
If C<$phase> is not given, then either C<share> or C<system> will be
detected.
=head2 alien_install_type_is
alien_install_type_is $type;
alien_install_type_is $type, $name;
Simple test to see if the install type is what you expect.
C<$type> should be one of C<system> or C<share>.
=head2 alien_download_ok
my $file = alien_download_ok;
my $file = alien_download_ok $name;
Makes a download attempt and test that a file or directory results. Returns
the file or directory if successful. Returns C<undef> otherwise.
=head2 alien_extract_ok
my $dir = alien_extract_ok;
my $dir = alien_extract_ok $archive;
my $dir = alien_extract_ok $archive, $name;
my $dir = alien_extract_ok undef, $name;
Makes an extraction attempt and test that a directory results. Returns
the directory if successful. Returns C<undef> otherwise.
=head2 alien_build_ok
my $alien = alien_build_ok;
my $alien = alien_build_ok $name;
my $alien = alien_build_ok { class => $class };
my $alien = alien_build_ok { class => $class }, $name;
Runs the download and build stages. Passes if the build succeeds. Returns an instance
of L<Alien::Base> which can be passed into C<alien_ok> from L<Test::Alien>. Returns
C<undef> if the test fails.
Options
=over 4
=item class
The base class to use for your alien. This is L<Alien::Base> by default. Should
be a subclass of L<Alien::Base>, or at least adhere to its API.
=back
=head2 alien_build_clean
alien_build_clean;
Removes all files with the current build, except for the runtime prefix.
This helps test that the final install won't depend on the build files.
=head2 alien_clean_install
alien_clean_install;
Runs C<$build-E<gt>clean_install>, and verifies it did not crash.
=head2 alien_checkpoint_ok
alien_checkpoint_ok;
alien_checkpoint_ok $test_name;
Test the checkpoint of a build.
=head2 alien_resume_ok
alien_resume_ok;
alien_resume_ok $test_name;
Test a resume a checkpointed build.
=head2 alien_rc
alien_rc $code;
Creates C<rc.pl> file in a temp directory and sets ALIEN_BUILD_RC. Useful for testing
plugins that should be called from C<~/.alienbuild/rc.pl>. Note that because of the
nature of how the C<~/.alienbuild/rc.pl> file works, you can only use this once!
=head2 alien_subtest
alien_subtest $test_name => sub {
...
};
Clear the build object and clear the build object before and after the subtest.
=head1 SEE ALSO
=over 4
=item L<Alien>
=item L<alienfile>
=item L<Alien::Build>
=item L<Test::Alien>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Test/Alien/CanCompile.pm 0000444 00000003631 15157554465 0012523 0 ustar 00 package Test::Alien::CanCompile;
use strict;
use warnings;
use 5.008004;
use Test2::API qw( context );
# ABSTRACT: Skip a test file unless a C compiler is available
our $VERSION = '2.84'; # VERSION
sub skip
{
require ExtUtils::CBuilder;
ExtUtils::CBuilder->new->have_compiler ? undef : 'This test requires a compiler.';
}
sub import
{
my $skip = __PACKAGE__->skip;
return unless defined $skip;
my $ctx = context();
$ctx->plan(0, SKIP => $skip);
$ctx->release;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Alien::CanCompile - Skip a test file unless a C compiler is available
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use Test::Alien::CanCompile;
=head1 DESCRIPTION
This is just a L<Test2> plugin that requires that a compiler
be available. Otherwise the test will be skipped.
=head1 SEE ALSO
=over 4
=item L<Test::Alien>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Test/Alien/CanPlatypus.pm 0000444 00000003634 15157554473 0012756 0 ustar 00 package Test::Alien::CanPlatypus;
use strict;
use warnings;
use 5.008004;
use Test2::API qw( context );
# ABSTRACT: Skip a test file unless FFI::Platypus is available
our $VERSION = '2.84'; # VERSION
sub skip
{
eval { require FFI::Platypus; 1 } ? undef : 'This test requires FFI::Platypus.';
}
sub import
{
my $skip = __PACKAGE__->skip;
return unless defined $skip;
my $ctx = context();
$ctx->plan(0, SKIP => $skip);
$ctx->release;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Alien::CanPlatypus - Skip a test file unless FFI::Platypus is available
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use Test::Alien::CanPlatypus;
=head1 DESCRIPTION
This is just a L<Test2> plugin that requires that L<FFI::Platypus>
be available. Otherwise the test will be skipped.
=head1 SEE ALSO
=over 4
=item L<Test::Alien>
=item L<FFI::Platypus>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Test/Alien/Synthetic.pm 0000444 00000010560 15157554500 0012450 0 ustar 00 package Test::Alien::Synthetic;
use strict;
use warnings;
use 5.008004;
use Test2::API qw( context );
# ABSTRACT: A mock alien object for testing
our $VERSION = '2.84'; # VERSION
sub _def ($) { my($val) = @_; defined $val ? $val : '' }
sub cflags { _def shift->{cflags} }
sub libs { _def shift->{libs} }
sub dynamic_libs { @{ shift->{dynamic_libs} || [] } }
sub runtime_prop
{
my($self) = @_;
defined $self->{runtime_prop}
? $self->{runtime_prop}
: {};
}
sub cflags_static
{
my($self) = @_;
defined $self->{cflags_static}
? $self->{cflags_static}
: $self->cflags;
}
sub libs_static
{
my($self) = @_;
defined $self->{libs_static}
? $self->{libs_static}
: $self->libs;
}
sub bin_dir
{
my $dir = shift->{bin_dir};
defined $dir && -d $dir ? ($dir) : ();
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Alien::Synthetic - A mock alien object for testing
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use Test2::V0;
use Test::Alien;
my $alien = synthetic {
cflags => '-I/foo/bar/include',
libs => '-L/foo/bar/lib -lbaz',
};
alien_ok $alien;
done_testing;
=head1 DESCRIPTION
This class is used to model a synthetic L<Alien>
class that implements the minimum L<Alien::Base>
interface needed by L<Test::Alien>.
It can be useful if you have a non-L<Alien::Base>
based L<Alien> distribution that you need to test.
B<NOTE>: The name of this class may move in the
future, so do not refer to this class name directly.
Instead create instances of this class using the
L<Test::Alien#synthetic> function.
=head1 ATTRIBUTES
=head2 cflags
String containing the compiler flags
=head2 cflags_static
String containing the static compiler flags
=head2 libs
String containing the linker and library flags
=head2 libs_static
String containing the static linker and library flags
=head2 dynamic_libs
List reference containing the dynamic libraries.
=head2 bin_dir
Tool binary directory.
=head2 runtime_prop
Runtime properties.
=head1 EXAMPLE
Here is a complete example using L<Alien::Libarchive> which is a non-L<Alien::Base>
based L<Alien> distribution.
use strict;
use warnings;
use Test2::V0;
use Test::Alien;
use Alien::Libarchive;
my $real = Alien::Libarchive->new;
my $alien = synthetic {
cflags => scalar $real->cflags,
libs => scalar $real->libs,
dynamic_libs => [$real->dlls],
};
alien_ok $alien;
xs_ok do { local $/; <DATA> }, with_subtest {
my($module) = @_;
my $ptr = $module->archive_read_new;
like $ptr, qr{^[0-9]+$};
$module->archive_read_free($ptr);
};
ffi_ok { symbols => [qw( archive_read_new )] }, with_subtest {
my($ffi) = @_;
my $new = $ffi->function(archive_read_new => [] => 'opaque');
my $free = $ffi->function(archive_read_close => ['opaque'] => 'void');
my $ptr = $new->();
like $ptr, qr{^[0-9]+$};
$free->($ptr);
};
done_testing;
__DATA__
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <archive.h>
MODULE = TA_MODULE PACKAGE = TA_MODULE
void *archive_read_new(class);
const char *class;
CODE:
RETVAL = (void*) archive_read_new();
OUTPUT:
RETVAL
void archive_read_free(class, ptr);
const char *class;
void *ptr;
CODE:
archive_read_free(ptr);
=head1 SEE ALSO
=over 4
=item L<Test::Alien>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Test/Alien/Run.pm 0000444 00000014144 15157554505 0011251 0 ustar 00 package Test::Alien::Run;
use strict;
use warnings;
use 5.008004;
use Test2::API qw( context );
# ABSTRACT: Run object
our $VERSION = '2.84'; # VERSION
sub out { shift->{out} }
sub err { shift->{err} }
sub exit { shift->{exit} }
sub signal { shift->{sig} }
sub success
{
my($self, $message) = @_;
$message ||= 'command succeeded';
my $ok = $self->exit == 0 && $self->signal == 0;
$ok = 0 if $self->{fail};
my $ctx = context();
$ctx->ok($ok, $message);
unless($ok)
{
$ctx->diag(" command exited with @{[ $self->exit ]}") if $self->exit;
$ctx->diag(" command killed with @{[ $self->signal ]}") if $self->signal;
$ctx->diag(" @{[ $self->{fail} ]}") if $self->{fail};
}
$ctx->release;
$self;
}
sub exit_is
{
my($self, $exit, $message) = @_;
$message ||= "command exited with value $exit";
my $ok = $self->exit == $exit;
my $ctx = context();
$ctx->ok($ok, $message);
$ctx->diag(" actual exit value was: @{[ $self->exit ]}") unless $ok;
$ctx->release;
$self;
}
sub exit_isnt
{
my($self, $exit, $message) = @_;
$message ||= "command exited with value not $exit";
my $ok = $self->exit != $exit;
my $ctx = context();
$ctx->ok($ok, $message);
$ctx->diag(" actual exit value was: @{[ $self->exit ]}") unless $ok;
$ctx->release;
$self;
}
sub _like
{
my($self, $regex, $source, $not, $message) = @_;
my $ok = $self->{$source} =~ $regex;
$ok = !$ok if $not;
my $ctx = context();
$ctx->ok($ok, $message);
unless($ok)
{
$ctx->diag(" $source:");
$ctx->diag(" $_") for split /\r?\n/, $self->{$source};
$ctx->diag($not ? ' matches:' : ' does not match:');
$ctx->diag(" $regex");
}
$ctx->release;
$self;
}
sub out_like
{
my($self, $regex, $message) = @_;
$message ||= "output matches $regex";
$self->_like($regex, 'out', 0, $message);
}
sub out_unlike
{
my($self, $regex, $message) = @_;
$message ||= "output does not match $regex";
$self->_like($regex, 'out', 1, $message);
}
sub err_like
{
my($self, $regex, $message) = @_;
$message ||= "standard error matches $regex";
$self->_like($regex, 'err', 0, $message);
}
sub err_unlike
{
my($self, $regex, $message) = @_;
$message ||= "standard error does not match $regex";
$self->_like($regex, 'err', 1, $message);
}
sub note
{
my($self) = @_;
my $ctx = context();
$ctx->note("[cmd]");
$ctx->note(" @{$self->{cmd}}");
if($self->out ne '')
{
$ctx->note("[out]");
$ctx->note(" $_") for split /\r?\n/, $self->out;
}
if($self->err ne '')
{
$ctx->note("[err]");
$ctx->note(" $_") for split /\r?\n/, $self->err;
}
$ctx->release;
$self;
}
sub diag
{
my($self) = @_;
my $ctx = context();
$ctx->diag("[cmd]");
$ctx->diag(" @{$self->{cmd}}");
if($self->out ne '')
{
$ctx->diag("[out]");
$ctx->diag(" $_") for split /\r?\n/, $self->out;
}
if($self->err ne '')
{
$ctx->diag("[err]");
$ctx->diag(" $_") for split /\r?\n/, $self->err;
}
$ctx->release;
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Alien::Run - Run object
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use Test2::V0;
use Test::Alien;
run_ok([ $^X, -e => 'print "some output"; exit 22'])
->exit_is(22)
->out_like(qr{some});
=head1 DESCRIPTION
This class stores information about a process run as performed by
L<Test::Alien#run_ok>. That function is the I<ONLY> way to create
an instance of this class.
=head1 ATTRIBUTES
=head2 out
my $str = $run->out;
The standard output from the run.
=head2 err
my $str = $run->err;
The standard error from the run.
=head2 exit
my $int = $run->exit;
The exit value of the run.
=head2 signal
my $int = $run->signal;
The signal that killed the run, or zero if the process was terminated normally.
=head1 METHODS
These methods return the run object itself, so they can be chained,
as in the synopsis above.
=head2 success
$run->success;
$run->success($message);
Passes if the process terminated normally with an exit value of 0.
=head2 exit_is
$run->exit_is($exit);
$run->exit_is($exit, $message);
Passes if the process terminated with the given exit value.
=head2 exit_isnt
$run->exit_isnt($exit);
$run->exit_isnt($exit, $message);
Passes if the process terminated with an exit value of anything
but the given value.
=head2 out_like
$run->out_like($regex);
$run->out_like($regex, $message);
Passes if the output of the run matches the given pattern.
=head2 out_unlike
$run->out_unlike($regex);
$run->out_unlike($regex, $message);
Passes if the output of the run does not match the given pattern.
=head2 err_like
$run->err_like($regex);
$run->err_like($regex, $message);
Passes if the standard error of the run matches the given pattern.
=head2 err_unlike
$run->err_unlike($regex);
$run->err_unlike($regex, $message);
Passes if the standard error of the run does not match the given pattern.
=head2 note
$run->note;
Send the output and standard error as test note.
=head2 diag
$run->diag;
Send the output and standard error as test diagnostic.
=head1 SEE ALSO
=over 4
=item L<Test::Alien>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Test/Alien/Diag.pm 0000444 00000010430 15157554512 0011341 0 ustar 00 package Test::Alien::Diag;
use strict;
use warnings;
use 5.008004;
use Test2::API qw( context );
use Exporter qw( import );
our @EXPORT = qw( alien_diag );
our @EXPORT_OK = @EXPORT;
# ABSTRACT: Print out standard diagnostic for Aliens in the test step.
our $VERSION = '2.84'; # VERSION
my @default_scalar_properties = qw(
cflags cflags_static libs libs_static version install_type
);
my @default_list_properties = qw(
dynamic_libs bin_dir
);
sub alien_diag ($@)
{
my $ctx = context();
my %options = defined $_[-1] && ref($_[-1]) eq 'HASH' ? %{ pop @_ } : ();
my @extra_properties = @{ delete $options{properties} || [] };
my @extra_list_properties = @{ delete $options{list_properties} || [] };
my $max = 0;
foreach my $alien (@_)
{
foreach my $name (@default_scalar_properties, @default_list_properties, @extra_properties, @extra_list_properties)
{
if(eval { $alien->can($name) })
{
my $str = "$alien->$name";
if(length($str) > $max)
{
$max = length($str);
}
}
}
}
$ctx->diag('');
if(%options)
{
my @extra = sort keys %options;
$ctx->diag("warning: unknown option@{[ @extra > 1 ? 's' : '' ]} for alien_diag: @extra");
$ctx->diag("(you should check for typos or maybe upgrade to a newer version of Alien::Build)");
}
foreach my $alien (@_) {
$ctx->diag('') for 1..2;
my $found = 0;
foreach my $name (sort(@default_scalar_properties, @extra_properties))
{
if(eval { $alien->can($name) })
{
$found++;
my $value = $alien->$name;
$value = '[undef]' unless defined $value;
$ctx->diag(sprintf "%-${max}s = %s", "$alien->$name", $value);
}
}
foreach my $name (sort(@default_list_properties, @extra_list_properties))
{
if(eval { $alien->can($name) })
{
$found++;
my @list = eval { $alien->$name };
next if $@;
$ctx->diag(sprintf "%-${max}s = %s", "$alien->$name", $_) for @list;
}
}
$ctx->diag("no diagnostics found for $alien") unless $found;
}
$ctx->diag('') for 1..2;
$ctx->release;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Alien::Diag - Print out standard diagnostic for Aliens in the test step.
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use Test2::V0;
use Test::Alien::Diag qw( alien_diag );
=head1 DESCRIPTION
This module provides an C<alien_diag> method that prints out diagnostics useful for
cpantesters and other bug reports that gives a quick summary of the important settings
like C<clfags> and C<libs>.
=head1 FUNCTIONS
=head2 alien_diag
alien_diag @aliens;
prints out diagnostics for each given alien. Each alien must be the class
name of an alien.
[version 2.68]
alien_diag @aliens, \%options;
Starting with L<Alien::Build> 2.68, you can provide an option hash to adjust the
behavior of C<alien_diag>. Valid options are:
=over 4
=item properties
Additional properties to display in the diagnostic. Useful when you have an L<Alien>
with custom properties defined in the subclass.
=item list_properties
Additional properties that are returned as a list to display in the diagnostic. Useful
when you have an L<Alien> with customer properties that return a list.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build.pm 0000444 00000204336 15157554524 0010632 0 ustar 00 package Alien::Build;
use strict;
use warnings;
use 5.008004;
use Path::Tiny ();
use Carp ();
use File::chdir;
use JSON::PP ();
use Env qw( @PATH @PKG_CONFIG_PATH );
use Config ();
use Alien::Build::Log;
# ABSTRACT: Build external dependencies for use in CPAN
our $VERSION = '2.84'; # VERSION
sub _path { goto \&Path::Tiny::path }
sub new
{
my($class, %args) = @_;
my $self = bless {
install_prop => {
root => _path($args{root} || "_alien")->absolute->stringify,
patch => (defined $args{patch}) ? _path($args{patch})->absolute->stringify : undef,
},
runtime_prop => {
alien_build_version => $Alien::Build::VERSION || 'dev',
},
plugin_instance_prop => {},
bin_dir => [],
pkg_config_path => [],
aclocal_path => [],
}, $class;
# force computing this as soon as possible
$self->download_rule;
$self->meta->filename(
$args{filename} || do {
my(undef, $filename) = caller;
_path($filename)->absolute->stringify;
}
);
if($args{meta_prop})
{
$self->meta->prop->{$_} = $args{meta_prop}->{$_} for keys %{ $args{meta_prop} };
}
$self;
}
my $count = 0;
sub load
{
my(undef, $alienfile, @args) = @_;
my $rcfile = Path::Tiny->new($ENV{ALIEN_BUILD_RC} || '~/.alienbuild/rc.pl')->absolute;
if(-r $rcfile)
{
require Alien::Build::rc;
package Alien::Build::rc;
require $rcfile;
}
unless(-r $alienfile)
{
Carp::croak "Unable to read alienfile: $alienfile";
}
my $file = _path $alienfile;
my $name = $file->parent->basename;
$name =~ s/^alien-//i;
$name =~ s/[^a-z]//g;
$name = 'x' if $name eq '';
$name = ucfirst $name;
my $class = "Alien::Build::Auto::$name@{[ $count++ ]}";
{ no strict 'refs';
@{ "${class}::ISA" } = ('Alien::Build');
*{ "${class}::Alienfile::meta" } = sub {
$class =~ s{::Alienfile$}{};
$class->meta;
}};
my @preload = qw( Core::Setup Core::Download Core::FFI Core::Override Core::CleanInstall );
push @preload, @Alien::Build::rc::PRELOAD;
push @preload, split /;/, $ENV{ALIEN_BUILD_PRELOAD}
if defined $ENV{ALIEN_BUILD_PRELOAD};
my @postload = qw( Core::Legacy Core::Gather Core::Tail );
push @postload, @Alien::Build::rc::POSTLOAD;
push @postload, split /;/, $ENV{ALIEN_BUILD_POSTLOAD}
if defined $ENV{ALIEN_BUILD_POSTLOAD};
my $self = $class->new(
filename => $file->absolute->stringify,
@args,
);
require alienfile;
foreach my $preload (@preload)
{
ref $preload eq 'CODE' ? $preload->($self->meta) : $self->meta->apply_plugin($preload);
}
# TODO: do this without a string eval ?
## no critic
eval '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) . qq{
package ${class}::Alienfile;
do '@{[ $file->absolute->stringify ]}';
die \$\@ if \$\@;
};
die $@ if $@;
## use critic
foreach my $postload (@postload)
{
ref $postload eq 'CODE' ? $postload->($self->meta) : $self->meta->apply_plugin($postload);
}
$self->{args} = \@args;
unless(defined $self->meta->prop->{arch})
{
$self->meta->prop->{arch} = 1;
}
unless(defined $self->meta->prop->{network})
{
$self->meta->prop->{network} = 1;
## https://github.com/PerlAlien/Alien-Build/issues/23#issuecomment-341114414
#$self->meta->prop->{network} = 0 if $ENV{NO_NETWORK_TESTING};
$self->meta->prop->{network} = 0 if (defined $ENV{ALIEN_INSTALL_NETWORK}) && ! $ENV{ALIEN_INSTALL_NETWORK};
}
unless(defined $self->meta->prop->{local_source})
{
if(! defined $self->meta->prop->{start_url})
{
$self->meta->prop->{local_source} = 0;
}
# we assume URL schemes are at least two characters, that
# way Windows absolute paths can be used as local start_url
elsif($self->meta->prop->{start_url} =~ /^([a-z]{2,}):/i)
{
my $scheme = $1;
$self->meta->prop->{local_source} = $scheme eq 'file';
}
else
{
$self->meta->prop->{local_source} = 1;
}
}
return $self;
}
sub resume
{
my(undef, $alienfile, $root) = @_;
my $h = JSON::PP::decode_json(_path("$root/state.json")->slurp);
my $self = Alien::Build->load("$alienfile", @{ $h->{args} });
$self->{install_prop} = $h->{install};
$self->{plugin_instance_prop} = $h->{plugin_instance};
$self->{runtime_prop} = $h->{runtime};
$self;
}
sub meta_prop
{
my($class) = @_;
$class->meta->prop;
}
sub install_prop
{
shift->{install_prop};
}
sub plugin_instance_prop
{
my($self, $plugin) = @_;
my $instance_id = $plugin->instance_id;
$self->{plugin_instance_prop}->{$instance_id} ||= {};
}
sub runtime_prop
{
shift->{runtime_prop};
}
sub hook_prop
{
shift->{hook_prop};
}
sub _command_prop
{
my($self) = @_;
return {
alien => {
install => $self->install_prop,
runtime => $self->runtime_prop,
hook => $self->hook_prop,
meta => $self->meta_prop,
},
perl => {
config => \%Config::Config,
},
env => \%ENV,
};
}
sub checkpoint
{
my($self) = @_;
my $root = $self->root;
_path("$root/state.json")->spew(
JSON::PP->new->pretty->canonical(1)->ascii->encode({
install => $self->install_prop,
runtime => $self->runtime_prop,
plugin_instance => $self->{plugin_instance_prop},
args => $self->{args},
})
);
$self;
}
sub root
{
my($self) = @_;
my $root = $self->install_prop->{root};
_path($root)->mkpath unless -d $root;
$root;
}
sub install_type
{
my($self) = @_;
$self->{runtime_prop}->{install_type} ||= $self->probe;
}
sub is_system_install
{
my($self) = @_;
$self->install_type eq 'system';
}
sub is_share_install
{
my($self) = @_;
$self->install_type eq 'share';
}
sub download_rule
{
my($self) = @_;
$self->install_prop->{download_rule} ||= do {
my $dr = $ENV{ALIEN_DOWNLOAD_RULE};
$dr = 'warn' unless defined $dr;
$dr = 'warn' if $dr eq 'default';
unless($dr =~ /^(warn|digest|encrypt|digest_or_encrypt|digest_and_encrypt)$/)
{
$self->log("unknown ALIEN_DOWNLOAD_RULE \"$dr\", using \"warn\" instead");
$dr = 'warn';
}
$dr;
};
}
sub set_prefix
{
my($self, $prefix) = @_;
if($self->meta_prop->{destdir})
{
$self->runtime_prop->{prefix} =
$self->install_prop->{prefix} = $prefix;
}
else
{
$self->runtime_prop->{prefix} = $prefix;
$self->install_prop->{prefix} = $self->install_prop->{stage};
}
}
sub set_stage
{
my($self, $dir) = @_;
$self->install_prop->{stage} = $dir;
}
sub _merge
{
my %h;
while(@_)
{
my $mod = shift;
my $ver = shift;
if((!defined $h{$mod}) || $ver > $h{$mod})
{ $h{$mod} = $ver }
}
\%h;
}
sub requires
{
my($self, $phase) = @_;
$phase ||= 'any';
my $meta = $self->meta;
$phase =~ /^(?:any|configure)$/
? $meta->{require}->{$phase} || {}
: _merge %{ $meta->{require}->{any} }, %{ $meta->{require}->{$phase} };
}
sub load_requires
{
my($self, $phase, $eval) = @_;
my $reqs = $self->requires($phase);
foreach my $mod (keys %$reqs)
{
my $ver = $reqs->{$mod};
my $check = sub {
my $pm = "$mod.pm";
$pm =~ s{::}{/}g;
require $pm;
};
if($eval)
{
eval { $check->() };
die "Required $mod @{[ $ver || 'undef' ]}, missing" if $@;
}
else
{
$check->();
}
# note Test::Alien::Build#alienfile_skip_if_missing_prereqs does a regex
# on this diagnostic, so if you change it here, change it there too.
die "Required $mod $ver, have @{[ $mod->VERSION || 0 ]}" if $ver && ! $mod->VERSION($ver);
# allow for requires on Alien::Build or Alien::Base
next if $mod eq 'Alien::Build';
next if $mod eq 'Alien::Base';
if($mod->can('bin_dir'))
{
push @{ $self->{bin_dir} }, $mod->bin_dir;
}
if(($mod->can('runtime_prop') && $mod->runtime_prop)
|| ($mod->isa('Alien::Base') && $mod->install_type('share')))
{
for my $dir (qw(lib share)) {
my $path = _path($mod->dist_dir)->child("$dir/pkgconfig");
if(-d $path)
{
push @{ $self->{pkg_config_path} }, $path->stringify;
}
}
my $path = _path($mod->dist_dir)->child('share/aclocal');
if(-d $path)
{
$path = "$path";
if($^O eq 'MSWin32')
{
# convert to MSYS path
$path =~ s{^([a-z]):}{/$1/}i;
}
push @{ $self->{aclocal_path} }, $path;
}
}
# sufficiently new Autotools have a aclocal_dir which will
# give us the directories we need.
if($mod eq 'Alien::Autotools' && $mod->can('aclocal_dir'))
{
push @{ $self->{aclocal_path} }, $mod->aclocal_dir;
}
if($mod->can('alien_helper'))
{
my $helpers = $mod->alien_helper;
foreach my $name (sort keys %$helpers)
{
my $code = $helpers->{$name};
$self->meta->interpolator->replace_helper($name => $code);
}
}
}
1;
}
sub _call_hook
{
my $self = shift;
local $ENV{PATH} = $ENV{PATH};
unshift @PATH, @{ $self->{bin_dir} };
local $ENV{PKG_CONFIG_PATH} = $ENV{PKG_CONFIG_PATH};
unshift @PKG_CONFIG_PATH, @{ $self->{pkg_config_path} };
local $ENV{ACLOCAL_PATH} = $ENV{ACLOCAL_PATH};
# autoconf uses MSYS paths, even for the ACLOCAL_PATH environment variable, so we can't use Env for this.
{
my @path;
@path = split /:/, $ENV{ACLOCAL_PATH} if defined $ENV{ACLOCAL_PATH};
unshift @path, @{ $self->{aclocal_path} };
$ENV{ACLOCAL_PATH} = join ':', @path;
}
my $config = ref($_[0]) eq 'HASH' ? shift : {};
my($name, @args) = @_;
local $self->{hook_prop} = {};
$self->meta->call_hook( $config, $name => $self, @args );
}
sub probe
{
my($self) = @_;
local $CWD = $self->root;
my $dir;
my $env = $self->_call_hook('override');
my $type;
my $error;
$env = '' if $env eq 'default';
if($env eq 'share')
{
$type = 'share';
}
else
{
$type = eval {
$self->_call_hook(
{
before => sub {
$dir = Alien::Build::TempDir->new($self, "probe");
$CWD = "$dir";
},
after => sub {
$CWD = $self->root;
},
ok => 'system',
continue => sub {
if($_[0] eq 'system')
{
foreach my $name (qw( probe_class probe_instance_id ))
{
if(exists $self->hook_prop->{$name} && defined $self->hook_prop->{$name})
{
$self->install_prop->{"system_$name"} = $self->hook_prop->{$name};
}
}
return undef;
}
else
{
return 1;
}
},
},
'probe',
);
};
$error = $@;
$type = 'share' unless defined $type;
}
if($error)
{
if($env eq 'system')
{
die $error;
}
$self->log("error in probe (will do a share install): $@");
$self->log("Don't panic, we will attempt a share build from source if possible.");
$self->log("Do not file a bug unless you expected a system install to succeed.");
$type = 'share';
}
if($env && $env ne $type)
{
die "requested $env install not available";
}
if($type !~ /^(system|share)$/)
{
Carp::croak "probe hook returned something other than system or share: $type";
}
if($type eq 'share' && (!$self->meta_prop->{network}) && (!$self->meta_prop->{local_source}))
{
$self->log("install type share requested or detected, but network fetch is turned off");
$self->log("see https://metacpan.org/pod/Alien::Build::Manual::FAQ#Network-fetch-is-turned-off");
Carp::croak "network fetch is turned off";
}
$self->runtime_prop->{install_type} = $type;
$type;
}
sub download
{
my($self) = @_;
return $self unless $self->install_type eq 'share';
return $self if $self->install_prop->{complete}->{download};
if($self->meta->has_hook('download'))
{
my $tmp;
local $CWD;
my $valid = 0;
$self->_call_hook(
{
before => sub {
$tmp = Alien::Build::TempDir->new($self, "download");
$CWD = "$tmp";
},
verify => sub {
my @list = grep { $_->basename !~ /^\./, } _path('.')->children;
my $count = scalar @list;
if($count == 0)
{
die "no files downloaded";
}
elsif($count == 1)
{
my($archive) = $list[0];
if(-d $archive)
{
# TODO: this is probably a bug that we don't set
# download or compelte properties?
$self->log("single dir, assuming directory");
}
else
{
$self->log("single file, assuming archive");
}
$self->install_prop->{download} = $archive->absolute->stringify;
$self->install_prop->{complete}->{download} = 1;
$valid = 1;
}
else
{
$self->log("multiple files, assuming directory");
$self->install_prop->{complete}->{download} = 1;
$self->install_prop->{download} = _path('.')->absolute->stringify;
$valid = 1;
}
},
after => sub {
$CWD = $self->root;
},
},
'download',
);
# experimental and undocumented for now
if($self->meta->has_hook('check_download'))
{
$self->meta->call_hook(check_download => $self);
}
return $self if $valid;
}
else
{
# This will call the default download hook
# defined in Core::Download since the recipe
# does not provide a download hook
my $ret = $self->_call_hook('download');
# experimental and undocumented for now
if($self->meta->has_hook('check_download'))
{
$self->meta->call_hook(check_download => $self);
}
return $self;
}
die "download failed";
}
sub fetch
{
my $self = shift;
my $url = $_[0] || $self->meta_prop->{start_url};
my $secure = 0;
if(defined $url && ($url =~ /^(https|file):/ || $url !~ /:/))
{
# considered secure when either https or a local file
$secure = 1;
}
elsif(!defined $url)
{
$self->log("warning: undefined url in fetch");
}
else
{
$self->log("warning: attempting to fetch a non-TLS or bundled URL: @{[ $url ]}");
}
die "insecure fetch is not allowed" if $self->download_rule =~ /^(encrypt|digest_and_encrypt)$/ && !$secure;
my $file = $self->_call_hook( 'fetch' => @_ );
$secure = 0;
if(ref($file) ne 'HASH')
{
$self->log("warning: fetch returned non-hash reference");
}
elsif(!defined $file->{protocol})
{
$self->log("warning: fetch did not return a protocol");
}
elsif($file->{protocol} !~ /^(https|file)$/)
{
$self->log("warning: fetch did not use a secure protocol: @{[ $file->{protocol} ]}");
}
else
{
$secure = 1;
}
die "insecure fetch is not allowed" if $self->download_rule =~ /^(encrypt|digest_and_encrypt)$/ && !$secure;
$file;
}
sub check_digest
{
my($self, $file) = @_;
return '' unless $self->meta_prop->{check_digest};
unless(ref($file) eq 'HASH')
{
my $path = Path::Tiny->new($file);
$file = {
type => 'file',
filename => $path->basename,
path => "$path",
tmp => 0,
};
}
my $path = $file->{path};
if(defined $path)
{
# there is technically a race condition here
die "Missing file in digest check: @{[ $file->{filename} ]}" unless -f $path;
die "Unreadable file in digest check: @{[ $file->{filename} ]}" unless -r $path;
}
else
{
die "File is wrong type" unless defined $file->{type} && $file->{type} eq 'file';
die "File has no filename" unless defined $file->{filename};
die "@{[ $file->{filename} ]} has no content" unless defined $file->{content};
}
my $filename = $file->{filename};
my $signature = $self->meta_prop->{digest}->{$filename} || $self->meta_prop->{digest}->{'*'};
die "No digest for $filename" unless defined $signature && ref $signature eq 'ARRAY';
my($algo, $expected) = @$signature;
if($self->meta->call_hook( check_digest => $self, $file, $algo, $expected ))
{
# record the verification here so that we can check in the extract step that the signature
# was checked.
$self->install_prop->{download_detail}->{$path}->{digest} = [$algo, $expected] if defined $path; return 1;
}
else
{
die "No plugin provides digest algorithm for $algo";
}
}
sub decode
{
my($self, $res) = @_;
my $res2 = $self->_call_hook( decode => $res );
$res2->{protocol} = $res->{protocol}
if !defined $res2->{protocol}
&& defined $res->{protocol};
return $res2;
}
sub prefer
{
my($self, $res) = @_;
my $res2 = $self->_call_hook( prefer => $res );
$res2->{protocol} = $res->{protocol}
if !defined $res2->{protocol}
&& defined $res->{protocol};
return $res2;
}
sub extract
{
my($self, $archive) = @_;
$archive ||= $self->install_prop->{download};
unless(defined $archive)
{
die "tried to call extract before download";
}
{
my $checked_digest = 0;
my $encrypted_fetch = 0;
my $detail = $self->install_prop->{download_detail}->{$archive};
if(defined $detail)
{
if(defined $detail->{digest})
{
my($algo, $expected) = @{ $detail->{digest} };
my $file = {
type => 'file',
filename => Path::Tiny->new($archive)->basename,
path => $archive,
tmp => 0,
};
$checked_digest = $self->meta->call_hook( check_digest => $self, $file, $algo, $expected )
}
if(!defined $detail->{protocol})
{
$self->log("warning: extract did not receive protocol details for $archive") unless $checked_digest;
}
elsif($detail->{protocol} !~ /^(https|file)$/)
{
$self->log("warning: extracting from a file that was fetched via insecure protocol @{[ $detail->{protocol} ]}") unless $checked_digest ;
}
else
{
$encrypted_fetch = 1;
}
}
else
{
$self->log("warning: extract received no download details for $archive");
}
if($self->download_rule eq 'digest')
{
die "required digest missing for $archive" unless $checked_digest;
}
elsif($self->download_rule eq 'encrypt')
{
die "file was fetched insecurely for $archive" unless $encrypted_fetch;
}
elsif($self->download_rule eq 'digest_or_encrypt')
{
die "file was fetched insecurely and required digest missing for $archive" unless $checked_digest || $encrypted_fetch;
}
elsif($self->download_rule eq 'digest_and_encrypt')
{
die "file was fetched insecurely and required digest missing for $archive" unless $checked_digest || $encrypted_fetch;
die "required digest missing for $archive" unless $checked_digest;
die "file was fetched insecurely for $archive" unless $encrypted_fetch;
}
elsif($self->download_rule eq 'warn')
{
unless($checked_digest || $encrypted_fetch)
{
$self->log("!!! NOTICE OF FUTURE CHANGE IN BEHAVIOR !!!");
$self->log("a future version of Alien::Build will die here by default with this exception: file was fetched insecurely and required digest missing for $archive");
$self->log("!!! NOTICE OF FUTURE CHANGE IN BEHAVIOR !!!");
}
}
else
{
die "internal error, unknown download rule: @{[ $self->download_rule ]}";
}
}
my $nick_name = 'build';
if($self->meta_prop->{out_of_source})
{
$nick_name = 'extract';
my $extract = $self->install_prop->{extract};
return $extract if defined $extract && -d $extract;
}
my $tmp;
local $CWD;
my $ret;
$self->_call_hook({
before => sub {
# called build instead of extract, because this
# will be used for the build step, and technically
# extract is a substage of build anyway.
$tmp = Alien::Build::TempDir->new($self, $nick_name);
$CWD = "$tmp";
},
verify => sub {
my $path = '.';
if($self->meta_prop->{out_of_source} && $self->install_prop->{extract})
{
$path = $self->install_prop->{extract};
}
my @list = grep { $_->basename !~ /^\./ && $_->basename ne 'pax_global_header' } _path($path)->children;
my $count = scalar @list;
if($count == 0)
{
die "no files extracted";
}
elsif($count == 1 && -d $list[0])
{
$ret = $list[0]->absolute->stringify;
}
else
{
$ret = "$tmp";
}
},
after => sub {
$CWD = $self->root;
},
}, 'extract', $archive);
$self->install_prop->{extract} ||= $ret;
$ret ? $ret : ();
}
sub build
{
my($self) = @_;
# save the evironment, in case some plugins decide
# to alter it. Or us! See just a few lines below.
local %ENV = %ENV;
my $stage = _path($self->install_prop->{stage});
$stage->mkpath;
my $tmp;
if($self->install_type eq 'share')
{
foreach my $suffix ('', '_ffi')
{
local $CWD;
delete $ENV{DESTDIR} unless $self->meta_prop->{destdir};
my %env_meta = %{ $self->meta_prop ->{env} || {} };
my %env_inst = %{ $self->install_prop->{env} || {} };
if($self->meta_prop->{env_interpolate})
{
foreach my $key (keys %env_meta)
{
$env_meta{$key} = $self->meta->interpolator->interpolate($env_meta{$key}, $self);
}
}
%ENV = (%ENV, %env_meta);
%ENV = (%ENV, %env_inst);
my $destdir;
$self->_call_hook(
{
before => sub {
if($self->meta_prop->{out_of_source})
{
$self->extract;
$CWD = $tmp = Alien::Build::TempDir->new($self, 'build');
}
else
{
$CWD = $tmp = $self->extract;
}
if($self->meta_prop->{destdir})
{
$destdir = Alien::Build::TempDir->new($self, 'destdir');
$ENV{DESTDIR} = "$destdir";
}
$self->_call_hook({ all => 1 }, "patch${suffix}");
},
after => sub {
$destdir = "$destdir" if $destdir;
},
}, "build${suffix}");
$self->install_prop->{"_ab_build@{[ $suffix || '_share' ]}"} = "$CWD";
$self->_call_hook("gather@{[ $suffix || '_share' ]}");
}
}
elsif($self->install_type eq 'system')
{
local $CWD = $self->root;
my $dir;
$self->_call_hook(
{
before => sub {
$dir = Alien::Build::TempDir->new($self, "gather");
$CWD = "$dir";
},
after => sub {
$CWD = $self->root;
},
},
'gather_system',
);
$self->install_prop->{finished} = 1;
$self->install_prop->{complete}->{gather_system} = 1;
}
$self;
}
sub test
{
my($self) = @_;
if($self->install_type eq 'share')
{
foreach my $suffix ('_share', '_ffi')
{
if($self->meta->has_hook("test$suffix"))
{
my $dir = $self->install_prop->{"_ab_build$suffix"};
Carp::croak("no build directory to run tests") unless $dir && -d $dir;
local $CWD = $dir;
$self->_call_hook("test$suffix");
}
}
}
else
{
if($self->meta->has_hook("test_system"))
{
my $dir = Alien::Build::TempDir->new($self, "test");
local $CWD = "$dir";
$self->_call_hook("test_system");
}
}
}
sub clean_install
{
my($self) = @_;
if($self->install_type eq 'share')
{
$self->_call_hook("clean_install");
}
}
sub system
{
my($self, $command, @args) = @_;
my $prop = $self->_command_prop;
($command, @args) = map {
$self->meta->interpolator->interpolate($_, $prop)
} ($command, @args);
$self->log("+ $command @args");
scalar @args
? system $command, @args
: system $command;
}
sub log
{
my(undef, $message) = @_;
my $caller = [caller];
chomp $message;
foreach my $line (split /\n/, $message)
{
Alien::Build::Log->default->log(
caller => $caller,
message => $line,
);
}
}
{
my %meta;
sub meta
{
my($class) = @_;
$class = ref $class if ref $class;
$meta{$class} ||= Alien::Build::Meta->new( class => $class );
}
}
package Alien::Build::Meta;
our @CARP_NOT = qw( alienfile );
sub new
{
my($class, %args) = @_;
my $self = bless {
phase => 'any',
build_suffix => '',
require => {
any => {},
share => {},
system => {},
},
around => {},
prop => {},
%args,
}, $class;
$self;
}
sub prop
{
shift->{prop};
}
sub filename
{
my($self, $new) = @_;
$self->{filename} = $new if defined $new;
$self->{filename};
}
sub add_requires
{
my $self = shift;
my $phase = shift;
while(@_)
{
my $module = shift;
my $version = shift;
my $old = $self->{require}->{$phase}->{$module};
if((!defined $old) || $version > $old)
{ $self->{require}->{$phase}->{$module} = $version }
}
$self;
}
sub interpolator
{
my($self, $new) = @_;
if(defined $new)
{
if(defined $self->{intr})
{
Carp::croak "tried to set interpolator twice";
}
if(ref $new)
{
$self->{intr} = $new;
}
else
{
$self->{intr} = $new->new;
}
}
elsif(!defined $self->{intr})
{
require Alien::Build::Interpolate::Default;
$self->{intr} = Alien::Build::Interpolate::Default->new;
}
$self->{intr};
}
sub has_hook
{
my($self, $name) = @_;
defined $self->{hook}->{$name};
}
sub _instr
{
my($self, $name, $instr) = @_;
if(ref($instr) eq 'CODE')
{
return $instr;
}
elsif(ref($instr) eq 'ARRAY')
{
my %phase = (
download => 'share',
fetch => 'share',
decode => 'share',
prefer => 'share',
extract => 'share',
patch => 'share',
patch_ffi => 'share',
build => 'share',
build_ffi => 'share',
stage => 'share',
gather_ffi => 'share',
gather_share => 'share',
gather_system => 'system',
test_ffi => 'share',
test_share => 'share',
test_system => 'system',
);
require Alien::Build::CommandSequence;
my $seq = Alien::Build::CommandSequence->new(@$instr);
$seq->apply_requirements($self, $phase{$name} || 'any');
return $seq;
}
else
{
Carp::croak "type not supported as a hook";
}
}
sub register_hook
{
my($self, $name, $instr) = @_;
push @{ $self->{hook}->{$name} }, _instr $self, $name, $instr;
$self;
}
sub default_hook
{
my($self, $name, $instr) = @_;
$self->{default_hook}->{$name} = _instr $self, $name, $instr;
$self;
}
sub around_hook
{
my($self, $name, $code) = @_;
if(my $old = $self->{around}->{$name})
{
# this is the craziest shit I have ever
# come up with.
$self->{around}->{$name} = sub {
my $orig = shift;
$code->(sub { $old->($orig, @_) }, @_);
};
}
else
{
$self->{around}->{$name} = $code;
}
}
sub after_hook
{
my($self, $name, $code) = @_;
$self->around_hook(
$name => sub {
my $orig = shift;
my $ret = $orig->(@_);
$code->(@_);
$ret;
}
);
}
sub before_hook
{
my($self, $name, $code) = @_;
$self->around_hook(
$name => sub {
my $orig = shift;
$code->(@_);
my $ret = $orig->(@_);
$ret;
}
);
}
sub call_hook
{
my $self = shift;
my %args = ref $_[0] ? %{ shift() } : ();
my($name, @args) = @_;
my $error;
my @hooks = @{ $self->{hook}->{$name} || []};
if(@hooks == 0)
{
if(defined $self->{default_hook}->{$name})
{
@hooks = ($self->{default_hook}->{$name})
}
elsif(!$args{all})
{
Carp::croak "No hooks registered for $name";
}
}
my $value;
foreach my $hook (@hooks)
{
if(eval { $args[0]->isa('Alien::Build') })
{
%{ $args[0]->{hook_prop} } = (
name => $name,
);
}
my $wrapper = $self->{around}->{$name} || sub { my $code = shift; $code->(@_) };
my $value;
$args{before}->() if $args{before};
if(ref($hook) eq 'CODE')
{
$value = eval {
my $value = $wrapper->(sub { $hook->(@_) }, @args);
$args{verify}->('code') if $args{verify};
$value;
};
}
else
{
$value = $wrapper->(sub {
eval {
$hook->execute(@_);
$args{verify}->('command') if $args{verify};
};
defined $args{ok} ? $args{ok} : 1;
}, @args);
}
$error = $@;
$args{after}->() if $args{after};
if($args{all})
{
die if $error;
}
else
{
next if $error;
next if $args{continue} && $args{continue}->($value);
return $value;
}
}
die $error if $error && ! $args{all};
$value;
}
sub apply_plugin
{
my($self, $name, @args) = @_;
my $class;
my $pm;
my $found;
if($name =~ /^=(.*)$/)
{
$class = $1;
$pm = "$class.pm";
$pm =~ s!::!/!g;
$found = 1;
}
if($name !~ /::/ && !$found)
{
foreach my $inc (@INC)
{
# TODO: allow negotiators to work with @INC hooks
next if ref $inc;
my $file = Path::Tiny->new("$inc/Alien/Build/Plugin/$name/Negotiate.pm");
if(-r $file)
{
$class = "Alien::Build::Plugin::${name}::Negotiate";
$pm = "Alien/Build/Plugin/$name/Negotiate.pm";
$found = 1;
last;
}
}
}
unless($found)
{
$class = "Alien::Build::Plugin::$name";
$pm = "Alien/Build/Plugin/$name.pm";
$pm =~ s{::}{/}g;
}
require $pm unless $class->can('new');
my $plugin = $class->new(@args);
$plugin->init($self);
$self;
}
package Alien::Build::TempDir;
# TODO: it's confusing that there is both a AB::TempDir and AB::Temp
# although they do different things. there could maybe be a better
# name for AB::TempDir (maybe AB::TempBuildDir, though that is a little
# redundant). Happily both are private classes, and either are able to
# rename, if a good name can be thought of.
use overload '""' => sub { shift->as_string }, bool => sub { 1 }, fallback => 1;
use File::Temp qw( tempdir );
sub new
{
my($class, $build, $name) = @_;
my $root = $build->install_prop->{root};
Path::Tiny->new($root)->mkpath unless -d $root;
bless {
dir => Path::Tiny->new(tempdir( "${name}_XXXX", DIR => $root)),
}, $class;
}
sub as_string
{
shift->{dir}->stringify;
}
sub DESTROY
{
my($self) = @_;
if(-d $self->{dir} && $self->{dir}->children == 0)
{
rmdir($self->{dir}) || warn "unable to remove @{[ $self->{dir} ]} $!";
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build - Build external dependencies for use in CPAN
=head1 VERSION
version 2.84
=head1 SYNOPSIS
my $build = Alien::Build->load('./alienfile');
$build->load_requires('configure');
$build->set_prefix('/usr/local');
$build->set_stage('/foo/mystage'); # needs to be absolute
$build->load_requires($build->install_type);
$build->download;
$build->build;
# files are now in /foo/mystage, it is your job (or
# ExtUtils::MakeMaker, Module::Build, etc) to copy
# those files into /usr/local
=head1 DESCRIPTION
This module provides tools for building external (non-CPAN) dependencies
for CPAN. It is mainly designed to be used at install time of a CPAN
client, and work closely with L<Alien::Base> which is used at runtime.
This is the detailed documentation for the L<Alien::Build> class.
If you are starting out you probably want to do so from one of these documents:
=over 4
=item L<Alien::Build::Manual::Alien>
A broad overview of C<Alien-Build> and its ecosystem.
=item L<Alien::Build::Manual::AlienUser>
For users of an C<Alien::libfoo> that is implemented using L<Alien::Base>.
(The developer of C<Alien::libfoo> I<should> provide the documentation
necessary, but if not, this is the place to start).
=item L<Alien::Build::Manual::AlienAuthor>
If you are writing your own L<Alien> based on L<Alien::Build> and L<Alien::Base>.
=item L<Alien::Build::Manual::FAQ>
If you have a common question that has already been answered, like
"How do I use L<alienfile> with some build system".
=item L<Alien::Build::Manual::PluginAuthor>
This is for the brave souls who want to write plugins that will work with
L<Alien::Build> + L<alienfile>.
=item L<Alien::Build::Manual::Security>
If you are concerned that L<Alien>s might be downloading tarballs off
the internet, then this is the place for you. This will discuss some
of the risks of downloading (really any) software off the internet
and will give you some tools to remediate these risks.
=back
Note that you will not usually create a L<Alien::Build> instance
directly, but rather be using a thin installer layer, such as
L<Alien::Build::MM> (for use with L<ExtUtils::MakeMaker>) or
L<Alien::Build::MB> (for use with L<Module::Build>). One of the
goals of this project is to remain installer agnostic.
=head1 CONSTRUCTORS
=head2 new
my $build = Alien::Build->new;
This creates a new empty instance of L<Alien::Build>. Normally you will
want to use C<load> below to create an instance of L<Alien::Build> from
an L<alienfile> recipe.
=head2 load
my $build = Alien::Build->load($alienfile);
This creates an L<Alien::Build> instance with the given L<alienfile>
recipe.
=head2 resume
my $build = Alien::Build->resume($alienfile, $root);
Load a checkpointed L<Alien::Build> instance. You will need the original
L<alienfile> and the build root (usually C<_alien>), and a build that
had been properly checkpointed using the C<checkpoint> method below.
=head1 PROPERTIES
There are three main properties for L<Alien::Build>. There are a number
of properties documented here with a specific usage. Note that these
properties may need to be serialized into something primitive like JSON
that does not support: regular expressions, code references of blessed
objects.
If you are writing a plugin (L<Alien::Build::Plugin>) you should use a
prefix like "plugin_I<name>" (where I<name> is the name of your plugin)
so that it does not interfere with other plugin or future versions of
L<Alien::Build>. For example, if you were writing
C<Alien::Build::Plugin::Fetch::NewProtocol>, please use the prefix
C<plugin_fetch_newprotocol>:
sub init
{
my($self, $meta) = @_;
$meta->prop( plugin_fetch_newprotocol_foo => 'some value' );
$meta->register_hook(
some_hook => sub {
my($build) = @_;
$build->install_prop->{plugin_fetch_newprotocol_bar} = 'some other value';
$build->runtime_prop->{plugin_fetch_newprotocol_baz} = 'and another value';
}
);
}
If you are writing a L<alienfile> recipe please use the prefix C<my_>:
use alienfile;
meta_prop->{my_foo} = 'some value';
probe sub {
my($build) = @_;
$build->install_prop->{my_bar} = 'some other value';
$build->install_prop->{my_baz} = 'and another value';
};
Any property may be used from a command:
probe [ 'some command %{.meta.plugin_fetch_newprotocol_foo}' ];
probe [ 'some command %{.install.plugin_fetch_newprotocol_bar}' ];
probe [ 'some command %{.runtime.plugin_fetch_newprotocol_baz}' ];
probe [ 'some command %{.meta.my_foo}' ];
probe [ 'some command %{.install.my_bar}' ];
probe [ 'some command %{.runtime.my_baz}' ];
=head2 meta_prop
my $href = $build->meta_prop;
my $href = Alien::Build->meta_prop;
Meta properties have to do with the recipe itself, and not any particular
instance that probes or builds that recipe. Meta properties can be changed
from within an L<alienfile> using the C<meta_prop> directive, or from
a plugin from its C<init> method (though should NOT be modified from any
hooks registered within that C<init> method). This is not strictly enforced,
but if you do not follow this rule your recipe will likely be broken.
=over
=item arch
This is a hint to an installer like L<Alien::Build::MM> or L<Alien::Build::MB>,
that the library or tool contains architecture dependent files and so should
be stored in an architecture dependent location. If not specified by your
L<alienfile> then it will be set to true.
=item check_digest
True if cryptographic digest should be checked when files are fetched
or downloaded. This is set by
L<Digest negotiator plugin|Alien::Build::Plugin::Digest::Negotiate>.
=item destdir
Some plugins (L<Alien::Build::Plugin::Build::Autoconf> for example) support
installing via C<DESTDIR>. They will set this property to true if they
plan on doing such an install. This helps L<Alien::Build> find the staged
install files and how to locate them.
If available, C<DESTDIR> is used to stage install files in a sub directory before
copying the files into C<blib>. This is generally preferred method
if available.
=item destdir_filter
Regular expression for the files that should be copied from the C<DESTDIR>
into the stage directory. If not defined, then all files will be copied.
=item destdir_ffi_filter
Same as C<destdir_filter> except applies to C<build_ffi> instead of C<build>.
=item digest
This properties contains the cryptographic digests (if any) that should
be used when verifying any fetched and downloaded files. It is a hash
reference where the key is the filename and the value is an array
reference containing a pair of values, the first being the algorithm
('SHA256' is recommended) and the second is the actual digest. The
special filename C<*> may be specified to indicate that any downloaded
file should match that digest. If there are both real filenames and
the C<*> placeholder, the real filenames will be used for filenames
that match and any other files will use the placeholder. Example:
$build->meta_prop->{digest} = {
'foo-1.00.tar.gz' => [ SHA256 => '9feac593aa49a44eb837de52513a57736457f1ea70078346c60f0bfc5f24f2c1' ],
'foo-1.01.tar.gz' => [ SHA256 => '6bbde6a7f10ae5924cf74afc26ff5b7bc4b4f9dfd85c6b534c51bd254697b9e7' ],
'*' => [ SHA256 => '33a20aae3df6ecfbe812b48082926d55391be4a57d858d35753ab1334b9fddb3' ],
};
Cryptographic signatures will only be checked
if the L<check_digest meta property|/check_digest> is set and if the
L<Digest negotiator plugin|Alien::Build::Plugin::Digest::Negotiate> is loaded.
(The Digest negotiator can be used directly, but is also loaded automatically
if you use the L<digest directive|alienfile/digest> is used by the L<alienfile>).
=item env
Environment variables to override during the build stage.
=item env_interpolate
Environment variable values will be interpolated with helpers. Example:
meta->prop->{env_interpolate} = 1;
meta->prop->{env}->{PERL} = '%{perl}';
=item local_source
Set to true if source code package is available locally. (that is not fetched
over the internet). This is computed by default based on the C<start_url>
property. Can be set by an L<alienfile> or plugin.
=item platform
Hash reference. Contains information about the platform beyond just C<$^O>.
=over 4
=item platform.compiler_type
Refers to the type of flags that the compiler accepts. May be expanded in the
future, but for now, will be one of:
=over 4
=item microsoft
On Windows when using Microsoft Visual C++
=item unix
Virtually everything else, including gcc on windows.
=back
The main difference is that with Visual C++ C<-LIBPATH> should be used instead
of C<-L>, and static libraries should have the C<.LIB> suffix instead of C<.a>.
=item platform.system_type
C<$^O> is frequently good enough to make platform specific logic in your
L<alienfile>, this handles the case when $^O can cover platforms that provide
multiple environments that Perl might run under. The main example is windows,
but others may be added in the future.
=over 4
=item unix
=item vms
=item windows-activestate
=item windows-microsoft
=item windows-mingw
=item windows-strawberry
=item windows-unknown
=back
Note that C<cygwin> and C<msys> are considered C<unix> even though they run
on windows!
=item platform.cpu.count
Contains a non-negative integer of available (possibly virtual) CPUs on the
system. This can be used by build plugins to build in parallel. The environment
variable C<ALIEN_CPU_COUNT> can be set to override the CPU count.
=item platform.cpu.arch.name
Contains a normalized name for the architecture of the current Perl. This can
be used by fetch plugins to determine which binary packages to download.
The value may be one of the following, but this list will be expanded as
needed.
=over 4
=item C<armel>
32-bit ARM soft-float
=item C<armhf>
32-bit ARM hard-float
=item C<aarch64>
64-bit ARM
=item C<ppc>
32-bit PowerPC (big-endian)
=item C<ppc64>
64-bit PowerPC (big-endian)
=item C<x86>
32-bit Intel (i386, i486, i686)
=item C<x86_64>
64-bit Intel (AMD64)
=item C<unknown>
Unable to detect architecture. Please report this if needed.
=back
=back
=item out_of_source
Build in a different directory from the where the source code is stored.
In autoconf this is referred to as a "VPATH" build. Everyone else calls this
an "out-of-source" build. When this property is true, instead of extracting
to the source build root, the downloaded source will be extracted to an source
extraction directory and the source build root will be empty. You can use the
C<extract> install property to get the location of the extracted source.
=item network
True if a network fetch is available. This should NOT be set by an L<alienfile>
or plugin. This is computed based on the C<ALIEN_INSTALL_NETWORK> environment
variables.
=item start_url
The default or start URL used by fetch plugins.
=back
=head2 install_prop
my $href = $build->install_prop;
Install properties are used during the install phase (either
under C<share> or C<system> install). They are remembered for
the entire install phase, but not kept around during the runtime
phase. Thus they cannot be accessed from your L<Alien::Base>
based module.
=over
=item autoconf_prefix
The prefix as understood by autoconf. This is only different on Windows
Where MSYS is used and paths like C<C:/foo> are represented as C</C/foo>
which are understood by the MSYS tools, but not by Perl. You should
only use this if you are using L<Alien::Build::Plugin::Build::Autoconf> in
your L<alienfile>. This is set during before the
L<build hook|Alien::Build::Manual::PluginAuthor/"build hook"> is run.
=item download
The location of the downloaded archive (tar.gz, or similar) or directory.
This will be undefined until the archive is actually downloaded.
=item download_detail
This property contains optional details about a downloaded file. This
property is populated by L<Alien::Build> core. This property is a
hash reference. The key is the path to the file that has been downloaded
and the value is a hash reference with additional detail. All fields
are optional.
=over 4
=item download_detail.digest
This, if available, with the cryptographic signature that was successfully
matched against the downloaded file. It is an array reference with a
pair of values, the algorithm (typically something like C<SHA256>) and
the digest.
=item download_detail.protocol
This, if available, will be the URL protocol used to fetch the downloaded
file.
=back
=item env
Environment variables to override during the build stage. Plugins are
free to set additional overrides using this hash.
=item extract
The location of the last source extraction. For a "out-of-source" build
(see the C<out_of_source> meta property above), this will only be set once.
For other types of builds, the source code may be extracted multiple times,
and thus this property may change.
=item old
[deprecated]
Hash containing information on a previously installed Alien of the same
name, if available. This may be useful in cases where you want to
reuse the previous install if it is still sufficient.
=over 4
=item old.prefix
[deprecated]
The prefix for the previous install. Versions prior to 1.42 unfortunately
had this in typo form of C<preifx>.
=item old.runtime
[deprecated]
The runtime properties from the previous install.
=back
=item patch
Directory with patches, if available. This will be C<undef> if there
are no patches. When initially installing an alien this will usually
be a sibling of the C<alienfile>, a directory called C<patch>. Once
installed this will be in the share directory called C<_alien/patch>.
The former is useful for rebuilding an alienized package using
L<af>.
=item prefix
The install time prefix. Under a C<destdir> install this is the
same as the runtime or final install location. Under a non-C<destdir>
install this is the C<stage> directory (usually the appropriate
share directory under C<blib>).
=item root
The build root directory. This will be an absolute path. It is the
absolute form of C<./_alien> by default.
=item stage
The stage directory where files will be copied. This is usually the
root of the blib share directory.
=item system_probe_class
After the probe step this property may contain the plugin class that
performed the system probe. It shouldn't be filled in directly by
the plugin (instead if should use the hook property C<probe_class>,
see below). This is optional, and not all probe plugins will provide
this information.
=item system_probe_instance_id
After the probe step this property may contain the plugin instance id that
performed the system probe. It shouldn't be filled in directly by
the plugin (instead if should use the hook property C<probe_instance_id>,
see below). This is optional, and not all probe plugins will provide
this information.
=back
=head2 plugin_instance_prop
my $href = $build->plugin_instance_prop($plugin);
This returns the private plugin instance properties for a given plugin.
This method should usually only be called internally by plugins themselves
to keep track of internal state. Because the content can be used arbitrarily
by the owning plugin because it is private to the plugin, and thus is not
part of the L<Alien::Build> spec.
=head2 runtime_prop
my $href = $build->runtime_prop;
Runtime properties are used during the install and runtime phases
(either under C<share> or C<system> install). This should include
anything that you will need to know to use the library or tool
during runtime, and shouldn't include anything that is no longer
relevant once the install process is complete.
=over 4
=item alien_build_version
The version of L<Alien::Build> used to install the library or tool.
=item alt
Alternate configurations. If the alienized package has multiple
libraries this could be used to store the different compiler or
linker flags for each library. Typically this will be set by a
plugin in the gather stage (for either share or system installs).
=item cflags
The compiler flags. This is typically set by a plugin in the
gather stage (for either share or system installs).
=item cflags_static
The static compiler flags. This is typically set by a plugin in the
gather stage (for either share or system installs).
=item command
The command name for tools where the name my differ from platform to
platform. For example, the GNU version of make is usually C<make> in
Linux and C<gmake> on FreeBSD. This is typically set by a plugin in the
gather stage (for either share or system installs).
=item ffi_name
The name DLL or shared object "name" to use when searching for dynamic
libraries at runtime. This is passed into L<FFI::CheckLib>, so if
your library is something like C<libarchive.so> or C<archive.dll> you
would set this to C<archive>. This may be a string or an array of
strings. This is typically set by a plugin in the gather stage
(for either share or system installs).
=item ffi_checklib
This property contains two sub properties:
=over 4
=item ffi_checklib.share
$build->runtime_prop->{ffi_checklib}->{share} = [ ... ];
Array of additional L<FFI::CheckLib> flags to pass in to C<find_lib>
for a C<share> install.
=item ffi_checklib.system
Array of additional L<FFI::CheckLib> flags to pass in to C<find_lib>
for a C<system> install.
Among other things, useful for specifying the C<try_linker_script>
flag:
$build->runtime_prop->{ffi_checklib}->{system} = [ try_linker_script => 1 ];
=back
This is typically set by a plugin in the gather stage
(for either share or system installs).
=item inline_auto_include
[version 2.53]
This property is an array reference of C code that will be passed into
L<Inline::C> to make sure that appropriate headers are automatically
included. See L<Inline::C/auto_include> for details.
=item install_type
The install type. This is set by AB core after the
L<probe hook|Alien::Build::Manual::PluginAuthor/"probe hook"> is
executed. Is one of:
=over 4
=item system
For when the library or tool is provided by the operating system, can be
detected by L<Alien::Build>, and is considered satisfactory by the
C<alienfile> recipe.
=item share
For when a system install is not possible, the library source will be
downloaded from the internet or retrieved in another appropriate fashion
and built.
=back
=item libs
The library flags. This is typically set by a plugin in the
gather stage (for either share or system installs).
=item libs_static
The static library flags. This is typically set by a plugin in the
gather stage (for either share or system installs).
=item perl_module_version
The version of the Perl module used to install the alien (if available).
For example if L<Alien::curl> is installing C<libcurl> this would be the
version of L<Alien::curl> used during the install step.
=item prefix
The final install root. This is usually they share directory.
=item version
The version of the library or tool. This is typically set by a plugin in the
gather stage (for either share or system installs).
=back
=head2 hook_prop
my $href = $build->hook_prop;
Hook properties are for the currently running (if any) hook. They are
used only during the execution of each hook and are discarded after.
If no hook is currently running then C<hook_prop> will return C<undef>.
=over 4
=item name
The name of the currently running hook.
=item version (probe)
Probe and PkgConfig plugins I<may> set this property indicating the
version of the alienized package. Not all plugins and configurations
may be able to provide this.
=item probe_class (probe)
Probe and PkgConfig plugins I<may> set this property indicating the
plugin class that made the probe. If the probe results in a system
install this will be propagated to C<system_probe_class> for later
use.
=item probe_instance_id (probe)
Probe and PkgConfig plugins I<may> set this property indicating the
plugin instance id that made the probe. If the probe results in a
system install this will be propagated to C<system_probe_instance_id>
for later use.
=back
=head1 METHODS
=head2 checkpoint
$build->checkpoint;
Save any install or runtime properties so that they can be reloaded on
a subsequent run in a separate process. This is useful if your build
needs to be done in multiple stages from a C<Makefile>, such as with
L<ExtUtils::MakeMaker>. Once checkpointed you can use the C<resume>
constructor (documented above) to resume the probe/build/install]
process.
=head2 root
my $dir = $build->root;
This is just a shortcut for:
my $root = $build->install_prop->{root};
Except that it will be created if it does not already exist.
=head2 install_type
my $type = $build->install_type;
This will return the install type. (See the like named install property
above for details). This method will call C<probe> if it has not already
been called.
=head2 is_system_install
my $boolean = $build->is_system_install;
Returns true if the alien is a system install type.
=head2 is_share_install
my $boolean = $build->is_share_install;
Returns true if the alien is a share install type.
=head2 download_rule
my $rule = $build->download_rule;
This returns install rule as a string. This is determined by the environment
and should be one of:
=over 4
=item C<warn>
Warn only if fetching via non secure source (secure sources include C<https>,
and bundled files, may include other encrypted protocols in the future).
=item C<digest>
Require that any downloaded source package have a cryptographic signature in
the L<alienfile> and that signature matches what was downloaded.
=item C<encrypt>
Require that any downloaded source package is fetched via secure source.
=item C<digest_or_encrypt>
Require that any downloaded source package is B<either> fetched via a secure source
B<or> has a cryptographic signature in the L<alienfile> and that signature matches
what was downloaded.
=item C<digest_and_encrypt>
Require that any downloaded source package is B<both> fetched via a secure source
B<and> has a cryptographic signature in the L<alienfile> and that signature matches
what was downloaded.
=back
The current default is C<warn>, but in the near future this will be upgraded to
C<digest_or_encrypt>.
=head2 set_prefix
$build->set_prefix($prefix);
Set the final (unstaged) prefix. This is normally only called by L<Alien::Build::MM>
and similar modules. It is not intended for use from plugins or from an L<alienfile>.
=head2 set_stage
$build->set_stage($dir);
Sets the stage directory. This is normally only called by L<Alien::Build::MM>
and similar modules. It is not intended for use from plugins or from an L<alienfile>.
=head2 requires
my $hash = $build->requires($phase);
Returns a hash reference of the modules required for the given phase. Phases
include:
=over 4
=item configure
These modules must already be available when the L<alienfile> is read.
=item any
These modules are used during either a C<system> or C<share> install.
=item share
These modules are used during the build phase of a C<share> install.
=item system
These modules are used during the build phase of a C<system> install.
=back
=head2 load_requires
$build->load_requires($phase);
This loads the appropriate modules for the given phase (see C<requires> above
for a description of the phases).
=head2 probe
my $install_type = $build->probe;
Attempts to determine if the operating system has the library or
tool already installed. If so, then the string C<system> will
be returned and a system install will be performed. If not,
then the string C<share> will be installed and the tool or
library will be downloaded and built from source.
If the environment variable C<ALIEN_INSTALL_TYPE> is set, then that
will force a specific type of install. If the detection logic
cannot accommodate the install type requested then it will fail with
an exception.
=head2 download
$build->download;
Download the source, usually as a tarball, usually from the internet.
Under a C<system> install this does not do anything.
=head2 fetch
my $res = $build->fetch;
my $res = $build->fetch($url, %options);
Fetch a resource using the fetch hook. Returns the same hash structure
described below in the
L<fetch hook|Alien::Build::Manual::PluginAuthor/"fetch hook"> documentation.
[version 2.39]
As of L<Alien::Build> 2.39, these options are supported:
=over 4
=item http_headers
my $res = $build->fetch($url, http_headers => [ $key1 => $value1, $key2 => $value 2, ... ]);
Set the HTTP request headers on all outgoing HTTP requests. Note that not all
protocols or fetch plugins support setting request headers, but the ones that
do not I<should> issue a warning if you try to set request headers and they
are not supported.
=back
=head2 check_digest
[experimental]
my $bool = $build->check_digest($path);
Checks any cryptographic signatures for the given file. The
file is specified by C<$path> which may be one of:
=over 4
=item string
Containing the path to the file to be checked.
=item L<Path::Tiny>
Containing the path to the file to be checked.
=item C<HASH>
A Hash reference containing information about a file. See
the L<fetch hook|Alien::Build::Manual::PluginAuthor/"fetch hook"> for details
on the format.
=back
Returns true if the cryptographic signature matches, false if cryptographic
signatures are disabled. Will throw an exception if the signature does not
match, or if no plugin provides the correct algorithm for checking the
signature.
=head2 decode
my $decoded_res = $build->decode($res);
Decode the HTML or file listing returned by C<fetch>. Returns the same
hash structure described below in the
L<decode hook|Alien::Build::Manual::PluginAuthor/"decode hook"> documentation.
=head2 prefer
my $sorted_res = $build->prefer($res);
Filter and sort candidates. The preferred candidate will be returned first in the list.
The worst candidate will be returned last. Returns the same hash structure described
below in the
L<prefer hook|Alien::Build::Manual::PluginAuthor/"prefer hook"> documentation.
=head2 extract
my $dir = $build->extract;
my $dir = $build->extract($archive);
Extracts the given archive into a fresh directory. This is normally called internally
to L<Alien::Build>, and for normal usage is not needed from a plugin or L<alienfile>.
=head2 build
$build->build;
Run the build step. It is expected that C<probe> and C<download>
have already been performed. What it actually does depends on the
type of install:
=over 4
=item share
The source is extracted, and built as determined by the L<alienfile>
recipe. If there is a C<gather_share> that will be executed last.
=item system
The
L<gather_system hook|Alien::Build::Manual::PluginAuthor/"gather_system hook">
will be executed.
=back
=head2 test
$build->test;
Run the test phase
=head2 clean_install
$build->clean_install
Clean files from the final install location. The default implementation removes all
files recursively except for the C<_alien> directory. This is helpful when you have
an old install with files that may break the new build.
For a non-share install this doesn't do anything.
=head2 system
$build->system($command);
$build->system($command, @args);
Interpolates the command and arguments and run the results using
the Perl C<system> command.
=head2 log
$build->log($message);
Send a message to the log. By default this prints to C<STDOUT>.
=head2 meta
my $meta = Alien::Build->meta;
my $meta = $build->meta;
Returns the meta object for your L<Alien::Build> class or instance. The
meta object is a way to manipulate the recipe, and so any changes to the
meta object should be made before the C<probe>, C<download> or C<build> steps.
=head1 META METHODS
=head2 prop
my $href = $build->meta->prop;
Meta properties. This is the same as calling C<meta_prop> on
the class or L<Alien::Build> instance.
=head2 add_requires
Alien::Build->meta->add_requires($phase, $module => $version, ...);
Add the requirement to the given phase. Phase should be one of:
=over 4
=item configure
=item any
=item share
=item system
=back
=head2 interpolator
my $interpolator = $build->meta->interpolator;
my $interpolator = Alien::Build->interpolator;
Returns the L<Alien::Build::Interpolate> instance for the L<Alien::Build> class.
=head2 has_hook
my $bool = $build->meta->has_hook($name);
my $bool = Alien::Build->has_hook($name);
Returns if there is a usable hook registered with the given name.
=head2 register_hook
$build->meta->register_hook($name, $instructions);
Alien::Build->meta->register_hook($name, $instructions);
Register a hook with the given name. C<$instruction> should be either
a code reference, or a command sequence, which is an array reference.
=head2 default_hook
$build->meta->default_hook($name, $instructions);
Alien::Build->meta->default_hook($name, $instructions);
Register a default hook, which will be used if the L<alienfile> does not
register its own hook with that name.
=head2 around_hook
$build->meta->around_hook($hook_name, $code);
Alien::Build->meta->around_hook($hook_name, $code);
Wrap the given hook with a code reference. This is similar to a L<Moose>
method modifier, except that it wraps around the given hook instead of
a method. For example, this will add a probe system requirement:
$build->meta->around_hook(
probe => sub {
my $orig = shift;
my $build = shift;
my $type = $orig->($build, @_);
return $type unless $type eq 'system';
# also require a configuration file
if(-f '/etc/foo.conf')
{
return 'system';
}
else
{
return 'share';
}
},
);
=head2 after_hook
$build->meta->after_hook($hook_name, sub {
my(@args) = @_;
...
});
Execute the given code reference after the hook. The original
arguments are passed into the code reference.
=head2 before_hook
$build->meta->before_hook($hook_name, sub {
my(@args) = @_;
...
});
Execute the given code reference before the hook. The original
arguments are passed into the code reference.
=head2 apply_plugin
Alien::Build->meta->apply_plugin($name);
Alien::Build->meta->apply_plugin($name, @args);
Apply the given plugin with the given arguments.
=head1 ENVIRONMENT
L<Alien::Build> responds to these environment variables:
=over 4
=item ALIEN_BUILD_LOG
The default log class used. See L<Alien::Build::Log> and L<Alien::Build::Log::Default>.
=item ALIEN_BUILD_PKG_CONFIG
Override the logic in L<Alien::Build::Plugin::PkgConfig::Negotiate> which
chooses the best C<pkg-config> plugin.
=item ALIEN_BUILD_POSTLOAD
semicolon separated list of plugins to automatically load after parsing
your L<alienfile>.
=item ALIEN_BUILD_PRELOAD
semicolon separated list of plugins to automatically load before parsing
your L<alienfile>.
=item ALIEN_BUILD_RC
Perl source file which can override some global defaults for L<Alien::Build>,
by, for example, setting preload and postload plugins.
=item ALIEN_DOWNLOAD_RULE
This value determines the rules by which types of downloads are allowed. The legal
values listed under L</download_rule>, plus C<default> which will be the default for
the current version of L<Alien::Build>. For this version that default is C<warn>.
=item ALIEN_INSTALL_NETWORK
If set to true (the default), then network fetch will be allowed. If set to
false, then network fetch will not be allowed.
What constitutes a local vs. network fetch is determined based on the C<start_url>
and C<local_source> meta properties. An L<alienfile> or plugin C<could> override
this detection (possibly inappropriately), so this variable is not a substitute
for properly auditing of Perl modules for environments that require that.
=item ALIEN_INSTALL_TYPE
If set to C<share> or C<system>, it will override the system detection logic.
If set to C<default>, it will use the default setting for the L<alienfile>.
The behavior of other values is undefined.
Although the recommended way for a consumer to use an L<Alien::Base> based L<Alien>
is to declare it as a static configure and build-time dependency, some consumers
may prefer to fallback on using an L<Alien> only when the consumer itself cannot
detect the necessary package. In some cases the consumer may want the user to opt-in
to using an L<Alien> before requiring it.
To keep the interface consistent among Aliens, the consumer of the fallback opt-in
L<Alien> may fallback on the L<Alien> if the environment variable C<ALIEN_INSTALL_TYPE>
is set to any value. The rationale is that by setting this environment variable the
user is aware that L<Alien> modules may be installed and have indicated consent.
The actual implementation of this, by its nature would have to be in the consuming
CPAN module.
=item DESTDIR
This environment variable will be manipulated during a destdir install.
=item PKG_CONFIG
This environment variable can be used to override the program name for C<pkg-config>
when using the command line plugin: L<Alien::Build::Plugin::PkgConfig::CommandLine>.
=item ftp_proxy, all_proxy
If these environment variables are set, it may influence the Download negotiation
plugin L<Alien::Build::Plugin::Download::Negotiate>. Other proxy variables may
be used by some Fetch plugins, if they support it.
=back
=head1 SUPPORT
The intent of the C<Alien-Build> team is to support the same versions of
Perl that are supported by the Perl toolchain. As of this writing that
means 5.16 and better.
Please feel encouraged to report issues that you encounter to the
project GitHub Issue tracker:
=over 4
=item L<https://github.com/PerlAlien/Alien-Build/issues>
=back
Better if you can fix the issue yourself, please feel encouraged to open
pull-request on the project GitHub:
=over 4
=item L<https://github.com/PerlAlien/Alien-Build/pulls>
=back
If you are confounded and have questions, join us on the C<#native>
channel on irc.perl.org. The C<Alien-Build> developers frequent this
channel and can probably help point you in the right direction. If you
don't have an IRC client handy, you can use this web interface:
=over 4
=item L<https://chat.mibbit.com/?channel=%23native&server=irc.perl.org>
=back
=head1 SEE ALSO
L<Alien::Build::Manual::AlienAuthor>,
L<Alien::Build::Manual::AlienUser>,
L<Alien::Build::Manual::Contributing>,
L<Alien::Build::Manual::FAQ>,
L<Alien::Build::Manual::PluginAuthor>
L<alienfile>, L<Alien::Build::MM>, L<Alien::Build::Plugin>, L<Alien::Base>, L<Alien>
=head1 THANKS
L<Alien::Base> was originally written by Joel Berger, the rest of this project would
not have been possible without him getting the project started. Thanks to his support
I have been able to augment the original L<Alien::Base> system with a reliable set
of tools (L<Alien::Build>, L<alienfile>, L<Test::Alien>), which make up this toolset.
The original L<Alien::Base> is still copyright (c) 2012-2020 Joel Berger. It has
the same license as the rest of the Alien::Build and related tools distributed as
C<Alien-Build>. Joel Berger thanked a number of people who helped in in the development
of L<Alien::Base>, in the documentation for that module.
I would also like to acknowledge the other members of the PerlAlien github
organization, Zakariyya Mughal (sivoais, ZMUGHAL) and mohawk (ETJ). Also important
in the early development of L<Alien::Build> were the early adopters Chase Whitener
(genio, CAPOEIRAB, author of L<Alien::libuv>), William N. Braswell, Jr (willthechill,
WBRASWELL, author of L<Alien::JPCRE2> and L<Alien::PCRE2>) and Ahmad Fatoum (a3f,
ATHREEF, author of L<Alien::libudev> and L<Alien::LibUSB>).
The Alien ecosystem owes a debt to Dan Book, who goes by Grinnz on IRC, for answering
question about how to use L<Alien::Build> and friends.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Util.pm 0000444 00000005651 15157554531 0010505 0 ustar 00 package Alien::Util;
use strict;
use warnings;
use Exporter qw( import );
# ABSTRACT: Alien Utilities used at build and runtime
our $VERSION = '2.84'; # VERSION
our @EXPORT_OK = qw( version_cmp );
# Sort::Versions isn't quite the same algorithm because it differs in
# behaviour with leading zeroes.
# See also https://dev.gentoo.org/~mgorny/pkg-config-spec.html#version-comparison
sub version_cmp {
my @x = (shift =~ m/([0-9]+|[a-z]+)/ig);
my @y = (shift =~ m/([0-9]+|[a-z]+)/ig);
while(@x and @y) {
my $x = shift @x; my $x_isnum = $x =~ m/[0-9]/;
my $y = shift @y; my $y_isnum = $y =~ m/[0-9]/;
if($x_isnum and $y_isnum) {
# Numerical comparison
return $x <=> $y if $x != $y;
}
elsif(!$x_isnum && !$y_isnum) {
# Alphabetic comparison
return $x cmp $y if $x ne $y;
}
else {
# Of differing types, the numeric one is newer
return $x_isnum - $y_isnum;
}
}
# Equal so far; the longer is newer
return @x <=> @y;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Util - Alien Utilities used at build and runtime
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use Alien::Util qw( version_cmp );
=head1 DESCRIPTION
This module contains some functions used by both the L<Alien::Build> build-time and <Alien::Base>
run-time for Alien.
=head2 version_cmp
$cmp = version_cmp($x, $y)
Comparison method used by L<Alien::Base/atleast_version>, L<Alien::Base/exact_version> and
L<Alien::Base/max_version>. May be useful to implement custom comparisons, or for
subclasses to overload to get different version comparison semantics than the
default rules, for packages that have some other rules than the F<pkg-config>
behaviour.
Should return a number less than, equal to, or greater than zero; similar in
behaviour to the C<< <=> >> and C<cmp> operators.
=head1 SEE ALSO
L<Alien::Base>, L<alienfile>, L<Alien::Build>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Role.pm 0000444 00000004414 15157554536 0010472 0 ustar 00 package Alien::Role;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Extend Alien::Base with roles!
our $VERSION = '2.84'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Role - Extend Alien::Base with roles!
=head1 VERSION
version 2.84
=head1 SYNOPSIS
package Alien::libfoo;
use parent qw( Alien::Base );
use Role::Tiny::With qw( with );
with 'Alien::Role::Dino';
1;
=head1 DESCRIPTION
The C<Alien::Role> namespace is intended for writing roles that can be
applied to L<Alien::Base> to extend its functionality. You could of
course write subclasses that extend L<Alien::Base>, but then you have
to either stick with just one subclass or deal with multiple inheritance!
It is recommended that you use L<Role::Tiny> since it can be used on
plain old Perl classes which is good since L<Alien::Base> doesn't use
anything fancy like L<Moose> or L<Moo>. There is one working example
that use this technique that are worth checking out in the event you
are interested: L<Alien::Role::Dino>.
This class itself doesn't do anything, it just documents the technique.
=head1 SEE ALSO
=over 4
=item L<Alien>
=item L<Alien::Base>
=item L<alienfile>
=item L<Alien::Build>
=item L<Alien::Role::Dino>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Base/PkgConfig.pm 0000444 00000011450 15157554551 0012305 0 ustar 00 package Alien::Base::PkgConfig;
use strict;
use warnings;
use 5.008004;
use Carp;
use Config;
use Path::Tiny qw( path );
use Capture::Tiny qw( capture_stderr );
# ABSTRACT: Private legacy pkg-config class for Alien::Base
our $VERSION = '2.84'; # VERSION
sub new {
my $class = shift;
# allow creation of an object from a full spec.
if (ref $_[0] eq 'HASH') {
return bless $_[0], $class;
}
my ($path) = @_;
croak "Must specify a file" unless defined $path;
$path = path( $path )->absolute;
my($name) = $path->basename =~ /^(.*)\.pc$/;
my $self = {
package => $name,
vars => { pcfiledir => $path->parent->stringify },
keywords => {},
};
bless $self, $class;
$self->read($path);
return $self;
}
sub read {
my $self = shift;
my ($path) = @_;
open my $fh, '<', $path
or croak "Cannot open .pc file $path: $!";
while (my $line = <$fh>) {
if ($line =~ /^([^=:]+?)=([^\n\r]*)/) {
$self->{vars}{$1} = $2;
} elsif ($line =~ /^([^=:]+?):\s*([^\n\r]*)/) {
$self->{keywords}{$1} = $2;
}
}
}
# getter/setter for vars
sub var {
my $self = shift;
my ($var, $newval) = @_;
if (defined $newval) {
$self->{vars}{$var} = $newval;
}
return $self->{vars}{$var};
}
# abstract keywords and other vars in terms of "pure" vars
sub make_abstract {
my $self = shift;
die "make_abstract needs a key (and possibly a value)" unless @_;
my ($var, $value) = @_;
$value = defined $value ? $value : $self->{vars}{$var};
# convert other vars
foreach my $key (keys %{ $self->{vars} }) {
next if $key eq $var; # don't overwrite the current var
$self->{vars}{$key} =~ s/\Q$value\E/\$\{$var\}/g;
}
# convert keywords
foreach my $key (keys %{ $self->{keywords} }) {
$self->{keywords}{$key} =~ s/\Q$value\E/\$\{$var\}/g;
}
}
sub _interpolate_vars {
my $self = shift;
my ($string, $override) = @_;
$override ||= {};
foreach my $key (keys %$override) {
carp "Overriden pkg-config variable $key, contains no data"
unless $override->{$key};
}
if (defined $string) {
1 while $string =~ s/\$\{(.*?)\}/$override->{$1} || $self->{vars}{$1}/e;
}
return $string;
}
sub keyword {
my $self = shift;
my ($keyword, $override) = @_;
{
no warnings 'uninitialized';
croak "overrides passed to 'keyword' must be a hashref"
if defined $override and ref $override ne 'HASH';
}
return $self->_interpolate_vars( $self->{keywords}{$keyword}, $override );
}
my $pkg_config_command;
sub pkg_config_command {
unless (defined $pkg_config_command) {
capture_stderr {
# For now we prefer PkgConfig.pm over pkg-config on
# Solaris 64 bit Perls. We may need to do this on
# other platforms, in which case this logic should
# be abstracted so that it can be shared here and
# in Build.PL
if (`pkg-config --version` && $? == 0 && !($^O eq 'solaris' && $Config{ptrsize} == 8)) {
$pkg_config_command = 'pkg-config';
} else {
require PkgConfig;
$pkg_config_command = "$^X $INC{'PkgConfig.pm'}";
}
}
}
$pkg_config_command;
}
sub TO_JSON
{
my($self) = @_;
my %hash = %$self;
$hash{'__CLASS__'} = ref($self);
\%hash;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Base::PkgConfig - Private legacy pkg-config class for Alien::Base
=head1 VERSION
version 2.84
=head1 DESCRIPTION
This class is used internally by L<Alien::Base> and L<Alien::Base::ModuleBuild>
to store information from pkg-config about installed Aliens. It is not used
internally by the newer L<alienfile> and L<Alien::Build>. It should never
be used externally, should not be used for code new inside of C<Alien-Build>.
=head1 SEE ALSO
=over
=item L<Alien::Base>
=item L<alienfile>
=item L<Alien::Build>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Base/FAQ.pod 0000444 00000003305 15157554556 0011220 0 ustar 00 # ABSTRACT: Frequently asked questions
# VERSION
# PODNAME: Alien::Base::FAQ
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Base::FAQ - Frequently asked questions
=head1 VERSION
version 2.84
=head1 SYNOPSIS
% perldoc Alien::Build::Manual::FAQ
% perldoc Alien::Base::ModuleBuild::FAQ
=head1 DESCRIPTION
This used to answer FAQs regarding the only way to author an L<Alien::Build>
distribution, which was with L<Alien::Base::ModuleBuild>. You should now
seriously consider using the newer more reliable method which is via
L<Alien::Build> and L<alienfile>.
=over 4
=item L<Alien::Build::Manual::FAQ>
=item L<Alien::Base::ModuleBuild::FAQ>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Base/Wrapper.pm 0000444 00000032325 15157554564 0012066 0 ustar 00 package Alien::Base::Wrapper;
use strict;
use warnings;
use 5.006;
use Config;
use Text::ParseWords qw( shellwords );
# NOTE: Although this module is now distributed with Alien-Build,
# it should have NO non-perl-core dependencies for all Perls
# 5.6.0-5.30.1 (as of this writing, and any Perl more recent).
# You should be able to extract this module from the rest of
# Alien-Build and use it by itself. (There is a dzil plugin
# for this [AlienBase::Wrapper::Bundle]
# ABSTRACT: Compiler and linker wrapper for Alien
our $VERSION = '2.84'; # VERSION
sub _join
{
join ' ',
map {
my $x = $_;
$x =~ s/(\s)/\\$1/g;
$x;
} @_;
}
sub new
{
my($class, @aliens) = @_;
my $export = 1;
my $writemakefile = 0;
my @cflags_I;
my @cflags_other;
my @ldflags_L;
my @ldflags_l;
my @ldflags_other;
my %requires = (
'ExtUtils::MakeMaker' => '6.52',
'Alien::Base::Wrapper' => '1.97',
);
foreach my $alien (@aliens)
{
if($alien eq '!export')
{
$export = 0;
next;
}
if($alien eq 'WriteMakefile')
{
$writemakefile = 1;
next;
}
my $version = 0;
if($alien =~ s/=(.*)$//)
{
$version = $1;
}
$alien = "Alien::$alien" unless $alien =~ /::/;
$requires{$alien} = $version;
my $alien_pm = $alien . '.pm';
$alien_pm =~ s/::/\//g;
require $alien_pm unless eval { $alien->can('cflags') } && eval { $alien->can('libs') };
my $cflags;
my $libs;
if($alien->install_type eq 'share' && $alien->can('cflags_static'))
{
$cflags = $alien->cflags_static;
$libs = $alien->libs_static;
}
else
{
$cflags = $alien->cflags;
$libs = $alien->libs;
}
$cflags = '' unless defined $cflags;
$libs = '' unless defined $libs;
push @cflags_I, grep /^-I/, shellwords $cflags;
push @cflags_other, grep !/^-I/, shellwords $cflags;
push @ldflags_L, grep /^-L/, shellwords $libs;
push @ldflags_l, grep /^-l/, shellwords $libs;
push @ldflags_other, grep !/^-[Ll]/, shellwords $libs;
}
my @cflags_define = grep /^-D/, @cflags_other;
my @cflags_other2 = grep !/^-D/, @cflags_other;
my @mm;
push @mm, INC => _join @cflags_I if @cflags_I;
push @mm, CCFLAGS => _join(@cflags_other2) . " $Config{ccflags}" if @cflags_other2;
push @mm, DEFINE => _join(@cflags_define) if @cflags_define;
# TODO: handle spaces in -L paths
push @mm, LIBS => ["@ldflags_L @ldflags_l"];
my @ldflags = (@ldflags_L, @ldflags_other);
push @mm, LDDLFLAGS => _join(@ldflags) . " $Config{lddlflags}" if @ldflags;
push @mm, LDFLAGS => _join(@ldflags) . " $Config{ldflags}" if @ldflags;
my @mb;
push @mb, extra_compiler_flags => _join(@cflags_I, @cflags_other);
push @mb, extra_linker_flags => _join(@ldflags_l);
if(@ldflags)
{
push @mb, config => {
lddlflags => _join(@ldflags) . " $Config{lddlflags}",
ldflags => _join(@ldflags) . " $Config{ldflags}",
},
}
bless {
cflags_I => \@cflags_I,
cflags_other => \@cflags_other,
ldflags_L => \@ldflags_L,
ldflags_l => \@ldflags_l,
ldflags_other => \@ldflags_other,
mm => \@mm,
mb => \@mb,
_export => $export,
_writemakefile => $writemakefile,
requires => \%requires,
}, $class;
}
my $default_abw = __PACKAGE__->new;
# for testing only
sub _reset { __PACKAGE__->new }
sub _myexec
{
my @command = @_;
if($^O eq 'MSWin32')
{
# To handle weird quoting on MSWin32
# this logic needs to be improved.
my $command = "@command";
$command =~ s{"}{\\"}g;
system $command;
if($? == -1 )
{
die "failed to execute: $!\n";
}
elsif($? & 127)
{
die "child died with signal @{[ $? & 128 ]}";
}
else
{
exit($? >> 8);
}
}
else
{
exec @command;
}
}
sub cc
{
my @command = (
shellwords($Config{cc}),
@{ $default_abw->{cflags_I} },
@{ $default_abw->{cflags_other} },
@ARGV,
);
print "@command\n" unless $ENV{ALIEN_BASE_WRAPPER_QUIET};
_myexec @command;
}
sub ld
{
my @command = (
shellwords($Config{ld}),
@{ $default_abw->{ldflags_L} },
@{ $default_abw->{ldflags_other} },
@ARGV,
@{ $default_abw->{ldflags_l} },
);
print "@command\n" unless $ENV{ALIEN_BASE_WRAPPER_QUIET};
_myexec @command;
}
sub mm_args
{
my $self = ref $_[0] ? shift : $default_abw;
@{ $self->{mm} };
}
sub mm_args2
{
my $self = shift;
$self = $default_abw unless ref $self;
my %args = @_;
my @mm = @{ $self->{mm} };
while(@mm)
{
my $key = shift @mm;
my $value = shift @mm;
if(defined $args{$key})
{
if($args{$key} eq 'LIBS')
{
require Carp;
# Todo: support this maybe?
Carp::croak("please do not specify your own LIBS key with mm_args2");
}
else
{
$args{$key} = join ' ', $value, $args{$key};
}
}
else
{
$args{$key} = $value;
}
}
foreach my $module (keys %{ $self->{requires} })
{
$args{CONFIGURE_REQUIRES}->{$module} = $self->{requires}->{$module};
}
%args;
}
sub mb_args
{
my $self = ref $_[0] ? shift : $default_abw;
@{ $self->{mb} };
}
sub import
{
shift;
my $abw = $default_abw = __PACKAGE__->new(@_);
if($abw->_export)
{
my $caller = caller;
no strict 'refs';
*{"${caller}::cc"} = \&cc;
*{"${caller}::ld"} = \&ld;
}
if($abw->_writemakefile)
{
my $caller = caller;
no strict 'refs';
*{"${caller}::WriteMakefile"} = \&WriteMakefile;
}
}
sub WriteMakefile
{
my %args = @_;
require ExtUtils::MakeMaker;
ExtUtils::MakeMaker->VERSION('6.52');
my @aliens;
if(my $reqs = delete $args{alien_requires})
{
if(ref $reqs eq 'HASH')
{
@aliens = map {
my $module = $_;
my $version = $reqs->{$module};
$version ? "$module=$version" : "$module";
} sort keys %$reqs;
}
elsif(ref $reqs eq 'ARRAY')
{
@aliens = @$reqs;
}
else
{
require Carp;
Carp::croak("aliens_require must be either a hash or array reference");
}
}
else
{
require Carp;
Carp::croak("You are using Alien::Base::Wrapper::WriteMakefile, but didn't specify any alien requirements");
}
ExtUtils::MakeMaker::WriteMakefile(
Alien::Base::Wrapper->new(@aliens)->mm_args2(%args),
);
}
sub _export { shift->{_export} }
sub _writemakefile { shift->{_writemakefile} }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Base::Wrapper - Compiler and linker wrapper for Alien
=head1 VERSION
version 2.84
=head1 SYNOPSIS
From the command line:
% perl -MAlien::Base::Wrapper=Alien::Foo,Alien::Bar -e cc -- -o foo.o -c foo.c
% perl -MAlien::Base::Wrapper=Alien::Foo,Alien::Bar -e ld -- -o foo foo.o
From Makefile.PL (static):
use ExtUtils::MakeMaker;
use Alien::Base::Wrapper ();
WriteMakefile(
Alien::Base::Wrapper->new( 'Alien::Foo', 'Alien::Bar')->mm_args2(
'NAME' => 'Foo::XS',
'VERSION_FROM' => 'lib/Foo/XS.pm',
),
);
From Makefile.PL (static with wrapper)
use Alien::Base::Wrapper qw( WriteMakefile);
WriteMakefile(
'NAME' => 'Foo::XS',
'VERSION_FROM' => 'lib/Foo/XS.pm',
'alien_requires' => {
'Alien::Foo' => 0,
'Alien::Bar' => 0,
},
);
From Makefile.PL (dynamic):
use Devel::CheckLib qw( check_lib );
use ExtUtils::MakeMaker 6.52;
my @mm_args;
my @libs;
if(check_lib( lib => [ 'foo' ] )
{
push @mm_args, LIBS => [ '-lfoo' ];
}
else
{
push @mm_args,
CC => '$(FULLPERL) -MAlien::Base::Wrapper=Alien::Foo -e cc --',
LD => '$(FULLPERL) -MAlien::Base::Wrapper=Alien::Foo -e ld --',
BUILD_REQUIRES => {
'Alien::Foo' => 0,
'Alien::Base::Wrapper' => 0,
}
;
}
WriteMakefile(
'NAME' => 'Foo::XS',
'VERSION_FROM' => 'lib/Foo/XS.pm',
'CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => 6.52,
},
@mm_args,
);
=head1 DESCRIPTION
This module acts as a wrapper around one or more L<Alien> modules. It is designed to work
with L<Alien::Base> based aliens, but it should work with any L<Alien> which uses the same
essential API.
In the first example (from the command line), this class acts as a wrapper around the
compiler and linker that Perl is configured to use. It takes the normal compiler and
linker flags and adds the flags provided by the Aliens specified, and then executes the
command. It will print the command to the console so that you can see exactly what is
happening.
In the second example (from Makefile.PL non-dynamic), this class is used to generate the
appropriate L<ExtUtils::MakeMaker> (EUMM) arguments needed to C<WriteMakefile>.
In the third example (from Makefile.PL dynamic), we do a quick check to see if the simple
linker flag C<-lfoo> will work, if so we use that. If not, we use a wrapper around the
compiler and linker that will use the alien flags that are known at build time. The
problem that this form attempts to solve is that compiler and linker flags typically
need to be determined at I<configure> time, when a distribution is installed, meaning
if you are going to use an L<Alien> module then it needs to be a configure prerequisite,
even if the library is already installed and easily detected on the operating system.
The author of this module believes that the third (from Makefile.PL dynamic) form is
somewhat unnecessary. L<Alien> modules based on L<Alien::Base> have a few prerequisites,
but they are well maintained and reliable, so while there is a small cost in terms of extra
dependencies, the overall reliability thanks to reduced overall complexity.
=head1 CONSTRUCTOR
=head2 new
my $abw = Alien::Base::Wrapper->new(@aliens);
Instead of passing the aliens you want to use into this modules import you can create
a non-global instance of C<Alien::Base::Wrapper> using the OO interface.
=head1 FUNCTIONS
=head2 cc
% perl -MAlien::Base::Wrapper=Alien::Foo -e cc -- cflags
Invoke the C compiler with the appropriate flags from C<Alien::Foo> and what
is provided on the command line.
=head2 ld
% perl -MAlien::Base::Wrapper=Alien::Foo -e ld -- ldflags
Invoke the linker with the appropriate flags from C<Alien::Foo> and what
is provided on the command line.
=head2 mm_args
my %args = $abw->mm_args;
my %args = Alien::Base::Wrapper->mm_args;
Returns arguments that you can pass into C<WriteMakefile> to compile/link against
the specified Aliens. Note that this does not set C<CONFIGURE_REQUIRES>. You
probably want to use C<mm_args2> below instead for that reason.
=head2 mm_args2
my %args = $abw->mm_args2(%args);
my %args = Alien::Base::Wrapper->mm_args2(%args);
Returns arguments that you can pass into C<WriteMakefile> to compile/link against. It works
a little differently from C<mm_args> above in that you can pass in arguments. It also adds
the appropriate C<CONFIGURE_REQUIRES> for you so you do not have to do that explicitly.
=head2 mb_args
my %args = $abw->mb_args;
my %args = Alien::Base::Wrapper->mb_args;
Returns arguments that you can pass into the constructor to L<Module::Build>.
=head2 WriteMakefile
use Alien::Base::Wrapper qw( WriteMakefile );
WriteMakefile(%args, alien_requires => \%aliens);
WriteMakefile(%args, alien_requires => \@aliens);
This is a thin wrapper around C<WriteMakefile> from L<ExtUtils::MakeMaker>, which adds the
given aliens to the configure requirements and sets the appropriate compiler and linker
flags.
If the aliens are specified as a hash reference, then the keys are the module names and the
values are the versions. For a list it is just the name of the aliens.
For the list form you can specify a version by appending C<=version> to the name of the
Aliens, that is:
WriteMakefile(
alien_requires => [ 'Alien::libfoo=1.23', 'Alien::libbar=4.56' ],
);
The list form is recommended if the ordering of the aliens matter. The aliens are sorted in
the hash form to make it consistent, but it may not be the order that you want.
=head1 ENVIRONMENT
Alien::Base::Wrapper responds to these environment variables:
=over 4
=item ALIEN_BASE_WRAPPER_QUIET
If set to true, do not print the command before executing
=back
=head1 SEE ALSO
L<Alien::Base>, L<Alien::Base>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Base/Authoring.pod 0000444 00000003370 15157554571 0012550 0 ustar 00 # ABSTRACT: Authoring an Alien distribution using Alien::Base
# PODNAME: Alien::Base::Authoring
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Base::Authoring - Authoring an Alien distribution using Alien::Base
=head1 VERSION
version 2.84
=head1 SYNOPSIS
% perldoc Alien::Build::Manual::AlienAuthor
% perldoc Alien::Base::ModuleBuild::Authoring
=head1 DESCRIPTION
This used to document the only way to author an L<Alien> distribution, which
was with L<Alien::Base::ModuleBuild>. You should now seriously consider using
the newer more reliable method which is via L<Alien::Build> and L<alienfile>. Read all about it in L<Alien::Build::Manual::AlienAuthor> and L<Alien::Base::ModuleBuild::Authoring>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/CommandSequence.pm 0000444 00000011655 15157554603 0013677 0 ustar 00 package Alien::Build::CommandSequence;
use strict;
use warnings;
use 5.008004;
use Text::ParseWords qw( shellwords );
use Capture::Tiny qw( capture );
# ABSTRACT: Alien::Build command sequence
our $VERSION = '2.84'; # VERSION
sub new
{
my($class, @commands) = @_;
my $self = bless {
commands => \@commands,
}, $class;
$self;
}
sub apply_requirements
{
my($self, $meta, $phase) = @_;
my $intr = $meta->interpolator;
foreach my $command (@{ $self->{commands} })
{
next if ref $command eq 'CODE';
if(ref $command eq 'ARRAY')
{
foreach my $arg (@$command)
{
next if ref $arg eq 'CODE';
$meta->add_requires($phase, $intr->requires($arg))
}
}
else
{
$meta->add_requires($phase, $intr->requires($command));
}
}
$self;
}
my %built_in = (
cd => sub {
my(undef, $dir) = @_;
if(!defined $dir)
{
die "undef passed to cd";
}
elsif(-d $dir)
{
chdir($dir) || die "unable to cd $dir $!";
}
else
{
die "unable to cd $dir, does not exist";
}
},
);
sub _run_list
{
my($build, @cmd) = @_;
$build->log("+ @cmd");
return $built_in{$cmd[0]}->(@cmd) if $built_in{$cmd[0]};
system @cmd;
die "external command failed" if $?;
}
sub _run_string
{
my($build, $cmd) = @_;
$build->log("+ $cmd");
{
my $cmd = $cmd;
$cmd =~ s{\\}{\\\\}g if $^O eq 'MSWin32';
my @cmd = shellwords($cmd);
return $built_in{$cmd[0]}->(@cmd) if $built_in{$cmd[0]};
}
system $cmd;
die "external command failed" if $?;
}
sub _run_with_code
{
my($build, @cmd) = @_;
my $code = pop @cmd;
$build->log("+ @cmd");
my %args = ( command => \@cmd );
if($built_in{$cmd[0]})
{
my $error;
($args{out}, $args{err}, $error) = capture {
eval { $built_in{$cmd[0]}->(@cmd) };
$@;
};
$args{exit} = $error eq '' ? 0 : 2;
$args{builtin} = 1;
}
else
{
($args{out}, $args{err}, $args{exit}) = capture {
system @cmd; $?
};
}
$build->log("[output consumed by Alien::Build recipe]");
$code->($build, \%args);
}
sub _apply
{
my($where, $prop, $value) = @_;
if($where =~ /^(.*?)\.(.*?)$/)
{
_apply($2, $prop->{$1}, $value);
}
else
{
$prop->{$where} = $value;
}
}
sub execute
{
my($self, $build) = @_;
my $intr = $build->meta->interpolator;
foreach my $command (@{ $self->{commands} })
{
if(ref($command) eq 'CODE')
{
$command->($build);
}
elsif(ref($command) eq 'ARRAY')
{
my($command, @args) = @$command;
my $code;
$code = pop @args if $args[-1] && ref($args[-1]) eq 'CODE';
if($args[-1] && ref($args[-1]) eq 'SCALAR')
{
my $dest = ${ pop @args };
if($dest =~ /^\%\{((?:alien|)\.(?:install|runtime|hook)\.[a-z\.0-9_]+)\}$/)
{
$dest = $1;
$dest =~ s/^\./alien./;
$code = sub {
my($build, $args) = @_;
die "external command failed" if $args->{exit};
my $out = $args->{out};
chomp $out;
_apply($dest, $build->_command_prop, $out);
};
}
else
{
die "illegal destination: $dest";
}
}
($command, @args) = map { $intr->interpolate($_, $build) } ($command, @args);
if($code)
{
_run_with_code $build, $command, @args, $code;
}
else
{
_run_list $build, $command, @args;
}
}
else
{
my $command = $intr->interpolate($command, $build);
_run_string $build, $command;
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::CommandSequence - Alien::Build command sequence
=head1 VERSION
version 2.84
=head1 CONSTRUCTOR
=head2 new
my $seq = Alien::Build::CommandSequence->new(@commands);
=head1 METHODS
=head2 apply_requirements
$seq->apply_requirements($meta, $phase);
=head2 execute
$seq->execute($build);
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Util.pm 0000444 00000011504 15157554610 0011534 0 ustar 00 package Alien::Build::Util;
use strict;
use warnings;
use 5.008004;
use Exporter qw( import );
use Path::Tiny qw( path );
use Config;
# ABSTRACT: Private utility functions for Alien::Build
our $VERSION = '2.84'; # VERSION
our @EXPORT_OK = qw( _mirror _dump _destdir_prefix _perl_config _ssl_reqs _has_ssl );
# usage: _mirror $source_directory, $dest_direction, \%options
#
# options:
# - filter -> regex for files that should match
# - empty_directory -> if true, create all directories, including empty ones.
# - verbose -> turn on verbosity
sub _mirror
{
my($src_root, $dst_root, $opt) = @_;
($src_root, $dst_root) = map { path($_) } ($src_root, $dst_root);
$opt ||= {};
require Alien::Build;
require File::Find;
require File::Copy;
File::Find::find({
wanted => sub {
next unless -e $File::Find::name;
my $src = path($File::Find::name)->relative($src_root);
return if $opt->{filter} && "$src" !~ $opt->{filter};
return if "$src" eq '.';
my $dst = $dst_root->child("$src");
$src = $src->absolute($src_root);
if(-l "$src")
{
unless(-d $dst->parent)
{
Alien::Build->log("mkdir -p @{[ $dst->parent ]}") if $opt->{verbose};
$dst->parent->mkpath;
}
# TODO: rmtree if a directory?
if(-e "$dst")
{ unlink "$dst" }
my $target = readlink "$src";
Alien::Build->log("ln -s $target $dst") if $opt->{verbose};
symlink($target, $dst) || die "unable to symlink $target => $dst";
}
elsif(-d "$src")
{
if($opt->{empty_directory})
{
unless(-d $dst)
{
Alien::Build->log("mkdir $dst") if $opt->{verbose};
mkdir($dst) || die "unable to create directory $dst: $!";
}
}
}
elsif(-f "$src")
{
unless(-d $dst->parent)
{
Alien::Build->log("mkdir -p @{[ $dst->parent ]}") if $opt->{verbose};
$dst->parent->mkpath;
}
# TODO: rmtree if a directory?
if(-e "$dst")
{ unlink "$dst" }
Alien::Build->log("cp $src $dst") if $opt->{verbose};
File::Copy::cp("$src", "$dst") || die "copy error $src => $dst: $!";
if($] < 5.012 && -x "$src" && $^O ne 'MSWin32')
{
# apparently Perl 5.8 and 5.10 do not preserver perms
my $mode = [stat "$src"]->[2] & oct(777);
eval { chmod $mode, "$dst" };
}
}
},
no_chdir => 1,
}, "$src_root");
();
}
sub _dump
{
if(eval { require YAML })
{
return YAML::Dump(@_);
}
else
{
require Data::Dumper;
return Data::Dumper::Dumper(@_);
}
}
sub _destdir_prefix
{
my($destdir, $prefix) = @_;
$prefix =~ s{^/?([a-z]):}{$1}i if $^O eq 'MSWin32';
path($destdir)->child($prefix)->stringify;
}
sub _perl_config
{
my($key) = @_;
$Config{$key};
}
sub _ssl_reqs
{
return {
'Net::SSLeay' => '1.49',
'IO::Socket::SSL' => '1.56',
};
}
sub _has_ssl
{
my %reqs = %{ _ssl_reqs() };
eval {
require Net::SSLeay;
die "need Net::SSLeay $reqs{'Net::SSLeay'}" unless Net::SSLeay->VERSION($reqs{'Net::SSLeay'});
require IO::Socket::SSL;
die "need IO::Socket::SSL $reqs{'IO::Socket::SSL'}" unless IO::Socket::SSL->VERSION($reqs{'IO::Socket::SSL'});
};
$@ eq '';
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Util - Private utility functions for Alien::Build
=head1 VERSION
version 2.84
=head1 DESCRIPTION
This module contains some private utility functions used internally by
L<Alien::Build>. It shouldn't be used by any distribution other than
C<Alien-Build>. That includes L<Alien::Build> plugins that are not
part of the L<Alien::Build> core.
You have been warned. The functionality within may be removed at
any time!
=head1 SEE ALSO
L<Alien::Build>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual/Security.pod 0000444 00000021323 15157554623 0014015 0 ustar 00 # PODNAME: Alien::Build::Manual::Security
# ABSTRACT: General alien author documentation
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual::Security - General alien author documentation
=head1 VERSION
version 2.84
=head1 SYNOPSIS
perldoc Alien::Build::Manual::Security
=head1 DESCRIPTION
You are rightly concerned that an L<Alien> might be downloading something random
off the internet. This manual will describe some of the real risks and go over
how you can mitigate them.
=head2 no warranty
L<Alien::Build> provides L<Alien> authors with tools to add external non-Perl
dependencies to CPAN modules. It is open source software that is entirely
volunteer driven, meaning the people writing this software are not getting
compensated monetarily for the work. As such, we do our best not to
intentionally introduce security vulnerabilities into our modules, or their
dependencies. But it is also not our responsibility either. If you are
operating in an environment where you need absolute security, you need to
carefully audit I<all> of the software that you use.
=head2 L<Alien::Build> vs. L<CPAN>
I suppose you could argue that L<Alien::Build> based L<Alien>s and L<Alien>s
in general are inherently less secure than the the Perl modules on L<CPAN>
that don't download random stuff off the internet. Worse yet, L<Alien>s
might be downloading from insecure sources like C<http> or C<ftp>.
This argument falls apart pretty quickly when you realize that
=over 4
=item 1
Perl modules from L<CPAN> are in fact random stuff off the internet.
Most modules, when installed execute a C<Makefile.PL> which can execute
completely arbitrary Perl code. Without a proper audit or firewalls
that L<CPAN> code could be making connections to insecure sources
like C<http> if they are not themselves doing something nefarious.
=item 2
By default, the most frequently used L<CPAN> client L<App::cpanminus|cpanm>
uses C<http> to fetch L<CPAN> modules. So unless you have specifically
configured it to connect to a secure source you are downloading
even more random stuff than usual off the internet.
=back
The TL;DR is that if you are using a Perl module, whether it be
C<Foo::PP>, C<Foo::XS> or C<Alien::libfoo> and you are concerned about
security you need to audit all of your Perl modules, not just the L<Alien>
ones.
=head2 Restricting L<Alien::Build> by environment
Okay, granted you need to audit software for security regardless of
if it is L<Alien>, you still don't like the idea of downloading external
dependencies and you can't firewall just the L<CPAN> module installs.
L<Alien::Build> based L<Alien>s respect a number of environment variables
that at least give you some control over how aggresive L<Alien::Build>
will be at fetching random stuff off the internet.
=over 4
=item C<ALIEN_DOWNLOAD_RULE>
This environment variable configures how L<Alien::Build> will deal
with insecure protocols and files that do not include a cryptographic
signature.
Part of the design of the L<Alien::Build> system is that it typically
tries to download the latest version of a package instead of a fixed
version, so that the L<Alien> doesn't need to be updated when a new
alienized package is released. This means that we frequently have
to rely on TLS or bundled alienized packages to ensure that the
alienized package is fetched securely.
Recently (as of L<Alien::Build> 2.59) we started supporting cryptographic
signatures defined in L<alienfile>s, but they are not yet very common,
and they only really work when a single alienized package URL is hard
coded into the L<alienfile> instead of the more typical mode of operation
where the latest version is downloaded.
=over 4
=item warn
This mode will warn you if an L<Alien::Build> based L<Alien> attempts
to fetch a alienized package insecurely. It will also warn you if
a package doesn't have a cryptographic signature. Neither of these
things wild stop the L<Alien> from being installed.
This is unfortunately currently the default mode of L<Alien::Build>,
for historical reasons. Once plugins and L<Alien>s are updated to
either use secure fetch (TLS or bundled alienized packages), or
cryptographic signatures, the default will be changed to
C<digest_or_encrypt>.
=item digest_or_encrypt
This mode will require that before an alienized package is extracted
that it is either fetched via a secure protocol (C<http> or C<file>),
or the package matches a cryptographic signature.
This will likely be the default for L<Alien::Build> in the near future,
but it doesn't hurt to set it now, if you don't mind submitting
tickets to L<Alien>s or L<plugins|Alien::Build::Plugin> that don't
support this mode yet.
=back
=item C<ALIEN_INSTALL_NETWORK>
By design L<Alien>s should use local installs of libraries and tools
before downloading source from the internet. Setting this environment
variable to false, will instruct L<Alien::Build> to not attempt to
fetch the alienized package off the internet if it is not available
locally or as a bundled package.
This is similar to setting C<ALIEN_INSTALL_TYPE> to C<system> (see
below), except it does allow L<Alien>s that bundle their alienized
package inside the L<CPAN> package tarball.
Some L<Alien>s will not install properly at first, but when they error
you can install the system package and try to re-install the L<Alien>.
=item C<ALIEN_INSTALL_TYPE>
Setting C<ALIEN_INSTALL_TYPE> to C<system> is similar to setting
C<ALIEN_INSTALL_NETWORK> to false, except that bundled alienized
packages will also be rejected. This environment variable is really
intended for use by operating system vendors packaging L<Alien>s,
or for L<Alien> developer testing (in CI for example). For some
who want to restrict how L<Alien>s install this might be the right
tool to reach for.
=back
Note that this is definitely best effort. If the L<Alien> author makes
a mistake or is malicious they could override these environment variables
inside the C<Makefile.PL>, so you still need to audit any software to
ensure that it doesn't fetch source off the internet.
=head2 Security Related Plugins
There are a number of plugins that give the user or installer control
over how L<Alien::Build> behaves, and may be useful for rudimentary
security.
=over 4
=item L<Alien::Build::Plugin::Fetch::Prompt>
This plugin will prompt before fetching any remote files. This only
really works when you are installing L<Alien>s interactively.
=item L<Alien::Build::Plugin::Fetch::HostAllowList>
This plugin will only allow fetching from hosts that are in an allow list.
=item L<Alien::Build::Plugin::Fetch::HostBlockList>
This plugin will not allow fetching from hosts that are in a block list.
=item L<Alien::Build::Plugin::Fetch::Rewrite>
This plugin can re-write fetched URLs before the request is made. This
can be useful if you have a local mirror of certain sources that you
want to use instead of fetching from the wider internet.
=item L<Alien::Build::Plugin::Probe::Override>
This plugin can override the C<ALIEN_INSTALL_TYPE> on a perl-Alien basis.
This can be useful if you want to install some L<Alien>s in C<share>
mode, but generally want to enforce C<system> mode.
=back
=head2 local configuration
You can configure the way L<Alien::Build> based L<Alien>s are installed with the
local configuration file C<~/.alienbuild/rc.pl>. See L<Alien::Build::rc> for
details.
=head1 CAVEATS
This whole document is caveats, but if you haven't gotten it by now then,
fundamentally if you need to use Perl modules securely then you need to
audit the code for security vulnerabilities. If you think that the security
of L<Alien::Build> and the L<Alien>s that depend on it, then I<patches welcome>.
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Manual>
Other L<Alien::Build> manuals.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual/FAQ.pod 0000444 00000051357 15157554630 0012625 0 ustar 00 # PODNAME: Alien::Build::Manual::FAQ
# ABSTRACT: Frequently Asked Questions about Alien::Build
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual::FAQ - Frequently Asked Questions about Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
perldoc Alien::Build::Manual::FAQ
=head1 DESCRIPTION
This document serves to answer the most frequently asked questions made by developers
creating L<Alien> modules using L<Alien::Build>.
=head1 QUESTIONS
=head2 What is Alien, Alien::Base and Alien::Build?
Alien in a Perl namespace for defining dependencies in CPAN for libraries and tools which
are not "native" to CPAN. For a manifesto style description of the Why, and How see
L<Alien>. L<Alien::Base> is a base class for the L<Alien> runtime. L<Alien::Build> is
a tool for probing the operating system for existing libraries and tools, and downloading, building
and installing packages. L<alienfile> is a recipe format for describing how to probe,
download, build and install a package.
=head2 How do I build a package that uses I<build system>
=head3 autoconf
Use the autoconf plugin (L<Alien::Build::Plugin::Build::Autoconf>). If your package
provides a pkg-config C<.pc> file, then you can also use the PkgConfig plugin
(L<Alien::Build::Plugin::PkgConfig::Negotiate>).
use alienfile
plugin PkgConfig => 'libfoo';
share {
start_url => 'http://example.org/dist';
plugin Download => (
version => qr/libfoo-([0-9\.])\.tar\.gz$/,
);
plugin Extract => 'tar.gz';
plugin 'Build::Autoconf';
};
If you need to provide custom flags to configure, you can do that too:
share {
plugin 'Build::Autoconf';
build [
'%{configure} --disable-shared --enable-foo',
'%{make}',
'%{make} install',
];
};
If your package requires GNU Make, use C<%{gmake}> instead of C<%{make}>.
=head3 autoconf without configure script
A number of Open Source projects are using autotools, but do not provide the
C<configure> script. When alienizing these types of packages you have a
few choices:
=over 4
=item build configure using autotools
The Alien L<Alien::Autotools> is designed to provide autotools for building
such packages from source. The advantage is that this is how the upstream
developers intend on having their package built. The downside is that it
is also adds more prereqs to your Alien. The silver lining is that if you
require this Alien in the C<share> block (as you should), then these prereqs
will only be pulled in during a share install when they are needed.
Please see the L<Alien::Autotools> documentation for specifics on how it
can be used in your L<alienfile>.
=item patch the package locally before build
You can use the L<alienfile/patch> directive to patch the alienized package
locally before building. This can sometimes be challenging because Autotools
uses timestamps in order to decide what needs to be rebuilt, and patching
can sometimes confuse it into thinking more needs to be rebuilt than what
actually does.
=item build configure and tarball
You can also build the configure script during development of your alien,
generate the tarball and provide it somewhere like GitHub and use that
as the source instead of the original source. This should usually be
a last resort if the other two methods prove too difficult.
=back
=head3 autoconf-like
If you see an error like this:
Unknown option "--with-pic".
It is because the autoconf plugin uses the C<--with-pic> option by default, since
it makes sense most of the time, and autoconf usually ignores options that it does
not recognize. Some autoconf style build systems fail when they see an option that
they do not recognize. You can turn this behavior off for these packages:
plugin 'Build::Autoconf' => (
with_pic => 0,
);
Another thing about the autoconf plugin is that it uses C<DESTDIR> to do a double
staged install. If you see an error like "nothing was installed into destdir", that
means that your package does not support C<DESTDIR>. You should instead use the
MSYS plugin and use a command sequence to do the build like this:
share {
plugin 'Build::MSYS';
build [
# explicitly running configure with "sh" will make sure that
# it works on windows as well as UNIX.
'sh configure --prefix=%{.install.prefix} --disable-shared',
'%{make}',
'%{make} install',
];
};
=head3 CMake
There is an alien L<Alien::cmake3> that provides C<cmake> 3.x or better (It is preferred to the
older L<Alien::CMake>). Though it is recommended that you use the C<cmake>
(L<Alien::Build::Plugin::Build::CMake>) plugin instead of using L<Alien::cmake3>.
use alienfile;
share {
plugin 'Build::CMake';
build [
# this is the default build step, if you do not specify one.
[ '%{cmake}',
@{ meta->prop->{plugin_build_cmake}->{args} },
# ... put extra cmake args here ...
'.'
],
'%{make}',
'%{make} install',
];
};
=head3 vanilla Makefiles
L<Alien::Build> provides a helper (C<%{make}>) for the C<make> that is used by Perl and
L<ExtUtils::MakeMaker> (EUMM). Unfortunately the C<make> supported by Perl and EUMM on
Windows (C<nmake> and C<dmake>) are not widely supported by most open source projects.
(Thankfully recent perls and EUMM support GNU Make on windows now).
You can use the C<make> plugin (L<Alien::Build::Plugin::Build::Make>) to tell the
L<Alien::Build> system which make the project that you are alienizing requires.
plugin 'Build::Make' => 'umake';
# umake makes %{make} either GNU Make or BSD Make on Unix and GNU Make on Windows.
build {
build [
# You can use the Perl config compiler and cflags using the %{perl.config...} helper
[ '%{make}', 'CC=%{perl.config.cc}', 'CFLAGS=%{perl.config.cccdlflags} %{perl.config.optimize}' ],
[ '%{make}', 'install', 'PREFIX=%{.install.prefix}' ],
],
};
Some open source projects require GNU Make, and you can specify that, and L<Alien::gmake>
will be pulled in on platforms that do not already have it.
plugin 'Build::Make' => 'gmake';
...
=head2 How do I probe for a package that uses pkg-config?
Use the C<pkg-config> plugin (L<Alien::Build::Plugin::PkgConfig::Negotiate>):
use alienfile;
plugin 'PkgConfig' => (
pkg_name => 'libfoo',
);
It will probe for a system version of the library. It will also add the appropriate C<version>
C<cflags> and C<libs> properties on either a C<system> or C<share> install.
=head2 How do I specify a minimum or exact version requirement for packages that use pkg-config?
The various pkg-config plugins all support atleast_version, exact_version and maximum_version
fields, which have the same meaning as the C<pkg-config> command line interface:
use alienfile;
plugin 'PkgConfig', pkg_name => 'foo', atleast_version => '1.2.3';
or
use alienfile;
plugin 'PkgConfig', pkg_name => foo, exact_version => '1.2.3';
=head2 How do I probe for a package that uses multiple .pc files?
Each of the C<PkgConfig> plugins will take an array reference instead of a string:
use alienfile;
plugin 'PkgConfig' => ( pkg_name => [ 'foo', 'bar', 'baz' ] );
The first C<pkg_name> given will be used by default once your alien is installed.
To get the configuration for C<foo> and C<bar> you can use the
L<Alien::Base alt method|Alien::Base/alt>:
use Alien::libfoo;
$cflags = Alien::libfoo->cflags; # compiler flags for 'foo'
$cflags = Alien::libfoo->alt('bar')->cflags ; # compiler flags for 'bar'
$cflags = Alien::libfoo->alt('baz')->cflags ; # compiler flags for 'baz'
=head2 How to create an Alien module for packages that do not support pkg-config?
=head3 Packages that provide a configuration script
Many packages provide a command that you can use to get the appropriate version, compiler
and linker flags. For those packages you can just use the commands in your L<alienfile>.
Something like this:
use alienfile;
probe [ 'foo-config --version' ];
share {
...
build [
'%{make} PREFIX=%{.runtime.prefix}',
'%{make} install PREFIX=%{.runtime.prefix}',
];
};
gather [
[ 'foo-config', '--version', \'%{.runtime.version}' ],
[ 'foo-config', '--cflags', \'%{.runtime.cflags}' ],
[ 'foo-config', '--libs', \'%{.runtime.libs}' ],
];
=head3 Packages that require a compile test
Some packages just expect you do know that C<-lfoo> will work. For those you can use
the C<cbuilder> plugin (L<Alien::Build::Plugin::Probe::CBuilder>).
use alienfile;
plugin 'Probe::CBuilder' => (
cflags => '-I/opt/libfoo/include',
libs => '-L/opt/libfoo/lib -lfoo',
);
share {
...
gather sub {
my($build) = @_;
my $prefix = $build->runtime_prop->{prefix};
$build->runtime_prop->{cflags} = "-I$prefix/include ";
$build->runtime_prop->{libs} = "-L$prefix/lib -lfoo ";
};
}
This plugin will build a small program with these flags and test that it works. (There
are also options to provide a program that can make simple tests to ensure the library
works). If the probe works, it will set the compiler and linker flags. (There are also
options for extracting the version from the test program). If you do a share install
you will need to set the compiler and linker flags yourself in the gather step, if you
aren't using a build plugin that will do that for you.
=head2 Can/Should I write a tool oriented Alien module?
Certainly. The original intent was to provide libraries, but tools are also quite doable using
the L<Alien::Build> toolset. A good example of how to do this is L<Alien::nasm>. You will want
to use the 'Probe::CommandLine':
use alienfile;
plugin 'Probe::CommandLine' => (
command => 'gzip',
);
=head2 How do I test my package once it is built (before it is installed)?
Use L<Test::Alien>. It has extensive documentation, and integrates nicely with L<Alien::Base>.
=head2 How do I patch packages that need alterations?
If you have a diff file you can use patch:
use alienfile;
probe sub { 'share' }; # replace with appropriate probe
share {
...
patch [ '%{patch} -p1 < %{.install.patch}/mypatch.diff' ];
build [ ... ] ;
}
...
You can also patch using Perl if that is easier:
use alienfile;
probe sub { 'share' };
share {
...
patch sub {
my($build) = @_;
# make changes to source prior to build
};
build [ ... ];
};
=head2 The flags that a plugin produces are wrong!
Sometimes, the compiler or linker flags that the PkgConfig plugin comes up with are not quite
right. (Frequently this is actually because a package maintainer is providing a broken
C<.pc> file). (Other plugins may also have problems). You could replace the plugin's C<gather> step
but a better way is to provide a subroutine callback to be called after the gather stage
is complete. You can do this with the L<alienfile> C<after> directive:
use alienfile;
plugin 'PkgConfig' => 'libfoo';
share {
...
after 'gather' => sub {
my($build) = @_;
$build->runtime_prop->{libs} .= " -lbar"; # libfoo also requires libbar
$build->runtime_prop->{libs_static} .= " -lbar -lbaz"; # libfoo also requires libbaz under static linkage
};
};
Sometimes you only need to do this on certain platforms. You can adjust the logic based on C<$^O>
appropriately.
use alienfile;
plugin 'PkgConfig' => 'libfoo';
share {
...
after 'gather' => sub {
my($build) = @_;
if($^O eq 'MSWin32') {
$build->runtime_prop->{libs} .= " -lpsapi";
}
};
};
=head2 "cannot open shared object file" trying to load XS
The error looks something like this:
t/acme_alien_dontpanic2.t ....... 1/?
# Failed test 'xs'
# at t/acme_alien_dontpanic2.t line 13.
# XSLoader failed
# Can't load '/home/cip/.cpanm/work/1581635869.456/Acme-Alien-DontPanic2-2.0401/_alien/tmp/test-alien-lyiQNX/auto/Test/Alien/XS/Mod0/Mod0.so' for module Test::Alien::XS::Mod0: libdontpanic.so.0: cannot open shared object file: No such file or directory at /opt/perl/5.30.1/lib/5.30.1/x86_64-linux/DynaLoader.pm line 193.
# at /home/cip/perl5/lib/perl5/Test/Alien.pm line 414.
# Compilation failed in require at /home/cip/perl5/lib/perl5/Test/Alien.pm line 414.
# BEGIN failed--compilation aborted at /home/cip/perl5/lib/perl5/Test/Alien.pm line 414.
t/acme_alien_dontpanic2.t ....... Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/6 subtests
t/acme_alien_dontpanic2__ffi.t .. ok
This error happened at test time for the Alien, but depending on your environment and Alien it might
happen later and the actual diagnostic wording might vary.
This is usually because your XS or Alien tries to use dynamic libraries instead of static ones.
Please consult the section about dynamic vs. static libraries in L<Alien::Build::Manual::AlienAuthor>.
The TL;DR is that L<Alien::Build::Plugin::Gather::IsolateDynamic> might help.
If you are the Alien author and the package you are alienizing doesn't have a static option you can
use L<Alien::Role::Dino>, but please note the extended set of caveats!
=head2 599 Internal Exception errors downloading packages from the internet
Alien::Build::Plugin::Fetch::HTTPTiny> 599 Internal Exception fetching http://dist.libuv.org/dist/v1.15.0
Alien::Build::Plugin::Fetch::HTTPTiny> exception: IO::Socket::SSL 1.42 must be installed for https support
Alien::Build::Plugin::Fetch::HTTPTiny> exception: Net::SSLeay 1.49 must be installed for https support
Alien::Build::Plugin::Fetch::HTTPTiny> An attempt at a SSL URL https was made, but your HTTP::Tiny does not appear to be able to use https.
Alien::Build::Plugin::Fetch::HTTPTiny> Please see: https://metacpan.org/pod/Alien::Build::Manual::FAQ#599-Internal-Exception-errors-downloading-packages-from-the-internet
error fetching http://dist.libuv.org/dist/v1.15.0: 599 Internal Exception at /Users/ollisg/.perlbrew/libs/perl-5.26.0@test1/lib/perl5/Alien/Build/Plugin/Fetch/HTTPTiny.pm line 68.
(Older versions of L<Alien::Build> produced a less verbose more confusing version of this diagnostic).
TL;DR, instead of this:
share {
start_url => 'http://example.org/dist';
...
};
do this:
share {
start_url => 'https://example.org/dist';
};
If the website is going to redirect to a secure URL anyway.
The "599 Internal Exception" indicates an "internal" exception from L<HTTP::Tiny> and is not a real
HTTP status code or error. This could mean a number of different problems, but most frequently
indicates that a SSL request was made without the required modules (L<Net::SSLeay> and
L<IO::Socket::SSL>). Normally the L<Alien::Build::Plugin::Download::Negotiate>
and L<Alien::Build::Plugin::Fetch::HTTPTiny> will make sure that the appropriate modules are added
to your prerequisites for you if you specify a C<https> URL. Some websites allow an initial request
from C<http> but then redirect to C<https>. If you can it is better to specify C<https>, if you
cannot, then you can instead use the C<ssl> property on either of those two plugins.
=head2 Does not detect system package even though it is installed
This could just be because the alien requires a more recent package that what is provided by your
operating system.
It could also be because you do not have the development package installed. Many Linux vendors
in particular separate packages into runtime and development pages. On RPM based systems these
development packages usually have C<-devel> suffix (example runtime: C<libffi> and development:
C<libffi-devel>). On Debian based systems these development packages usually have a C<-dev>
suffix (example runtime: C<libffi> and development: C<libffi-dev>).
=head2 Network fetch is turned off
If you get an error like this:
Alien::Build> install type share requested or detected, but network fetch is turned off
Alien::Build> see see https://metacpan.org/pod/Alien::Build::Manual::FAQ#Network-fetch-is-turned-off
This is because your environment is setup not to install aliens that require the network. You
can turn network fetch back on by setting C<ALIEN_INSTALL_NETWORK> to true, or by unsetting it.
This environment variable is designed for environments that don't ever want to install aliens that
require downloading source packages over the internet.
=head2 I would really prefer you not download stuff off the internet
The idea of L<Alien> is to download missing packages and build them automatically to make installing
easier. Some people may not like this, or may even have security requirements that they not download
random package over the internet (caveat, downloading random stuff off of CPAN may not be any safer,
so make sure you audit all of the open source software that you use appropriately). Another reason
you may not want to download from the internet is if you are packaging up an alien for an operating
system vendor, which will always want to use the system version of a library. In that situation you
don't want L<Alien::Build> to go off and download something from the internet because the probe failed
for some reason.
This is easy to take care of, simply set C<ALIEN_INSTALL_TYPE> to C<system> and a build from source
code will never be attempted. On systems that do not provide system versions of the library or tool
you will get an error, allowing you to install the library, and retry the alien install. You can
also set the environment variable on just some aliens.
% export ALIEN_INSTALL_TYPE=system # for everyone
% env ALIEN_INSTALL_TYPE=system cpanm -v Alien::libfoo
=head2 For testing I would like to test both system and share installs!
You can use the C<ALIEN_INSTALL_TYPE> environment variable. It will force either a C<share> or
C<system> install depending on how it is set. For Travis-CI you can do something like this:
env:
matrix:
- ALIEN_INSTALL_TYPE=share
- ALIEN_INSTALL_TYPE=system
=head2 How do I use Alien::Build from Dist::Zilla?
For creating L<Alien::Base> and L<Alien::Build> based dist from L<Dist::Zilla> you can use the
dzil plugin L<Dist::Zilla::Plugin::AlienBuild>.
=head2 Cannot find either a share directory or a ConfigData module
If you see an error like this:
Cannot find either a share directory or a ConfigData module for Alien::libfoo.
(Alien::libfoo loaded from lib/Alien/libfoo.pm)
Please see https://metacpan.org/pod/distribution/Alien-Build/lib/Alien/Build/Manual/FAQ.pod#Cannot-find-either-a-share-directory-or-a-ConfigData-module
Can't locate Alien/libfoo/ConfigData.pm in @INC (you may need to install the Alien::libfoo::ConfigData module) (@INC contains: ...)
it means you are trying to use an Alien that hasn't been properly installed. An L<Alien::Base>
based Alien needs to have either the share directory build during the install process or for
older legacy L<Alien::Base::ModuleBuild> based Aliens, a ConfigData module generated by
L<Module::Build>.
This usually happens if you try to use an Alien module from the lib directory as part of the
Alien's distribution. You need to build the alien and use C<blib/lib> instead of C<lib> or
install the alien and use the installed path.
It is also possible that your Alien installer is not set up correctly. Make sure your
C<Makefile.PL> is using L<Alien::Build::MM> correctly.
=head2 I have a question not listed here!
There are a number of forums available to people working on L<Alien>, L<Alien::Base> and
L<Alien::Build> modules:
=over 4
=item C<#native> on irc.perl.org
This is intended for native interfaces in general so is a good place for questions about L<Alien>
generally or L<Alien::Base> and L<Alien::Build> specifically.
=item mailing list
The C<perl5-alien> google group is intended for L<Alien> issues generally, including L<Alien::Base>
and L<Alien::Build>.
L<https://groups.google.com/forum/#!forum/perl5-alien>
=item Open a support ticket
If you have an issue with L<Alien::Build> itself, then please open a support ticket on the project's GitHub issue
tracker.
L<https://github.com/PerlAlien/Alien-Build/issues>
=back
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Manual>
Other L<Alien::Build> manuals.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual/Alien.pod 0000444 00000005527 15157554635 0013251 0 ustar 00 # PODNAME: Alien::Build::Manual::Alien
# ABSTRACT: General alien author documentation
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual::Alien - General alien author documentation
=head1 VERSION
version 2.84
=head1 SYNOPSIS
perldoc Alien::Build::Manual::Alien
=head1 DESCRIPTION
The goal of the L<Alien> namespace is to provide non-CPAN dependencies (so called "Alien" dependencies) for
CPAN modules. The history and intent of this idea is documented in the documentation-only L<Alien> module.
The C<Alien-Build> distribution provides a framework for building aliens. The intent is to fix bugs and
enhance the interface of a number of common tools so that all aliens may benefit. The distribution is broken
up into these parts:
=over 4
=item The Alien Installer (configure / build-time)
L<Alien::Build> and L<alienfile> are used to detect and install aliens. They are further documented in
L<Alien::Build::Manual::AlienAuthor>.
=item The Alien Runtime (runtime)
L<Alien::Base> is the base class for aliens in the C<Alien-Build> system. Its use by Alien consumers
is documented in L<Alien::Build::Manual::AlienUser>.
=item The Plugin system (configure / build-time)
Because many packages are implemented using different tools, the detection, build and install logic
for a particular L<Alien> can vary a lot. As such, much of L<Alien::Build> is implemented as a
series of plugins that inherit from L<Alien::Build::Plugin>. An overview of building your own
plugins is documented in L<Alien::Build::Manual::PluginAuthor>.
=back
Additional useful documentation may be found here:
=over 4
=item FAQ
L<Alien::Build::Manual::FAQ>
=item Contributing
L<Alien::Build::Manual::Contributing>
=back
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Manual>
Other L<Alien::Build> manuals.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual/PluginAuthor.pod 0000444 00000052341 15157554642 0014634 0 ustar 00 # PODNAME: Alien::Build::Manual::PluginAuthor
# ABSTRACT: Alien::Build plugin author documentation
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual::PluginAuthor - Alien::Build plugin author documentation
=head1 VERSION
version 2.84
=head1 SYNOPSIS
your plugin:
package Alien::Build::Plugin::Build::MyPlugin;
use strict;
use warnings;
use Alien::Build::Plugin;
has arg1 => 'default_for arg1';
has arg2 => sub { [ 'default', 'for', 'arg2' ] };
sub init
{
my($self, $meta) = @_;
...
}
1;
and then from L<alienfile>:
use alienfile;
plugin 'Build::MyPlugin' => (
arg1 => 'override for arg1',
arg2 => [ 'something', 'else' ],
);
=for html <p>flowchart</p>
<div style="display: flex"><div style="margin: 3px; flex: 1 1 50%">
<img src="image/PluginAuthor-flowchart.png" style="max-width: 100%">
</div></div>
<p><b>Notes</b>: The colored blocks indicate <tt>alienfile</tt> blocks.
Hooks are indicated as predefined process (rectangle with double struck
vertical edges). Hooks that can easily be implemented from an
<tt>alienfile</tt> are indicated in blue (Note that <tt>[]</tt> is used
to indicate passing in an array reference, but a subroutine
reference can also be used). For simplicity, the the flowchart does
not include when required modules are loaded. Except for configure
time requirements, they are loaded when the corresponding <tt>alienfile</tt>
blocks are entered. It is not shown, but generally any plugin can cause
a <b>Fail</b> by throwing an exception with <tt>die</tt>.</p>
Perlish pseudo code for how plugins are called:
my $probe;
my $override = override();
if($override eq 'system') {
$probe = probe();
if($probe ne 'system') {
die 'system tool or library not found';
}
}
elsif($override eq 'default') {
$probe = probe();
} else { # $override eq 'share'
# note that in this instance the
# probe hook is never called
$probe = 'share';
}
if($probe eq 'system') {
gather_system();
} else { # $probe eq 'share'
download();
extract();
patch();
build();
gather_share();
# Check to see if there isa build_ffi hook
if(defined &build_ffi) {
patch_ffi();
build_ffi();
gather_ffi();
}
}
# By default this just returns the value of $ENV{ALIEN_INSTALL_TYPE}
sub override {
return $ENV{ALIEN_INSTALL_TYPE};
}
# Default download implementation; can be
# replaced by specifying a different download
# hook. See Alien::Build::Plugin::Core::Download
# for detailed implementation.
sub download {
my $response = fetch();
if($response->{type} eq 'html' || $response->{type} eq 'dir_listing') {
# decode will transform an HTML listing (html) or a FTP directory
# listing (dir_listing) into a regular list
$response = decode($response);
}
if($response->{type} eq 'list') {
# prefer will filter bad entries in the list
# and sort them so that the first one is
# the one that we want
$response = prefer($response);
my $first_preferred = $res->{list}->[0];
# prefer can sometimes infer the version from the
# filename.
if(defined $first_preferred->{version}) {
# not a hook
runtime_prop->{version} = $first_preferred->{version};
}
$response = fetch($first_preferred);
}
if($response->{type} eq 'file') {
# not a hook
write_file_to_disk $response;
}
}
=head1 DESCRIPTION
This document explains how to write L<Alien::Build> plugins using the
L<Alien::Build::Plugin> base class.
=head2 Writing plugins
Plugins use L<Alien::Build::Plugin>, which sets the appropriate base
class, and provides you with the C<has> property builder. C<has> takes
two arguments, the name of the property and the default value. (As
with L<Moose> and L<Moo>, you should use a code reference to specify
default values for non-string defaults). No B<not> set this as your
plugin's base class directly:
use parent qw( Alien::Build::Plugin ); # wrong
use Alien::Build::Plugin; # right
The only method that you need to implement is C<init>. From this method
you can add hooks to change the behavior of the L<alienfile> recipe.
This is a very simple example of a probe hook, with the actual probe
logic removed:
sub init
{
my($self, $meta) = @_;
$meta->register_hook(
probe => sub {
my($build) = @_;
if( ... )
{
return 'system';
}
else
{
return 'share';
}
},
);
}
Hooks get the L<Alien::Build> instance as their first argument, and depending
on the hook may get additional arguments.
=head2 Modifying hooks
You can also modify hooks using C<before_hook>, C<around_hook> and C<after_hook>,
similar to L<Moose> modifiers:
sub init
{
my($self, $meta) = @_;
$meta->before_hook(
build => sub {
my($build) = @_;
$build->log('this runs before the build');
},
);
$meta->after_hook(
build => sub {
my($build) = @_;
$build->log('this runs after the build');
},
);
$meta->around_hook(
build => sub {
my $orig = shift;
# around hooks are useful for setting environment variables
local $ENV{CPPFLAGS} = '-I/foo/include';
$orig->(@_);
},
);
}
=head2 Testing plugins
You can and should write tests for your plugin. The best way to do
this is using L<Test::Alien::Build>, which allows you to write an
inline L<alienfile> in your test. Here is an example:
use Test::V0;
use Test::Alien::Build;
my $build = alienfile_ok q{
use alienfile;
plugin 'Build::MyPlugin' => (
arg1 => 'override for arg1',
arg2 => [ 'something', 'else' ],
);
...
};
# you can interrogate $build, it is an instance of L<Alien::Build>.
my $alien = alien_build_ok;
# you can interrogate $alien, it is an instance of L<Alien::Base>.
=head2 Negotiator plugins
A Negotiator plugin doesn't itself typically implement anything on
its own, but picks the best plugin to achieve a particular goal.
The "best" plugin can in some cases vary depending on the platform
or tools that are available. For example The
L<download negotiator|Alien::Build::Plugin::Download::Negotiate>
might choose to use the fetch plugin that relies on the command line
C<curl>, or it might choose the fetch plugin that relies on the Perl
module L<HTTP::Tiny> depending on the platform and what is already
installed. (For either to be useful they have to support SSL).
The Negotiator plugin is by convention named something like
C<Alien::Build::Plugin::*::Negotiate>, but is typically invoked
without the C<::Negotiate> suffix. For example:
plugin 'Download'; # is short for Alien::Build::Plugin::Download::Negotiator
Here is a simple example of a negotiator which picks C<curl> if already
installed and L<HTTP::Tiny> otherwise. (The actual download plugin
is a lot smarter and complicated than this, but this is a good
simplified example).
package Alien::Build::Plugin::Download::Negotiate;
use strict;
use warnings;
use Alien::Build::Plugin;
use File::Which qw( which );
sub init
{
my($self, $meta) = @_;
if(which('curl')) {
$meta->apply_plugin('Fetch::Curl');
} else {
$meta->apply_plugin('Fetch::HTTPTiny');
}
}
=head2 Hooks
The remainder of this document is a reference for the hooks that you
can register. Generally speaking you can register any hook that you
like, but some care must be taken as some hooks have default behavior
that will be overridden when you register a hook. The hooks are
presented in alphabetical order. The execution order is shown
in the flowchart above (if you are browsing the HTML version of this
document), or the Perlish pseudo code in the synopsis section.
=head1 HOOKS
=head2 build hook
$meta->register_hook( build => sub {
my($build) = @_;
...
});
This does the main build of the alienized project and installs it into
the staging area. The current directory is the build root. You need
to run whatever tools are necessary for the project, and install them
into C<$build->install_prop->{prefix}> (C<%{.install.prefix}>).
=head2 build_ffi hook
$meta->register_hook( build_ffi => sub {
my($build) = @_;
...
});
This is the same as L<build|/"build hook">, except it fires only on a FFI build.
=head2 decode hook
$meta->register_hook( decode => sub {
my($build, $res) = @_;
...
}
This hook takes a response hash reference from the C<fetch> hook above
with a type of C<html> or C<dir_listing> and converts it into a response
hash reference of type C<list>. In short it takes an HTML or FTP file
listing response from a fetch hook and converts it into a list of filenames
and links that can be used by the prefer hook to choose the correct file to
download. See the L<fetch hook|/"fetch hook"> for the specification of the
input and response hash references.
=head2 check_digest hook
# implement the well known FOO-92 digest
$meta->register_hook( check_digest => sub {
my($build, $file, $algorithm, $digest) = @_;
if($algorithm ne 'FOO92') {
return 0;
}
my $actual = foo92_hex_digest($file);
if($actual eq $digest) {
return 1;
} else {
die "Digest FOO92 does not match: got $actual, expected $digest";
}
});
This hook should check the given C<$file> (the format is the same as used by
L<the fetch hook|/"fetch hook">) matches the given C<$digest> using the
given C<$algorithm>. If the plugin does not support the given algorithm,
then it should return a false value. If the digest does not match, it
should throw an exception. If the digest matches, it should return a
true value.
=head2 clean_install
$meta->register_hook( clean_install => sub {
my($build) = @_;
});
This hook allows you to remove files from the final install location before
the files are installed by the installer layer (examples: L<Alien::Build::MM>,
L<Alien::Build::MB> or L<App::af>). This hook is not called by default,
and must be enabled via the interface to the installer layer
(example: L<Alien::Build::MM/clean_install>).
This hook SHOULD NOT remove the C<_alien> directory or its content from the
install location.
The default implementation removes all the files EXCEPT the C<_alien> directory
and its content.
=head2 download hook
$meta->register_hook( download => sub {
my($build) = @_;
...
});
This hook is used to download from the internet the source. Either as
an archive (like tar, zip, etc), or as a directory of files (C<git clone>,
etc). When the hook is called, the current working directory will be a
new empty directory, so you can save the download to the current
directory. If you store a single file in the directory, L<Alien::Build>
will assume that it is an archive, which will be processed by the
L<extract hook|/"extract hook">. If you store multiple files, L<Alien::Build> will
assume the current directory is the source root. If no files are stored
at all, an exception with an appropriate diagnostic will be thrown.
B<Note>: If you register this hook, then the fetch, decode and prefer
hooks will NOT be called, unless you call them yourself from this hook.
=head2 extract hook
$meta->register_hook( extract => sub {
my($build, $archive) = @_;
...
});
This hook is used to extract an archive that has already been downloaded.
L<Alien::Build> already has plugins for the most common archive formats,
so you will likely only need this to add support for new or novel archive
formats. When this hook is called, the current working directory will
be a new empty directory, so you can save the content of the archive to
the current directory. If a single directory is written to the current
directory, L<Alien::Build> will assume that is the root directory of the
package. If multiple files and/or directories are present, that will
indicate that the current working directory is the root of the package.
The logic typically handles correctly the default behavior for tar
(where packages are typically extracted to a subdirectory) and for
zip (where packages are typically extracted to the current directory).
=head2 fetch hook
package Alien::Build::Plugin::MyPlugin;
use strict;
use warnings;
use Alien::Build::Plugin;
use Carp ();
has '+url' => sub { Carp::croak "url is required property" };
sub init
{
my($self, $meta) = @_;
$meta->register_hook( fetch => sub {
my($build, $url, %options) = @_;
...
}
}
1;
Used to fetch a resource. The first time it will be called without an
argument (or with C<$url> set to C<undef>, so the configuration used to
find the resource should be specified by the plugin's properties. On
subsequent calls the first argument will be a URL.
The C<%options> hash may contain these options:
=over 4
=item http_headers
HTTP request headers, if an appropriate protocol is being used. The
headers are provided as an array reference of key/value pairs, which
allows for duplicate header keys with multiple values.
If a non-HTTP protocol is used, or if the plugin cannot otherwise
send HTTP request headers, the plugin SHOULD issue a warning using
the C<< $build->log >> method, but because this option wasn't part
of the original spec, the plugin MAY no issue that warning while
ignoring it.
=back
Note that versions of L<Alien::Build> prior to 2.39 did not pass the
options hash into the fetch plugin.
Normally the first fetch will be to either a file or a directory listing.
If it is a file then the content should be returned as a hash reference
with the following keys:
# content of file stored in Perl
return {
type => 'file',
filename => $filename,
content => $content,
version => $version, # optional, if known
protocol => $protocol, # AB 2.60 optional, but recommended
};
# content of file stored in the filesystem
return {
type => 'file',
filename => $filename,
path => $path, # full file system path to file
version => $version, # optional, if known
tmp => $tmp, # optional
protocol => $protocol, # AB 2.60 optional, but recommended
};
C<$tmp> if set will indicate if the file is temporary or not, and can
be used by L<Alien::Build> to save a copy in some cases. The default
is true, so L<Alien::Build> assumes the file or directory is temporary
if you don't tell it otherwise. Probably the most common situation
when you would set C<tmp> to false, is when the file is bundled inside
the L<Alien> distribution. See L<Alien::Build::Plugin::Fetch::Local>
for example.
If the URL points to a directory listing you should return it as either
a hash reference containing a list of files:
return {
type => 'list',
list => [
# filename: each filename should be just the
# filename portion, no path or url.
# url: each url should be the complete url
# needed to fetch the file.
# version: OPTIONAL, may be provided by some fetch or prefer
{ filename => $filename1, url => $url1, version => $version1 },
{ filename => $filename2, url => $url2, version => $version2 },
],
protocol => $protocol, # AB 2.60 optional, but recommended
};
or if the listing is in HTML format as a hash reference containing the
HTML information:
return {
type => 'html',
charset => $charset, # optional
base => $base, # the base URL: used for computing relative URLs
content => $content, # the HTML content
protocol => $protocol, # optional, but recommended
};
or a directory listing (usually produced by an FTP servers) as a hash
reference:
return {
type => 'dir_listing',
base => $base,
content => $content,
protocol => $protocol, # AB 2.60 optional, but recommended
};
[version 2.60]
For all of these responses C<$protocol> is optional, since it was not part
of the original spec, however it is strongly recommended that you include
this field, because future versions of L<Alien::Build> will use this to
determine if a file was downloaded securely (that is via a secure protocol
such as SSL).
Some plugins (like L<decode plugins |Alien::Build::Plugin::Decode>) trans
late a file hash from one type to another, they should maintain the
C<$protocol> from the old to the new representation of the file.
=head2 gather_ffi hook
$meta->register_hook( gather_ffi => sub {
my($build) = @_;
$build->runtime_prop->{cflags} = ...;
$build->runtime_prop->{libs} = ...;
$build->runtime_prop->{version} = ...;
});
This hook is called for a FFI build to determine the properties
necessary for using the library or tool. These properties should be
stored in the L<runtime_prop|Alien::Build/runtime_prop> hash as shown above.
Typical properties that are needed for libraries are cflags and libs.
If at all possible you should also try to determine the version of the
library or tool.
=head2 gather_share hook
$meta->register_hook( gather_share => sub {
my($build) = @_;
$build->runtime_prop->{cflags} = ...;
$build->runtime_prop->{libs} = ...;
$build->runtime_prop->{version} = ...;
});
This hook is called for a share install to determine the properties
necessary for using the library or tool. These properties should be
stored in the L<runtime_prop|Alien::Build/runtime_prop> hash as shown above.
Typical properties that are needed for libraries are cflags and libs.
If at all possible you should also try to determine the version of the
library or tool.
=head2 gather_system hook
$meta->register_hook( gather_system => sub {
my($build) = @_;
$build->runtime_prop->{cflags} = ...;
$build->runtime_prop->{libs} = ...;
$build->runtime_prop->{version} = ...;
});
This hook is called for a system install to determine the properties
necessary for using the library or tool. These properties should be
stored in the L<runtime_prop|Alien::Build/runtime_prop> hash as shown above.
Typical properties that are needed for libraries are cflags and libs.
If at all possible you should also try to determine the version of the
library or tool.
=head2 override hook
$meta->register_hook( override => sub {
my($build) = @_;
return $ENV{ALIEN_INSTALL_TYPE} || '';
});
This allows you to alter the override logic. It should return one of
C<share>, C<system>, C<default> or C<''>. The default implementation
is shown above. L<Alien::Build::Plugin::Probe::Override> and
L<Alien::Build::Plugin::Probe::OverrideCI> are examples of how you
can use this hook.
=head2 patch hook
$meta->register_hook( patch => sub {
my($build) = @_;
...
});
This hook is completely optional. If registered, it will be triggered after
extraction and before build. It allows you to apply any patches or make any
modifications to the source if they are necessary.
=head2 patch_ffi hook
$meta->register_hook( patch_ffi => sub {
my($build) = @_;
...
});
This hook is exactly like the L<patch hook|/"patch hook">, except it fires only on an
FFI build.
=head2 prefer hook
$meta->register_hook( prefer => sub {
my($build, $res) = @_;
return {
type => 'list',
list => [sort @{ $res->{list} }],
};
}
This hook sorts candidates from a listing generated from either the C<fetch>
or C<decode> hooks. It should return a new list hash reference with the
candidates sorted from best to worst. It may also remove candidates
that are totally unacceptable.
=head2 probe hook
$meta->register_hook( probe => sub {
my($build) = @_;
return 'system' if ...; # system install
return 'share'; # otherwise
});
$meta->register_hook( probe => [ $command ] );
This hook should return the string C<system> if the operating
system provides the library or tool. It should return C<share>
otherwise.
You can also use a command that returns true when the tool
or library is available. For example for use with C<pkg-config>:
$meta->register_hook( probe =>
[ '%{pkgconf} --exists libfoo' ] );
Or if you needed a minimum version:
$meta->register_hook( probe =>
[ '%{pkgconf} --atleast-version=1.00 libfoo' ] );
Note that this hook SHOULD NOT gather system properties, such as
cflags, libs, versions, etc, because the probe hook will be skipped
in the event the environment variable C<ALIEN_INSTALL_TYPE> is set.
The detection of these properties should instead be done by the
L<gather_system|/"gather_system hook"> hook.
Multiple probe hooks can be given. These will be used in sequence,
stopping at the first that detects a system installation.
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Manual>
Other L<Alien::Build> manuals.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual/AlienUser.pod 0000444 00000015215 15157554647 0014106 0 ustar 00 # PODNAME: Alien::Build::Manual::AlienUser
# ABSTRACT: Alien user documentation
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual::AlienUser - Alien user documentation
=head1 VERSION
version 2.84
=head1 SYNOPSIS
perldoc Alien::Build::Manual::AlienUser
=head1 DESCRIPTION
This document is intended for a user of an L<Alien::Base> based L<Alien>
module's user. Although specifically geared for L<Alien::Base>
subclasses, it may have some useful hints for L<Alien> in general.
Full working examples of how to use an L<Alien> module are also bundled
with L<Alien::Build> in the distribution's C<example/user> directory.
Those examples use L<Alien::xz>, which uses L<alienfile> + L<Alien::Build>
+ L<Alien::Base>.
The following documentation will assume you are trying to use an L<Alien>
called C<Alien::Foo> which provides the library C<libfoo> and the command
line tool C<foo>. Many L<Alien>s will only provide one or the other.
The best interface to use for using L<Alien::Base> based aliens is
L<Alien::Base::Wrapper>. This allows you to combine multiple aliens together
and handles a number of corner obscure corner cases that using L<Alien>s
directly does not. Also as of 0.64, L<Alien::Base::Wrapper> comes bundled
with L<Alien::Build> and L<Alien::Base> anyway, so it is not an extra
dependency.
What follows are the main use cases.
=head2 ExtUtils::MakeMaker
use ExtUtils::MakeMaker;
use Alien::Base::Wrapper ();
WriteMakefile(
Alien::Base::Wrapper->new('Alien::Foo')->mm_args2(
NAME => 'FOO::XS',
...
),
);
L<Alien::Base::Wrapper> will take a hash of C<WriteMakefile> arguments
and insert the appropriate compiler and linker flags for you. This
is recommended over doing this yourself as the exact incantation to
get EUMM to work is tricky to get right.
The C<mm_args2> method will also set your C<CONFIGURE_REQUIRES> for
L<Alien::Base::Wrapper>, L<ExtUtils::MakeMaker> and any aliens that
you specify.
=head2 Module::Build
use Module::Build;
use Alien::Base::Wrapper qw( Alien::Foo !export );
use Alien::Foo;
my $build = Module::Build->new(
...
configure_requires => {
'Alien::Base::Wrapper' => '0',
'Alien::Foo' => '0',
...
},
Alien::Base::Wrapper->mb_args,
...
);
$build->create_build_script;
For L<Module::Build> you can also use L<Alien::Base::Wrapper>, but
you will have to specify the C<configure_requires> yourself.
=head2 Inline::C / Inline::CPP
use Inline 0.56 with => 'Alien::Foo';
L<Inline::C> and L<Inline::CPP> can be configured
to use an L<Alien::Base> based L<Alien> with the C<with> keyword.
=head2 ExtUtils::Depends
use ExtUtils::MakeMaker;
use ExtUtils::Depends;
my $pkg = ExtUtils::Depends->new("Alien::Foo");
WriteMakefile(
...
$pkg->get_makefile_vars,
...
);
L<ExtUtils::Depends> works similar to L<Alien::Base::Wrapper>, but uses
the L<Inline> interface under the covers.
=head2 Dist::Zilla
[@Filter]
-bundle = @Basic
-remove = MakeMaker
[Prereqs / ConfigureRequires]
Alien::Foo = 0
[MakeMaker::Awesome]
header = use Alien::Base::Wrapper qw( Alien::Foo !export );
WriteMakefile_arg = Alien::Base::Wrapper->mm_args
=head2 FFI::Platypus
Requires C<Alien::Foo> always:
use FFI::Platypus;
use Alien::Foo;
my $ffi = FFI::Platypus->new(
lib => [ Alien::Foo->dynamic_libs ],
);
Use C<Alien::Foo> in fallback mode:
use FFI::Platypus;
use FFI::CheckLib 0.28 qw( find_lib_or_die );
use Alien::Foo;
my $ffi = FFI::Platypus->new(
lib => [ find_lib_or_die lib => 'foo', alien => ['Alien::Foo'] ],
);
If you are going to always require an L<Alien> you can just call C<dynamic_libs>
and pass it into L<FFI::Platypus>' lib method. You should consider
using L<FFI::CheckLib> to use the L<Alien> in fallback mode instead.
This way you only need to install the L<Alien> if the system doesn't
provide it.
For fallback mode to work correctly you need to be using L<FFI::CheckLib>
0.28 or better.
=head2 Inline::C
use Inline with => 'Alien::Foo';
use Inline C => <<~'END';
#include <foo.h>
const char *my_foo_wrapper()
{
foo();
}
END
sub exported_foo()
{
my_foo_wrapper();
}
=head2 tool
use Alien::Foo;
use Env qw( @PATH );
unshift @PATH, Alien::Foo->bin_dir;
system 'foo', '--bar', '--baz';
Some L<Alien>s provide tools instead of or in addition to a library.
You need to add them to the C<PATH> environment variable though.
(Unless the tool is already provided by the system, in which case
it is already in the path and the C<bin_dir> method will return an
empty list).
=head1 ENVIRONMENT
=over 4
=item ALIEN_INSTALL_TYPE
Although the recommended way for a consumer to use an L<Alien::Base> based L<Alien>
is to declare it as a static configure and build-time dependency, some consumers
may prefer to fallback on using an L<Alien> only when the consumer itself cannot
detect the necessary package. In some cases the consumer may want the user to opt-in
to using an L<Alien> before requiring it.
To keep the interface consistent among Aliens, the consumer of the fallback opt-in
L<Alien> may fallback on the L<Alien> if the environment variable C<ALIEN_INSTALL_TYPE>
is set to any value. The rationale is that by setting this environment variable the
user is aware that L<Alien> modules may be installed and have indicated consent.
The actual implementation of this, by its nature would have to be in the consuming
CPAN module.
This behavior should be documented in the consumer's POD.
See L<Alien::Build/ENVIRONMENT> for more details on the usage of this environment
variable.
=back
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Manual>
Other L<Alien::Build> manuals.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual/Contributing.pod 0000444 00000021745 15157554655 0014672 0 ustar 00 # PODNAME: Alien::Build::Manual::Contributing
# ABSTRACT: Over-detailed contributing guide
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual::Contributing - Over-detailed contributing guide
=head1 VERSION
version 2.84
=head1 SYNOPSIS
perldoc Alien::Build::Manual::Contributing
=head1 DESCRIPTION
Thank you for considering to contribute to my open source project! If
you have a small patch please consider just submitting it. Doing so
through the project GitHub is probably the best way:
L<https://github.com/plicease/Alien-Build/issues>
If you have a more invasive enhancement or bugfix to contribute, please
take the time to review these guidelines. In general it is good idea to
work closely with the L<Alien::Build> developers, and the best way to
contact them is on the C<#native> IRC channel on irc.perl.org.
=head2 History
Joel Berger wrote the original L<Alien::Base>. This distribution
included the runtime code L<Alien::Base> and an installer class
L<Alien::Base::ModuleBuild>. The significant thing about L<Alien::Base>
was that it provided tools to make it relatively easy for people to roll
their own L<Alien> distributions. Over time, the PerlAlien (github
organization) or "Alien::Base team" has taken over development of
L<Alien::Base> with myself (Graham Ollis) being responsible for
integration and releases. Joel Berger is still involved in the project.
Since the original development of L<Alien::Base>, L<Module::Build>, on
which L<Alien::Base::ModuleBuild> is based, has been removed from the
core of Perl. It seemed worthwhile to write a replacement installer
that works with L<ExtUtils::MakeMaker> which IS still bundled with the
Perl core. Because this is a significant undertaking it is my intention
to integrate the many lessons learned by Joel Berger, myself and the
"Alien::Base team" as possible. If the interface seems good then it is
because I've stolen the ideas from some pretty good places.
=head2 Philosophy
=head3 Alien runtime should be as config-only as possible.
Ideally the code for an L<Alien::Base> based L<Alien> should simply
inherit from L<Alien::Base>, like so:
package Alien::libfoo;
use parent qw( Alien::Base );
1;
The detection logic should be done by the installer code (L<alienfile>
and L<Alien::Build>) and saved into runtime properties (see
L<Alien::Build/runtime_prop>). And as much as
possible the runtime should be implemented in the base class (L<Alien::Base>).
Where reasonable, the base class should be expanded to meet the needs
of this arrangement.
=head3 when downloading a package grab the latest version
If the maintainer of an L<Alien> disappears for a while, and if the
version downloaded during a "share" install is hardcoded in the
L<alienfile>, it can be problematic for end-users.
There are exceptions, of course, in particular when a package provides
a very unstable interface from version to version it makes sense
to hard code the version and for the Alien developer and Alien consumer
developer to coordinate closely.
=head3 when installing a package the operating system as a whole should not be affected
The convenience of using an L<Alien> is that a user of a CPAN module
that consumes an L<Alien> doesn't need to know the exact incantation
to install the libraries on which it depends (or indeed it may not be
easily installed through the package manager anyway).
As a corollary, a user of a CPAN module that consumes an L<Alien>
module shouldn't expect operating system level packages to be
installed, or for these packages to be installed in common system
level directories, like C</usr/local> or C</opt>. Instead a "share"
directory associated with the Perl install and L<Alien> module
should be used.
Plugins that require user opt-in could be written to prompt a user
to automatically install operating system packages, but this should
never be done by default or without consent by the user.
=head3 avoid dependencies
One of the challenges with L<Alien> development is that you are by the
nature of the problem, trying to make everyone happy. Developers
working out of CPAN just want stuff to work, and some build environments
can be hostile in terms of tool availability, so for reliability you end
up pulling a lot of dependencies. On the other hand, operating system
vendors who are building Perl modules usually want to use the system
version of a library so that they do not have to patch libraries in
multiple places. Such vendors have to package any extra dependencies
and having to do so for packages that the don't even use makes them
understandably unhappy.
As general policy the L<Alien::Build> core should have as few
dependencies as possible, and should only pull extra dependencies if
they are needed. Where dependencies cannot be avoidable, popular and
reliable CPAN modules, which are already available as packages in the
major Linux vendors (Debian, Red Hat) should be preferred.
As such L<Alien::Build> is hyper aggressive at using dynamic
prerequisites.
=head3 interface agnostic
One of the challenges with L<Alien::Base::ModuleBuild> was that
L<Module::Build> was pulled from the core. In addition, there is a
degree of hostility toward L<Module::Build> in some corners of the Perl
community. I agree with Joel Berger's rationale for choosing
L<Module::Build> at the time, as I believe its interface more easily
lends itself to building L<Alien> distributions.
That said, an important feature of L<Alien::Build> is that it is
installer agnostic. Although it is initially designed to work with
L<ExtUtils::MakeMaker>, it has been designed from the ground up to work
with any installer (Perl, or otherwise).
As an extension of this, although L<Alien::Build> may have external CPAN
dependencies, they should not be exposed to developers USING
L<Alien::Build>. As an example, L<Path::Tiny> is used heavily
internally because it does what L<File::Spec> does, plus the things that
it doesn't, and uses forward slashes on Windows (backslashes are the
"correct separator on windows, but actually using them tends to break
everything). However, there aren't any interfaces in L<Alien::Build>
that will return a L<Path::Tiny> object (or if there are, then this is a
bug).
This means that if we ever need to port L<Alien::Build> to a platform
that doesn't support L<Path::Tiny> (such as VMS), then it may require
some work to L<Alien::Build> itself, modules that USE L<Alien::Build>
shouldn't need to be modified.
=head3 plugable
The actual logic that probes the system, downloads source and builds it
should be as pluggable as possible. One of the challenges with
L<Alien::Base::ModuleBuild> was that it was designed to work well with
software that works with C<autoconf> and C<pkg-config>. While you can
build with other tools, you have to know a bit of how the installer
logic works, and which hooks need to be tweaked.
L<Alien::Build> has plugins for C<autoconf>, C<pkgconf> (successor of
C<pkg-config>), vanilla Makefiles, and CMake. If your build system
doesn't have a plugin, then all you have to do is write one! Plugins
that prove their worth may be merged into the L<Alien::Build> core.
Plugins that after a while feel like maybe not such a good idea may be
removed from the core, or even from CPAN itself.
In addition, L<Alien::Build> has a special type of plugin, called a
negotiator which picks the best plugin for the particular environment
that it is running in. This way, as development of the negotiator and
plugins develop over time modules that use L<Alien::Build> will benefit,
without having to change the way they interface with L<Alien::Build>
=head1 ACKNOWLEDGEMENT
I would like to that Joel Berger for getting things running in the first
place. Also important to thank other members of the "Alien::Base team":
Zaki Mughal (SIVOAIS)
Ed J (ETJ, mohawk)
Also kind thanks to all of the developers who have contributed to
L<Alien::Base> over the years:
L<https://metacpan.org/pod/Alien::Base#CONTRIBUTORS>
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Manual>
Other L<Alien::Build> manuals.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual/AlienAuthor.pod 0000444 00000061152 15157554662 0014430 0 ustar 00 # PODNAME: Alien::Build::Manual::AlienAuthor
# ABSTRACT: Alien author documentation
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual::AlienAuthor - Alien author documentation
=head1 VERSION
version 2.84
=head1 SYNOPSIS
perldoc Alien::Build::Manual::AlienAuthor
=head1 DESCRIPTION
B<Note>: Please read the entire document before you get started in
writing your own L<alienfile>. The section on dynamic vs. static
libraries will likely save you a lot of grief if you read it now!
This document is intended to teach L<Alien> authors how to build their
own L<Alien> distribution using L<Alien::Build> and L<Alien::Base>.
Such an L<Alien> distribution consists of three essential parts:
=over 4
=item An L<alienfile>
This is a recipe for how to 1) detect an already installed version of
the library or tool you are alienizing 2) download and build the library
or tool that you are alienizing and 3) gather the configuration settings
necessary for the use of that library or tool.
=item An installer C<Makefile.PL> or C<Build.PL> or a C<dist.ini> if you are using L<Dist::Zilla>
This is a thin layer between your L<alienfile> recipe, and the Perl
installer (either L<ExtUtils::MakeMaker> or L<Module::Build>.
=item A Perl class (.pm file) that inherits from L<Alien::Base>
For most L<Alien>s this does not need to be customized at all, since
L<Alien::Base> usually does what you need.
=back
For example if you were alienizing a library called libfoo, you might
have these files:
Alien-Libfoo-1.00/Makefile.PL
Alien-Libfoo-1.00/alienfile
Alien-Libfoo-1.00/lib/Alien/Libfoo.pm
This document will focus mainly on instructing you how to construct an
L<alienfile>, but we will also briefly cover making a simple
C<Makefile.PL> or C<dist.ini> to go along with it. We will also touch
on when you might want to extend your subclass to add non-standard
functionality.
=head2 Using commands
Most software libraries and tools will come with instructions for how to
install them in the form of commands that you are intended to type into
a shell manually. The easiest way to automate those instructions is to
just put the commands in your L<alienfile>. For example, lets suppose
that libfoo is built using autoconf and provides a C<pkg-config> C<.pc>
file.
We will also later discuss plugins. For common build systems like
autoconf or CMake, it is usually better to use the appropriate plugin
because they will handle corner cases better than a simple set of
commands. We're going to take a look at commands first because it's
easier to understand the different phases with commands.
(Aside, autoconf is a series of tools and macros used to configure
(usually) a C or C++ library or tool by generating any number of
Makefiles. It is the C equivalent to L<ExtUtils::MakeMaker>, if you
will. Basically, if your library or tool instructions start with
'./configure' it is most likely an autoconf based library or tool).
(Aside2, C<pkg-config> is a standard-ish way to provide the compiler and
linker flags needed for compiling and linking against the library. If
your tool installs a C<.pc> file, usually in C<$PREFIX/lib/pkgconfig>
then, your tool uses C<pkg-config>).
Here is the L<alienfile> that you might have:
use alienfile;
probe [ 'pkg-config --exists libfoo' ];
share {
start_url 'http://www.libfoo.org/src/libfoo-1.00.tar.gz';
download [ 'wget %{.meta.start_url}' ];
extract [ 'tar zxf %{.install.download}' ];
build [
[ './configure --prefix=%{.install.prefix} --disable-shared' ],
[ '%{make}' ],
[ '%{make} install' ],
];
};
gather [
[ 'pkg-config --modversion libfoo', \'%{.runtime.version}' ],
[ 'pkg-config --cflags libfoo', \'%{.runtime.cflags}' ],
[ 'pkg-config --libs libfoo', \'%{.runtime.libs}' ],
];
There is a lot going on here, so lets decode it a little bit. An
L<alienfile> is just some Perl with some alien specific sugar. The
first line
use alienfile;
imports the sugar into the L<alienfile>. It also is a flag for the
reader to see that this is an L<alienfile> and not some other kind of
Perl script.
The second line is the probe directive:
probe [ 'pkg-config --exists libfoo' ];
is used to see if the library is already installed on the target system.
If C<pkg-config> is in the path, and if libfoo is installed, this should
exit with a success (0) and tell L<Alien::Build> to use the system
library. If either C<pkg-config> in the PATH, or if libfoo is not
installed, then it will exist with non-success (!= 0) and tells
L<Alien::Build> to download and build from source.
You can provide as many probe directives as you want. This is useful if
there are different ways to probe for the system. L<Alien::Build> will
stop on the first successfully found system library found. Say our
library libfoo comes with a C<.pc> file for use with C<pkg-config> and
also provides a C<foo-config> program to find the same values. You
could then specify this in your L<alienfile>
probe [ 'pkg-config --exists libfoo' ];
probe [ 'foo-config --version' ];
Other directives can be specified multiple times if there are different
methods that can be tried for the various steps.
Sometimes it is easier to probe for a library from Perl rather than with
a command. For that you can use a code reference. For example, another
way to call C<pkg-config> would be from Perl:
probe sub {
my($build) = @_; # $build is the Alien::Build instance.
system 'pkg-config --exists libfoo';
$? == 0 ? 'system' : 'share';
};
The Perl code should return 'system' if the library is installed, and
'share' if not. (Other directives should return a true value on
success, and a false value on failure). You can also throw an exception with
C<die> to indicate a failure.
The next part of the L<alienfile> is the C<share> block, which is used
to group the directives which are used to download and install the
library or tool in the event that it is not already installed.
share {
start_url 'http://www.libfoo.org/src/libfoo-1.00.tar.gz';
download [ 'wget %{.meta.start_url}' ];
extract [ 'tar zxf %{.install.download}' ];
build [
[ './configure --prefix=%{.install.prefix} --disable-shared' ],
[ '%{make}' ],
[ '%{make} install' ],
];
};
The start_url specifies where to find the package that you are alienizing.
It should be either a tarball (or zip file, or what have you) or an
HTML index. The download directive as you might imagine specifies how
to download the library or tool. The extract directive specifies how
to extract the archive once it is downloaded. In the extract step, you
can use the variable C<%{.install.download}> as a placeholder for the archive
that was downloaded in the download step. This is also accessible if
you use a code reference from the L<Alien::Build> instance:
share {
...
requires 'Archive::Extract';
extract sub {
my($build) = @_;
my $tarball = $build->install_prop->{download};
my $ae = Archive::Extract->new( archive => $tarball );
$ae->extract;
1;
}
...
};
The build directive specifies how to build the library or tool once it
has been downloaded and extracted. Note the special variable
C<%{.install.prefix}> is the location where the library should be
installed. C<%{make}> is a helper which will be replaced by the
appropriate C<make>, which may be called something different on some
platforms (on Windows for example, it frequently may be called C<nmake>
or C<dmake>).
The final part of the L<alienfile> has a gather directive which
specifies how to get the details on how to compile and link against the
library. For this, once again we use the C<pkg-config> command:
gather [
[ 'pkg-config --modversion libfoo', \'%{.runtime.version}' ],
[ 'pkg-config --cflags libfoo', \'%{.runtime.cflags}' ],
[ 'pkg-config --libs libfoo', \'%{.runtime.libs}' ],
];
The scalar reference as the final item in the command list tells
L<Alien::Build> that the output from the command should be stored in the
given variable. The runtime variables are the ones that will be
available to C<Alien::Libfoo> once it is installed. (Install
properties, which are the ones that we have seen up till now are thrown
away once the L<Alien> distribution is installed.
You can also provide a C<sys> block for directives that should be used
when a system install is detected. Normally you only need to do this if
the gather step is different between share and system installs. For
example, the above is equivalent to:
build {
...
gather [
[ 'pkg-config --modversion libfoo', \'%{.runtime.version}' ],
[ 'pkg-config --cflags libfoo', \'%{.runtime.cflags}' ],
[ 'pkg-config --libs libfoo', \'%{.runtime.libs}' ],
];
};
sys {
gather [
[ 'pkg-config --modversion libfoo', \'%{.runtime.version}' ],
[ 'pkg-config --cflags libfoo', \'%{.runtime.cflags}' ],
[ 'pkg-config --libs libfoo', \'%{.runtime.libs}' ],
];
};
(Aside3, the reason it is called C<sys> and not C<system> is so that it
does not conflict with the built in C<system> function)!
=head2 Using plugins
The first example is a good way of showing the full manual path that you
can choose, but there is a lot of repetition, if you are doing many
L<Alien>s that use autoconf and C<pkg-config> (which are quite common.
L<alienfile> allows you to use plugins. See L<Alien::Build::Plugin> for
a list of some of the plugin categories.
For now, I will just show you how to write the L<alienfile> for libfoo
above using L<Alien::Build::Plugin::Build::Autoconf>,
L<Alien::Build::Plugin::PkgConfig::Negotiate>,
L<Alien::Build::Plugin::Download::Negotiate>, and
L<Alien::Build::Plugin::Extract::Negotiate>
use alienfile;
plugin 'PkgConfig' => (
pkg_name => 'libfoo',
);
share {
start_url 'http://www.libfoo.org/src';
plugin 'Download' => (
filter => qr/^libfoo-[0-9\.]+\.tar\.gz$/,
version => qr/^libfoo-([0-9\.]+)\.tar\.gz$/,
);
plugin 'Extract' => 'tar.gz';
plugin 'Build::Autoconf';
build [
'%{configure} --disable-shared',
'%{make}',
'%{make} install',
];
};
The first plugin that we use is the C<pkg-config> negotiation plugin. A
negotiation plugin is one which doesn't do the actual work but selects
the best one from a set of plugins depending on your platform and
environment. (In the case of
L<Alien::Build::Plugin::PkgConfig::Negotiate>, it may choose to use
command line tools, a pure Perl implementation (L<PkgConfig>), or
libpkgconf, depending on what is available). When using negotiation
plugins you may omit the C<::Negotiate> suffix. So as you can see using
the plugin here is an advantage because it is more reliable than just
specifying a command which may not be installed!
Next we use the download negotiation plugin. This is also better than
the version above, because again, C<wget> my not be installed on the
target system. Also you can specify a URL which will be scanned for
links, and use the most recent version.
We use the Extract negotiation plugin to use either command line tools,
or Perl libraries to extract from the archive once it is downloaded.
Finally we use the Autoconf plugin
(L<Alien::Build::Plugin::Build::Autoconf>). This is a lot more
sophisticated and reliable than in the previous example, for a number of
reasons. This version will even work on Windows assuming the library or
tool you are alienizing supports that platform!
Strictly speaking the build directive is not necessary, because the
autoconf plugin provides a default which is reasonable. The only reason
that you would want to include it is if you need to provide additional
flags to the configure step.
share {
...
build [
'%{configure} --enable-bar --enable-baz --disable-shared',
'%{make}',
'%{make} install',
];
};
=head2 Multiple .pc files
Some packages come with multiple libraries paired with multiple C<.pc>
files. In this case you want to provide the
L<Alien::Build::Plugin::PkgConfig::Negotiate> with an array reference
of package names.
plugin 'PkgConfig' => (
pkg_name => [ 'foo', 'bar', 'baz' ],
);
All packages must be found in order for the C<system> install to succeed.
Once installed the first C<pkg_name> will be used by default (in this
example C<foo>), and you can retrieve any other C<pkg_name> using
the L<Alien::Base alt method|Alien::Base/alt>.
=head2 A note about dynamic vs. static libraries
If you are using your L<Alien> to build an XS module, it is important
that you use static libraries if possible. If you have a package that
refuses to build a static library, then you can use L<Alien::Role::Dino>.
Actually let me back up a minute. For a C<share> install it is best
to use static libraries to build your XS extension. This is because
if your L<Alien> is ever upgraded to a new version it can break your
existing XS modules. For a C<system> install shared libraries are
usually best because you can often get security patches without having
to re-build anything in perl land.
If you looked closely at the "Using commands" and "Using plugins"
sections above, you may notice that we went out of our way where
possible to tell Autotools to build only static libraries using the
C<--disable-shared> command. The Autoconf plugin also does this by
default.
Sometimes though you will have a package that builds both, or maybe
you I<want> both static and dynamic libraries to work with XS and FFI.
For that case, there is the L<Alien::Build::Plugin::Gather::IsolateDynamic>
plugin.
use alienfile;
...
plugin 'Gather::IsolateDynamic';
What it does, is that it moves the dynamic libraries (usually .so on
Unix and .DLL on Windows) to a place where they can be found by FFI,
and where they won't be used by the compiler for building XS. It usually
doesn't do any harm to include this plugin, so if you are just starting
out you might want to add it anyway. Arguably it should have been the
default behavior from the beginning.
If you have already published an Alien that does not isolate its
dynamic libraries, then you might get some fails from old upgraded
aliens because the share directory isn't cleaned up by default (this is
perhaps a design bug in the way that share directories work, but it
is a long standing characteristic). One work around for this is to
use the C<clean_install> property on L<Alien::Build::MM>, which will
clean out the share directory on upgrade, and possibly save you a lot
of grief.
=head2 Verifying and debugging your alienfile
You could feed your alienfile directly into L<Alien::Build>, or
L<Alien::Build::MM>, but it is sometimes useful to test your alienfile
using the C<af> command (it does not come with L<Alien::Build>, you need
to install L<App::af>). By default C<af> will use the C<alienfile> in
the current directory (just as C<make> uses the C<Makefile> in the
current directory; just like C<make> you can use the C<-f> option to
specify a different L<alienfile>).
You can test your L<alienfile> in dry run mode:
% af install --dry-run
Alien::Build::Plugin::Core::Legacy> adding legacy hash to config
Alien::Build::Plugin::Core::Gather> mkdir -p /tmp/I2YXRyxb0r/_alien
---
cflags: ''
cflags_static: ''
install_type: system
legacy:
finished_installing: 1
install_type: system
name: libfoo
original_prefix: /tmp/7RtAusykNN
version: 1.2.3
libs: '-lfoo '
libs_static: '-lfoo '
prefix: /tmp/7RtAusykNN
version: 1.2.3
You can use the C<--type> option to force a share install (download and
build from source):
% af install --type=share --dry-run
Alien::Build::Plugin::Core::Download> decoding html
Alien::Build::Plugin::Core::Download> candidate *https://www.libfoo.org/download/libfoo-1.2.4.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.3.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.2.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.1.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.0.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.1.9.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.1.8.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.1.7.tar.gz
Alien::Build::Plugin::Core::Download> candidate ...
Alien::Build::Plugin::Core::Download> setting version based on archive to 1.2.4
Alien::Build::Plugin::Core::Download> downloaded libfoo-1.2.4.tar.gz
Alien::Build::CommandSequence> + ./configure --prefix=/tmp/P22WEXj80r --with-pic --disable-shared
... snip ...
Alien::Build::Plugin::Core::Gather> mkdir -p /tmp/WsoLAQ889w/_alien
---
cflags: ''
cflags_static: ''
install_type: share
legacy:
finished_installing: 1
install_type: share
original_prefix: /tmp/P22WEXj80r
version: 1.2.4
libs: '-L/tmp/P22WEXj80r/lib -lfoo '
libs_static: '-L/tmp/P22WEXj80r/lib -lfoo '
prefix: /tmp/P22WEXj80r
version: 1.2.4
You can also use the C<--before> and C<--after> options to take a peek
at what the build environment looks like at different stages as well,
which can sometimes be useful:
% af install --dry-run --type=share --before build bash
Alien::Build::Plugin::Core::Download> decoding html
Alien::Build::Plugin::Core::Download> candidate *https://www.libfoo.org/download/libfoo-1.2.4.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.3.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.2.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.1.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.2.0.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.1.9.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.1.8.tar.gz
Alien::Build::Plugin::Core::Download> candidate https://www.libfoo.org/download/libfoo-1.1.7.tar.gz
Alien::Build::Plugin::Core::Download> candidate ...
Alien::Build::Plugin::Core::Download> setting version based on archive to 1.2.4
Alien::Build::Plugin::Core::Download> downloaded libfoo-1.2.4.tar.gz
App::af::install> [ before build ] + bash
/tmp/fbVPu4LRTs/build_5AVn/libfoo-1.2.4$ ls
CHANGES Makefile autoconf.ac lib
/tmp/fbVPu4LRTs/build_5AVn/libfoo-1.2.4$
There are a lot of other useful things that you can do with the C<af>
command. See L<af> for details.
=head2 Integrating with MakeMaker
Once you have a working L<alienfile> you can write your C<Makefile.PL>.
use ExtUtils::MakeMaker;
use Alien::Build::MM;
my $abmm = Alien::Build::MM->new;
WriteMakefile($abmm->mm_args(
ABSTRACT => 'Discover or download and install libfoo',
DISTNAME => 'Alien-Libfoo',
NAME => 'Alien::Libfoo',
VERSION_FROM => 'lib/Alien/Libfoo.pm',
CONFIGURE_REQUIRES => {
'Alien::Build::MM' => 0,
},
BUILD_REQUIRES => {
'Alien::Build::MM' => 0,
},
PREREQ_PM => {
'Alien::Base' => 0,
},
# If you are going to write the recommended
# tests you will will want these:
TEST_REQUIRES => {
'Test::Alien' => 0,
'Test2::V0' => 0,
},
));
sub MY::postamble {
$abmm->mm_postamble;
}
The C<lib/Alien/Libfoo.pm> that goes along with it is very simple:
package Alien::Libfoo;
use strict;
use warnings;
use parent qw( Alien::Base );
1;
You are done and can install it normally:
% perl Makefile.PL
% make
% make test
% make install
=head2 Integrating with Module::Build
Please don't! Okay if you have to there is L<Alien::Build::MB>.
=head2 Non standard configuration
L<Alien::Base> support most of the things that your L<Alien> will need,
like compiler flags (cflags), linker flags (libs) and binary directory
(bin_dir). Your library or tool may have other configuration items
which are not supported by default. You can store the values in the
L<alienfile> into the runtime properties:
gather [
# standard:
[ 'foo-config --version libfoo', \'%{.runtime.version}' ],
[ 'foo-config --cflags libfoo', \'%{.runtime.cflags}' ],
[ 'foo-config --libs libfoo', \'%{.runtime.libs}' ],
# non-standard
[ 'foo-config --bar-baz libfoo', \'%{.runtime.bar_baz}' ],
];
then you can expose them in your L<Alien::Base> subclass:
package Alien::Libfoo;
use strict;
use warnings;
use parent qw( Alien::Base );
sub bar_baz {
my($self) = @_;
$self->runtime_prop->{bar_baz},
};
1;
=head2 Testing
(optional, but highly recommended)
You should write a test using L<Test::Alien> to make sure that your
alien will work with any XS modules that are going to use it:
use Test2::V0;
use Test::Alien;
use Alien::Libfoo;
alien_ok 'Alien::Libfoo';
xs_ok do { local $/; <DATA> }, with_subtest {
is Foo::something(), 1, 'Foo::something() returns 1';
};
done_testing;
__DATA__
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <foo.h>
MODULE = Foo PACKAGE = Foo
int something()
You can also use L<Test::Alien> to test tools instead of libraries:
use Test2::V0;
use Test::Alien;
use Alien::Libfoo;
alien_ok 'Alien::Libfoo';
run_ok(['foo', '--version'])
->exit_is(0);
done_testing;
You can also write tests specifically for L<FFI::Platypus>, if your
alien is going to be used to write FFI bindings. (the test below
is the FFI equivalent to the XS example above).
use Test2::V0;
use Test::Alien;
use Alien::Libfoo;
alien_ok 'Alien::Libfoo';
ffi_ok { symbols => [ 'something' ] }, with_subtest {
# $ffi is an instance of FFI::Platypus with the lib
# set appropriately.
my($ffi) = @_;
my $something = $ffi->function( something => [] => 'int' );
is $something->call(), 1, 'Foo::something() returns 1';
};
If you do use C<ffi_ok> you want to make sure that your alien reliably
produces dynamic libraries. If it isn't consistent (if for example
some platforms tend not to provide or build dynamic libraries), you can
check that C<dynamic_libs> doesn't return an empty list.
...
alien_ok 'Alien::Libfoo';
SKIP: {
skip "This test requires a dynamic library"
unless Alien::Libfoo->dynamic_libs;
ffi_ok { symbols [ 'something' ] }, with_subtest {
...
};
}
More details on testing L<Alien> modules can be found in the
L<Test::Alien> documentation.
You can also run the tests that come with the package that you are alienizing,
by using a C<test> block in your L<alienfile>. Keep in mind that some packages
use testing tools or have other prerequisites that will not be available on your
users machines when they attempt to install your alien. So you do not want to
blindly add a test block without checking what the prereqs are. For Autoconf
style packages you typically test a package using the C<make check> command:
use alienfile;
plugin 'PkgConfig' => 'libfoo';
share {
... # standard build steps.
test [ '%{make} check' ];
};
=head2 Dist::Zilla
(optional, mildly recommended)
You can also use the L<Alien::Build> L<Dist::Zilla> plugin
L<Dist::Zilla::Plugin::AlienBuild>:
name = Alien-Libfoo
author = E. Xavier Ample <example@cpan.org>
license = Perl_5
copyright_holder = E. Xavier Ample <example@cpan.org>
copyright_year = 2017
version = 0.01
[@Basic]
[AlienBuild]
The plugin takes care of a lot of details like making sure that the
correct minimum versions of L<Alien::Build> and L<Alien::Base> are used.
See the plugin documentation for additional details.
=head2 Using your Alien
Once you have installed you can use your Alien. See
L<Alien::Build::Manual::AlienUser> for guidance on that.
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Manual>
Other L<Alien::Build> manuals.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Temp.pm 0000444 00000005560 15157554670 0011537 0 ustar 00 package Alien::Build::Temp;
use strict;
use warnings;
use 5.008004;
use Carp ();
use Path::Tiny ();
use File::Temp ();
use File::Spec ();
# ABSTRACT: Temp Dir support for Alien::Build
our $VERSION = '2.84'; # VERSION
# problem with vanilla File::Temp is that is often uses
# as /tmp that has noexec turned on. Workaround is to
# create a temp directory in the build directory, but
# we have to be careful about cleanup. This puts all that
# (attempted) carefulness in one place so that when we
# later discover it isn't so careful we can fix it in
# one place rather than all the places that we need
# temp directories.
# we also have a speical case for Windows, which often
# has problems with long paths if we try to use the
# current directory for temp files, so for those we
# use the system tmp directory.
my %root;
sub _root
{
return File::Spec->tmpdir if $^O eq 'MSWin32';
my $root = Path::Tiny->new(-d "_alien" ? "_alien/tmp" : ".tmp")->absolute;
unless(-d $root)
{
mkdir $root or die "unable to create temp root $!";
}
# TODO: doesn't account for fork...
my $lock = $root->child("l$$");
unless(-f $lock)
{
open my $fh, '>', $lock;
close $fh;
}
$root{"$root"} = 1;
$root;
}
END {
foreach my $root (keys %root)
{
my $lock = Path::Tiny->new($root)->child("l$$");
unlink $lock;
# try to delete if possible.
# if not possible then punt
rmdir $root if -d $root;
}
}
sub newdir
{
my $class = shift;
Carp::croak "uneven" if @_ % 2;
File::Temp->newdir(DIR => _root, @_);
}
sub new
{
my $class = shift;
Carp::croak "uneven" if @_ % 2;
File::Temp->new(DIR => _root, @_);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Temp - Temp Dir support for Alien::Build
=head1 VERSION
version 2.84
=head1 DESCRIPTION
This class is private to L<Alien::Build>.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Log/Abbreviate.pm 0000444 00000005074 15157554702 0013413 0 ustar 00 package Alien::Build::Log::Abbreviate;
use strict;
use warnings;
use 5.008004;
use Term::ANSIColor ();
use Path::Tiny qw( path );
use File::chdir;
use parent qw( Alien::Build::Log );
# ABSTRACT: Log class for Alien::Build which is less verbose
our $VERSION = '2.84'; # VERSION
sub _colored
{
my($code, @out) = @_;
-t STDOUT ? Term::ANSIColor::colored($code, @out) : @out;
}
my $root = path("$CWD");
sub log
{
my(undef, %args) = @_;
my($message) = $args{message};
my ($package, $filename, $line) = @{ $args{caller} };
my $source = $package;
$source =~ s/^Alien::Build::Auto::[^:]+::Alienfile/alienfile/;
my $expected = $package;
$expected .= '.pm' unless $package eq 'alienfile';
$expected =~ s/::/\//g;
if($filename !~ /\Q$expected\E$/)
{
$source = path($filename)->relative($root);
}
else
{
$source =~ s/^Alien::Build::Plugin/ABP/;
$source =~ s/^Alien::Build/AB/;
}
print _colored([ "bold on_black" ], '[');
print _colored([ "bright_green on_black" ], $source);
print _colored([ "on_black" ], ' ');
print _colored([ "bright_yellow on_black" ], $line);
print _colored([ "bold on_black" ], ']');
print _colored([ "white on_black" ], ' ', $message);
print "\n";
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Log::Abbreviate - Log class for Alien::Build which is less verbose
=head1 VERSION
version 2.84
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=head2 log
$log->log(%opts);
Send single log line to stdout.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Log/Default.pm 0000444 00000004015 15157554707 0012732 0 ustar 00 package Alien::Build::Log::Default;
use strict;
use warnings;
use 5.008004;
use parent qw( Alien::Build::Log );
# ABSTRACT: Default Alien::Build log class
our $VERSION = '2.84'; # VERSION
sub log
{
my(undef, %args) = @_;
my($message) = $args{message};
my ($package, $filename, $line) = @{ $args{caller} };
print "$package> $message\n";
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Log::Default - Default Alien::Build log class
=head1 VERSION
version 2.84
=head1 SYNOPSIS
Alien::Build->log("message1");
$build->log("message2");
=head1 DESCRIPTION
This is the default log class for L<Alien::Build>. It does
the sensible thing of sending the message to stdout, along
with the class that made the log call. For more details
about logging with L<Alien::Build>, see L<Alien::Build::Log>.
=head1 METHODS
=head2 log
$log->log(%opts);
Send single log line to stdout.
=head1 SEE ALSO
=over 4
=item L<Alien::Build>
=item L<Alien::Build::Log>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Log.pm 0000444 00000006222 15157554714 0011346 0 ustar 00 package Alien::Build::Log;
use strict;
use warnings;
use 5.008004;
use Carp ();
# ABSTRACT: Alien::Build logging
our $VERSION = '2.84'; # VERSION
my $log_class;
my $self;
sub new
{
my($class) = @_;
Carp::croak("Cannot instantiate base class") if $class eq 'Alien::Build::Log';
return bless {}, $class;
}
sub default
{
$self || do {
my $class = $log_class || $ENV{ALIEN_BUILD_LOG} || 'Alien::Build::Log::Default';
unless(eval { $class->can('new') })
{
my $pm = "$class.pm";
$pm =~ s/::/\//g;
require $pm;
}
$class->new;
}
}
sub set_log_class
{
my(undef, $class) = @_;
return if defined $class && ($class eq ($log_class || ''));
$log_class = $class;
undef $self;
}
sub log
{
Carp::croak("AB Log base class");
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Log - Alien::Build logging
=head1 VERSION
version 2.84
=head1 SYNOPSIS
Create your custom log class:
package Alien::Build::Log::MyLog;
use parent qw( Alien::Build::Log );
sub log
{
my(undef, %opt) = @_;
my($package, $filename, $line) = @{ $opt{caller} };
my $message = $opt{message};
...;
}
override log class:
% env ALIEN_BUILD_LOG=Alien::Build::Log::MyLog cpanm Alien::libfoo
=head1 DESCRIPTION
=head1 CONSTRUCTORS
=head2 new
my $log = Alien::Build::Log->new;
Create an instance of the log class.
=head2 default
my $log = Alien::Build::Log->default;
Return singleton instance of log class used by L<Alien::Build>.
=head1 METHODS
=head2 set_log_class
Alien::Build::Log->set_log_class($class);
Set the default log class used by L<Alien::Build>. This method will also reset the
default instance used by L<Alien::Build>. If not specified, L<Alien::Build::Log::Default>
will be used.
=head2 log
$log->log(%options);
Overridable method which does the actual work of the log class. Options:
=over 4
=item caller
Array references containing the package, file and line number of where the
log was called.
=item message
The message to log.
=back
=head1 ENVIRONMENT
=over 4
=item ALIEN_BUILD_LOG
The default log class used by L<Alien::Build>.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Interpolate/Default.pm 0000444 00000020202 15157554726 0014474 0 ustar 00 package Alien::Build::Interpolate::Default;
use strict;
use warnings;
use 5.008004;
use parent qw( Alien::Build::Interpolate );
use File::chdir;
use File::Which qw( which );
use Capture::Tiny qw( capture );
# ABSTRACT: Default interpolator for Alien::Build
our $VERSION = '2.84'; # VERSION
sub _config
{
$Config::Config{$_[0]};
}
sub new
{
my($class) = @_;
my $self = $class->SUPER::new(@_);
$self->add_helper( ar => sub { _config 'ar' }, 'Config' );
$self->add_helper( bison => undef, sub {
my $helper = shift;
if(which 'bison')
{
$helper->code(sub { 'bison' });
return ();
}
else
{
return 'Alien::bison' => '0.17';
}
});
$self->add_helper( bzip2 => undef, sub {
my $helper = shift;
if(which 'bzip2')
{
$helper->code( sub { 'bzip2' });
return ();
}
else
{
return 'Alien::Libbz2' => '0.04';
}
});
$self->add_helper( cc => sub { _config 'cc' }, 'Config' );
$self->add_helper( cmake => sub { 'cmake' }, sub {
if(which 'cmake')
{
return ();
}
else
{
return 'Alien::CMake' => '0.07';
}
});
$self->add_helper( cp => sub { _config 'cp' }, 'Config' );
$self->add_helper( devnull => sub { $^O eq 'MSWin32' ? 'NUL' : '/dev/null' });
$self->add_helper( flex => undef, sub {
my $helper = shift;
if(which 'flex')
{
$helper->code(sub { 'flex' });
return ();
}
else
{
return 'Alien::flex' => '0.08';
}
});
$self->add_helper( gmake => undef, 'Alien::gmake' => '0.11' );
$self->add_helper( install => sub { 'install' });
$self->add_helper( ld => sub { _config 'ld' }, 'Config' );
$self->add_helper( m4 => undef, 'Alien::m4' => '0.08' );
if($^O eq 'MSWin32')
{
# TL;DR: dmake is bad, and shouldn't be used to build anything but older
# versions of Windows Perl that don't support gmake.
my $perl_make = _config 'make';
my $my_make;
$self->add_helper( make => sub {
return $my_make if defined $my_make;
if( $perl_make ne 'dmake' && which $perl_make )
{
# assume if it is called nmake or gmake that it really is what it
# says it is.
if( $perl_make eq 'nmake' || $perl_make eq 'gmake' )
{
return $my_make = $perl_make;
}
my $out = capture { system $perl_make, '--version' };
if( $out =~ /GNU make/i || $out =~ /Microsoft \(R\) Program Maintenance/ )
{
return $my_make = $perl_make;
}
}
# if we see something that looks like it might be gmake, use that.
foreach my $try (qw( gmake mingw32-make ))
{
return $my_make = $try if which $try;
}
if( which 'make' )
{
my $out = capture { system 'make', '--version' };
if( $out =~ /GNU make/i || $out =~ /Microsoft \(R\) Program Maintenance/ )
{
return $my_make = 'make';
}
}
# if we see something that looks like it might be nmake, use that.
foreach my $try (qw( nmake ))
{
return $my_make = $try if which $try;
}
$my_make = $perl_make;
});
}
else
{
$self->add_helper( make => sub { _config 'make' }, 'Config' );
}
$self->add_helper( mkdir_deep => sub { $^O eq 'MSWin32' ? 'md' : 'mkdir -p'}, 'Alien::Build' => '1.04' );
$self->add_helper( make_path => sub { $^O eq 'MSWin32' ? 'md' : 'mkdir -p'}, 'Alien::Build' => '1.05' );
$self->add_helper( nasm => undef, sub {
my $helper = shift;
if(which 'nasm')
{
$helper->code(sub { 'nasm' });
return ();
}
else
{
return 'Alien::nasm' => '0.11';
}
});
$self->add_helper( patch => undef, sub {
my $helper = shift;
if(which 'patch')
{
if($^O eq 'MSWin32')
{
$helper->code(sub { 'patch --binary' });
}
else
{
$helper->code(sub { 'patch' });
}
return ();
}
else
{
return 'Alien::patch' => '0.09';
}
});
$self->add_helper( perl => sub {
my $perl = Devel::FindPerl::find_perl_interpreter();
$perl =~ s{\\}{/}g if $^O eq 'MSWin32';
$perl;
}, 'Devel::FindPerl' );
$self->add_helper( pkgconf => undef, 'Alien::pkgconf' => 0.06 );
$self->add_helper( cwd => sub {
my $cwd = "$CWD";
$cwd =~ s{\\}{/}g if $^O eq 'MSWin32';
$cwd;
} );
$self->add_helper( sh => sub { 'sh' }, 'Alien::MSYS' => '0.07' );
$self->add_helper( rm => sub { _config 'rm' }, 'Config' );
$self->add_helper( xz => undef, sub {
my $helper = shift;
if(which 'xz')
{
$helper->code(sub { 'xz' });
return ();
}
else
{
return 'Alien::xz' => '0.02';
}
});
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Interpolate::Default - Default interpolator for Alien::Build
=head1 VERSION
version 2.84
=head1 CONSTRUCTOR
=head2 new
my $intr = Alien::Build::Interpolate::Default->new;
=head1 HELPERS
=head2 ar
%{ar}
The ar command.
=head2 bison
%{bison}
Requires: L<Alien::bison> 0.17 if not already in C<PATH>.
=head2 bzip2
%{bzip2}
Requires: L<Alien::Libbz2> 0.04 if not already in C<PATH>.
=head2 cc
%{cc}
The C Compiler used to build Perl
=head2 cmake
%{cmake}
Requires: L<Alien::CMake> 0.07 if cmake is not already in C<PATH>.
Deprecated: Use the L<Alien::Build::Plugin::Build::CMake> plugin instead (which will replace
this helper with one that works with L<Alien::cmake3> that works better).
=head2 cp
%{cp}
The copy command.
=head2 devnull
%{devnull}
The null device, if available. On Unix style operating systems this will be C</dev/null> on Windows it is C<NUL>.
=head2 flex
%{flex}
Requires: L<Alien::flex> 0.08 if not already in C<PATH>.
=head2 gmake
%{gmake}
Requires: L<Alien::gmake> 0.11
Deprecated: use L<Alien::Build::Plugin::Build::Make> instead.
=head2 install
%{install}
The Unix C<install> command. Not normally available on Windows.
=head2 ld
%{ld}
The linker used to build Perl
=head2 m4
%{m4}
Requires: L<Alien::m4> 0.08
L<Alien::m4> should pull in a version of C<m4> that will work with Autotools.
=head2 make
%{make}
Make. On Unix this will be the same make used by Perl. On Windows this will be
C<gmake> or C<nmake> if those are available, and only C<dmake> if the first two
are not available.
=head2 make_path
%{make_path}
Make directory, including all parent directories as needed. This is usually C<mkdir -p>
on Unix and simply C<md> on windows.
=head2 nasm
%{nasm}
Requires: L<Alien::nasm> 0.11 if not already in the C<PATH>.
=head2 patch
%{patch}
Requires: L<Alien::patch> 0.09 if not already in the C<PATH>.
On Windows this will normally render C<patch --binary>, which makes patch work like it does on Unix.
=head2 perl
%{perl}
Requires: L<Devel::FindPerl>
=head2 pkgconf
%{pkgconf}
Requires: L<Alien::pkgconf> 0.06.
=head2 cwd
%{cwd}
=head2 sh
%{sh}
Unix style command interpreter (/bin/sh).
Deprecated: use the L<Alien::Build::Plugin::Build::MSYS> plugin instead.
=head2 rm
%{rm}
The remove command
=head2 xz
%{xz}
Requires: L<Alien::xz> 0.02 if not already in the C<PATH>.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Interpolate.pm 0000444 00000014607 15157554733 0013122 0 ustar 00 package Alien::Build::Interpolate;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Advanced interpolation engine for Alien builds
our $VERSION = '2.84'; # VERSION
sub new
{
my($class) = @_;
my $self = bless {
helper => {},
classes => {},
}, $class;
$self;
}
sub add_helper
{
my $self = shift;
my $name = shift;
my $code = shift;
if(defined $self->{helper}->{$name})
{
require Carp;
Carp::croak("duplicate implementation for interpolated key $name");
}
my $require;
if(ref $_[0] eq 'CODE')
{
$require = shift;
}
else
{
$require = [];
while(@_)
{
my $module = shift;
my $version = shift;
$version ||= 0;
push @$require, $module => $version;
}
}
$self->{helper}->{$name} = Alien::Build::Helper->new(
$name,
$code,
$require,
);
}
sub replace_helper
{
my $self = shift;
my($name) = @_;
delete $self->{helper}->{$name};
$self->add_helper(@_);
}
sub has_helper
{
my($self, $name) = @_;
return unless defined $self->{helper}->{$name};
my @require = $self->{helper}->{$name}->require;
while(@require)
{
my $module = shift @require;
my $version = shift @require;
{
my $pm = "$module.pm";
$pm =~ s/::/\//g;
require $pm;
$module->VERSION($version) if $version;
}
unless($self->{classes}->{$module})
{
if($module->can('alien_helper'))
{
my $helpers = $module->alien_helper;
foreach my $k (keys %$helpers)
{
$self->{helper}->{$k}->code($helpers->{$k});
}
}
$self->{classes}->{$module} = 1;
}
}
my $code = $self->{helper}->{$name}->code;
return unless defined $code;
if(ref($code) ne 'CODE')
{
my $perl = $code;
package Alien::Build::Interpolate::Helper;
$code = sub {
## no critic
my $value = eval $perl;
## use critic
die $@ if $@;
$value;
};
}
$code;
}
sub execute_helper
{
my($self, $name) = @_;
my $code = $self->has_helper($name);
die "no helper defined for $name" unless defined $code;
$code->();
}
sub _get_prop
{
my($name, $prop, $orig) = @_;
$name =~ s/^\./alien./;
if($name =~ /^(.*?)\.(.*)$/)
{
my($key,$rest) = ($1,$2);
return _get_prop($rest, $prop->{$key}, $orig);
}
elsif(exists $prop->{$name})
{
return $prop->{$name};
}
else
{
require Carp;
Carp::croak("No property $orig is defined");
}
}
sub interpolate
{
my($self, $string, $build) = @_;
my $prop = defined $build && eval { $build->isa('Alien::Build') }
? $build->_command_prop
: {};
$string =~ s{(?<!\%)\%\{([a-zA-Z_][a-zA-Z_0-9]+)\}}{$self->execute_helper($1)}eg;
$string =~ s{(?<!\%)\%\{([a-zA-Z_\.][a-zA-Z_0-9\.]+)\}}{_get_prop($1,$prop,$1)}eg;
$string =~ s/\%(?=\%)//g;
$string;
}
sub requires
{
my($self, $string) = @_;
map {
my $helper = $self->{helper}->{$_};
$helper ? $helper->require : ();
} $string =~ m{(?<!\%)\%\{([a-zA-Z_][a-zA-Z_0-9]+)\}}g;
}
sub clone
{
my($self) = @_;
require Storable;
my %helper;
foreach my $name (keys %{ $self->{helper} })
{
$helper{$name} = $self->{helper}->{$name}->clone;
}
my $new = bless {
helper => \%helper,
classes => Storable::dclone($self->{classes}),
}, ref $self;
}
package Alien::Build::Helper;
sub new
{
my($class, $name, $code, $require) = @_;
bless {
name => $name,
code => $code,
require => $require,
}, $class;
}
sub name { shift->{name} }
sub code
{
my($self, $code) = @_;
$self->{code} = $code if $code;
$self->{code};
}
sub require
{
my($self) = @_;
if(ref $self->{require} eq 'CODE')
{
$self->{require} = [ $self->{require}->($self) ];
}
@{ $self->{require} };
}
sub clone
{
my($self) = @_;
my $class = ref $self;
$class->new(
$self->name,
$self->code,
[ $self->require ],
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Interpolate - Advanced interpolation engine for Alien builds
=head1 VERSION
version 2.84
=head1 CONSTRUCTOR
=head2 new
my $intr = Alien::Build::Interpolate->new;
=head2 add_helper
$intr->add_helper($name => $code);
$intr->add_helper($name => $code, %requirements);
=head2 replace_helper
$intr->replace_helper($name => $code);
$intr->replace_helper($name => $code, %requirements);
=head2 has_helper
my $coderef = $intr->has_helper($name);
Used to discover if a helper exists with the given name.
Returns the code reference.
=head2 execute_helper
my $value = $intr->execute_helper($name);
This evaluates the given helper and returns the result.
=head2 interpolate
my $string = $intr->interpolate($template, $build);
my $string = $intr->interpolate($template);
This takes a template and fills in the appropriate values of any helpers used
in the template.
[version 2.58]
If you pass in an L<Alien::Build> instance as the second argument, you can use
properties as well as helpers in the template. Example:
my $patch = $intr->template("%{.install.patch}/foo-%{.runtime.version}.patch", $build);
=head2 requires
my %requires = $intr->requires($template);
This returns a hash of modules required in order to execute the given template.
The keys are the module names and the values are the versions. Version will be
set to C<0> if any version is sufficient.
=head2 clone
my $intr2 = $intr->clone;
This creates a clone of the interpolator.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Manual.pod 0000444 00000004613 15157554740 0012211 0 ustar 00 # PODNAME: Alien::Build::Manual
# ABSTRACT: The Alien::Build Manual
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Manual - The Alien::Build Manual
=head1 VERSION
version 2.84
=head1 SYNOPSIS
perldoc Alien::Build::Manual::Alien
perldoc Alien::Build::Manual::AlienAuthor
perldoc Alien::Build::Manual::AlienUser
perldoc Alien::Build::Manual::Contributing
perldoc Alien::Build::Manual::FAQ
perldoc Alien::Build::Manual::PluginAuthor
=head1 DESCRIPTION
L<Alien::Build> comes with a number of manuals that are useful depending on how you
are using L<Alien>.
=over 4
=item L<Alien::Build::Manual::Alien>
General alien author documentation.
=item L<Alien::Build::Manual::AlienAuthor>
Alien author documentation.
=item L<Alien::Build::Manual::AlienUser>
Alien user documentation.
=item L<Alien::Build::Manual::Contributing>
Overly-detailed contributing guide.
=item L<Alien::Build::Manual::FAQ>
Frequently Asked Questions about L<Alien::Build>.
=item L<Alien::Build::Manual::PluginAuthor>
L<Alien::Build> plugin author documentation — or how to extend L<Alien::Build> with the plugin system.
=item L<Alien::Build::Manual::Security>
Documents some of the challenges and configuration tools related to security of L<Alien>s.
=back
=head1 SEE ALSO
=over 4
=item L<Alien::Base>
=item L<Alien::Build>
=item L<alienfile>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/MM.pm 0000444 00000035661 15157554746 0011154 0 ustar 00 package Alien::Build::MM;
use strict;
use warnings;
use 5.008004;
use Alien::Build;
use Path::Tiny ();
use Capture::Tiny qw( capture );
use Carp ();
# ABSTRACT: Alien::Build installer code for ExtUtils::MakeMaker
our $VERSION = '2.84'; # VERSION
sub new
{
my($class, %prop) = @_;
my $self = bless {}, $class;
my %meta = map { $_ => $prop{$_} } grep /^my_/, keys %prop;
my $build = $self->{build} =
Alien::Build->load('alienfile',
root => "_alien",
(-d 'patch' ? (patch => 'patch') : ()),
meta_prop => \%meta,
)
;
if(%meta)
{
$build->meta->add_requires(configure => 'Alien::Build::MM' => '1.20');
$build->meta->add_requires(configure => 'Alien::Build' => '1.20');
}
if(defined $prop{alienfile_meta})
{
$self->{alienfile_meta} = $prop{alienfile_meta};
}
else
{
$self->{alienfile_meta} = 1;
}
$self->{clean_install} = $prop{clean_install};
$self->build->load_requires('configure');
$self->build->root;
$self->build->checkpoint;
$self;
}
sub build
{
shift->{build};
}
sub alienfile_meta
{
shift->{alienfile_meta};
}
sub clean_install
{
shift->{clean_install};
}
sub mm_args
{
my($self, %args) = @_;
if($args{DISTNAME})
{
$self->build->set_stage(Path::Tiny->new("blib/lib/auto/share/dist/$args{DISTNAME}")->absolute->stringify);
$self->build->install_prop->{mm}->{distname} = $args{DISTNAME};
my $module = $args{DISTNAME};
$module =~ s/-/::/g;
# See if there is an existing version installed, without pulling it into this process
my($old_prefix, $err, $ret) = capture { system $^X, "-M$module", -e => "print $module->dist_dir"; $? };
if($ret == 0)
{
chomp $old_prefix;
my $file = Path::Tiny->new($old_prefix, qw( _alien alien.json ));
if(-r $file)
{
my $old_runtime = eval {
require JSON::PP;
JSON::PP::decode_json($file->slurp);
};
unless($@)
{
$self->build->install_prop->{old}->{runtime} = $old_runtime;
$self->build->install_prop->{old}->{prefix} = $old_prefix;
}
}
}
}
else
{
Carp::croak "DISTNAME is required";
}
my $ab_version = '0.25';
if($self->clean_install)
{
$ab_version = '1.74';
}
$args{CONFIGURE_REQUIRES} = Alien::Build::_merge(
'Alien::Build::MM' => $ab_version,
%{ $args{CONFIGURE_REQUIRES} || {} },
%{ $self->build->requires('configure') || {} },
);
if($self->build->install_type eq 'system')
{
$args{BUILD_REQUIRES} = Alien::Build::_merge(
'Alien::Build::MM' => $ab_version,
%{ $args{BUILD_REQUIRES} || {} },
%{ $self->build->requires('system') || {} },
);
}
elsif($self->build->install_type eq 'share')
{
$args{BUILD_REQUIRES} = Alien::Build::_merge(
'Alien::Build::MM' => $ab_version,
%{ $args{BUILD_REQUIRES} || {} },
%{ $self->build->requires('share') || {} },
);
}
else
{
die "unknown install type: @{[ $self->build->install_type ]}"
}
$args{PREREQ_PM} = Alien::Build::_merge(
'Alien::Build' => $ab_version,
%{ $args{PREREQ_PM} || {} },
);
#$args{META_MERGE}->{'meta-spec'}->{version} = 2;
$args{META_MERGE}->{dynamic_config} = 1;
if($self->alienfile_meta)
{
$args{META_MERGE}->{x_alienfile} = {
generated_by => "@{[ __PACKAGE__ ]} version @{[ __PACKAGE__->VERSION || 'dev' ]}",
requires => {
map {
my %reqs = %{ $self->build->requires($_) };
$reqs{$_} = "$reqs{$_}" for keys %reqs;
$_ => \%reqs;
} qw( share system )
},
};
}
$self->build->checkpoint;
%args;
}
sub mm_postamble
{
# NOTE: older versions of the Alien::Build::MM documentation
# didn't include $mm and @rest args, so anything that this
# method uses them for has to be optional.
# (as of this writing they are unused, but are being added
# to match the way mm_install works).
my($self, $mm, @rest) = @_;
my $postamble = '';
# remove the _alien directory on a make realclean:
$postamble .= "realclean :: alien_realclean\n" .
"\n" .
"alien_realclean:\n" .
"\t\$(RM_RF) _alien\n\n";
# remove the _alien directory on a make clean:
$postamble .= "clean :: alien_clean\n" .
"\n" .
"alien_clean:\n" .
"\t\$(RM_RF) _alien\n\n";
my $dirs = $self->build->meta_prop->{arch}
? '$(INSTALLARCHLIB) $(INSTALLSITEARCH) $(INSTALLVENDORARCH)'
: '$(INSTALLPRIVLIB) $(INSTALLSITELIB) $(INSTALLVENDORLIB)'
;
# set prefix
$postamble .= "alien_prefix : _alien/mm/prefix\n\n" .
"_alien/mm/prefix :\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e prefix \$(INSTALLDIRS) $dirs\n\n";
# set version
$postamble .= "alien_version : _alien/mm/version\n\n" .
"_alien/mm/version : _alien/mm/prefix\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e version \$(VERSION)\n\n";
# download
$postamble .= "alien_download : _alien/mm/download\n\n" .
"_alien/mm/download : _alien/mm/prefix _alien/mm/version\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e download\n\n";
# build
$postamble .= "alien_build : _alien/mm/build\n\n" .
"_alien/mm/build : _alien/mm/download\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e build\n\n";
# append to all
$postamble .= "pure_all :: _alien/mm/build\n\n";
$postamble .= "subdirs-test_dynamic subdirs-test_static subdirs-test :: alien_test\n\n";
$postamble .= "alien_test :\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e test\n\n";
# prop
$postamble .= "alien_prop :\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e dumpprop\n\n";
$postamble .= "alien_prop_meta :\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e dumpprop meta\n\n";
$postamble .= "alien_prop_install :\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e dumpprop install\n\n";
$postamble .= "alien_prop_runtime :\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e dumpprop runtime\n\n";
# install
$postamble .= "alien_clean_install : _alien/mm/prefix\n" .
"\t\$(FULLPERL) -MAlien::Build::MM=cmd -e clean_install\n\n";
$postamble;
}
sub mm_install
{
# NOTE: older versions of the Alien::Build::MM documentation
# didn't include this method, so anything that this method
# does has to be optional
my($self, $mm, @rest) = @_;
my $section = do {
package
MY;
$mm->SUPER::install(@rest);
};
return
".NOTPARALLEL : \n\n"
. ".NO_PARALLEL : \n\n"
. "install :: alien_clean_install\n\n"
. $section;
}
sub import
{
my(undef, @args) = @_;
foreach my $arg (@args)
{
if($arg eq 'cmd')
{
package main;
*_args = sub
{
my $build = Alien::Build->resume('alienfile', '_alien');
$build->load_requires('configure');
$build->load_requires($build->install_type);
($build, @ARGV)
};
*_touch = sub {
my($name) = @_;
my $path = Path::Tiny->new("_alien/mm/$name");
$path->parent->mkpath;
$path->touch;
};
*prefix = sub
{
my($build, $type, $perl, $site, $vendor) = _args();
my $distname = $build->install_prop->{mm}->{distname};
my $prefix = $type eq 'perl'
? $perl
: $type eq 'site'
? $site
: $type eq 'vendor'
? $vendor
: die "unknown INSTALLDIRS ($type)";
$prefix = Path::Tiny->new($prefix)->child("auto/share/dist/$distname")->absolute->stringify;
$build->log("prefix $prefix");
$build->set_prefix($prefix);
$build->checkpoint;
_touch('prefix');
};
*version = sub
{
my($build, $version) = _args();
$build->runtime_prop->{perl_module_version} = $version;
$build->checkpoint;
_touch('version');
};
*download = sub
{
my($build) = _args();
$build->download;
$build->checkpoint;
_touch('download');
};
*build = sub
{
my($build) = _args();
$build->build;
my $distname = $build->install_prop->{mm}->{distname};
if($build->meta_prop->{arch})
{
my $archdir = Path::Tiny->new("blib/arch/auto/@{[ join '/', split /-/, $distname ]}");
$archdir->mkpath;
my $archfile = $archdir->child($archdir->basename . '.txt');
$archfile->spew('Alien based distribution with architecture specific file in share');
}
my $cflags = $build->runtime_prop->{cflags};
my $libs = $build->runtime_prop->{libs};
if(($cflags && $cflags !~ /^\s*$/)
|| ($libs && $libs !~ /^\s*$/))
{
my $mod = join '::', split /-/, $distname;
my $install_files_pm = Path::Tiny->new("blib/lib/@{[ join '/', split /-/, $distname ]}/Install/Files.pm");
$install_files_pm->parent->mkpath;
$install_files_pm->spew(
"package ${mod}::Install::Files;\n",
"use strict;\n",
"use warnings;\n",
"require ${mod};\n",
"sub Inline { shift; ${mod}->Inline(\@_) }\n",
"1;\n",
"\n",
"=begin Pod::Coverage\n",
"\n",
" Inline\n",
"\n",
"=cut\n",
) unless -f "$install_files_pm";
}
$build->checkpoint;
_touch('build');
};
*test = sub
{
my($build) = _args();
$build->test;
$build->checkpoint;
};
*clean_install = sub
{
my($build) = _args();
$build->clean_install;
$build->checkpoint;
};
*dumpprop = sub
{
my($build, $type) = _args();
my %h = (
meta => $build->meta_prop,
install => $build->install_prop,
runtime => $build->runtime_prop,
);
require Alien::Build::Util;
print Alien::Build::Util::_dump($type ? $h{$type} : \%h);
}
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::MM - Alien::Build installer code for ExtUtils::MakeMaker
=head1 VERSION
version 2.84
=head1 SYNOPSIS
In your C<Makefile.PL>:
use ExtUtils::MakeMaker;
use Alien::Build::MM;
my $abmm = Alien::Build::MM->new;
WriteMakefile($abmm->mm_args(
ABSTRACT => 'Discover or download and install libfoo',
DISTNAME => 'Alien-Libfoo',
NAME => 'Alien::Libfoo',
VERSION_FROM => 'lib/Alien/Libfoo.pm',
...
));
sub MY::postamble {
$abmm->mm_postamble(@_);
}
sub MY::install {
$abmm->mm_install(@_);
}
In your C<lib/Alien/Libfoo.pm>:
package Alien::Libfoo;
use parent qw( Alien::Base );
1;
In your alienfile (needs to be named C<alienfile> and should be in the root of your dist):
use alienfile;
plugin 'PkgConfig' => 'libfoo';
share {
start_url 'http://libfoo.org';
...
};
=head1 DESCRIPTION
This class allows you to use Alien::Build and Alien::Base with L<ExtUtils::MakeMaker>.
It load the L<alienfile> recipe in the root of your L<Alien> dist, updates the prereqs
passed into C<WriteMakefile> if any are specified by your L<alienfile> or its plugins,
and adds a postamble to the C<Makefile> that will download/build/test the alienized
package as appropriate.
The L<alienfile> must be named C<alienfile>.
If you are using L<Dist::Zilla> to author your L<Alien> dist, you should consider using
the L<Dist::Zilla::Plugin::AlienBuild> plugin.
I personally don't recommend it, but if you want to use L<Module::Build> instead, you
can use L<Alien::Build::MB>.
=head1 CONSTRUCTOR
=head2 new
my $abmm = Alien::Build::MM->new;
Create a new instance of L<Alien::Build::MM>.
=head1 PROPERTIES
=head2 build
my $build = $abmm->build;
The L<Alien::Build> instance.
=head2 alienfile_meta
my $bool = $abmm->alienfile_meta
Set to a false value, in order to turn off the x_alienfile meta
=head2 clean_install
my $bool = $abmm->clean_install;
Set to a true value, in order to clean the share directory prior to
installing. If you use this you have to make sure that you install
the install handler in your C<Makefile.PL>:
$abmm = Alien::Build::MM->new(
clean_install => 1,
);
...
sub MY::install {
$abmm->mm_install(@_);
}
=head1 METHODS
=head2 mm_args
my %args = $abmm->mm_args(%args);
Adjust the arguments passed into C<WriteMakefile> as needed by L<Alien::Build>.
=head2 mm_postamble
my $postamble $abmm->mm_postamble;
my $postamble $abmm->mm_postamble($mm);
Returns the postamble for the C<Makefile> needed for L<Alien::Build>.
This adds the following C<make> targets which are normally called when
you run C<make all>, but can be run individually if needed for debugging.
=over 4
=item alien_prefix
Determines the final install prefix (C<%{.install.prefix}>).
=item alien_version
Determine the perl_module_version (C<%{.runtime.perl_module_version}>)
=item alien_download
Downloads the source from the internet. Does nothing for a system install.
=item alien_build
Build from source (if a share install). Gather configuration (for either
system or share install).
=item alien_prop, alien_prop_meta, alien_prop_install, alien_prop_runtime
Prints the meta, install and runtime properties for the Alien.
=item alien_realclean, alien_clean
Removes the alien specific files. These targets are executed when you call
the C<realclean> and C<clean> targets respectively.
=item alien_clean_install
Cleans out the Alien's share directory. Caution should be used in invoking
this target directly, as if you do not understand what you are doing you
are likely to break your already installed Alien.
=back
=head2 mm_install
sub MY::install {
$abmm->mm_install(@_);
}
B<EXPERIMENTAL>
Adds an install rule to clean the final install dist directory prior to installing.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base>, L<Alien>, L<Dist::Zilla::Plugin::AlienBuild>, L<Alien::Build::MB>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Version/Basic.pm 0000444 00000011373 15157554760 0013277 0 ustar 00 package Alien::Build::Version::Basic;
use strict;
use warnings;
use 5.008004;
use Carp ();
use Exporter qw( import );
use overload
'<=>' => sub { shift->cmp(@_) },
'cmp' => sub { shift->cmp(@_) },
'""' => sub { shift->as_string },
bool => sub { 1 },
fallback => 1;
our @EXPORT_OK = qw( version );
# ABSTRACT: Very basic version object for Alien::Build
our $VERSION = '2.84'; # VERSION
sub new
{
my($class, $value) = @_;
$value =~ s/\.$//; # trim trailing dot
Carp::croak("invalud version: $value")
unless $value =~ /^[0-9]+(\.[0-9]+)*$/;
bless \$value, $class;
}
sub version ($)
{
my($value) = @_;
__PACKAGE__->new($value);
}
sub as_string
{
my($self) = @_;
"@{[ $$self ]}";
}
sub cmp
{
my @x = split /\./, ${$_[0]};
my @y = split /\./, ${ref($_[1]) ? $_[1] : version($_[1])};
while(@x or @y)
{
my $x = (shift @x) || 0;
my $y = (shift @y) || 0;
return $x <=> $y if $x <=> $y;
}
0;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Version::Basic - Very basic version object for Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
OO interface:
use Alien::Build::Version::Basic;
my $version = Alien::Build::Version::Basic->new('1.2.3');
if($version > '1.2.2') # true
{
...
}
Function interface:
use Alien::Build::Version::Basic qw( version );
if(version('1.2.3') > version('1.2.2')) # true
{
...
}
my @sorted = sort map { version($_) } qw( 2.1 1.2.3 1.2.2 );
# will come out in the order 1.2.2, 1.2.3, 2.1
=head1 DESCRIPTION
This module provides a very basic class for comparing versions.
This is already a crowded space on CPAN. Parts of L<Alien::Build>
already use L<Sort::Versions>, which is fine for sorting versions.
Sometimes you need to compare to see if versions match exact I<values>,
and the best candidates (such as L<Sort::Versions> on CPAN compare
C<1.2.3.0> and C<1.2.3> as being different. This class compares
those two as the same.
This class is also quite limited, in that it only works with version
schemes using a doted version numbers or real numbers with a fixed
number of digits. Versions with: dashes, letters, hex digits, or
anything else are not supported.
This class overloads both C<E<lt>=E<gt>> and C<cmp> to compare the version in
the way that you would expect for version numbers. This way you can
compare versions like numbers, or sort them using sort.
if(version($v1) > version($v2))
{
...
}
my @sorted = sort map { version($_) } @unsorted;
it also overloads C<""> to stringify as whatever string value you
passed to the constructor.
=head1 CONSTRUCTOR
=head2 new
my $version = Alien::Build::Version::Basic->new($value);
This is the long form of the constructor, if you don't want to import
anything into your namespace.
=head2 version
my $version = version($value);
This is the short form of the constructor, if you are sane. It is
NOT exported by default so you will have to explicitly import it.
=head1 METHODS
=head2 as_string
my $string = $version->as_string;
my $string = "$version";
Returns the string representation of the version object.
=head2 cmp
my $bool = $version->cmp($other);
my $bool = $version <=> $other;
my $bool = $version cmp $other;
Returns C<-1>, C<0> or C<1> just like the regular C<E<lt>=E<gt>> and C<cmp>
operators. Although C<$version> must be a version object, C<$other> may
be either a version object, or a string that could be used to create a
valid version object.
=head1 SEE ALSO
=over 4
=item L<Sort::Versions>
Good, especially if you have to support rpm style versions (like C<1.2.3-2-b>)
or don't care if trailing zeros (C<1.2.3> vs C<1.2.3.0>) are treated as
different values.
=item L<version>
Problematic for historical reasons.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/PkgConfig.pod 0000444 00000004311 15157554772 0014101 0 ustar 00 # PODNAME: Alien::Build::Plugin::PkgConfig
# ABSTRACT: PkgConfig Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::PkgConfig - PkgConfig Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'PkgConfig' => (
pkg_name => 'foo',
);
=head1 DESCRIPTION
PkgConfig plugins use C<pkg-config> or a compatible library to retrieve flags
at probe and gather stages.
=over 4
=item L<Alien::Build::Plugin::PkgConfig::CommandLine>
Use the command-line C<pkg-config> or C<pkgconf> to get compiler and linker flags.
=item L<Alien::Build::Plugin::PkgConfig::LibPkgConf>
Use the XS L<PkgConfig::LibPkgConf> to get compiler and linker flags.
=item L<Alien::Build::Plugin::PkgConfig::MakeStatic>
Convert .pc file to use static linkage by default.
=item L<Alien::Build::Plugin::PkgConfig::MakeStatic>
Choose the best plugin to do C<pkg-config> work. The best choice is typically
platform and configuration dependent.
=item L<Alien::Build::Plugin::PkgConfig::PP>
Use the pure-perl L<PkgConfig> to get compiler and linker flags.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Probe.pod 0000444 00000004473 15157554777 0013317 0 ustar 00 # PODNAME: Alien::Build::Plugin::Probe
# ABSTRACT: Probe Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Probe - Probe Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
look for libraries in known location:
use alienfile;
plugin 'Probe::CBuilder' => (
cflags => '-I/opt/libfoo/include',
libs => '-L/opt/libfoo/lib -lfoo',
);
look for tools in the path:
use alienfile;
plugin 'Probe::CommandLine' => (
command => 'gzip',
args => [ '--version' ],
match => qr/gzip/,
version => qr/gzip ([0-9\.]+)/,
);
Use C<vcpkg> for Visual C++ Perl:
use alienfile;
plugin 'Probe::Vcpkg' => 'libffi';
=head1 DESCRIPTION
Probe plugins try to find existing libraries and tools
I<already> installed on the system. If found they can
be used instead of downloading the source from the
internet and building.
=over 4
=item L<Alien::Build::Plugin::Probe::CBuilder>
Use L<ExtUtils::CBuilder> to probe for existing installed
library.
=item L<Alien::Build::Plugin::Probe::CommandLine>
Execute commands to probe for existing tools.
=item L<Alien::Build::Plugin::Probe::Vcpkg>
Use L<Win32::Vcpkg> to probe for existing installed library.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Digest.pod 0000444 00000004273 15157555004 0013445 0 ustar 00 # PODNAME: Alien::Build::Plugin::Digest
# ABSTRACT: Fetch Alien::Digest plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Digest - Fetch Alien::Digest plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'http://ftp.gnu.org/gnu/make/make-3.75.tar.gz';
plugin 'Digest' => [ SHA256 => '2bc876304905aee78abf0f7163ba55a2efcec803034f75c75d1b94650c36aba7';
plugin 'Download';
};
=head1 DESCRIPTION
Digest plugins checks the cryptographic signatures of downloaded files.
Typically you will probably want to use SHA256 via the
L<Digest Negotiator plugin|Alien::Build::Plugin::Digest::Negotiate>.
=over 4
=item L<Alien::Build::Plugin::Digest::Negotiate>
Negotiate the most appropriate plugin to calculate digest.
=item L<Alien::Build::Plugin::Digest::SHA>
Use the XS based L<Digest::SHA> for computing SHA digests. This is the default since
L<Digest::SHA> comes with recent versions of Perl.
=item L<Alien::Build::Plugin::Digest::SHAPP>
Use the pure-perl based L<Digest::SHA::PurePerl> for computing SHA digests.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Prefer/BadVersion.pm 0000444 00000010223 15157555017 0015333 0 ustar 00 package Alien::Build::Plugin::Prefer::BadVersion;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
# ABSTRACT: Plugin to filter out known bad versions
our $VERSION = '2.84'; # VERSION
has '+filter' => sub { Carp::croak("The filter property is required for the Prefer::BadVersion plugin") };
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure', __PACKAGE__, '1.05');
my $filter;
if(ref($self->filter) eq '')
{
my $string = $self->filter;
$filter = sub {
my($file) = @_;
$file->{version} ne $string;
};
}
elsif(ref($self->filter) eq 'ARRAY')
{
my %filter = map { $_ => 1 } @{ $self->filter };
$filter = sub {
my($file) = @_;
! $filter{$file->{version}};
};
}
elsif(ref($self->filter) eq 'CODE')
{
my $code = $self->filter;
$filter = sub { ! $code->($_[0]) };
}
else
{
Carp::croak("unknown filter type for Prefer::BadVersion");
}
$meta->around_hook(
prefer => sub {
my($orig, $build, @therest) = @_;
my $res1 = $orig->($build, @therest);
return $res1 unless $res1->{type} eq 'list';
return {
type => 'list',
list => [
grep { $filter->($_) } @{ $res1->{list} }
],
};
},
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Prefer::BadVersion - Plugin to filter out known bad versions
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Prefer::BadVersion' => '1.2.3';
=head1 DESCRIPTION
This plugin allows you to easily filter out known bad versions of libraries in a share install.
It doesn't affect a system install at all. You need a Prefer plugin that filters and sorts files
first. You may specify the filter in one of three ways:
=over
=item as a string
Filter out any files that match the given version.
use alienfile;
plugin 'Prefer::BadVersion' => '1.2.3';
=item as an array
Filter out all files that match any of the given versions.
use alienfile;
plugin 'Prefer::BadVersion' => [ '1.2.3', '1.2.4' ];
=item as a code reference
Filter out any files return a true value.
use alienfile;
plugin 'Prefer::BadVersion' => sub {
my($file) = @_;
$file->{version} eq '1.2.3'; # same as the string version above
};
=back
This plugin can also be used to filter out known bad versions of a library on just one platform.
For example, if you know that version 1.2.3 if bad on windows, but okay on other platforms:
use alienfile;
plugin 'Prefer::BadVersion' => '1.2.3' if $^O eq 'MSWin32';
=head1 PROPERTIES
=head2 filter
Filter out entries that match the filter.
=head1 CAVEATS
If you are using the string or array mode, then you need an existing Prefer plugin that sets the
version number for each file candidate, such as L<Alien::Build::Plugin::Prefer::SortVersions>.
Unless you want to exclude the latest version from a share install, this plugin isn't really
that useful. It has no effect on system installs, which may not be obvious at first.
=head1 SEE ALSO
=over 4
=item L<alienfile>
=item L<Alien::Build>
=item L<Alien::Build::Plugin::Prefer::SortVersions>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Prefer/SortVersions.pm 0000444 00000007147 15157555024 0015770 0 ustar 00 package Alien::Build::Plugin::Prefer::SortVersions;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Plugin to sort candidates by most recent first
our $VERSION = '2.84'; # VERSION
has 'filter' => undef;
has '+version' => qr/([0-9](?:[0-9\.]*[0-9])?)/;
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'Sort::Versions' => 0);
$meta->register_hook( prefer => sub {
my(undef, $res) = @_;
my $cmp = sub {
my($A,$B) = map { ($_ =~ $self->version)[0] } @_;
Sort::Versions::versioncmp($B,$A);
};
my @list = sort { $cmp->($a->{filename}, $b->{filename}) }
map {
($_->{version}) = $_->{filename} =~ $self->version;
$_ }
grep { $_->{filename} =~ $self->version }
grep { defined $self->filter ? $_->{filename} =~ $self->filter : 1 }
@{ $res->{list} };
return {
type => 'list',
list => \@list,
};
});
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Prefer::SortVersions - Plugin to sort candidates by most recent first
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Prefer::SortVersions';
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This Prefer plugin sorts the packages that were retrieved from a dir listing, either
directly from a Fetch plugin, or from a Decode plugin. It Returns a listing with the
items sorted from post preferable to least, and filters out any undesirable candidates.
This plugin updates the file list to include the versions that are extracted, so they
can be used by other plugins, such as L<Alien::Build::Plugin::Prefer::BadVersion>.
=head1 PROPERTIES
=head2 filter
This is a regular expression that lets you filter out files that you do not
want to consider downloading. For example, if the directory listing contained
tarballs and readme files like this:
foo-1.0.0.tar.gz
foo-1.0.0.readme
You could specify a filter of C<qr/\.tar\.gz$/> to make sure only tarballs are
considered for download.
=head2 version
Regular expression to parse out the version from a filename. The regular expression
should store the result in C<$1>. The default C<qr/([0-9\.]+)/> is frequently
reasonable.
=head1 SEE ALSO
L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Prefer/GoodVersion.pm 0000444 00000010320 15157555031 0015527 0 ustar 00 package Alien::Build::Plugin::Prefer::GoodVersion;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
# ABSTRACT: Plugin to filter known good versions
our $VERSION = '2.84'; # VERSION
has '+filter' => sub { Carp::croak("The filter property is required for the Prefer::GoodVersion plugin") };
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure', __PACKAGE__, '1.44');
my $filter;
if(ref($self->filter) eq '')
{
my $string = $self->filter;
$filter = sub {
my($file) = @_;
$file->{version} eq $string;
};
}
elsif(ref($self->filter) eq 'ARRAY')
{
my %filter = map { $_ => 1 } @{ $self->filter };
$filter = sub {
my($file) = @_;
!! $filter{$file->{version}};
};
}
elsif(ref($self->filter) eq 'CODE')
{
my $code = $self->filter;
$filter = sub { !! $code->($_[0]) };
}
else
{
Carp::croak("unknown filter type for Prefer::GoodVersion");
}
$meta->around_hook(
prefer => sub {
my($orig, $build, @therest) = @_;
my $res1 = $orig->($build, @therest);
return $res1 unless $res1->{type} eq 'list';
return {
type => 'list',
list => [
grep { $filter->($_) } @{ $res1->{list} }
],
};
},
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Prefer::GoodVersion - Plugin to filter known good versions
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Prefer::GoodVersion' => '1.2.3';
=head1 DESCRIPTION
This plugin allows you to specify one or more good versions of a library. This doesn't affect
a system install at all. This plugin does the opposite of the C<Prefer::BadVersion> plugin.
You need need a Prefer plugin that filters and sorts files first. You may specify the filter
in one of three ways:
=over
=item as a string
Filter any files that match the given version.
use alienfile;
plugin 'Prefer::GoodVersion' => '1.2.3';
=item as an array
Filter all files that match any of the given versions.
use alienfile;
plugin 'Prefer::GoodVersion' => [ '1.2.3', '1.2.4' ];
=item as a code reference
Filter any files return a true value.
use alienfile;
plugin 'Prefer::GoodVersion' => sub {
my($file) = @_;
$file->{version} eq '1.2.3'; # same as the string version above
};
=back
This plugin can also be used to filter known good versions of a library on just one platform.
For example, if you know that version 1.2.3 if good on windows, but the default logic is fine
on other platforms:
use alienfile;
plugin 'Prefer::GoodVersion' => '1.2.3' if $^O eq 'MSWin32';
=head1 PROPERTIES
=head2 filter
Filter entries that match the filter.
=head1 CAVEATS
If you are using the string or array mode, then you need an existing Prefer plugin that sets the
version number for each file candidate, such as L<Alien::Build::Plugin::Prefer::SortVersions>.
Unless you want to exclude the latest version from a share install, this plugin isn't really
that useful. It has no effect on system installs, which may not be obvious at first.
=head1 SEE ALSO
=over 4
=item L<alienfile>
=item L<Alien::Build>
=item L<Alien::Build::Plugin::Prefer::SortVersions>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/Tail.pm 0000444 00000003270 15157555043 0013640 0 ustar 00 package Alien::Build::Plugin::Core::Tail;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Core tail setup plugin
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
if($meta->prop->{out_of_source})
{
$meta->add_requires('configure' => 'Alien::Build' => '1.08');
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::Tail - Core tail setup plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin does some core tail setup for you.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/Setup.pm 0000444 00000016525 15157555050 0014054 0 ustar 00 package Alien::Build::Plugin::Core::Setup;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Config;
use File::Which qw( which );
# ABSTRACT: Core setup plugin
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->prop->{platform} ||= {};
$self->_platform($meta->prop->{platform});
}
sub _platform
{
my(undef, $hash) = @_;
if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
{
$hash->{compiler_type} = 'microsoft';
}
else
{
$hash->{compiler_type} = 'unix';
}
if($^O eq 'MSWin32')
{
$hash->{system_type} = 'windows-unknown';
if(defined &Win32::BuildNumber)
{
$hash->{system_type} = 'windows-activestate';
}
elsif($Config{myuname} =~ /strawberry-perl/)
{
$hash->{system_type} = 'windows-strawberry';
}
elsif($hash->{compiler_type} eq 'microsoft')
{
$hash->{system_type} = 'windows-microsoft';
}
else
{
my $uname_exe = which('uname');
if($uname_exe)
{
my $uname = `$uname_exe`;
if($uname =~ /^(MINGW)(32|64)_NT/)
{
$hash->{system_type} = 'windows-' . lc $1;
}
}
}
}
elsif($^O =~ /^(VMS)$/)
{
# others probably belong in here...
$hash->{system_type} = lc $^O;
}
else
{
$hash->{system_type} = 'unix';
}
$hash->{cpu}{count} =
exists $ENV{ALIEN_CPU_COUNT} && $ENV{ALIEN_CPU_COUNT} > 0
? $ENV{ALIEN_CPU_COUNT}
: _cpu_count();
$hash->{cpu}{arch} = _cpu_arch(\%Config);
}
# Retrieve number of available CPU cores. Adopted from
# <https://metacpan.org/release/MARIOROY/MCE-1.879/source/lib/MCE/Util.pm#L49>
# which is in turn adopted from Test::Smoke::Util with improvements.
sub _cpu_count {
local $ENV{PATH} = $ENV{PATH};
if( $^O ne 'MSWin32' ) {
$ENV{PATH} = "/usr/sbin:/sbin:/usr/bin:/bin:$ENV{PATH}";
}
$ENV{PATH} =~ /(.*)/; $ENV{PATH} = $1; ## Remove tainted'ness
my $ncpu = 1;
OS_CHECK: {
local $_ = lc $^O;
/linux/ && do {
my ( $count, $fh );
if ( open $fh, '<', '/proc/stat' ) {
$count = grep { /^cpu\d/ } <$fh>;
close $fh;
}
$ncpu = $count if $count;
last OS_CHECK;
};
/bsd|darwin|dragonfly/ && do {
chomp( my @output = `sysctl -n hw.ncpu 2>/dev/null` );
$ncpu = $output[0] if @output;
last OS_CHECK;
};
/aix/ && do {
my @output = `lparstat -i 2>/dev/null | grep "^Online Virtual CPUs"`;
if ( @output ) {
$output[0] =~ /(\d+)\n$/;
$ncpu = $1 if $1;
}
if ( !$ncpu ) {
@output = `pmcycles -m 2>/dev/null`;
if ( @output ) {
$ncpu = scalar @output;
} else {
@output = `lsdev -Cc processor -S Available 2>/dev/null`;
$ncpu = scalar @output if @output;
}
}
last OS_CHECK;
};
/gnu/ && do {
chomp( my @output = `nproc 2>/dev/null` );
$ncpu = $output[0] if @output;
last OS_CHECK;
};
/haiku/ && do {
my @output = `sysinfo -cpu 2>/dev/null | grep "^CPU #"`;
$ncpu = scalar @output if @output;
last OS_CHECK;
};
/hp-?ux/ && do {
my $count = grep { /^processor/ } `ioscan -fkC processor 2>/dev/null`;
$ncpu = $count if $count;
last OS_CHECK;
};
/irix/ && do {
my @out = grep { /\s+processors?$/i } `hinv -c processor 2>/dev/null`;
$ncpu = (split ' ', $out[0])[0] if @out;
last OS_CHECK;
};
/osf|solaris|sunos|svr5|sco/ && do {
if (-x '/usr/sbin/psrinfo') {
my $count = grep { /on-?line/ } `psrinfo 2>/dev/null`;
$ncpu = $count if $count;
}
else {
my @output = grep { /^NumCPU = \d+/ } `uname -X 2>/dev/null`;
$ncpu = (split ' ', $output[0])[2] if @output;
}
last OS_CHECK;
};
/mswin|mingw|msys|cygwin/ && do {
if (exists $ENV{NUMBER_OF_PROCESSORS}) {
$ncpu = $ENV{NUMBER_OF_PROCESSORS};
}
last OS_CHECK;
};
warn "CPU count: unknown operating system";
}
$ncpu = 1 if (!$ncpu || $ncpu < 1);
$ncpu;
}
sub _cpu_arch {
my ($my_config) = @_;
my $arch = {};
my %Config = %$my_config;
die "Config missing archname" unless exists $Config{archname};
die "Config missing ptrsize" unless exists $Config{ptrsize};
if( $Config{archname} =~ m/
\b x64 \b # MSWin32-x64
| \b x86_64 \b # x86_64-linux
| \b amd64 \b # amd64-freebsd
/ix) {
$arch = { name => 'x86_64' };
} elsif( $Config{archname} =~ m/
\b x86 \b # MSWin32-x86
| \b i386 \b # freebsd-i386
| \b i486 \b # i486-linux
| \b i686 \b # i686-cygwin
/ix ) {
$arch = { name => 'x86' };
} elsif( $Config{archname} =~ m/
\b darwin \b
/ix ) {
chomp( my $hw_machine = `sysctl -n hw.machine 2>/dev/null` );
HW_MACHINE:
for($hw_machine) {
$_ eq 'arm64' && do {
$arch = { name => 'aarch64' };
last HW_MACHINE;
};
$_ eq 'x86_64' && do {
$arch = { name => $Config{ptrsize} == 8 ? 'x86_64' : 'x86' };
last HW_MACHINE;
};
$_ eq 'i386' && do {
$arch = { name => 'x86' };
last HW_MACHINE;
};
$_ eq 'Power Macintosh' && do {
$arch = { name => $Config{ptrsize} == 8 ? 'ppc64' : 'ppc' };
last HW_MACHINE;
};
warn "Architecture detection: unknown macOS arch hw.machine = $_, ptrsize = $Config{ptrsize}";
$arch = { name => 'unknown' };
}
} elsif( $Config{archname} =~ /
\b aarch64 \b
| \b arm64 \b # arm64-freebsd (FreeBSD can have either aarch64 or arm64)
/ix ) {
$arch = { name => 'aarch64' }; # ARM64
} elsif( $Config{archname} =~ m/
\b arm-linux-gnueabi \b
/ix ) {
# 32-bit ARM soft-float
$arch = { name => 'armel' };
} elsif( $Config{archname} =~ m/
\b arm-linux-gnueabihf \b
/ix ) {
# 32-bit ARM hard-float
$arch = { name => 'armhf' };
}
unless(exists $arch->{name}) {
warn "Architecture detection: Unknown archname '$Config{archname}'.";
$arch->{name} = 'unknown';
}
return $arch;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::Setup - Core setup plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin does some core setup for you.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/Download.pm 0000444 00000012676 15157555055 0014533 0 ustar 00 package Alien::Build::Plugin::Core::Download;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Path::Tiny ();
use Alien::Build::Util qw( _mirror );
# ABSTRACT: Core download plugin
our $VERSION = '2.84'; # VERSION
sub _hook
{
my($build) = @_;
my $res = $build->fetch;
if($res->{type} =~ /^(?:html|dir_listing)$/)
{
my $type = $res->{type};
$type =~ s/_/ /;
$build->log("decoding $type");
$res = $build->decode($res);
}
if($res->{type} eq 'list')
{
my $orig = $res;
$res = $build->prefer($res);
my @exclude;
if($build->meta->prop->{start_url} =~ /^https:/)
{
@{ $res->{list} } = grep {
$_->{url} =~ /https:/ ? 1 : do {
push @exclude, $_->{url};
0;
}
} @{ $res->{list} };
}
if(@{ $res->{list} } == 0)
{
my @excluded = map { $_->{url} } @{ $orig->{list} };
if(@excluded)
{
if(@excluded > 15)
{
splice @excluded , 14;
push @excluded, '...';
}
$build->log("These files were excluded by the filter stage:");
$build->log("excluded $_") for @excluded;
}
else
{
$build->log("No files found prior to the filter stage");
}
die "no matching files in listing";
}
my $version = $res->{list}->[0]->{version};
my($pick, @other) = map { $_->{url} } @{ $res->{list} };
if(@other > 8)
{
splice @other, 7;
push @other, '...';
}
$build->log("candidate *$pick");
$build->log("candidate $_") for @other;
if(@exclude)
{
if(@exclude > 8)
{
splice @exclude, 7;
push @exclude, '...';
}
$build->log("excluded insecure URLs:");
$build->log($_) for @exclude;
}
$res = $build->fetch($pick);
if($version)
{
$version =~ s/\.+$//;
$build->log("setting version based on archive to $version");
$build->runtime_prop->{version} = $version;
}
}
if($res->{type} eq 'file')
{
my $alienfile = $res->{filename};
$build->log("downloaded $alienfile");
if($res->{content})
{
my $tmp = Alien::Build::TempDir->new($build, "download");
my $path = Path::Tiny->new("$tmp/$alienfile");
$path->spew_raw($res->{content});
$build->install_prop->{download} = $path->stringify;
$build->install_prop->{complete}->{download} = 1;
$build->install_prop->{download_detail}->{"$path"}->{protocol} = $res->{protocol} if defined $res->{protocol};
return $build;
}
elsif($res->{path})
{
if(defined $res->{tmp} && !$res->{tmp})
{
if(-e $res->{path})
{
$build->install_prop->{download} = $res->{path};
$build->install_prop->{complete}->{download} = 1;
$build->install_prop->{download_detail}->{$res->{path}}->{protocol} = $res->{protocol} if defined $res->{protocol};
}
else
{
die "not a file or directory: @{[ $res->{path} ]}";
}
}
else
{
my $from = Path::Tiny->new($res->{path});
my $tmp = Alien::Build::TempDir->new($build, "download");
my $to = Path::Tiny->new("$tmp/@{[ $from->basename ]}");
if(-d $res->{path})
{
# Please note: _mirror and Alien::Build::Util are ONLY
# allowed to be used by core plugins. If you are writing
# a non-core plugin it may be removed. That is why it
# is private.
_mirror $from, $to;
}
else
{
require File::Copy;
File::Copy::copy(
"$from" => "$to",
) || die "copy $from => $to failed: $!";
}
$build->install_prop->{download} = $to->stringify;
$build->install_prop->{complete}->{download} = 1;
$build->install_prop->{download_detail}->{"$to"}->{protocol} = $res->{protocol} if defined $res->{protocol};
}
return $build;
}
die "file without content or path";
}
die "unknown fetch response type: @{[ $res->{type} ]}";
}
sub init
{
my($self, $meta) = @_;
$meta->default_hook(download => \&_hook);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::Download - Core download plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin does some core download logic.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/CleanInstall.pm 0000444 00000004262 15157555062 0015323 0 ustar 00 package Alien::Build::Plugin::Core::CleanInstall;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Path::Tiny ();
# ABSTRACT: Implementation for clean_install hook.
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->default_hook(
clean_install => sub {
my($build) = @_;
my $root = Path::Tiny->new(
$build->runtime_prop->{prefix}
);
if(-d $root)
{
foreach my $child ($root->children)
{
if($child->basename eq '_alien')
{
$build->log("keeping $child");
}
else
{
$build->log("removing $child");
$child->remove_tree({ safe => 0});
}
}
}
}
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::CleanInstall - Implementation for clean_install hook.
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin implements the default C<clean_install> hook.
You shouldn't use it directly.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/Gather.pm 0000444 00000012642 15157555070 0014164 0 ustar 00 package Alien::Build::Plugin::Core::Gather;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Env qw( @PATH @PKG_CONFIG_PATH );
use Path::Tiny ();
use File::chdir;
use Alien::Build::Util qw( _mirror _destdir_prefix );
use JSON::PP ();
# ABSTRACT: Core gather plugin
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->default_hook(
$_ => sub {},
) for qw( gather_system gather_share );
$meta->around_hook(
gather_share => sub {
my($orig, $build) = @_;
local $ENV{PATH} = $ENV{PATH};
local $ENV{PKG_CONFIG_PATH} = $ENV{PKG_CONFIG_PATH};
unshift @PATH, Path::Tiny->new('bin')->absolute->stringify
if -d 'bin';
for my $dir (qw(share lib)) {
unshift @PKG_CONFIG_PATH, Path::Tiny->new("$dir/pkgconfig")->absolute->stringify
if -d "$dir/pkgconfig";
}
$orig->($build)
}
);
foreach my $type (qw( share ffi ))
{
$meta->around_hook(
"gather_$type" => sub {
my($orig, $build) = @_;
if($build->meta_prop->{destdir})
{
my $destdir = $ENV{DESTDIR};
if(-d $destdir)
{
my $src = Path::Tiny->new(_destdir_prefix($ENV{DESTDIR}, $build->install_prop->{prefix}));
my $dst = Path::Tiny->new($build->install_prop->{stage});
my $res = do {
local $CWD = "$src";
$orig->($build);
};
$build->log("mirror $src => $dst");
$dst->mkpath;
# Please note: _mirror and Alien::Build::Util are ONLY
# allowed to be used by core plugins. If you are writing
# a non-core plugin it may be removed. That is why it
# is private.
_mirror("$src", "$dst", {
verbose => 1,
filter => $build->meta_prop->{$type eq 'share' ? 'destdir_filter' : 'destdir_ffi_filter'},
});
return $res;
}
else
{
die "nothing was installed into destdir" if $type eq 'share';
}
}
else
{
local $CWD = $build->install_prop->{stage};
my $ret = $orig->($build);
# if we are not doing a double staged install we want to substitute the install
# prefix with the runtime prefix.
my $old = $build->install_prop->{prefix};
my $new = $build->runtime_prop->{prefix};
foreach my $flag (qw( cflags cflags_static libs libs_static ))
{
next unless defined $build->runtime_prop->{$flag};
$build->runtime_prop->{$flag} =~ s{(-I|-L|-LIBPATH:)\Q$old\E}{$1 . $new}eg;
}
return $ret;
}
}
);
}
$meta->after_hook(
$_ => sub {
my($build) = @_;
die "stage is not defined. be sure to call set_stage on your Alien::Build instance"
unless $build->install_prop->{stage};
my $stage = Path::Tiny->new($build->install_prop->{stage});
$build->log("mkdir -p $stage/_alien");
$stage->child('_alien')->mkpath;
# drop a alien.json file for the runtime properties
$stage->child('_alien/alien.json')->spew(
JSON::PP->new->pretty->canonical(1)->ascii->encode($build->runtime_prop)
);
# copy the alienfile, if we managed to keep it around.
if($build->meta->filename &&
-r $build->meta->filename &&
$build->meta->filename !~ /\.(pm|pl)$/ &&
! -d $build->meta->filename)
{
Path::Tiny->new($build->meta->filename)
->copy($stage->child('_alien/alienfile'));
}
if($build->install_prop->{patch} && -d $build->install_prop->{patch})
{
# Please note: _mirror and Alien::Build::Util are ONLY
# allowed to be used by core plugins. If you are writing
# a non-core plugin it may be removed. That is why it
# is private.
_mirror($build->install_prop->{patch},
$stage->child('_alien/patch')->stringify);
}
},
) for qw( gather_share gather_system );
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::Gather - Core gather plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin helps make the gather stage work.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/Legacy.pm 0000444 00000004724 15157555075 0014165 0 ustar 00 package Alien::Build::Plugin::Core::Legacy;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Core Alien::Build plugin to maintain compatibility with legacy Alien::Base
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->after_hook(
$_ => sub {
my($build) = @_;
$build->log("adding legacy hash to config");
my $runtime = $build->runtime_prop;
if($runtime->{cflags} && ! defined $runtime->{cflags_static})
{
$runtime->{cflags_static} = $runtime->{cflags};
}
if($runtime->{libs} && ! defined $runtime->{libs_static})
{
$runtime->{libs_static} = $runtime->{libs};
}
$runtime->{legacy}->{finished_installing} = 1;
$runtime->{legacy}->{install_type} = $runtime->{install_type};
$runtime->{legacy}->{version} = $runtime->{version};
$runtime->{legacy}->{original_prefix} = $runtime->{prefix};
}
) for qw( gather_system gather_share );
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::Legacy - Core Alien::Build plugin to maintain compatibility with legacy Alien::Base
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin provides some compatibility with the legacy L<Alien::Base::ModuleBuild>
interfaces.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/FFI.pm 0000444 00000003353 15157555102 0013351 0 ustar 00 package Alien::Build::Plugin::Core::FFI;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Core FFI plugin
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->default_hook(
$_ => sub {},
) for qw( build_ffi gather_ffi );
$meta->prop->{destdir_ffi_filter} = '^dynamic';
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::FFI - Core FFI plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin helps make the build_ffi work. You should not
need to interact with it directly.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core/Override.pm 0000444 00000003344 15157555107 0014531 0 ustar 00 package Alien::Build::Plugin::Core::Override;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Core override plugin
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->default_hook(
override => sub {
my($build) = @_;
return $ENV{ALIEN_INSTALL_TYPE} || '';
},
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core::Override - Core override plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# already loaded
=head1 DESCRIPTION
This plugin implements the C<ALIEN_INSTALL_TYPE> environment variable.
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Base::ModuleBuild>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Extract/ArchiveZip.pm 0000444 00000006170 15157555121 0015534 0 ustar 00 package Alien::Build::Plugin::Extract::ArchiveZip;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Plugin to extract a tarball using Archive::Zip
our $VERSION = '2.84'; # VERSION
has '+format' => 'zip';
sub handles
{
my($class, $ext) = @_;
return 1 if $ext eq 'zip';
return 0;
}
sub available
{
my(undef, $ext) = @_;
!! ( $ext eq 'zip' && eval { require Archive::Zip; 1} );
}
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'Archive::Zip' => 0);
$meta->register_hook(
extract => sub {
my($build, $src) = @_;
my $zip = Archive::Zip->new;
$zip->read($src);
$zip->extractTree;
}
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Extract::ArchiveZip - Plugin to extract a tarball using Archive::Zip
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Extract::ArchiveZip' => (
format => 'zip',
);
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Extract::Negotiate>
instead. It picks the appropriate Extract plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
B<Note>: Seriously do NOT use this plugin! L<Archive::Zip> is pretty unreliable and
breaks all-the-time. If you use the negotiator plugin mentioned above, then it will
prefer installing L<Alien::unzip>, which is much more reliable than L<Archive::Zip>.
This plugin extracts from an archive in zip format using L<Archive::Zip>.
=head2 format
Gives a hint as to the expected format. This should always be C<zip>.
=head1 METHODS
=head2 handles
Alien::Build::Plugin::Extract::ArchiveZip->handles($ext);
$plugin->handles($ext);
Returns true if the plugin is able to handle the archive of the
given format.
=head2 available
Alien::Build::Plugin::Extract::ArchiveZip->available($ext);
Returns true if the plugin has what it needs right now to extract from the given format
=head1 SEE ALSO
L<Alien::Build::Plugin::Extract::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Extract/CommandLine.pm 0000444 00000032531 15157555126 0015663 0 ustar 00 package Alien::Build::Plugin::Extract::CommandLine;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Path::Tiny ();
use File::Which ();
use File::chdir;
use File::Temp qw( tempdir );
use Capture::Tiny qw( capture_merged );
# ABSTRACT: Plugin to extract an archive using command line tools
our $VERSION = '2.84'; # VERSION
has '+format' => 'tar';
sub gzip_cmd
{
_which('gzip') ? 'gzip' : undef;
}
sub _which { scalar File::Which::which(@_) }
sub bzip2_cmd
{
_which('bzip2') ? 'bzip2' : undef;
}
sub xz_cmd
{
_which('xz') ? 'xz' : undef;
}
{
my $bsd_tar;
# Note: GNU tar can be iffy to very bad on windows, where absolute
# paths get confused with remote tars. We used to assume that 'tar.exe'
# is borked on Windows, but recent versions of Windows 10 come bundled
# with bsdtar (libarchive) named 'tar.exe', and we should definitely
# prefer that to ptar.
sub _windows_tar_is_bsdtar
{
return 1 if $^O ne 'MSWin32';
return $bsd_tar if defined $bsd_tar;
my($out) = capture_merged {
system 'tar', '--version';
};
return $bsd_tar = $out =~ /bsdtar/ ? 1 : 0
}
}
sub tar_cmd
{
_which('bsdtar')
? 'bsdtar'
# Slowlaris /usr/bin/tar doesn't seem to like pax global header
# but seems to have gtar in the path by default, which is okay with it
: $^O eq 'solaris' && _which('gtar')
? 'gtar'
# See note above for Windows logic.
: _which('tar') && _windows_tar_is_bsdtar()
? 'tar'
: _which('ptar')
? 'ptar'
: undef;
};
sub unzip_cmd
{
if($^O eq 'MSWin32' && _which('tar') && _windows_tar_is_bsdtar())
{
(_which('tar'), 'xf');
}
else
{
_which('unzip') ? 'unzip' : undef;
}
}
sub _run
{
my(undef, $build, @cmd) = @_;
$build->log("+ @cmd");
system @cmd;
die "execute failed" if $?;
}
sub _cp
{
my(undef, $build, $from, $to) = @_;
require File::Copy;
$build->log("copy $from => $to");
File::Copy::cp($from, $to) || die "unable to copy: $!";
}
sub _mv
{
my(undef, $build, $from, $to) = @_;
$build->log("move $from => $to");
rename($from, $to) || die "unable to rename: $!";
}
sub _dcon
{
my($self, $src) = @_;
my $name;
my $cmd;
if($src =~ /\.(gz|tgz|Z|taz)$/)
{
$self->gzip_cmd(_which('gzip')) unless defined $self->gzip_cmd;
if($src =~ /\.(gz|tgz)$/)
{
$cmd = $self->gzip_cmd unless $self->_tar_can('tar.gz');
}
elsif($src =~ /\.(Z|taz)$/)
{
$cmd = $self->gzip_cmd unless $self->_tar_can('tar.Z');
}
}
elsif($src =~ /\.(bz2|tbz)$/)
{
$self->bzip2_cmd(_which('bzip2')) unless defined $self->bzip2_cmd;
$cmd = $self->bzip2_cmd unless $self->_tar_can('tar.bz2');
}
elsif($src =~ /\.(xz|txz)$/)
{
$self->xz_cmd(_which('xz')) unless defined $self->xz_cmd;
$cmd = $self->xz_cmd unless $self->_tar_can('tar.xz');
}
if($cmd && $src =~ /\.(gz|bz2|xz|Z)$/)
{
$name = $src;
$name =~ s/\.(gz|bz2|xz|Z)$//g;
}
elsif($cmd && $src =~ /\.(tgz|tbz|txz|taz)$/)
{
$name = $src;
$name =~ s/\.(tgz|tbz|txz|taz)$/.tar/;
}
($name,$cmd);
}
sub handles
{
my($class, $ext) = @_;
my $self = ref $class
? $class
: __PACKAGE__->new;
$ext = 'tar.Z' if $ext eq 'taz';
$ext = 'tar.gz' if $ext eq 'tgz';
$ext = 'tar.bz2' if $ext eq 'tbz';
$ext = 'tar.xz' if $ext eq 'txz';
return 1 if $ext eq 'tar.gz' && $self->_tar_can('tar.gz');
return 1 if $ext eq 'tar.Z' && $self->_tar_can('tar.Z');
return 1 if $ext eq 'tar.bz2' && $self->_tar_can('tar.bz2');
return 1 if $ext eq 'tar.xz' && $self->_tar_can('tar.xz');
return 0 if $ext =~ s/\.(gz|Z)$// && (!$self->gzip_cmd);
return 0 if $ext =~ s/\.bz2$// && (!$self->bzip2_cmd);
return 0 if $ext =~ s/\.xz$// && (!$self->xz_cmd);
return 1 if $ext eq 'tar' && $self->_tar_can('tar');
return 1 if $ext eq 'zip' && $self->_tar_can('zip');
return 0;
}
sub available
{
my(undef, $ext) = @_;
# this is actually the same as handles
__PACKAGE__->handles($ext);
}
sub init
{
my($self, $meta) = @_;
if($self->format eq 'tar.xz' && !$self->handles('tar.xz'))
{
$meta->add_requires('share' => 'Alien::xz' => '0.06');
}
elsif($self->format eq 'tar.bz2' && !$self->handles('tar.bz2'))
{
$meta->add_requires('share' => 'Alien::Libbz2' => '0.22');
}
elsif($self->format =~ /^tar\.(gz|Z)$/ && !$self->handles($self->format))
{
$meta->add_requires('share' => 'Alien::gzip' => '0.03');
}
elsif($self->format eq 'zip' && !$self->handles('zip'))
{
$meta->add_requires('share' => 'Alien::unzip' => '0');
}
$meta->register_hook(
extract => sub {
my($build, $src) = @_;
my($dcon_name, $dcon_cmd) = _dcon($self, $src);
if($dcon_name)
{
unless($dcon_cmd)
{
die "unable to decompress $src";
}
# if we have already decompressed, then keep it.
unless(-f $dcon_name)
{
# we don't use pipes, because that may not work on Windows.
# keep the original archive, in case another extract
# plugin needs it. keep the decompressed archive
# in case WE need it again.
my $src_tmp = Path::Tiny::path($src)
->parent
->child('x'.Path::Tiny::path($src)->basename);
my $dcon_tmp = Path::Tiny::path($dcon_name)
->parent
->child('x'.Path::Tiny::path($dcon_name)->basename);
$self->_cp($build, $src, $src_tmp);
$self->_run($build, $dcon_cmd, "-d", $src_tmp);
$self->_mv($build, $dcon_tmp, $dcon_name);
}
$src = $dcon_name;
}
if($src =~ /\.zip$/i)
{
$self->_run($build, $self->unzip_cmd, $src);
}
elsif($src =~ /\.tar/ || $src =~ /(\.tgz|\.tbz|\.txz|\.taz)$/i)
{
$self->_run($build, $self->tar_cmd, '-xf', $src);
}
else
{
die "not sure of archive type from extension";
}
}
);
}
my %tars;
sub _tar_can
{
my($self, $ext) = @_;
unless(%tars)
{
my $name = '';
local $_; # to avoid dynamically scoped read-only $_ from upper scopes
while(my $line = <DATA>)
{
if($line =~ /^\[ (.*) \]$/)
{
$name = $1;
}
else
{
$tars{$name} .= $line;
}
}
foreach my $key (keys %tars)
{
$tars{$key} = unpack "u", $tars{$key};
}
}
my $name = "xx.$ext";
return 0 unless $tars{$name};
local $CWD = tempdir( CLEANUP => 1 );
my $cleanup = sub {
my $save = $CWD;
unlink $name;
unlink 'xx.txt';
$CWD = '..';
rmdir $save;
};
Path::Tiny->new($name)->spew_raw($tars{$name});
my @cmd = ($self->tar_cmd, 'xf', $name);
if($ext eq 'zip')
{
@cmd = ($self->unzip_cmd, $name);
}
my(undef, $exit) = capture_merged {
system(@cmd);
$?;
};
if($exit)
{
$cleanup->();
return 0;
}
my $content = eval { Path::Tiny->new('xx.txt')->slurp };
$cleanup->();
return defined $content && $content eq "xx\n";
}
1;
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Extract::CommandLine - Plugin to extract an archive using command line tools
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Extract::CommandLine' => (
format => 'tar.gz',
);
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Extract::Negotiate>
instead. It picks the appropriate Extract plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin extracts from an archive in various formats using command line tools.
=head1 PROPERTIES
=head2 format
Gives a hint as to the expected format.
=head2 gzip_cmd
The C<gzip> command, if available. C<undef> if not available.
=head2 bzip2_cmd
The C<bzip2> command, if available. C<undef> if not available.
=head2 xz_cmd
The C<xz> command, if available. C<undef> if not available.
=head2 tar_cmd
The C<tar> command, if available. C<undef> if not available.
=head2 unzip_cmd
The C<unzip> command, if available. C<undef> if not available.
=head1 METHODS
=head2 handles
Alien::Build::Plugin::Extract::CommandLine->handles($ext);
$plugin->handles($ext);
Returns true if the plugin is able to handle the archive of the
given format.
=head2 available
Alien::Build::Plugin::Extract::CommandLine->available($ext);
Returns true if the plugin is available to extract without
installing anything new.
=head1 SEE ALSO
L<Alien::Build::Plugin::Extract::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__DATA__
[ xx.tar ]
M>'@N='AT````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M`````````````#`P,#8T-"``,#`P-S8U(``P,#`P,C0@`#`P,#`P,#`P,#`S
M(#$S-#,U,#0S-#(R(#`Q,C<P,P`@,```````````````````````````````
M````````````````````````````````````````````````````````````
M``````````````````````````````````````````!U<W1A<@`P,&]L;&ES
M9P``````````````````````````````````<W1A9F8`````````````````
M```````````````````P,#`P,#`@`#`P,#`P,"``````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M``````````````````````!X>`H`````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
M````````````````````````````````````````````````````````````
7````````````````````````````````
[ xx.tar.Z ]
M'YV0>/"XH(.'#H"#"!,J7,BPH<.'$"-*1`BCH@T:-$``J`CCAHT:&CG"D)%Q
MH\B3,T#$F$%C1@T8+6G(D`$"1@P9-V#,`%!SHL^?0(,*!5!G#ITP<DR^8<,F
MS9PS0Q<:#6/&3-2%)V&$/*GQJM>O8,.*'1I0P=BS:-.J7<NVK=NW<./*G4NW
7KMV[>//JW<NWK]^_@`,+'DRXL.'#0P$`
[ xx.tar.bz2 ]
M0EIH.3%!629365(,+ID``$A[D-$0`8!``7^``!!AI)Y`!```""``=!JGIBC3
M30&CU`]($HHTTR:`>D#0)SI*Z'R%H*J"&3@H]P@J>U$F5BMHOC`$L-"8C!(V
I"`'?*WA:(9*4U)@4)+"(V%.G]#W(_E6B'J8G]D`/Q=R13A0D%(,+ID``
[ xx.tar.gz ]
M'XL("!)'=%P``WAX+G1A<@"KJ-`KJ2AAH"DP,#`P,S%1`-'F9J9@VL`(PH<"
M8P5#8Q-C4P,38Q,C(P4#0R-S`V,&!0/:.@L"2HM+$HN`3LG/R<DL3L>M#J@L
E+0V/.1"/*,#I(0(J*K@&V@FC8!2,@E$P"@8````U:,3F``@`````
[ xx.tar.xz ]
M_3=Z6%H```3FUK1&`@`A`18```!T+^6CX`?_`&!=`#Q@M.AX.4O&N38V648.
M[J6L\\<_[3M*R;CASOTX?B.F\V:^)+G;\YY4"!4MLF9`*\N40G=O+K,J0"NF
M0VU7J%NN(A,R^DM8@/(_YGR5CAO+1CS_YNHE:,1!G%6L1\GT``"[$^?"O*"!
9`P`!?(`0````:OY*7K'$9_L"``````196@``
[ xx.zip ]
M4$L#!`H``````%5V64X:^I"B`P````,````&`!P`>'@N='AT550)``,21W1<
M$D=T7'5X"P`!!/4!```$%````'AX"E!+`0(>`PH``````%5V64X:^I"B`P``
M``,````&`!@```````$```"D@0````!X>"YT>'155`4``Q)'=%QU>`L``03U
>`0``!!0```!02P4&``````$``0!,````0P``````
perl5/5.32/Alien/Build/Plugin/Extract/Directory.pm 0000444 00000006620 15157555133 0015437 0 ustar 00 package Alien::Build::Plugin::Extract::Directory;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Alien::Build::Util qw( _mirror );
use Path::Tiny ();
# ABSTRACT: Plugin to extract a downloaded directory to a build directory
our $VERSION = '2.84'; # VERSION
has '+format' => 'd';
sub handles
{
my(undef, $ext) = @_;
$ext eq 'd' ? 1 : ();
}
sub available
{
my(undef, $ext) = @_;
__PACKAGE__->handles($ext);
}
sub init
{
my($self, $meta) = @_;
$meta->register_hook(
extract => sub {
my($build, $src) = @_;
die "not a directory: $src" unless -d $src;
if($build->meta_prop->{out_of_source})
{
$build->install_prop->{extract} = Path::Tiny->new($src)->absolute->stringify;
}
else
{
my $dst = Path::Tiny->new('.')->absolute;
# Please note: _mirror and Alien::Build::Util are ONLY
# allowed to be used by core plugins. If you are writing
# a non-core plugin it may be removed. That is why it
# is private.
_mirror $src => $dst, { verbose => 1 };
}
}
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Extract::Directory - Plugin to extract a downloaded directory to a build directory
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Extract::Directory';
=head1 DESCRIPTION
Some Download or Fetch plugins may produce a directory instead of an archive
file. This plugin is used to mirror the directory from the Download step
into a fresh directory in the Extract step. An example of when you might use
this plugin is if you were using the C<git> command in the Download step,
which results in a directory hierarchy.
=head1 PROPERTIES
=head2 format
Should always set to C<d> (for directories).
=head1 METHODS
=head2 handles
Alien::Build::Plugin::Extract::Directory->handles($ext);
$plugin->handles($ext);
Returns true if the plugin is able to handle the archive of the
given format. Only returns true for C<d> (for directory).
=head2 available
Alien::Build::Plugin::Extract::Directory->available($ext);
$plugin->available($ext);
Returns true if the plugin can extract the given format with
what is already installed.
=head1 SEE ALSO
L<Alien::Build::Plugin::Extract::Negotiate>, L<Alien::Build::Plugin::Extract::File>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Extract/ArchiveTar.pm 0000444 00000011415 15157555140 0015517 0 ustar 00 package Alien::Build::Plugin::Extract::ArchiveTar;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::chdir;
use File::Temp ();
use Path::Tiny ();
# ABSTRACT: Plugin to extract a tarball using Archive::Tar
our $VERSION = '2.84'; # VERSION
has '+format' => 'tar';
sub handles
{
my(undef, $ext) = @_;
return 1 if $ext =~ /^(tar|tar\.gz|tar\.bz2|tar\.xz|tbz|taz|txz)$/;
return 0;
}
sub available
{
my(undef, $ext) = @_;
if($ext eq 'tar.gz')
{
return !! eval { require Archive::Tar; Archive::Tar->has_zlib_support };
}
elsif($ext eq 'tar.bz2')
{
return !! eval { require Archive::Tar; Archive::Tar->has_bzip2_support && __PACKAGE__->_can_bz2 };
}
elsif($ext eq 'tar.xz')
{
return !! eval { require Archive::Tar; Archive::Tar->has_xz_support };
}
else
{
return $ext eq 'tar';
}
}
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'Archive::Tar' => 0);
if($self->format eq 'tar.gz' || $self->format eq 'tgz')
{
$meta->add_requires('share' => 'IO::Zlib' => 0);
}
elsif($self->format eq 'tar.bz2' || $self->format eq 'tbz')
{
$meta->add_requires('share' => 'IO::Uncompress::Bunzip2' => 0);
$meta->add_requires('share' => 'IO::Compress::Bzip2' => 0);
}
elsif($self->format eq 'tar.xz' || $self->format eq 'txz')
{
$meta->add_requires('share' => 'Archive::Tar' => 2.34);
$meta->add_requires('share' => 'IO::Uncompress::UnXz' => 0);
}
$meta->register_hook(
extract => sub {
my($build, $src) = @_;
my $tar = Archive::Tar->new;
$tar->read($src);
$tar->extract;
}
);
}
sub _can_bz2
{
# even when Archive::Tar reports that it supports bz2, I can sometimes get this error:
# 'Cannot read enough bytes from the tar file', so lets just probe for actual support!
my $dir = Path::Tiny->new(File::Temp::tempdir( CLEANUP => 1 ));
eval {
local $CWD = $dir;
my $tarball = unpack "u", q{M0EIH.3%!62936=+(]$0``$A[D-$0`8!``7^``!!AI)Y`!```""``=!JGIH-(MT#0]0/2!**---&F@;4#0&:D;X?(6@JH(2<%'N$%3VHC-9E>S/N@"6&I*1@GNJNHCC2>$I5(<0BKR.=XBZ""HVZ;T,CV\LJ!K&*?9`#\7<D4X4)#2R/1$`};
Path::Tiny->new('xx.tar.bz2')->spew_raw($tarball);
require Archive::Tar;
my $tar = Archive::Tar->new;
$tar->read('xx.tar.bz2');
$tar->extract;
my $content = Path::Tiny->new('xx.txt')->slurp;
die unless $content && $content eq "xx\n";
};
my $error = $@;
$dir->remove_tree;
!$error;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Extract::ArchiveTar - Plugin to extract a tarball using Archive::Tar
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Extract::ArchiveTar' => (
format => 'tar.gz',
);
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Extract::Negotiate>
instead. It picks the appropriate Extract plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin extracts from an archive in tarball format (optionally compressed by either
gzip or bzip2) using L<Archive::Tar>.
=head1 PROPERTIES
=head2 format
Gives a hint as to the expected format. This helps make sure the prerequisites are set
correctly, since compressed archives require extra Perl modules to be installed.
=head1 METHODS
=head2 handles
Alien::Build::Plugin::Extract::ArchiveTar->handles($ext);
$plugin->handles($ext);
Returns true if the plugin is able to handle the archive of the
given format.
=head2 available
Alien::Build::Plugin::Extract::ArchiveTar->available($ext);
Returns true if the plugin has what it needs right now to extract from the given format
=head1 SEE ALSO
L<Alien::Build::Plugin::Extract::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Extract/File.pm 0000444 00000006212 15157555146 0014353 0 ustar 00 package Alien::Build::Plugin::Extract::File;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Alien::Build::Util qw( _mirror );
use Path::Tiny ();
# ABSTRACT: Plugin to extract a downloaded file to a build directory
our $VERSION = '2.84'; # VERSION
has '+format' => 'f';
sub handles
{
my(undef, $ext) = @_;
$ext eq 'f' ? 1 : ();
}
sub available
{
my(undef, $ext) = @_;
__PACKAGE__->handles($ext);
}
sub init
{
my($self, $meta) = @_;
$meta->register_hook(
extract => sub {
my($build, $src) = @_;
die "not a file: $src" unless -f $src;
$src = Path::Tiny->new($src)->absolute->parent;;
my $dst = Path::Tiny->new('.')->absolute;
# Please note: _mirror and Alien::Build::Util are ONLY
# allowed to be used by core plugins. If you are writing
# a non-core plugin it may be removed. That is why it
# is private.
$build->log("extracting $src => $dst");
_mirror $src => $dst, { verbose => 1 };
}
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Extract::File - Plugin to extract a downloaded file to a build directory
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Extract::File';
=head1 DESCRIPTION
Some Download or Fetch plugins may produce a single file (usually an executable)
instead of an archive file. This plugin is used to mirror the file from
the Download step into a fresh directory in the Extract step.
=head1 PROPERTIES
=head2 format
Should always set to C<f> (for file).
=head1 METHODS
=head2 handles
Alien::Build::Plugin::Extract::File->handles($ext);
$plugin->handles($ext);
Returns true if the plugin is able to handle the archive of the
given format. Only returns true for C<f> (for file).
=head2 available
Alien::Build::Plugin::Extract::File->available($ext);
$plugin->available($ext);
Returns true if the plugin can extract the given format with
what is already installed.
=head1 SEE ALSO
L<Alien::Build::Plugin::Extract::Negotiate>, L<Alien::Build::Plugin::Extract::File>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Extract/Negotiate.pm 0000444 00000010537 15157555153 0015416 0 ustar 00 package Alien::Build::Plugin::Extract::Negotiate;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Alien::Build::Plugin::Extract::ArchiveTar;
use Alien::Build::Plugin::Extract::ArchiveZip;
use Alien::Build::Plugin::Extract::CommandLine;
use Alien::Build::Plugin::Extract::Directory;
# ABSTRACT: Extraction negotiation plugin
our $VERSION = '2.84'; # VERSION
has '+format' => 'tar';
sub init
{
my($self, $meta) = @_;
my $format = $self->format;
$format = 'tar.gz' if $format eq 'tgz';
$format = 'tar.bz2' if $format eq 'tbz';
$format = 'tar.xz' if $format eq 'txz';
my $plugin = $self->pick($format);
$meta->apply_plugin($plugin, format => $format);
$self;
}
sub pick
{
my(undef, $format) = @_;
if($format =~ /^tar(\.(gz|bz2))?$/)
{
if(Alien::Build::Plugin::Extract::ArchiveTar->available($format))
{
return 'Extract::ArchiveTar';
}
else
{
return 'Extract::CommandLine';
}
}
elsif($format eq 'zip')
{
# Archive::Zip is not that reliable. But if it is already installed it is probably working
if(Alien::Build::Plugin::Extract::ArchiveZip->available($format))
{
return 'Extract::ArchiveZip';
}
# If it isn't available, then use the command-line unzip. Alien::unzip will be used
# as necessary in environments where it isn't already installed.
else
{
return 'Extract::CommandLine';
}
}
elsif($format eq 'tar.xz')
{
# The windows version of tar.exe (which is based on BSD tar) will try to use external
# program xz to decompress tar.xz files if it is available. The default windows
# install does not have this in the PATH, but if it IS in the PATH then it often
# or always can hang, so the pure Perl Archive::Tar is more reliable on that platform,
# but will require a newer version of Archive::Tar and IO::Uncompress::UnXz
if(Alien::Build::Plugin::Extract::ArchiveTar->available('tar.xz') || $^O eq 'MSWin32')
{
return 'Extract::ArchiveTar';
}
else
{
return 'Extract::CommandLine';
}
}
elsif($format eq 'tar.Z')
{
return 'Extract::CommandLine';
}
elsif($format eq 'd')
{
return 'Extract::Directory';
}
elsif($format eq 'f')
{
return 'Extract::File';
}
else
{
die "do not know how to handle format: $format";
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Extract::Negotiate - Extraction negotiation plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Extract' => (
format => 'tar.gz',
);
=head1 DESCRIPTION
This is a negotiator plugin for extracting packages downloaded from the internet.
This plugin picks the best Extract plugin to do the actual work. Which plugins are
picked depend on the properties you specify, your platform and environment. It is
usually preferable to use a negotiator plugin rather than using a specific Extract
Plugin from your L<alienfile>.
=head1 PROPERTIES
=head2 format
The expected format for the download. Possible values include:
C<tar>, C<tar.gz>, C<tar.bz2>, C<tar.xz>, C<zip>, C<d>.
=head1 METHODS
=head2 pick
my $name = Alien::Build::Plugin::Extract::Negotiate->pick($format);
Returns the name of the best plugin for the given format.
=head1 SEE ALSO
L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Prefer.pod 0000444 00000003751 15157555160 0013454 0 ustar 00 # PODNAME: Alien::Build::Plugin::Prefer
# ABSTRACT: Prefer Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Prefer - Prefer Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'http://ftp.gnu.org/gnu/make';
plugin 'Download';
};
=head1 DESCRIPTION
Prefer plugins sort
Decode plugins decode HTML and FTP file listings. Normally you
will want to use the L<Alien::Build::Plugin::Download::Negotiate>
plugin which will automatically load the appropriate Prefer plugins.
=over 4
=item L<Alien::Build::Plugin::Prefer::BadVersion>
Filter out known bad versions from a candidate list.
=item L<Alien::Build::Plugin::Prefer::GoodVersion>
Require specific known good versions from a candidate list.
=item L<Alien::Build::Plugin::Prefer::SortVersions>
Sort candidates by version.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Decode.pod 0000444 00000004771 15157555165 0013424 0 ustar 00 # PODNAME: Alien::Build::Plugin::Decode
# ABSTRACT: Decode Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Decode - Decode Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Decode::HTML';
plugin 'Decode::DirListing';
=head1 DESCRIPTION
Decode plugins decode HTML and FTP file listings. Normally you
will want to use the L<Alien::Build::Plugin::Download::Negotiate>
plugin which will automatically load the appropriate Decode plugins.
=over 4
=item L<Alien::Build::Plugin::Decode::DirListing>
Default decoder for FTP file listings, that uses the pure-perl L<File::Listing>.
=item L<Alien::Build::Plugin::Decode::DirListingFtpcopy>
Another decoder for FTP file listings, that uses the XS module L<File::Listing::Ftpcopy>.
=item L<Alien::Build::Plugin::Decode::HTML>
Older decoder for HTML file listings, which uses the XS module L<HTML::LinkExtor>. This
used to be the default decoder until L<Alien::Build> version 1.75. In some cases, this
will be used as the HTML decoder if you configure with L<Alien::Build> prior to 1.75
and but upgrade to a more recent version for the build stage of your L<Alien>
=item L<Alien::Build::Plugin::Decode::Mojo>
Newer decoder for HTML file listings, which uses the pure-perl L<Mojo::DOM> or L<Mojo::DOM58>.
This became the default decoder at L<Alien::Build> version 1.75.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Test/Mock.pm 0000444 00000026471 15157555177 0013707 0 ustar 00 package Alien::Build::Plugin::Test::Mock;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
use Path::Tiny ();
use File::chdir;
# ABSTRACT: Mock plugin for testing
our $VERSION = '2.84'; # VERSION
has 'probe';
has 'download';
has 'extract';
has 'build';
has 'gather';
has check_digest => 1;
sub init
{
my($self, $meta) = @_;
if(my $probe = $self->probe)
{
if($probe =~ /^(share|system)$/)
{
$meta->register_hook(
probe => sub {
$probe;
},
);
}
elsif($probe eq 'die')
{
$meta->register_hook(
probe => sub {
die "fail";
},
);
}
else
{
Carp::croak("usage: plugin 'Test::Mock' => ( probe => $probe ); where $probe is one of share, system or die");
}
}
if(my $download = $self->download)
{
$download = { 'foo-1.00.tar.gz' => _tarball() } unless ref $download eq 'HASH';
$meta->register_hook(
download => sub {
my($build) = @_;
_fs($build, $download, 1);
},
);
}
if(my $extract = $self->extract)
{
$extract = {
'foo-1.00' => {
'configure' => _tarball_configure(),
'foo.c' => _tarball_foo_c(),
},
} unless ref $extract eq 'HASH';
$meta->register_hook(
extract => sub {
my($build) = @_;
_fs($build, $extract);
},
);
}
if(my $build = $self->build)
{
$build = [
{
'foo.o', => _build_foo_o(),
'libfoo.a' => _build_libfoo_a(),
},
{
'lib' => {
'libfoo.a' => _build_libfoo_a(),
'pkgconfig' => {
'foo.pc' => sub {
my($build) = @_;
"prefix=$CWD\n" .
"exec_prefix=\${prefix}\n" .
"libdir=\${prefix}/lib\n" .
"includedir=\${prefix}/include\n" .
"\n" .
"Name: libfoo\n" .
"Description: libfoo\n" .
"Version: 1.0.0\n" .
"Cflags: -I\${includedir}\n" .
"Libs: -L\${libdir} -lfoo\n";
},
},
},
},
] unless ref $build eq 'ARRAY';
my($build_dir, $install_dir) = @$build;
$meta->register_hook(
build => sub {
my($build) = @_;
_fs($build, $build_dir);
local $CWD = $build->install_prop->{prefix};
_fs($build, $install_dir);
},
);
}
if(my $gather = $self->gather)
{
$meta->register_hook(
$_ => sub {
my($build) = @_;
if(ref $gather eq 'HASH')
{
foreach my $key (keys %$gather)
{
$build->runtime_prop->{$key} = $gather->{$key};
}
}
else
{
my $prefix = $build->runtime_prop->{prefix};
$build->runtime_prop->{cflags} = "-I$prefix/include";
$build->runtime_prop->{libs} = "-L$prefix/lib -lfoo";
}
},
) for qw( gather_share gather_system );
}
if(my $cd = $self->check_digest)
{
$meta->register_hook(
check_digest => ref($cd) eq 'CODE' ? $cd : sub {
my($build, $file, $algorithm, $digest) = @_;
if($algorithm ne 'FOO92')
{
return 'FAKE';
}
if($digest eq 'deadbeaf')
{
return 1;
}
else
{
die "Digest FAKE does not match: got deadbeaf, expected $digest";
}
}
);
$meta->register_hook(
check_download => sub {
my($build) = @_;
my $path = $build->install_prop->{download};
if(defined $path)
{
$build->check_digest($path);
}
},
);
}
}
sub _fs
{
my($build, $hash, $download) = @_;
foreach my $key (sort keys %$hash)
{
my $val = $hash->{$key};
if(ref $val eq 'HASH')
{
mkdir $key;
local $CWD = $key;
_fs($build,$val);
}
elsif(ref $val eq 'CODE')
{
my $path = Path::Tiny->new($key)->absolute;
$path->spew_raw($val->($build));
if($download)
{
$build->install_prop->{download_detail}->{"$path"}->{protocol} = 'file';
$build->install_prop->{download_detail}->{"$path"}->{digest} = [ FAKE => 'deadbeaf' ];
}
}
elsif(defined $val)
{
my $path = Path::Tiny->new($key)->absolute;
$path->spew_raw($val);
if($download)
{
$build->install_prop->{download_detail}->{"$path"}->{protocol} = 'file';
$build->install_prop->{download_detail}->{"$path"}->{digest} = [ FAKE => 'deadbeaf' ];
}
}
}
}
sub _tarball
{
return unpack 'u', <<'EOF';
M'XL(`+DM@5@``^V4P4K$,!"&>YZGF-V]J*SM9#=)#RN^B'BHV;0)U`32U(OX
M[D;0*LJREZVRF.\R?TA@)OS\TWI_S4JBJI@/(JJ%P%19+>AKG4"V)4Z;C922
M(;T=6(%BQIDFQB$V(8WB^]X.W>%WQ^[?_S'5,Z']\%]YU]IN#/KT/8[ZO^6?
M_B=-C-=<%$BG'^4G_]S_U:)ZL*X:#(!6QN/26(Q&![W<P5_/EIF?*?])E&J>
M'BD/DO/#^6<DON__6O*<_]]@99WJQ[W&FR'NK2_-+8!U$1X;ZRZ2P"9T:HW*
D-`&ODGZZN[^$9T`,.H[!(>W@)2^*3":3.3]>`:%LBYL`#@``
`
EOF
}
sub _tarball_configure
{
return unpack 'u', <<'EOF';
<(R$O8FEN+W-H"@IE8VAO(")H:2!T:&5R92(["@``
`
EOF
}
sub _tarball_foo_c
{
return unpack 'u', <<'EOF';
M(VEN8VQU9&4@/'-T9&EO+F@^"@II;G0*;6%I;BAI;G0@87)G8RP@8VAA<B`J
887)G=EM=*0I["B`@<F5T=7)N(#`["GT*
`
EOF
}
sub _build_foo_o
{
return unpack 'u', <<'EOF';
MS_KM_@<```$#`````0````0```"P`0```"`````````9````.`$`````````
M`````````````````````````&@`````````T`$```````!H``````````<`
M```'`````P````````!?7W1E>'0`````````````7U]415A4````````````
M````````````"`````````#0`0``!`````````````````0`@```````````
M`````%]?8V]M<&%C=%]U;G=I;F1?7TQ$````````````````"``````````@
M`````````-@!```#````.`(```$````````"````````````````7U]E:%]F
M<F%M90```````%]?5$585``````````````H`````````$``````````^`$`
M``,```````````````L``&@````````````````D````$``````-"@``````
M`@```!@```!``@```0```%`"```(````"P```%`````````````````````!
M`````0``````````````````````````````````````````````````````
M``````````````````!52(GE,<!=PP``````````"`````````$`````````
M````````````%``````````!>E(``7@0`1`,!PB0`0``)````!P```"X____
M_____P@``````````$$.$(8"0PT&```````````````!```&`0````\!````
/``````````!?;6%I;@``
`
EOF
}
sub _build_libfoo_a
{
return unpack 'u', <<'EOF';
M(3QA<F-H/@HC,2\R,"`@("`@("`@("`@,34S,S$U-38Q."`@-3`Q("`@,C`@
M("`@,3`P-C0T("`T-"`@("`@("`@8`I?7RY364U$148@4T]25$5$``````@`
M````````<`````@```!?;6%I;@```",Q+S$R("`@("`@("`@("`Q-3,S,34U
M-#8X("`U,#$@("`R,"`@("`Q,#`V-#0@(#8Q,B`@("`@("!@"F9O;RYO````
M`````,_Z[?X'```!`P````$````$````L`$````@````````&0```#@!````
M``````````````````````````````!H`````````-`!````````:```````
M```'````!P````,`````````7U]T97AT`````````````%]?5$585```````
M``````````````````@`````````T`$```0````````````````$`(``````
M``````````!?7V-O;7!A8W1?=6YW:6YD7U],1`````````````````@`````
M````(`````````#8`0```P```#@"```!`````````@```````````````%]?
M96A?9G)A;64```````!?7U1%6%0`````````````*`````````!`````````
M`/@!```#```````````````+``!H````````````````)````!``````#0H`
M``````(````8````0`(```$```!0`@``"`````L```!0````````````````
M`````0````$`````````````````````````````````````````````````
M````````````````````````54B)Y3'`7<,```````````@````````!````
M`````````````````!0``````````7I2``%X$`$0#`<(D`$``"0````<````
MN/________\(``````````!!#A"&`D,-!@```````````````0``!@$````/
3`0``````````````7VUA:6X`````
`
EOF
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Test::Mock - Mock plugin for testing
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Test::Mock' => (
probe => 'share',
download => 1,
extract => 1,
build => 1,
gather => 1,
);
=head1 DESCRIPTION
This plugin is used for testing L<Alien::Build> plugins. Usually you only want to test
one or two phases in an L<alienfile> for your plugin, but you still have to have a fully
formed L<alienfile> that contains all required phases. This plugin lets you fill in the
other phases with the appropriate hooks. This is usually better than using real plugins
which may pull in additional dynamic requirements that you do not want to rely on at
test time.
=head1 PROPERTIES
=head2 probe
plugin 'Test::Mock' => (
probe => $probe,
);
Override the probe behavior by one of the following:
=over
=item share
For a C<share> build.
=item system
For a C<system> build.
=item die
To throw an exception in the probe hook. This will usually cause L<Alien::Build>
to try the next probe hook, if available, or to assume a C<share> install.
=back
=head2 download
plugin 'Test::Mock' => (
download => \%fs_spec,
);
plugin 'Test::Mock' => (
download => 1,
);
Mock out a download. The C<%fs_spec> is a hash where the hash values are directories
and the string values are files. This a spec like this:
plugin 'Test::Mock' => (
download => {
'foo-1.00' => {
'README.txt' => "something to read",
'foo.c' => "#include <stdio.h>\n",
"int main() {\n",
" printf(\"hello world\\n\");\n",
"}\n",
}
},
);
Would generate two files in the directory 'foo-1.00', a C<README.txt> and a C file named C<foo.c>.
The default, if you provide a true non-hash value is to generate a single tarball with the name
C<foo-1.00.tar.gz>.
=head2 extract
plugin 'Test::Mock' => (
extract => \%fs_spec,
);
plugin 'Test::Mock' => (
extract => 1,
);
Similar to C<download> above, but for the C<extract> phase.
=head2 build
plugin 'Test::Mock' => (
build => [ \%fs_spec_build, \%fs_spec_install ],
);
plugin 'Test::Mock' => (
build => 1,
);
=head2 gather
plugin 'Test::Mock' => (
gather => \%runtime_prop,
);
plugin 'Test::Mock' => (
gather => 1,
);
This adds a gather hook (for both C<share> and C<system>) that adds the given runtime properties, or
if a true non-hash value is provided, some reasonable runtime properties for testing.
=head2 check_digest
plugin 'Test::Mock' => (
check_digest => 1, # the default
);
This adds a check_digest hook that uses fake algorithm FAKE that hashes everything to C<deadbeaf>.
The mock download above will set the digest for download_details so that this will pass the
signature check.
plugin 'Test::Mock' => (
check_digest => sub {
my($build, $file, $algo, $digest) = @_;
...
},
);
If you give it a code reference then you can write your own faux digest. See the
L<check_digest hook|Alien::Build::Manual::PluginAuthor/"check_digest hook"> in
L<Alien::Build::Manual::PluginAuthor> for details.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch/LocalDir.pm 0000444 00000007565 15157555211 0014611 0 ustar 00 package Alien::Build::Plugin::Fetch::LocalDir;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::chdir;
use Path::Tiny ();
# ABSTRACT: Plugin for fetching a local directory
our $VERSION = '2.84'; # VERSION
has root => undef;
has ssl => 0;
sub init
{
my($self, $meta) = @_;
my $url = $meta->prop->{start_url} || 'patch';
$meta->add_requires('configure' => 'Alien::Build::Plugin::Fetch::LocalDir' => '0.72' );
if($url =~ /^file:/)
{
$meta->add_requires('share' => 'URI' => 0 );
$meta->add_requires('share' => 'URI::file' => 0 );
}
{
my $root = $self->root;
if(defined $root)
{
$root = Path::Tiny->new($root)->absolute->stringify;
}
else
{
$root = "$CWD";
}
$self->root($root);
}
$meta->register_hook(
fetch => sub {
my($build, $path, %options) = @_;
$build->log("plugin Fetch::LocalDir does not support http_headers option") if $options{http_headers};
$path ||= $url;
if($path =~ /^file:/)
{
my $root = URI::file->new($self->root);
my $url = URI->new_abs($path, $root);
$path = $url->path;
$path =~ s{^/([a-z]:)}{$1}i if $^O eq 'MSWin32';
}
$path = Path::Tiny->new($path)->absolute($self->root);
if(-d $path)
{
return {
type => 'file',
filename => $path->basename,
path => $path->stringify,
tmp => 0,
protocol => 'file',
};
}
else
{
$build->log("path $path is not a directory");
$build->log("(you specified $url with root @{[ $self->root ]})");
die "$path is not a directory";
}
}
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch::LocalDir - Plugin for fetching a local directory
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'patch/libfoo-1.00/';
plugin 'Fetch::LocalDir';
};
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This fetch plugin fetches files from the local file system. It is mostly useful if you
intend to bundle source with your Alien. If you are bundling tarballs see
L<Alien::Build::Plugin::Fetch::Local>.
=head1 PROPERTIES
=head2 root
The directory from which the start URL should be relative. The default is usually reasonable.
=head2 ssl
This property is for compatibility with other fetch plugins, but is not used.
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Plugin::Download::Negotiate>
=item L<Alien::Build::Plugin::Fetch::Local>
=item L<Alien::Build>
=item L<alienfile>
=item L<Alien::Build::MM>
=item L<Alien>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch/NetFTP.pm 0000444 00000012767 15157555217 0014226 0 ustar 00 package Alien::Build::Plugin::Fetch::NetFTP;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
use File::Temp ();
use Path::Tiny qw( path );
# ABSTRACT: Plugin for fetching files using Net::FTP
our $VERSION = '2.84'; # VERSION
has '+url' => '';
has ssl => 0;
has passive => 0;
sub init
{
my($self, $meta) = @_;
$meta->prop->{start_url} ||= $self->url;
$self->url($meta->prop->{start_url});
$self->url || Carp::croak('url is a required property');
$meta->add_requires('share' => 'Net::FTP' => 0 );
$meta->add_requires('share' => 'URI' => 0 );
$meta->add_requires('share' => 'Alien::Build::Plugin::Fetch::NetFTP' => '0.61')
if $self->passive;
$meta->register_hook( fetch => sub {
my($build, $url, %options) = @_;
$url ||= $self->url;
$build->log("plugin Fetch::NetFTP does not support http_headers option") if $options{http_headers};
$url = URI->new($url);
die "Fetch::NetFTP does not support @{[ $url->scheme ]}"
unless $url->scheme eq 'ftp';
$build->log("trying passive mode FTP first") if $self->passive;
my $ftp = _ftp_connect($url, $self->passive);
my $path = $url->path;
unless($path =~ m!/$!)
{
my(@parts) = split /\//, $path;
my $filename = pop @parts;
my $dir = join '/', @parts;
my $path = eval {
$ftp->cwd($dir) or die;
my $tdir = File::Temp::tempdir( CLEANUP => 1);
my $path = path("$tdir/$filename")->stringify;
unless(eval { $ftp->get($filename, $path) }) # NAT problem? try to use passive mode
{
$ftp->quit;
$build->log("switching to @{[ $self->passive ? 'active' : 'passive' ]} mode");
$ftp = _ftp_connect($url, !$self->passive);
$ftp->cwd($dir) or die;
$ftp->get($filename, $path) or die;
}
$path;
};
if(defined $path)
{
return {
type => 'file',
filename => $filename,
path => $path,
protocol => 'ftp',
};
}
$path .= "/";
}
$ftp->quit;
$ftp = _ftp_connect($url, $self->passive);
$ftp->cwd($path) or die "unable to fetch $url as either a directory or file";
my $list = eval { $ftp->ls };
unless(defined $list) # NAT problem? try to use passive mode
{
$ftp->quit;
$build->log("switching to @{[ $self->passive ? 'active' : 'passive' ]} mode");
$ftp = _ftp_connect($url, !$self->passive);
$ftp->cwd($path) or die "unable to fetch $url as either a directory or file";
$list = $ftp->ls;
die "cannot list directory $path on $url" unless defined $list;
}
die "no files found at $url" unless @$list;
$path .= '/' unless $path =~ /\/$/;
return {
type => 'list',
protocol => 'ftp',
list => [
map {
my $filename = $_;
my $furl = $url->clone;
$furl->path($path . $filename);
my %h = (
filename => $filename,
url => $furl->as_string,
);
\%h;
} sort @$list,
],
};
});
$self;
}
sub _ftp_connect {
my $url = shift;
my $is_passive = shift || 0;
my $ftp = Net::FTP->new(
$url->host, Port =>$url->port, Passive =>$is_passive,
) or die "error fetching $url: $@";
$ftp->login($url->user, $url->password)
or die "error on login $url: @{[ $ftp->message ]}";
$ftp->binary;
$ftp;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch::NetFTP - Plugin for fetching files using Net::FTP
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'ftp://ftp.gnu.org/gnu/make';
plugin 'Fetch::NetFTP';
};
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This fetch plugin fetches files and directory listings via the C<ftp>, protocol using
L<Net::FTP>.
=head1 PROPERTIES
=head2 url
The initial URL to fetch. This may be a directory or the final file.
=head2 ssl
This property is for compatibility with other fetch plugins, but is not used.
=head2 passive
If set to true, try passive mode FIRST. By default it will try an active mode, then
passive mode.
=head1 SEE ALSO
L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch/CurlCommand.pm 0000444 00000020311 15157555224 0015310 0 ustar 00 package Alien::Build::Plugin::Fetch::CurlCommand;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::Which qw( which );
use Path::Tiny qw( path );
use Capture::Tiny qw( capture );
use File::Temp qw( tempdir );
use List::Util 1.33 qw( any pairmap );
use File::chdir;
# ABSTRACT: Plugin for fetching files using curl
our $VERSION = '2.84'; # VERSION
sub curl_command
{
defined $ENV{CURL} ? scalar which($ENV{CURL}) : scalar which('curl');
}
has ssl => 0;
has _see_headers => 0;
has '+url' => '';
# when bootstrapping we have to specify this plugin as a prereq
# 1 is the default so that when this plugin is used directly
# you also get the prereq
has bootstrap_ssl => 1;
sub protocol_ok
{
my($class, $protocol) = @_;
my $curl = $class->curl_command;
return 0 unless defined $curl;
my($out, $err, $exit) = capture {
system $curl, '--version';
};
{
# make sure curl supports the -J option.
# CentOS 6 for example is recent enough
# that it does not. gh#147, gh#148, gh#149
local $CWD = tempdir( CLEANUP => 1 );
my $file1 = path('foo/foo.txt');
$file1->parent->mkpath;
$file1->spew("hello world\n");
my $url = 'file://' . $file1->absolute;
my($out, $err, $exit) = capture {
system $curl, '-O', '-J', $url;
};
my $file2 = $file1->parent->child($file1->basename);
unlink "$file1";
unlink "$file2";
rmdir($file1->parent);
return 0 if $exit;
}
foreach my $line (split /\n/, $out)
{
if($line =~ /^Protocols:\s*(.*)\s*$/)
{
my %proto = map { $_ => 1 } split /\s+/, $1;
return $proto{$protocol} if $proto{$protocol};
}
}
return 0;
}
sub init
{
my($self, $meta) = @_;
$meta->prop->{start_url} ||= $self->url;
$self->url($meta->prop->{start_url});
$self->url || Carp::croak('url is a required property');
$meta->add_requires('configure', 'Alien::Build::Plugin::Fetch::CurlCommand' => '1.19')
if $self->bootstrap_ssl;
$meta->register_hook(
fetch => sub {
my($build, $url, %options) = @_;
$url ||= $self->url;
my($scheme) = $url =~ /^([a-z0-9]+):/i;
if($scheme =~ /^https?$/)
{
local $CWD = tempdir( CLEANUP => 1 );
my @writeout = (
"ab-filename :%{filename_effective}",
"ab-content_type :%{content_type}",
"ab-url :%{url_effective}",
);
$build->log("writeout: $_\\n") for @writeout;
path('writeout')->spew(join("\\n", @writeout));
my @headers;
if(my $headers = $options{http_headers})
{
if(ref $headers eq 'ARRAY')
{
@headers = pairmap { -H => "$a: $b" } @$headers;
}
else
{
$build->log("Fetch for $url with http_headers that is not an array reference");
}
}
my @command = (
$self->curl_command,
'-L', '-f', '-O', '-J',
-w => '@writeout',
@headers,
);
push @command, -D => 'head' if $self->_see_headers;
push @command, $url;
my($stdout, $stderr) = $self->_execute($build, @command);
my %h = map { /^ab-(.*?)\s*:(.*)$/ ? ($1 => $2) : () } split /\n/, $stdout;
if(-e 'head')
{
$build->log(" ~ $_ => $h{$_}") for sort keys %h;
$build->log(" header: $_") for path('headers')->lines;
}
my($type) = split /;/, $h{content_type};
if($type eq 'text/html')
{
return {
type => 'html',
base => $h{url},
content => scalar path($h{filename})->slurp,
protocol => $scheme,
};
}
else
{
return {
type => 'file',
filename => $h{filename},
path => path($h{filename})->absolute->stringify,
protocol => $scheme,
};
}
}
# elsif($scheme eq 'ftp')
# {
# if($url =~ m{/$})
# {
# my($stdout, $stderr) = $self->_execute($build, $self->curl_command, -l => $url);
# chomp $stdout;
# return {
# type => 'list',
# list => [
# map { { filename => $_, url => "$url$_" } } sort split /\n/, $stdout,
# ],
# };
# }
#
# my $first_error;
#
# {
# local $CWD = tempdir( CLEANUP => 1 );
#
# my($filename) = $url =~ m{/([^/]+)$};
# $filename = 'unknown' if (! defined $filename) || ($filename eq '');
# my($stdout, $stderr) = eval { $self->_execute($build, $self->curl_command, -o => $filename, $url) };
# $first_error = $@;
# if($first_error eq '')
# {
# return {
# type => 'file',
# filename => $filename,
# path => path($filename)->absolute->stringify,
# };
# }
# }
#
# {
# my($stdout, $stderr) = eval { $self->_execute($build, $self->curl_command, -l => "$url/") };
# if($@ eq '')
# {
# chomp $stdout;
# return {
# type => 'list',
# list => [
# map { { filename => $_, url => "$url/$_" } } sort split /\n/, $stdout,
# ],
# };
# };
# }
#
# $first_error ||= 'unknown error';
# die $first_error;
#
# }
else
{
die "scheme $scheme is not supported by the Fetch::CurlCommand plugin";
}
},
) if $self->curl_command;
$self;
}
sub _execute
{
my($self, $build, @command) = @_;
$build->log("+ @command");
my($stdout, $stderr, $err) = capture {
system @command;
$?;
};
if($err)
{
chomp $stderr;
$build->log($_) for split /\n/, $stderr;
if($stderr =~ /Remote filename has no length/ && !!(any { /^-O$/ } @command))
{
my @new_command = map {
/^-O$/ ? ( -o => 'index.html' ) : /^-J$/ ? () : ($_)
} @command;
return $self->_execute($build, @new_command);
}
die "error in curl fetch";
}
($stdout, $stderr);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch::CurlCommand - Plugin for fetching files using curl
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'https://www.openssl.org/source/';
plugin 'Fetch::CurlCommand';
};
=head1 DESCRIPTION
This plugin provides a fetch based on the C<curl> command. It works with other fetch
plugins (that is, the first one which succeeds will be used). Most of the time the best plugin
to use will be L<Alien::Build::Plugin::Download::Negotiate>, but for some SSL bootstrapping
it may be desirable to try C<curl> first.
Protocols supported: C<http>, C<https>
C<https> support requires that curl was built with SSL support.
=head1 PROPERTIES
=head2 curl_command
The full path to the C<curl> command. The default is usually correct.
=head2 ssl
Ignored by this plugin. Provided for compatibility with some other fetch plugins.
=head1 METHODS
=head2 protocol_ok
my $bool = $plugin->protocol_ok($protocol);
my $bool = Alien::Build::Plugin::Fetch::CurlCommand->protocol_ok($protocol);
=head1 SEE ALSO
=over 4
=item L<alienfile>
=item L<Alien::Build>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch/HTTPTiny.pm 0000444 00000014320 15157555231 0014530 0 ustar 00 package Alien::Build::Plugin::Fetch::HTTPTiny;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::Basename ();
use Alien::Build::Util qw( _ssl_reqs );
use Carp ();
# ABSTRACT: Plugin for fetching files using HTTP::Tiny
our $VERSION = '2.84'; # VERSION
has '+url' => '';
has ssl => 0;
# ignored for compatability
has bootstrap_ssl => 1;
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'HTTP::Tiny' => '0.044' );
$meta->add_requires('share' => 'URI' => '0' );
$meta->add_requires('share' => 'Mozilla::CA' => '0' );
$meta->prop->{start_url} ||= $self->url;
$self->url($meta->prop->{start_url});
$self->url || Carp::croak('url is a required property');
if($self->url =~ /^https:/ || $self->ssl)
{
my $reqs = _ssl_reqs;
foreach my $mod (sort keys %$reqs)
{
$meta->add_requires('share' => $mod => $reqs->{$mod});
}
}
$meta->register_hook( fetch => sub {
my($build, $url, %options) = @_;
$url ||= $self->url;
$url = URI->new($url) unless ref($url) && $url->isa('URI');
my %headers;
if(my $headers = $options{http_headers})
{
if(ref $headers eq 'ARRAY')
{
my @headers = @$headers;
while(@headers)
{
my $key = shift @headers;
my $value = shift @headers;
unless(defined $key && defined $value)
{
$build->log("Fetch for $url with http_headers contains undef key or value");
next;
}
push @{ $headers{$key} }, $value;
}
}
else
{
$build->log("Fetch for $url with http_headers that is not an array reference");
}
}
my $ua = HTTP::Tiny->new(
agent => "Alien-Build/@{[ $Alien::Build::VERSION || 'dev' ]} ",
verify_SSL => $build->download_rule =~ /encrypt/ ? 1 : 0,
);
my $res = $ua->get($url, { headers => \%headers });
unless($res->{success})
{
my $status = $res->{status} || '---';
my $reason = $res->{reason} || 'unknown';
$build->log("$status $reason fetching $url");
if($status == 599)
{
$build->log("exception: $_") for split /\n/, $res->{content};
my($can_ssl, $why_ssl) = HTTP::Tiny->can_ssl;
if(! $can_ssl)
{
if($res->{redirects}) {
foreach my $redirect (@{ $res->{redirects} })
{
if(defined $redirect->{headers}->{location} && $redirect->{headers}->{location} =~ /^https:/)
{
$build->log("An attempt at a SSL URL https was made, but your HTTP::Tiny does not appear to be able to use https.");
$build->log("Please see: https://metacpan.org/pod/Alien::Build::Manual::FAQ#599-Internal-Exception-errors-downloading-packages-from-the-internet");
}
}
}
}
}
die "error fetching $url: $status $reason";
}
my($type) = split /;/, $res->{headers}->{'content-type'};
$type = lc $type;
my $base = URI->new($res->{url});
my $filename = File::Basename::basename do { my $name = $base->path; $name =~ s{/$}{}; $name };
# TODO: this doesn't get exercised by t/bin/httpd
if(my $disposition = $res->{headers}->{"content-disposition"})
{
# Note: from memory without quotes does not match the spec,
# but many servers actually return this sort of value.
if($disposition =~ /filename="([^"]+)"/ || $disposition =~ /filename=([^\s]+)/)
{
$filename = $1;
}
}
if($type eq 'text/html')
{
return {
type => 'html',
base => $base->as_string,
content => $res->{content},
protocol => $url->scheme,
};
}
else
{
return {
type => 'file',
filename => $filename || 'downloadedfile',
content => $res->{content},
protocol => $url->scheme,
};
}
});
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch::HTTPTiny - Plugin for fetching files using HTTP::Tiny
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'http://ftp.gnu.org/gnu/make';
plugin 'Fetch::HTTPTiny';
};
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This fetch plugin fetches files and directory listings via the C<http> and C<https>
protocol using L<HTTP::Tiny>. If the URL specified uses the C<https> scheme, then
the required SSL modules will automatically be injected as requirements. If your
initial URL is not C<https>, but you know that it will be needed on a subsequent
request you can use the ssl property below.
=head1 PROPERTIES
=head2 url
The initial URL to fetch. This may be a directory listing (in HTML) or the final file.
=head2 ssl
If set to true, then the SSL modules required to make an C<https> connection will be
added as prerequisites.
=head1 SEE ALSO
L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch/LWP.pm 0000444 00000010411 15157555243 0013547 0 ustar 00 package Alien::Build::Plugin::Fetch::LWP;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
# ABSTRACT: Plugin for fetching files using LWP
our $VERSION = '2.84'; # VERSION
has '+url' => '';
has ssl => 0;
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'LWP::UserAgent' => 0 );
$meta->prop->{start_url} ||= $self->url;
$self->url($meta->prop->{start_url});
$self->url || Carp::croak('url is a required property');
if($self->url =~ /^https:/ || $self->ssl)
{
$meta->add_requires('share' => 'LWP::Protocol::https' => 0 );
}
$meta->register_hook( fetch => sub {
my($build, $url, %options) = @_;
$url ||= $self->url;
my @headers;
if(my $headers = $options{http_headers})
{
if(ref $headers eq 'ARRAY')
{
@headers = @$headers;
}
else
{
$build->log("Fetch for $url with http_headers that is not an array reference");
}
}
my $ua = LWP::UserAgent->new;
$ua->env_proxy;
my $res = $ua->get($url, @headers);
my($protocol) = $url =~ /^([a-z]+):/;
die "error fetching $url: @{[ $res->status_line ]}"
unless $res->is_success;
my($type, $charset) = $res->content_type_charset;
my $base = $res->base;
my $filename = $res->filename;
if($type eq 'text/html')
{
return {
type => 'html',
charset => $charset,
base => "$base",
content => $res->decoded_content || $res->content,
protocol => $protocol,
};
}
elsif($type eq 'text/ftp-dir-listing')
{
return {
type => 'dir_listing',
base => "$base",
content => $res->decoded_content || $res->content,
protocol => $protocol,
};
}
else
{
return {
type => 'file',
filename => $filename || 'downloadedfile',
content => $res->content,
protocol => $protocol,
};
}
});
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch::LWP - Plugin for fetching files using LWP
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'http://ftp.gnu.org/gnu/make';
plugin 'Fetch::LWP';
};
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This fetch plugin fetches files and directory listings via the C<http> C<https>, C<ftp>,
C<file> protocol using L<LWP>. If the URL specified uses the C<https> scheme, then
the required SSL modules will automatically be injected as requirements. If your
initial URL is not C<https>, but you know that it will be needed on a subsequent
request you can use the ssl property below.
=head1 PROPERTIES
=head2 url
The initial URL to fetch. This may be a directory listing (in HTML) or the final file.
=head2 ssl
If set to true, then the SSL modules required to make an C<https> connection will be
added as prerequisites.
=head1 SEE ALSO
L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch/Local.pm 0000444 00000010263 15157555251 0014143 0 ustar 00 package Alien::Build::Plugin::Fetch::Local;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::chdir;
use Path::Tiny ();
# ABSTRACT: Plugin for fetching a local file
our $VERSION = '2.84'; # VERSION
has '+url' => '';
has root => undef;
has ssl => 0;
sub init
{
my($self, $meta) = @_;
$meta->prop->{start_url} ||= $self->url;
$self->url($meta->prop->{start_url} || 'patch');
if($self->url =~ /^file:/)
{
$meta->add_requires('share' => 'URI' => 0 );
$meta->add_requires('share' => 'URI::file' => 0 );
$meta->add_requires('share' => 'URI::Escape' => 0 );
}
{
my $root = $self->root;
if(defined $root)
{
$root = Path::Tiny->new($root)->absolute->stringify;
}
else
{
$root = "$CWD";
}
$self->root($root);
}
$meta->register_hook( fetch => sub {
my($build, $path, %options) = @_;
$build->log("plugin Fetch::Local does not support http_headers option") if $options{http_headers};
$path ||= $self->url;
if($path =~ /^file:/)
{
my $root = URI::file->new($self->root);
my $url = URI->new_abs($path, $root);
$path = URI::Escape::uri_unescape($url->path);
$path =~ s{^/([a-z]:)}{$1}i if $^O eq 'MSWin32';
}
$path = Path::Tiny->new($path)->absolute($self->root);
if(-d $path)
{
return {
type => 'list',
protocol => 'file',
list => [
map { { filename => $_->basename, url => $_->stringify } }
sort { $a->basename cmp $b->basename } $path->children,
],
};
}
elsif(-f $path)
{
return {
type => 'file',
filename => $path->basename,
path => $path->stringify,
tmp => 0,
protocol => 'file',
};
}
else
{
die "no such file or directory $path";
}
});
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch::Local - Plugin for fetching a local file
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'patch/libfoo-1.00.tar.gz';
plugin 'Fetch::Local';
};
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This fetch plugin fetches files from the local file system. It is mostly useful if you
intend to bundle packages (as tarballs or zip files) with your Alien. If you intend to
bundle a source tree, use L<Alien::Build::Plugin::Fetch::LocalDir>.
=head1 PROPERTIES
=head2 url
The initial URL to fetch. This may be a C<file://> style URL, or just the path on the
local system.
=head2 root
The directory from which the URL should be relative. The default is usually reasonable.
=head2 ssl
This property is for compatibility with other fetch plugins, but is not used.
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Plugin::Download::Negotiate>
=item L<Alien::Build::Plugin::Fetch::LocalDir>
=item L<Alien::Build>
=item L<alienfile>
=item L<Alien::Build::MM>
=item L<Alien>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch/Wget.pm 0000444 00000012344 15157555256 0014026 0 ustar 00 package Alien::Build::Plugin::Fetch::Wget;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::Temp qw( tempdir );
use Path::Tiny qw( path );
use File::Which qw( which );
use Capture::Tiny qw( capture capture_merged );
use File::chdir;
use List::Util qw( pairmap );
# ABSTRACT: Plugin for fetching files using wget
our $VERSION = '2.84'; # VERSION
sub _wget
{
my $wget = defined $ENV{WGET} ? which($ENV{WGET}) : which('wget');
return undef unless defined $wget;
my $output = capture_merged { system $wget, '--help' };
# The wget that BusyBox implements does not follow that same interface
# as GNU wget and may not check ssl certs which is not good.
return undef if $output =~ /BusyBox/;
return $wget;
}
has wget_command => sub { _wget() };
has ssl => 0;
# when bootstrapping we have to specify this plugin as a prereq
# 1 is the default so that when this plugin is used directly
# you also get the prereq
has bootstrap_ssl => 1;
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure', 'Alien::Build::Plugin::Fetch::Wget' => '1.19')
if $self->bootstrap_ssl;
$meta->register_hook(
fetch => sub {
my($build, $url, %options) = @_;
$url ||= $meta->prop->{start_url};
my($scheme) = $url =~ /^([a-z0-9]+):/i;
if($scheme eq 'http' || $scheme eq 'https')
{
local $CWD = tempdir( CLEANUP => 1 );
my @headers;
if(my $headers = $options{http_headers})
{
if(ref $headers eq 'ARRAY')
{
my @copy = @$headers;
my %headers;
while(@copy)
{
my $key = shift @copy;
my $value = shift @copy;
push @{ $headers{$key} }, $value;
}
@headers = pairmap { "--header=$a: @{[ join ', ', @$b ]}" } %headers;
}
else
{
$build->log("Fetch for $url with http_headers that is not an array reference");
}
}
my($stdout, $stderr) = $self->_execute(
$build,
$self->wget_command,
'-k', '--content-disposition', '-S',
@headers,
$url,
);
my($path) = path('.')->children;
die "no file found after wget" unless $path;
my($type) = $stderr =~ /Content-Type:\s*(.*?)$/m;
$type =~ s/;.*$// if $type;
if($type eq 'text/html')
{
return {
type => 'html',
base => $url,
content => scalar $path->slurp,
protocol => $scheme,
};
}
else
{
return {
type => 'file',
filename => $path->basename,
path => $path->absolute->stringify,
protocol => $scheme,
};
}
}
else
{
die "scheme $scheme is not supported by the Fetch::Wget plugin";
}
},
) if $self->wget_command;
}
sub _execute
{
my($self, $build, @command) = @_;
$build->log("+ @command");
my($stdout, $stderr, $err) = capture {
system @command;
$?;
};
if($err)
{
chomp $stderr;
$stderr = [split /\n/, $stderr]->[-1];
die "error in wget fetch: $stderr";
}
($stdout, $stderr);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch::Wget - Plugin for fetching files using wget
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'https://www.openssl.org/source/';
plugin 'Fetch::Wget';
};
=head1 DESCRIPTION
B<WARNING>: This plugin is somewhat experimental at this time.
This plugin provides a fetch based on the C<wget> command. It works with other fetch
plugins (that is, the first one which succeeds will be used). Most of the time the best plugin
to use will be L<Alien::Build::Plugin::Download::Negotiate>, but for some SSL bootstrapping
it may be desirable to try C<wget> first.
Protocols supported: C<http>, C<https>
=head1 PROPERTIES
=head2 wget_command
The full path to the C<wget> command. The default is usually correct.
=head2 ssl
Ignored by this plugin. Provided for compatibility with some other fetch plugins.
=head1 SEE ALSO
=over 4
=item L<alienfile>
=item L<Alien::Build>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Digest/SHAPP.pm 0000444 00000004564 15157555271 0014163 0 ustar 00 package Alien::Build::Plugin::Digest::SHAPP;
use strict;
use warnings;
use Alien::Build::Plugin;
# ABSTRACT: Plugin to check SHA digest with Digest::SHA::PurePerl
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure' => 'Alien::Build' => "2.57" );
$meta->add_requires('share' => 'Digest::SHA::PurePerl' => "0" );
$meta->register_hook( check_digest => sub {
my($build, $file, $algo, $expected_digest) = @_;
return 0 unless $algo =~ /^SHA[0-9]+$/;
my $sha = Digest::SHA::PurePerl->new($algo);
return 0 unless defined $sha;
if(defined $file->{content})
{
$sha->add($file->{content});
}
elsif(defined $file->{path})
{
$sha->addfile($file->{path}, "b");
}
else
{
die "unknown file type";
}
my $actual_digest = $sha->hexdigest;
return 1 if $expected_digest eq $actual_digest;
die "@{[ $file->{filename} ]} SHA@{[ $sha->algorithm ]} digest does not match: got $actual_digest, expected $expected_digest";
});
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Digest::SHAPP - Plugin to check SHA digest with Digest::SHA::PurePerl
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Digest::SHAPP';
=head1 DESCRIPTION
This plugin is experimental.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Digest/SHA.pm 0000444 00000004406 15157555276 0013723 0 ustar 00 package Alien::Build::Plugin::Digest::SHA;
use strict;
use warnings;
use Alien::Build::Plugin;
# ABSTRACT: Plugin to check SHA digest with Digest::SHA
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure' => 'Alien::Build' => "2.57" );
$meta->register_hook( check_digest => sub {
my($build, $file, $algo, $expected_digest) = @_;
return 0 unless $algo =~ /^SHA[0-9]+$/;
my $sha = Digest::SHA->new($algo);
return 0 unless defined $sha;
if(defined $file->{content})
{
$sha->add($file->{content});
}
elsif(defined $file->{path})
{
$sha->addfile($file->{path}, "b");
}
else
{
die "unknown file type";
}
my $actual_digest = $sha->hexdigest;
return 1 if $expected_digest eq $actual_digest;
die "@{[ $file->{filename} ]} SHA@{[ $sha->algorithm ]} digest does not match: got $actual_digest, expected $expected_digest";
});
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Digest::SHA - Plugin to check SHA digest with Digest::SHA
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Digest::SHA';
=head1 DESCRIPTION
This plugin is experimental.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Digest/Negotiate.pm 0000444 00000007451 15157555303 0015221 0 ustar 00 package Alien::Build::Plugin::Digest::Negotiate;
use strict;
use warnings;
use Alien::Build::Plugin;
# ABSTRACT: Plugin negotiator for cryptographic signatures
our $VERSION = '2.84'; # VERSION
has '+sig' => sub { {} };
has check_fetch => 1;
has check_download => 1;
has allow_listing => 1;
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure' => 'Alien::Build::Plugin::Digest::Negotiate' => "0" );
$meta->prop->{check_digest} = 1;
my $sigs = $meta->prop->{digest} ||= {};
if(ref($self->sig) eq 'HASH') {
foreach my $filename (keys %{ $self->sig })
{
my $signature = $self->sig->{$filename};
my($algo) = @$signature;
die "Unknown digest algorithm $algo" unless $algo =~ /^SHA(1|224|256|384|512|512224|512256)$/; # reportedly what is supported by Digest::SHA
$sigs->{$filename} = $signature;
}
} elsif(ref($self->sig) eq 'ARRAY') {
my $signature = $self->sig;
my($algo) = @$signature;
die "Unknown digest algorithm $algo" unless $algo =~ /^SHA(1|224|256|384|512|512224|512256)$/; # reportedly what is supported by Digest::SHA
$sigs->{'*'} = $signature;
}
# In the future if this negotiator supports algorithms other
# than SHA, we should probably ajust this to keep track of
# which ones we actually need when we are looping through them
# above. Also technically you could call this plugin without
# any sigs, and we shouldn't in theory need to apply Digest::SHA,
# but stuff won't work that way so that is a corner case we
# are not going to worry about.
$meta->apply_plugin('Digest::SHA');
$meta->around_hook(
fetch => sub {
my($orig, $build, @rest) = @_;
my $res = $orig->($build, @rest);
if($res->{type} eq 'file')
{
$build->check_digest($res);
}
else
{
die "listing fetch not allowed" unless $self->allow_listing;
}
$res;
},
) if $self->check_fetch;
# Note that check_download hook is currently undocumented and
# may change in the future.
$meta->register_hook(
check_download => sub {
my($build) = @_;
my $path = $build->install_prop->{download};
die "Checking cryptographic signatures on download only works for single archive" unless defined $path;
$build->check_digest($path);
},
) if $self->check_download;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Digest::Negotiate - Plugin negotiator for cryptographic signatures
=head1 VERSION
version 2.84
=head1 SYNOPSIS
for a single file:
use alienfile;
plugin 'Digest' => [ SHA256 => $digest ];
or for multiple files:
use alienfile;
plugin 'Digest' => {
file1 => [ SHA256 => $digest1 ],
file2 => [ SHA256 => $digest2 ],
};
=head1 DESCRIPTION
This plugin is experimental.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Decode/DirListingFtpcopy.pm 0000444 00000006433 15157555315 0016665 0 ustar 00 package Alien::Build::Plugin::Decode::DirListingFtpcopy;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::Basename ();
# ABSTRACT: Plugin to extract links from a directory listing using ftpcopy
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'File::Listing::Ftpcopy' => 0);
$meta->add_requires('share' => 'URI' => 0);
$meta->register_hook( decode => sub {
my(undef, $res) = @_;
die "do not know how to decode @{[ $res->{type} ]}"
unless $res->{type} eq 'dir_listing';
my $base = URI->new($res->{base});
return {
type => 'list',
list => [
map {
my($name) = @$_;
my $basename = $name;
$basename =~ s{/$}{};
my %h = (
filename => File::Basename::basename($basename),
url => URI->new_abs($name, $base)->as_string,
);
\%h;
} File::Listing::Ftpcopy::parse_dir($res->{content})
],
};
});
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Decode::DirListingFtpcopy - Plugin to extract links from a directory listing using ftpcopy
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Decode::DirListingFtpcopy';
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate decode plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin decodes a ftp file listing into a list of candidates for your Prefer plugin.
It is useful when fetching from an FTP server via L<Alien::Build::Plugin::Fetch::LWP>.
It is different from the similarly named L<Alien::Build::Plugin::Decode::DirListingFtpcopy>
in that it uses L<File::Listing::Ftpcopy> instead of L<File::Listing>. The rationale for
the C<Ftpcopy> version is that it supports a different set of FTP servers, including
OpenVMS. In most cases, however, you probably want to use the non C<Ftpcopy> version
since it is pure perl.
=head1 SEE ALSO
L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build::Plugin::Decode::DirListing>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Decode/Mojo.pm 0000444 00000010440 15157555322 0014143 0 ustar 00 package Alien::Build::Plugin::Decode::Mojo;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Plugin to extract links from HTML using Mojo::DOM or Mojo::DOM58
our $VERSION = '2.84'; # VERSION
sub _load ($;$)
{
my($class, $version) = @_;
my $pm = "$class.pm";
$pm =~ s/::/\//g;
eval { require $pm };
return 0 if $@;
if(defined $version)
{
eval { $class->VERSION($version) };
return 0 if $@;
}
return 1;
}
has _class => sub {
return 'Mojo::DOM58' if _load 'Mojo::DOM58';
return 'Mojo::DOM' if _load 'Mojo::DOM' and _load 'Mojolicious', 7.00;
return 'Mojo::DOM58';
};
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'URI' => 0);
$meta->add_requires('share' => 'URI::Escape' => 0);
my $class = $meta->prop->{plugin_decode_mojo_class} ||= $self->_class;
if($class eq 'Mojo::DOM58')
{
$meta->add_requires('share' => 'Mojo::DOM58' => '1.00');
}
elsif($class eq 'Mojo::DOM')
{
$meta->add_requires('share' => 'Mojolicious' => '7.00');
$meta->add_requires('share' => 'Mojo::DOM' => '0');
}
else
{
die "bad class";
}
$meta->register_hook( decode => sub {
my(undef, $res) = @_;
die "do not know how to decode @{[ $res->{type} ]}"
unless $res->{type} eq 'html';
my $dom = $class->new($res->{content});
my $base = URI->new($res->{base});
if(my $base_element = $dom->find('head base')->first)
{
my $href = $base_element->attr('href');
$base = URI->new($href) if defined $href;
}
my @list = map {
my $url = URI->new_abs($_, $base);
my $path = $url->path;
$path =~ s{/$}{}; # work around for Perl 5.8.7- gh#8
{
filename => URI::Escape::uri_unescape(File::Basename::basename($path)),
url => URI::Escape::uri_unescape($url->as_string),
}
}
grep !/^\.\.?\/?$/,
map { $_->attr('href') || () }
@{ $dom->find('a')->to_array };
return {
type => 'list',
list => \@list,
};
})
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Decode::Mojo - Plugin to extract links from HTML using Mojo::DOM or Mojo::DOM58
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Decode::Mojo';
Force using C<Decode::Mojo> via the download negotiator:
use alienfile 1.68;
configure {
requires 'Alien::Build::Plugin::Decode::Mojo';
};
plugin 'Download' => (
...
decoder => 'Decode::Mojo',
);
=head1 DESCRIPTION
Note: in most cases you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate decode plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin decodes an HTML file listing into a list of candidates for your Prefer plugin.
It works just like L<Alien::Build::Plugin::Decode::HTML> except it uses either L<Mojo::DOM>
or L<Mojo::DOM58> to do its job.
This plugin is much lighter than The C<Decode::HTML> plugin, and doesn't require XS. It
is the default decode plugin used by L<Alien::Build::Plugin::Download::Negotiate> if it
detects that you need to parse an HTML index.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Decode/DirListing.pm 0000444 00000005547 15157555327 0015330 0 ustar 00 package Alien::Build::Plugin::Decode::DirListing;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::Basename ();
# ABSTRACT: Plugin to extract links from a directory listing
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'File::Listing' => 0);
$meta->add_requires('share' => 'URI' => 0);
$meta->register_hook( decode => sub {
my(undef, $res) = @_;
die "do not know how to decode @{[ $res->{type} ]}"
unless $res->{type} eq 'dir_listing';
my $base = URI->new($res->{base});
return {
type => 'list',
list => [
map {
my($name) = @$_;
my $basename = $name;
$basename =~ s{/$}{};
my %h = (
filename => File::Basename::basename($basename),
url => URI->new_abs($name, $base)->as_string,
);
\%h;
} File::Listing::parse_dir($res->{content})
],
};
});
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Decode::DirListing - Plugin to extract links from a directory listing
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Decode::DirListing';
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate decode plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin decodes a ftp file listing into a list of candidates for your Prefer plugin.
It is useful when fetching from an FTP server via L<Alien::Build::Plugin::Fetch::LWP>.
=head1 SEE ALSO
L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build::Plugin::Decode::DirListingFtpcopy>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Decode/HTML.pm 0000444 00000006063 15157555334 0014014 0 ustar 00 package Alien::Build::Plugin::Decode::HTML;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::Basename ();
# ABSTRACT: Plugin to extract links from HTML
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->add_requires('share' => 'HTML::LinkExtor' => 0);
$meta->add_requires('share' => 'URI' => 0);
$meta->add_requires('share' => 'URI::Escape' => 0);
$meta->register_hook( decode => sub {
my(undef, $res) = @_;
die "do not know how to decode @{[ $res->{type} ]}"
unless $res->{type} eq 'html';
my $base = URI->new($res->{base});
my @list;
my $p = HTML::LinkExtor->new(sub {
my($tag, %links) = @_;
if($tag eq 'base' && $links{href})
{
$base = URI->new($links{href});
}
elsif($tag eq 'a' && $links{href})
{
my $href = $links{href};
return if $href =~ m!^\.\.?/?$!;
my $url = URI->new_abs($href, $base);
my $path = $url->path;
$path =~ s{/$}{}; # work around for Perl 5.8.7- gh#8
push @list, {
filename => URI::Escape::uri_unescape(File::Basename::basename($path)),
url => URI::Escape::uri_unescape($url->as_string),
};
}
});
$p->parse($res->{content});
return {
type => 'list',
list => \@list,
};
});
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Decode::HTML - Plugin to extract links from HTML
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Decode::HTML';
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::Download::Negotiate>
instead. It picks the appropriate decode plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin decodes an HTML file listing into a list of candidates for your Prefer plugin.
=head1 SEE ALSO
L<Alien::Build::Plugin::Download::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Test.pod 0000444 00000003257 15157555342 0013153 0 ustar 00 # PODNAME: Alien::Build::Plugin::Test
# ABSTRACT: Probe Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Test - Probe Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Test::Mock' => (
probe => 'share',
download => 1,
extract => 1,
build => 1,
gather => 1,
);
=head1 DESCRIPTION
Test plugins are used in unit tests for L<Alien::Build> and possibly
its plugins.
=over 4
=item L<Alien::Build::Plugin::Test::Mock>
Mocks common steps in an L<alienfile>.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Extract.pod 0000444 00000004435 15157555347 0013652 0 ustar 00 # PODNAME: Alien::Build::Plugin::Extract
# ABSTRACT: Extract Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Extract - Extract Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile
share {
plugin 'Extract' => 'tar.gz';
};
=head1 DESCRIPTION
Extract plugins extract packages that have been downloaded from the internet.
Unless you are doing something unusual you will likely want to use the
L<Alien::Build::Plugin::Extract::Negotiate> plugin to select the best
Extract plugin available.
=over 4
=item L<Alien::Build::Plugin::Extract::ArchiveTar>
Extract using C<tar>. Typically also works with compressed tarballs like C<tar.gz>.
=item L<Alien::Build::Plugin::Extract::ArchiveZip>
Extract using L<Archive::Zip>.
=item L<Alien::Build::Plugin::Extract::CommandLine>
Extract using command line tools like C<tar> or C<unxip>.
=item L<Alien::Build::Plugin::Extract::Directory>
Extract a local directory.
=item L<Alien::Build::Plugin::Extract::File>
"Extract" a single file.
=item L<Alien::Build::Plugin::Extract::Negotiate>
Pick the best extract plugin based on the extension of the package archive.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Build/MSYS.pm 0000444 00000007323 15157555361 0013717 0 ustar 00 package Alien::Build::Plugin::Build::MSYS;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::Which ();
use Env qw( @PATH );
# ABSTRACT: MSYS plugin for Alien::Build
our $VERSION = '2.84'; # VERSION
has msys_version => '0.07';
sub init
{
my($self, $meta) = @_;
if($self->msys_version ne '0.07')
{
$meta->add_requires('configure' => 'Alien::Build::Plugin::Build::MSYS' => '0.84');
}
if(_win_and_needs_msys($meta))
{
$meta->add_requires('share' => 'Alien::MSYS' => $self->msys_version);
$meta->around_hook(
$_ => sub {
my $orig = shift;
my $build = shift;
local $ENV{PATH} = $ENV{PATH};
unshift @PATH, Alien::MSYS::msys_path();
$orig->($build, @_);
},
) for qw( build build_ffi test_share test_ffi );
}
if($^O eq 'MSWin32')
{
# Most likely if we are trying to build something unix-y and
# we are using MSYS, then we want to use the make that comes
# with MSYS.
$meta->interpolator->replace_helper(
make => sub { 'make' },
);
}
$self;
}
sub _win_and_needs_msys
{
my($meta) = @_;
# check to see if we are running on windows.
# if we are running on windows, check to see if
# it is MSYS2, then we can just use that. Otherwise
# we are probably on Strawberry, or (less likely)
# VC Perl, in which case we will still need Alien::MSYS
return 0 unless $^O eq 'MSWin32';
return 0 if $meta->prop->{platform}->{system_type} eq 'windows-mingw';
return 1;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Build::MSYS - MSYS plugin for Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Build::MSYS';
=head1 DESCRIPTION
This plugin sets up the MSYS environment for your build on Windows. It does
not do anything on non-windows platforms. MSYS provides the essential tools
for building software that is normally expected in a UNIX or POSIX environment.
This like C<sh>, C<awk> and C<make>. To provide MSYS, this plugin uses
L<Alien::MSYS>.
=head1 PROPERTIES
=head2 msys_version
The version of L<Alien::MSYS> required if it is deemed necessary. If L<Alien::MSYS>
isn't needed (if running under Unix, or MSYS2, for example) this will do nothing.
=head1 HELPERS
=head2 make
%{make}
On windows the default C<%{make}> helper is replace with the make that comes with
L<Alien::MSYS>. This is almost certainly what you want, as most unix style make
projects will not build with C<nmake> or C<dmake> typically used by Perl on Windows.
=head1 SEE ALSO
L<Alien::Build::Plugin::Build::Autoconf>, L<Alien::Build::Plugin>, L<Alien::Build>, L<Alien::Base>, L<Alien>
L<http://www.mingw.org/wiki/MSYS>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Build/Autoconf.pm 0000444 00000022647 15157555366 0014715 0 ustar 00 package Alien::Build::Plugin::Build::Autoconf;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use constant _win => $^O eq 'MSWin32';
use Path::Tiny ();
use File::Temp ();
# ABSTRACT: Autoconf plugin for Alien::Build
our $VERSION = '2.84'; # VERSION
has with_pic => 1;
has ffi => 0;
has msys_version => undef;
has config_site => sub {
my $config_site = "# file automatically generated by @{[ __FILE__ ]}\n";
$config_site .= ". $ENV{CONFIG_SITE}\n" if defined $ENV{CONFIG_SITE};
$config_site .= ". $ENV{ALIEN_BUILD_SITE_CONFIG}\n" if defined $ENV{ALIEN_BUILD_SITE_CONFIG};
# on some platforms autofools sorry I mean autotools likes to install into
# exec_prefix/lib64 or even worse exec_prefix/lib/64 but that messes everything
# else up so we try to nip that in the bud.
$config_site .= "libdir='\${prefix}/lib'\n";
$config_site;
};
sub init
{
my($self, $meta) = @_;
$meta->apply_plugin('Build::MSYS',
(defined $self->msys_version ? (msys_version => $self->msys_version) : ()),
);
$meta->prop->{destdir} = 1;
$meta->prop->{autoconf} = 1;
my $intr = $meta->interpolator;
my $set_autoconf_prefix = sub {
my($build) = @_;
my $prefix = $build->install_prop->{prefix};
die "Prefix is not set. Did you forget to run 'make alien_prefix'?"
unless $prefix;
if(_win)
{
$prefix = Path::Tiny->new($prefix)->stringify;
$prefix =~ s!^([a-z]):!/$1!i if _win;
}
$build->install_prop->{autoconf_prefix} = $prefix;
};
$meta->before_hook(
build_ffi => $set_autoconf_prefix,
);
# FFI mode undocumented for now...
if($self->ffi)
{
$meta->add_requires('configure', 'Alien::Build::Plugin::Build::Autoconf' => '0.41');
$meta->default_hook(
build_ffi => [
'%{configure} --enable-shared --disable-static --libdir=%{.install.autoconf_prefix}/dynamic',
'%{make}',
'%{make} install',
]
);
if($^O eq 'MSWin32')
{
# for whatever reason autohell puts the .dll files in bin, even if you
# point --bindir somewhere else.
$meta->after_hook(
build_ffi => sub {
my($build) = @_;
my $prefix = $build->install_prop->{autoconf_prefix};
my $bin = Path::Tiny->new($ENV{DESTDIR})->child($prefix)->child('bin');
my $lib = Path::Tiny->new($ENV{DESTDIR})->child($prefix)->child('dynamic');
if(-d $bin)
{
foreach my $from (grep { $_->basename =~ /.dll$/i } $bin->children)
{
$lib->mkpath;
my $to = $lib->child($from->basename);
$build->log("copy $from => $to");
$from->copy($to);
}
}
}
);
}
}
$meta->around_hook(
build => sub {
my $orig = shift;
my $build = shift;
$set_autoconf_prefix->($build);
my $prefix = $build->install_prop->{autoconf_prefix};
die "Prefix is not set. Did you forget to run 'make alien_prefix'?"
unless $prefix;
local $ENV{CONFIG_SITE} = do {
my $site_config = Path::Tiny->new(File::Temp::tempdir( CLEANUP => 1 ))->child('config.site');
$site_config->spew($self->config_site);
"$site_config";
};
$intr->replace_helper(
configure => sub {
my $configure;
if($build->meta_prop->{out_of_source})
{
my $extract = $build->install_prop->{extract};
$configure = _win ? "sh $extract/configure" : "$extract/configure";
}
else
{
$configure = _win ? 'sh ./configure' : './configure';
}
$configure .= ' --prefix=' . $prefix;
$configure .= ' --with-pic' if $self->with_pic;
$configure;
}
);
my $ret = $orig->($build, @_);
if(_win)
{
my $real_prefix = Path::Tiny->new($build->install_prop->{prefix});
my @pkgconf_dirs;
push @pkgconf_dirs, Path::Tiny->new($ENV{DESTDIR})->child($prefix)->child("$_/pkgconfig") for qw(lib share);
# for any pkg-config style .pc files that are dropped, we need
# to convert the MSYS /C/Foo style paths to C:/Foo
for my $pkgconf_dir (@pkgconf_dirs) {
if(-d $pkgconf_dir)
{
foreach my $pc_file ($pkgconf_dir->children)
{
$pc_file->edit(sub {s/\Q$prefix\E/$real_prefix->stringify/eg;});
}
}
}
}
$ret;
},
);
$intr->add_helper(
configure => sub {
my $configure = _win ? 'sh configure' : './configure';
$configure .= ' --with-pic' if $self->with_pic;
$configure;
},
);
$meta->default_hook(
build => [
'%{configure} --disable-shared',
'%{make}',
'%{make} install',
]
);
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Build::Autoconf - Autoconf plugin for Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Build::Autoconf';
=head1 DESCRIPTION
This plugin provides some tools for building projects that use autoconf. The main thing
this provides is a C<configure> helper, documented below and the default build stage,
which is:
'%{configure} --disable-shared',
'%{make}',
'%{make} install',
On Windows, this plugin also pulls in the L<Alien::Build::Plugin::Build::MSYS> which is
required for autoconf style projects on windows.
The other thing that this plugin does is that it does a double staged C<DESTDIR> install.
The author has found this improves the overall reliability of L<Alien> modules that are
based on autoconf packages.
This plugin supports out-of-source builds (known in autoconf terms as "VPATH" builds) via
the meta property C<out_of_source>.
B<NOTE>: by itself, this plugin is only intended for use on packages that include a
C<configure> script. For packages that expect you to use Autotools to generate a
configure script before building, you can use L<Alien::Autotools> to generate the
C<configure> script and use this plugin to run it. For more details see the
documentation for L<Alien::Autotools>.
=head1 PROPERTIES
=head2 with_pic
Adds C<--with-pic> option when running C<configure>. If supported by your package, it
will generate position independent code on platforms that support it. This is required
to XS modules, and generally what you want.
autoconf normally ignores options that it does not understand, so it is usually a safe
and reasonable default to include it. A small number of projects look like they use
autoconf, but are really an autoconf style interface with a different implementation.
They may fail if you try to provide it with options such as C<--with-pic> that they do
not recognize. Such packages are the rationale for this property.
=head2 msys_version
The version of L<Alien::MSYS> required if it is deemed necessary. If L<Alien::MSYS>
isn't needed (if running under Unix, or MSYS2, for example) this will do nothing.
=head2 config_site
The content for the generated C<config.site>.
=head1 HELPERS
=head2 configure
%{configure}
The correct incantation to start an autoconf style C<configure> script on your platform.
Some reasonable default flags will be provided.
=head1 ENVIRONMENT
=over 4
=item C<SITE_CONFIG>
For a share install, this plugin needs to alter the behavior of autotools using C<site.config>.
It does this by generating a C<site.config> file on the fly, and setting the C<SITE_CONFIG>
environment variable. In the event that you already have your own C<SITE_CONFIG> set, that
file will be sourced from the generated one, so your local defaults should still be honored,
unless it is one that needs to be changed for a share install.
In particular, the C<lib> directory must be overridden, because on some platforms dynamic libraries
will otherwise be placed in directories that L<Alien::Build> doesn't normally look in. Since
the alienized package will be installed in a share directory, and not a system directory,
that should be fine.
=item C<ALIEN_BUILD_SITE_CONFIG>
If defined, this file will be also be sourced in the generated C<site.config>. This allows
you to have local defaults for alien share installs only.
=back
=head1 SEE ALSO
L<Alien::Build::Plugin::Build::MSYS>, L<Alien::Build::Plugin>, L<Alien::Build>, L<Alien::Base>, L<Alien>
L<https://www.gnu.org/software/autoconf/autoconf.html>
L<https://www.gnu.org/prep/standards/html_node/DESTDIR.html>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Build/Copy.pm 0000444 00000007517 15157555373 0014046 0 ustar 00 package Alien::Build::Plugin::Build::Copy;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Path::Tiny ();
# ABSTRACT: Copy plugin for Alien::Build
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
$meta->add_requires( 'configure', __PACKAGE__, 0);
if($^O eq 'MSWin32')
{
$meta->register_hook(build => sub {
my($build) = @_;
my $stage = Path::Tiny->new($build->install_prop->{stage})->canonpath;
$build->system(qq{xcopy . "$stage" /E});
});
}
elsif($^O eq 'darwin')
{
# On recent macOS -pPR is the same as -aR
# on older Mac OS X (10.5 at least) -a is not supported but -pPR is.
# Looks like -pPR should also work on coreutils if for some reason
# someone is using coreutils on macOS, although there are semantic
# differences between -pPR and -aR on coreutils, that may or may not be
# important enough to care about.
$meta->register_hook(build => [
'cp -pPR * "%{.install.stage}"',
]);
}
else
{
# TODO: some platforms might not support -a
# I think most platforms will support -r
$meta->register_hook(build => [
'cp -aR * "%{.install.stage}"',
]);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Build::Copy - Copy plugin for Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Build::Copy';
=head1 DESCRIPTION
This plugin copies all of the files from the source to the staging prefix.
This is mainly useful for software packages that are provided as binary
blobs. It works on both Unix and Windows using the appropriate commands
for those platforms without having worry about the platform details in your
L<alienfile>.
If you want to filter add or remove files from what gets installed you can
use a C<before> hook.
build {
...
before 'build' => sub {
# remove or modify files
};
plugin 'Build::Copy';
...
};
Some packages might have binary blobs on some platforms and require build
from source on others. In that situation you can use C<if> statements
with the appropriate logic in your L<alienfile>.
configure {
# normally the Build::Copy plugin will insert itself
# as a config requires, but since it is only used
# on some platforms, you will want to explicitly
# require it in your alienfile in case you build your
# alien dist on a platform that doesn't use it.
requires 'Alien::Build::Plugin::Build::Copy';
};
build {
...
if($^O eq 'linux')
{
start_url 'http://example.com/binary-blob-linux.tar.gz';
plugin 'Download';
plugin 'Extract' => 'tar.gz';
plugin 'Build::Copy';
}
else
{
start_url 'http://example.com/source.tar.gz';
plugin 'Download';
plugin 'Extract' => 'tar.gz';
plugin 'Build::Autoconf';
}
};
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Build/Make.pm 0000444 00000010233 15157555405 0013772 0 ustar 00 package Alien::Build::Plugin::Build::Make;
use strict;
use warnings;
use 5.008004;
use Carp ();
use Capture::Tiny qw( capture );
use Alien::Build::Plugin;
# ABSTRACT: Make plugin for Alien::Build
our $VERSION = '2.84'; # VERSION
has '+make_type' => undef;
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure', 'Alien::Build::Plugin::Build::Make', '0.99');
my $type = $self->make_type;
return unless defined $type;
$type = 'gmake' if $^O eq 'MSWin32' && $type eq 'umake';
if($type eq 'nmake')
{
$meta->interpolator->replace_helper( make => sub { 'nmake' } );
}
elsif($type eq 'dmake')
{
$meta->interpolator->replace_helper( make => sub { 'dmake' } );
}
elsif($type eq 'gmake')
{
my $found = 0;
foreach my $make (qw( gmake make mingw32-make ))
{
my($out, $err) = capture { system $make, '--version' };
if($out =~ /GNU Make/)
{
$meta->interpolator->replace_helper( make => sub { $make } );
$found = 1;
}
}
unless($found)
{
$meta->add_requires('share' => 'Alien::gmake' => '0.20');
$meta->interpolator->replace_helper('make' => sub { require Alien::gmake; Alien::gmake->exe });
}
}
elsif($type eq 'umake')
{
# nothing
}
else
{
Carp::croak("unknown make type = ", $self->make_type);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Build::Make - Make plugin for Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# For a recipe that requires GNU Make
plugin 'Build::Make' => 'gmake';
=head1 DESCRIPTION
By default L<Alien::Build> provides a helper for the C<make> that is used by Perl and L<ExtUtils::MakeMaker> itself.
This is handy, because it is the one make that you can mostly guarantee that you will have. Unfortunately it may be
a C<make> that isn't supported by the library or tool that you are trying to alienize. This is mostly a problem on
Windows, where the supported C<make>s for years were Microsoft's C<nmake> and Sun's C<dmake>, which many open source
projects do not use. This plugin will alter the L<alienfile> recipe to use a different C<make>. It may (as in the
case of C<gmake> / L<Alien::gmake>) automatically download and install an alienized version of that C<make> if it
is not already installed.
This plugin should NOT be used with other plugins that replace the C<make> helper, like
L<Alien::Build::Plugin::Build::CMake>, L<Alien::Build::Plugin::Build::Autoconf>,
L<Alien::Build::Plugin::Build::MSYS>. This plugin is intended instead for projects that use vanilla makefiles of
a specific type.
This plugin is for now distributed separately from L<Alien::Build>, but the intention is for it to soon become
a core plugin for L<Alien::Build>.
=head1 PROPERTIES
=head2 make_type
The make type needed by the L<alienfile> recipe:
=over 4
=item dmake
Sun's dmake.
=item gmake
GNU Make.
=item nmake
Microsoft's nmake. It comes with Visual C++.
=item umake
Any UNIX C<make> Usually either BSD or GNU Make.
=back
=head1 HELPERS
=head2 make
%{make}
This plugin may change the make helper used by your L<alienfile> recipe.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Build/CMake.pm 0000444 00000013335 15157555412 0014101 0 ustar 00 package Alien::Build::Plugin::Build::CMake;
use strict;
use warnings;
use 5.008004;
use Config;
use Alien::Build::Plugin;
use Capture::Tiny qw( capture );
# ABSTRACT: CMake plugin for Alien::Build
our $VERSION = '2.84'; # VERSION
sub cmake_generator
{
if($^O eq 'MSWin32')
{
return 'MinGW Makefiles' if is_dmake();
{
my($out, $err) = capture { system $Config{make}, '/?' };
return 'NMake Makefiles' if $out =~ /NMAKE/;
}
{
my($out, $err) = capture { system $Config{make}, '--version' };
return 'MinGW Makefiles' if $out =~ /GNU Make/;
}
die 'make not detected';
}
else
{
return 'Unix Makefiles';
}
}
sub init
{
my($self, $meta) = @_;
$meta->prop->{destdir} = $^O eq 'MSWin32' ? 0 : 1;
$meta->add_requires('configure' => 'Alien::Build::Plugin::Build::CMake' => '0.99');
$meta->add_requires('share' => 'Alien::cmake3' => '0.02');
if(is_dmake())
{
# even on at least some older versions of strawberry that do not
# use it, come with gmake in the PATH. So to save us the effort
# of having to install Alien::gmake lets just use that version
# if we can find it!
my $found_gnu_make = 0;
foreach my $exe (qw( gmake make mingw32-make ))
{
my($out, $err) = capture { system $exe, '--version' };
if($out =~ /GNU Make/)
{
$meta->interpolator->replace_helper('make' => sub { $exe });
$found_gnu_make = 1;
last;
}
}
if(!$found_gnu_make)
{
$meta->add_requires('share' => 'Alien::gmake' => '0.20');
$meta->interpolator->replace_helper('make' => sub { require Alien::gmake; Alien::gmake->exe });
}
}
$meta->interpolator->replace_helper('cmake' => sub { require Alien::cmake3; Alien::cmake3->exe });
$meta->interpolator->add_helper('cmake_generator' => \&cmake_generator);
my @args = (
-G => '%{cmake_generator}',
'-DCMAKE_POSITION_INDEPENDENT_CODE:BOOL=true',
'-DCMAKE_INSTALL_PREFIX:PATH=%{.install.prefix}',
'-DCMAKE_INSTALL_LIBDIR:PATH=lib',
'-DCMAKE_MAKE_PROGRAM:PATH=%{make}',
);
$meta->prop->{plugin_build_cmake}->{args} = \@args;
$meta->default_hook(
build => [
['%{cmake}', @args, '%{.install.extract}' ],
['%{make}' ],
['%{make}', 'install' ],
],
);
# TODO: handle destdir on windows ??
}
my $is_dmake;
sub is_dmake
{
unless(defined $is_dmake)
{
if($^O eq 'MSWin32')
{
my($out, $err) = capture { system $Config{make}, '-V' };
$is_dmake = $out =~ /dmake/ ? 1 : 0;
}
else
{
$is_dmake = 0;
}
}
$is_dmake;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Build::CMake - CMake plugin for Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
plugin 'Build::CMake';
build [
# this is the default build step, if you do not specify one.
[ '%{cmake}',
@{ meta->prop->{plugin_build_cmake}->{args} },
# ... put extra cmake args here ...
'%{.install.extract}'
],
'%{make}',
'%{make} install',
];
};
=head1 DESCRIPTION
This plugin helps build alienized projects that use C<cmake>.
The intention is to make this a core L<Alien::Build> plugin if/when
it becomes stable enough.
This plugin provides a meta property C<plugin_build_cmake.args> which may change over time
but for the moment includes:
-G %{cmake_generator} \
-DCMAKE_POSITION_INDEPENDENT_CODE:BOOL=true \
-DCMAKE_INSTALL_PREFIX:PATH=%{.install.prefix} \
-DCMAKE_INSTALL_LIBDIR:PATH=lib \
-DCMAKE_MAKE_PROGRAM:PATH=%{make}
This plugin supports out-of-source builds via the meta property C<out_of_source>.
=head1 METHODS
=head2 cmake_generator
Returns the C<cmake> generator according to your Perl's C<make>.
=head2 is_dmake
Returns true if your Perls C<make> appears to be C<dmake>.
=head1 HELPERS
=head2 cmake
This plugin replaces the default C<cmake> helper with the one that comes from L<Alien::cmake3>.
=head2 cmake_generator
This is the appropriate C<cmake> generator to use based on the make used by your Perl. This is
frequently C<Unix Makefiles>. One place where it may be different is if your Windows Perl uses
C<nmake>, which comes with Visual C++.
=head2 make
This plugin I<may> replace the default C<make> helper if the default C<make> is not supported by
C<cmake>. This is most often an issue with older versions of Strawberry Perl which used C<dmake>.
On Perls that use C<dmake>, this plugin will search for GNU Make in the PATH, and if it can't be
found will fallback on using L<Alien::gmake>.
=head1 SEE ALSO
=over 4
=item L<Alien::Build>
=item L<Alien::Build::Plugin::Build::Autoconf>
=item L<alienfile>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Build/SearchDep.pm 0000444 00000012556 15157555420 0014762 0 ustar 00 package Alien::Build::Plugin::Build::SearchDep;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Text::ParseWords qw( shellwords );
# ABSTRACT: Add dependencies to library and header search path
our $VERSION = '2.84'; # VERSION
has aliens => {};
has public_I => 0;
has public_l => 0;
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure' => 'Alien::Build::Plugin::Build::SearchDep' => '0.35');
$meta->add_requires('share' => 'Env::ShellWords' => 0.01);
if($self->public_I || $self->public_l)
{
$meta->add_requires('configure' => 'Alien::Build::Plugin::Build::SearchDep' => '0.53');
}
my @aliens;
if(ref($self->aliens) eq 'HASH')
{
@aliens = keys %{ $self->aliens };
$meta->add_requires('share' => $_ => $self->aliens->{$_}) for @aliens;
}
else
{
@aliens = ref $self->aliens ? @{ $self->aliens } : ($self->aliens);
$meta->add_requires('share' => $_ => 0) for @aliens;
}
$meta->around_hook(
build => sub {
my($orig, $build) = @_;
local $ENV{CFLAGS} = $ENV{CFLAGS};
local $ENV{CXXFLAGS} = $ENV{CXXFLAGS};
local $ENV{LDFLAGS} = $ENV{LDFLAGS};
tie my @CFLAGS, 'Env::ShellWords', 'CFLAGS';
tie my @CXXFLAGS, 'Env::ShellWords', 'CXXFLAGS';
tie my @LDFLAGS, 'Env::ShellWords', 'LDFLAGS';
my $cflags = $build->install_prop->{plugin_build_searchdep_cflags} = [];
my $ldflags = $build->install_prop->{plugin_build_searchdep_ldflags} = [];
my $libs = $build->install_prop->{plugin_build_searchdep_libs} = [];
foreach my $other (@aliens)
{
my $other_cflags;
my $other_libs;
if($other->install_type('share'))
{
$other_cflags = $other->cflags_static;
$other_libs = $other->libs_static;
}
else
{
$other_cflags = $other->cflags;
$other_libs = $other->libs;
}
unshift @$cflags, grep /^-I/, shellwords($other_cflags);
unshift @$ldflags, grep /^-L/, shellwords($other_libs);
unshift @$libs, grep /^-l/, shellwords($other_libs);
}
unshift @CFLAGS, @$cflags;
unshift @CXXFLAGS, @$cflags;
unshift @LDFLAGS, @$ldflags;
$orig->($build);
},
);
$meta->after_hook(
gather_share => sub {
my($build) = @_;
$build->runtime_prop->{libs} = '' unless defined $build->runtime_prop->{libs};
$build->runtime_prop->{libs_static} = '' unless defined $build->runtime_prop->{libs_static};
if($self->public_l)
{
$build->runtime_prop->{$_} = join(' ', _space_escape(@{ $build->install_prop->{plugin_build_searchdep_libs} })) . ' ' . $build->runtime_prop->{$_}
for qw( libs libs_static );
}
$build->runtime_prop->{$_} = join(' ', _space_escape(@{ $build->install_prop->{plugin_build_searchdep_ldflags} })) . ' ' . $build->runtime_prop->{$_}
for qw( libs libs_static );
if($self->public_I)
{
$build->runtime_prop->{cflags} = '' unless defined $build->runtime_prop->{cflags};
$build->runtime_prop->{cflags_static} = '' unless defined $build->runtime_prop->{cflags_static};
$build->runtime_prop->{$_} = join(' ', _space_escape(@{ $build->install_prop->{plugin_build_searchdep_cflags} })) . ' ' . $build->runtime_prop->{$_}
for qw( cflags cflags_static );
}
},
);
}
sub _space_escape
{
map {
my $str = $_;
$str =~ s{(\s)}{\\$1}g;
$str;
} @_;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Build::SearchDep - Add dependencies to library and header search path
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Build::SearchDep' => (
aliens => [qw( Alien::Foo Alien::Bar )],
);
=head1 DESCRIPTION
This plugin adds the other aliens as prerequisites, and adds their header and library
search path to C<CFLAGS> and C<LDFLAGS> environment variable, so that tools that use
them (like autoconf) can pick them up.
=head1 PROPERTIES
=head2 aliens
Either a list reference or hash reference of the other aliens. If a hash reference
then the keys are the class names and the values are the versions of those classes.
=head2 public_I
Include the C<-I> flags when setting the runtime cflags property.
=head2 public_l
Include the C<-l> flags when setting the runtime libs property.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Fetch.pod 0000444 00000005152 15157555425 0013263 0 ustar 00 # PODNAME: Alien::Build::Plugin::Fetch
# ABSTRACT: Fetch Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Fetch - Fetch Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'http://ftp.gnu.org/gnu/make';
plugin 'Download';
};
=head1 DESCRIPTION
Fetch plugins retrieve single resources from the internet. The difference
between a Fetch plugin and a Download plugin is that Download
plugin may fetch several resources from the internet (usually using
a Fetch plugin), before finding the final archive. Normally you
will not need to use Fetch plugins directly but should instead
use the L<Alien::Build::Plugin::Download::Negotiate> plugin, which
will pick the best plugins for your given URL.
=over 4
=item L<Alien::Build::Plugin::Fetch::CurlCommand>
Fetch using the C<curl> command.
=item L<Alien::Build::Plugin::Fetch::HTTPTiny>
Fetch using L<HTTP::Tiny>.
=item L<Alien::Build::Plugin::Fetch::LWP>
Fetch using L<LWP::UserAgent>.
=item L<Alien::Build::Plugin::Fetch::Local>
Fetch from a local file. This is typically used to bundle packages with your L<Alien>.
=item L<Alien::Build::Plugin::Fetch::LocalDir>
Fetch from a local directory. This is typically used to bundle packages with your L<Alien>.
=item L<Alien::Build::Plugin::Fetch::NetFTP>
Fetch using L<Net::FTP>. Use of FTP should be discouraged as of this writing (August 2022).
=item L<Alien::Build::Plugin::Fetch::Wget>
Fetch using C<wget>.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Probe/CommandLine.pm 0000444 00000012745 15157555437 0015332 0 ustar 00 package Alien::Build::Plugin::Probe::CommandLine;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
use Capture::Tiny qw( capture );
use File::Which ();
use Alien::Util qw( version_cmp );
# ABSTRACT: Probe for tools or commands already available
our $VERSION = '2.84'; # VERSION
has '+command' => sub { Carp::croak "@{[ __PACKAGE__ ]} requires command property" };
has 'args' => [];
has 'secondary' => 0;
has 'match' => undef;
has 'match_stderr' => undef;
has 'version' => undef;
has 'version_stderr' => undef;
has 'atleast_version' => undef;
sub init
{
my($self, $meta) = @_;
my $check = sub {
my($build) = @_;
unless(File::Which::which($self->command))
{
die 'Command not found ' . $self->command;
}
if(defined $self->match || defined $self->match_stderr || defined $self->version || defined $self->version_stderr)
{
my($out,$err,$ret) = capture {
system( $self->command, @{ $self->args } );
};
die 'Command did not return a true value' if $ret;
die 'Command output did not match' if defined $self->match && $out !~ $self->match;
die 'Command standard error did not match' if defined $self->match_stderr && $err !~ $self->match_stderr;
if (defined $self->version or defined $self->version_stderr)
{
my $found_version = '0';
if(defined $self->version)
{
if($out =~ $self->version)
{
$found_version = $1;
$build->runtime_prop->{version} = $found_version;
}
}
if(defined $self->version_stderr)
{
if($err =~ $self->version_stderr)
{
$found_version = $1;
$build->hook_prop->{version} = $found_version;
$build->runtime_prop->{version} = $found_version;
}
}
if (my $atleast_version = $self->atleast_version)
{
if(version_cmp ($found_version, $self->atleast_version) < 0)
{
# reset the versions
$build->runtime_prop->{version} = undef;
$build->hook_prop->{version} = undef;
die "CommandLine probe found version $found_version, but at least $atleast_version is required.";
}
}
}
}
$build->runtime_prop->{command} = $self->command;
'system';
};
if($self->secondary)
{
$meta->around_hook(
probe => sub {
my $orig = shift;
my $build = shift;
my $type = $orig->($build, @_);
return $type unless $type eq 'system';
$check->($build);
},
);
}
else
{
$meta->register_hook(
probe => $check,
);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Probe::CommandLine - Probe for tools or commands already available
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Probe::CommandLine' => (
command => 'gzip',
args => [ '--version' ],
match => qr/gzip/,
version => qr/gzip ([0-9\.]+)/,
);
=head1 DESCRIPTION
This plugin probes for the existence of the given command line program.
=head1 PROPERTIES
=head2 command
The name of the command.
=head2 args
The arguments to pass to the command.
=head2 secondary
If you are using another probe plugin (such as L<Alien::Build::Plugin::Probe::CBuilder> or
L<Alien::Build::Plugin::PkgConfig::Negotiate>) to detect the existence of a library, but
also need a program to exist, then you should set secondary to a true value. For example
when you need both:
use alienfile;
# requires both liblzma library and xz program
plugin 'PkgConfig' => 'liblzma';
plugin 'Probe::CommandLine' => (
command => 'xz',
secondary => 1,
);
When you don't:
use alienfile;
plugin 'Probe::CommandLine' => (
command => 'gzip',
secondary => 0, # default
);
=head2 match
Regular expression for which the program output should match.
=head2 match_stderr
Regular expression for which the program standard error should match.
=head2 version
Regular expression to parse out the version from the program output.
The regular expression should store the version number in C<$1>.
=head2 version_stderr
Regular expression to parse out the version from the program standard error.
The regular expression should store the version number in C<$1>.
=head2 atleast_version
The minimum required version as provided by the system.
=head1 SEE ALSO
L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Probe/CBuilder.pm 0000444 00000015034 15157555444 0014625 0 ustar 00 package Alien::Build::Plugin::Probe::CBuilder;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use File::chdir;
use File::Temp ();
use Capture::Tiny qw( capture_merged capture );
use Alien::Util qw( version_cmp );
# ABSTRACT: Probe for system libraries by guessing with ExtUtils::CBuilder
our $VERSION = '2.84'; # VERSION
has options => sub { {} };
has cflags => '';
has libs => '';
has program => 'int main(int argc, char *argv[]) { return 0; }';
has version => undef;
has 'atleast_version' => undef;
has aliens => [];
has lang => 'C';
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure' => 'ExtUtils::CBuilder' => 0 );
if(@{ $self->aliens })
{
die "You can't specify both 'aliens' and either 'cflags' or 'libs' for the Probe::CBuilder plugin" if $self->cflags || $self->libs;
$meta->add_requires('configure' => $_ => 0 ) for @{ $self->aliens };
$meta->add_requires('Alien::Build::Plugin::Probe::CBuilder' => '0.53');
my $cflags = '';
my $libs = '';
foreach my $alien (@{ $self->aliens })
{
my $pm = "$alien.pm";
$pm =~ s/::/\//g;
require $pm;
$cflags .= $alien->cflags . ' ';
$libs .= $alien->libs . ' ';
}
$self->cflags($cflags);
$self->libs($libs);
}
my @cpp;
if($self->lang ne 'C')
{
$meta->add_requires('Alien::Build::Plugin::Probe::CBuilder' => '0.53');
@cpp = ('C++' => 1) if $self->lang eq 'C++';
}
$meta->register_hook(
probe => sub {
my($build) = @_;
$build->hook_prop->{probe_class} = __PACKAGE__;
$build->hook_prop->{probe_instance_id} = $self->instance_id;
local $CWD = File::Temp::tempdir( CLEANUP => 1, DIR => $CWD );
open my $fh, '>', 'mytest.c';
print $fh $self->program;
close $fh;
$build->log("trying: cflags=@{[ $self->cflags ]} libs=@{[ $self->libs ]}");
my $cb = ExtUtils::CBuilder->new(%{ $self->options });
my($out1, $obj) = capture_merged { eval {
$cb->compile(
source => 'mytest.c',
extra_compiler_flags => $self->cflags,
@cpp,
);
} };
if(my $error = $@)
{
$build->log("compile failed: $error");
$build->log("compile failed: $out1");
die $error;
}
my($out2, $exe) = capture_merged { eval {
$cb->link_executable(
objects => [$obj],
extra_linker_flags => $self->libs,
);
} };
if(my $error = $@)
{
$build->log("link failed: $error");
$build->log("link failed: $out2");
die $error;
}
my($out, $err, $ret) = capture { system($^O eq 'MSWin32' ? $exe : "./$exe") };
die "execute failed" if $ret;
my $cflags = $self->cflags;
my $libs = $self->libs;
$cflags =~ s{\s*$}{ };
$libs =~ s{\s*$}{ };
$build->install_prop->{plugin_probe_cbuilder_gather}->{$self->instance_id} = {
cflags => $cflags,
libs => $libs,
};
if(defined $self->version)
{
my($version) = $out =~ $self->version;
if (defined $self->atleast_version)
{
if(version_cmp ($version, $self->atleast_version) < 0)
{
die "CBuilder probe found version $version, but at least @{[ $self->atleast_version ]} is required.";
}
}
$build->hook_prop->{version} = $version;
$build->install_prop->{plugin_probe_cbuilder_gather}->{$self->instance_id}->{version} = $version;
}
'system';
}
);
$meta->register_hook(
gather_system => sub {
my($build) = @_;
return if $build->hook_prop->{name} eq 'gather_system'
&& ($build->install_prop->{system_probe_instance_id} || '') ne $self->instance_id;
if(my $p = $build->install_prop->{plugin_probe_cbuilder_gather}->{$self->instance_id})
{
$build->runtime_prop->{$_} = $p->{$_} for keys %$p;
}
},
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Probe::CBuilder - Probe for system libraries by guessing with ExtUtils::CBuilder
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Probe::CBuilder' => (
cflags => '-I/opt/libfoo/include',
libs => '-L/opt/libfoo/lib -lfoo',
);
alternately:
ues alienfile;
plugin 'Probe::CBuilder' => (
aliens => [ 'Alien::libfoo', 'Alien::libbar' ],
);
=head1 DESCRIPTION
This plugin probes for compiler and linker flags using L<ExtUtils::CBuilder>. This is a useful
alternative to L<Alien::Build::Plugin::PkgConfig::Negotiate> for packages that do not provide
a pkg-config C<.pc> file, or for when those C<.pc> files may not be available. (For example,
on FreeBSD, C<libarchive> is a core part of the operating system, but doesn't include a C<.pc>
file which is usually provided when you install the C<libarchive> package on Linux).
=head1 PROPERTIES
=head2 options
Any extra options that you want to have passed into the constructor to L<ExtUtils::CBuilder>.
=head2 cflags
The compiler flags.
=head2 libs
The linker flags
=head2 program
The program to use in the test.
=head2 version
This is a regular expression to parse the version out of the output from the
test program.
=head2 atleast_version
The minimum required version as provided by the system.
=head2 aliens
List of aliens to query fro compiler and linker flags.
=head2 lang
The programming language to use. One of either C<C> or C<C++>.
=head1 SEE ALSO
L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Probe/Vcpkg.pm 0000444 00000015405 15157555451 0014206 0 ustar 00 package Alien::Build::Plugin::Probe::Vcpkg;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
# ABSTRACT: Probe for system libraries using Vcpkg
our $VERSION = '2.84'; # VERSION
has '+name';
has 'lib';
has 'ffi_name';
has 'include';
sub init
{
my($self, $meta) = @_;
if(defined $self->include)
{
$meta->add_requires('configure' => 'Alien::Build::Plugin::Probe::Vcpkg' => '2.16' );
}
elsif(defined $self->ffi_name)
{
$meta->add_requires('configure' => 'Alien::Build::Plugin::Probe::Vcpkg' => '2.14' );
}
else
{
$meta->add_requires('configure' => 'Alien::Build::Plugin::Probe::Vcpkg' => '0' );
}
if($meta->prop->{platform}->{compiler_type} eq 'microsoft')
{
$meta->register_hook(
probe => sub {
my($build) = @_;
$build->hook_prop->{probe_class} = __PACKAGE__;
$build->hook_prop->{probe_instance_id} = $self->instance_id;
eval {
require Win32::Vcpkg;
require Win32::Vcpkg::List;
require Win32::Vcpkg::Package;
Win32::Vcpkg->VERSION('0.02');
};
if(my $error = $@)
{
$build->log("unable to load Win32::Vcpkg: $error");
return 'share';
}
my $package;
if($self->name)
{
$package = Win32::Vcpkg::List->new
->search($self->name, include => $self->include);
}
elsif($self->lib)
{
$package = eval { Win32::Vcpkg::Package->new( lib => $self->lib, include => $self->include) };
return 'share' if $@;
}
else
{
$build->log("you must provode either name or lib property for Probe::Vcpkg");
return 'share';
}
my $version = $package->version;
$version = 'unknown' unless defined $version;
$build->install_prop->{plugin_probe_vcpkg}->{$self->instance_id} = {
version => $version,
cflags => $package->cflags,
libs => $package->libs,
};
$build->hook_prop->{version} = $version;
$build->install_prop->{plugin_probe_vcpkg}->{$self->instance_id}->{ffi_name} = $self->ffi_name
if defined $self->ffi_name;
return 'system';
},
);
$meta->register_hook(
gather_system => sub {
my($build) = @_;
return if $build->hook_prop->{name} eq 'gather_system'
&& ($build->install_prop->{system_probe_instance_id} || '') ne $self->instance_id;
if(my $c = $build->install_prop->{plugin_probe_vcpkg}->{$self->instance_id})
{
$build->runtime_prop->{version} = $c->{version} unless defined $build->runtime_prop->{version};
$build->runtime_prop->{$_} = $c->{$_} for grep { defined $c->{$_} } qw( cflags libs ffi_name );
}
},
);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Probe::Vcpkg - Probe for system libraries using Vcpkg
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Probe::Vcpkg' => 'libffi';
=head1 DESCRIPTION
This plugin probe can be used to find "system" packages using Microsoft's C<Vcpkg> package manager for
Visual C++ builds of Perl. C<Vcpkg> is a package manager for Visual C++ that includes a number of
open source packages. Although C<Vcpkg> does also support Linux and macOS, this plugin does not
support finding C<Vcpkg> packages on those platforms. For more details on C<Vcpkg>, see the project
github page here:
L<https://github.com/microsoft/vcpkg>
Here is the quick start guide for getting L<Alien::Build> to work with C<Vpkg>:
# install Vcpkg
C:\> git clone https://github.com/Microsoft/vcpkg.git
C:\> cd vcpkg
C:\vcpkg> .\bootstrap-vcpkg.bat
C:\vcpkg> .\vcpkg integrate install
# update PATH to include the bin directory
# so that .DLL files can be found by Perl
C:\vcpkg> path c:\vcpkg\installed\x64-windows\bin;%PATH%
# install the packages that you want
C:\vcpkg> .\vcpkg install libffi
# install the alien that uses it
C:\vcpkg> cpanm Alien::FFI
If you are using 32 bit build of Perl, then substitute C<x86-windows> for C<x64-windows>. If you do
not want to add the C<bin> directory to the C<PATH>, then you can use C<x64-windows-static> instead,
which will provide static libraries. (As of this writing static libraries for 32 bit Windows are not
available). The main downside to using C<x64-windows-static> is that Aliens that require dynamic
libraries for FFI will not be installable.
If you do not want to install C<Vcpkg> user wide (the C<integrate install> command above), then you
can use the C<PERL_WIN32_VCPKG_ROOT> environment variable instead:
# install Vcpkg
C:\> git clone https://github.com/Microsoft/vcpkg.git
C:\> cd vcpkg
C:\vcpkg> .\bootstrap-vcpkg.bat
C:\vcpkg> set PERL_WIN32_VCPKG_ROOT=c:\vcpkg
=head1 PROPERTIES
=head2 name
Specifies the name of the Vcpkg. This should not be used with the C<lib> property below, choose only one.
This is the default property, so these two are equivalent:
plugin 'Probe::Vcpkg' => (name => 'foo');
and
plugin 'Probe::Vcpkg' => 'foo';
=head2 lib
Specifies the list of libraries that make up the Vcpkg. This should not be used with the C<name> property
above, choose only one. Note that using this detection method, the version number of the package will
not be automatically determined (since multiple packages could potentially make up the list of libraries),
so you need to determine the version number another way if you need it.
This must be an array reference. Do not include the C<.lib> extension.
plugin 'Probe::Vcpkg' => (lib => ['foo','bar']);
=head2 ffi_name
Specifies an alternate ffi_name for finding dynamic libraries.
=head1 SEE ALSO
L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Build.pod 0000444 00000004664 15157555456 0013304 0 ustar 00 # PODNAME: Alien::Build::Plugin::Build
# ABSTRACT: Build Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Build - Build Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
For autoconf:
use alienfile;
plugin 'Build::Autoconf';
for unixy (even on windows):
use alienfile;
plugin 'Build::MSYS';
=head1 DESCRIPTION
Build plugins provide tools for building your package once it has been
downloaded and extracted.
=over 4
=item L<Alien::Build::Plugin::Build::Autoconf>
For dealing with packages that are configured using autotools,
or an autotools-like C<configure> script.
=item L<Alien::Build::Plugin::Build::CMake>
For dealing with packages that are configured and built using CMake.
=item L<Alien::Build::Plugin::Build::Copy>
For dealing with packages that do not require any build, and can just
be copied into their final location.
=item L<Alien::Build::Plugin::Build::MSYS>
For dealing with packages that require MSYS on Windows in order to
build. This plugin is typically a no-op on other platforms.
=item L<Alien::Build::Plugin::Build::Make>
For dealing with packages that require Make to build. Several
flavors of Make are supported, including GNU Make and BSD Make.
=item L<Alien::Build::Plugin::Build::SearchDep>
Add other L<Alien>s as dependencies.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Download.pod 0000444 00000003122 15157555463 0013776 0 ustar 00 # PODNAME: Alien::Build::Plugin::Download
# ABSTRACT: Download Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Download - Download Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile
share {
start_url 'http://ftp.gnu.org/gnu/make';
plugin 'Download';
};
=head1 DESCRIPTION
Download plugins download packages from the internet.
=over 4
=item L<Alien::Build::Plugin::Download::Negotiate>
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Gather.pod 0000444 00000003311 15157555471 0013440 0 ustar 00 # PODNAME: Alien::Build::Plugin::Gather
# ABSTRACT: Gather Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Gather - Gather Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Gather::IsolateDynamic'; # just as an example
=head1 DESCRIPTION
Gather plugins enhance L<alienfile> recipes at the gather stage, either
during a C<system> or C<share> install.
=over 4
=item L<Alien::Build::Plugin::Gather::IsolateDynamic>
Isolate dynamic libraries (C<.so>, <.DLL> or <.dylib>) so that they aren't used
by XS.
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Gather/IsolateDynamic.pm 0000444 00000006505 15157555503 0016203 0 ustar 00 package Alien::Build::Plugin::Gather::IsolateDynamic;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Path::Tiny ();
use Alien::Build::Util qw( _destdir_prefix );
use File::Copy ();
# ABSTRACT: Plugin to gather dynamic libraries into a separate directory
our $VERSION = '2.84'; # VERSION
sub init
{
my($self, $meta) = @_;
# plugin was introduced in 0.42, but had a bug which was fixed in 0.48
$meta->add_requires('share' => 'Alien::Build::Plugin::Gather::IsolateDynamic' => '0.48' );
$meta->after_hook(
gather_share => sub {
my($build) = @_;
$build->log("Isolating dynamic libraries ...");
my $install_root;
if($build->meta_prop->{destdir})
{
my $destdir = $ENV{DESTDIR};
$install_root = Path::Tiny->new(_destdir_prefix($ENV{DESTDIR}, $build->install_prop->{prefix}));
}
else
{
$install_root = Path::Tiny->new($build->install_prop->{stage});
}
foreach my $dir (map { $install_root->child($_) } qw( bin lib ))
{
next unless -d $dir;
foreach my $from ($dir->children)
{
next unless $from->basename =~ /\.so/
|| $from->basename =~ /\.(dylib|bundle|la|dll|dll\.a)$/;
my $to = $install_root->child('dynamic', $from->basename);
$to->parent->mkpath;
unlink "$to" if -e $to;
$build->log("move @{[ $from->parent->basename ]}/@{[ $from->basename ]} => dynamic/@{[ $to->basename ]}");
File::Copy::move("$from", "$to") || die "unable to move $from => $to $!";
}
}
$build->log(" Done!");
},
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Gather::IsolateDynamic - Plugin to gather dynamic libraries into a separate directory
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'Gather::IsolateDynamic';
=head1 DESCRIPTION
This plugin moves dynamic libraries from the C<lib> and C<bin> directories and puts them in
their own C<dynamic> directory. This allows them to be used by FFI modules, but to be ignored
by XS modules.
This plugin provides the equivalent functionality of the C<alien_isolate_dynamic> attribute
from L<Alien::Base::ModuleBuild>.
=head1 SEE ALSO
L<Alien::Build>, L<alienfile>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/PkgConfig/MakeStatic.pm 0000444 00000006547 15157555515 0015771 0 ustar 00 package Alien::Build::Plugin::PkgConfig::MakeStatic;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Path::Tiny ();
# ABSTRACT: Convert .pc files into static
our $VERSION = '2.84'; # VERSION
has path => undef;
sub _convert
{
my($self, $build, $path) = @_;
die "unable to read $path" unless -r $path;
die "unable to write $path" unless -w $path;
$build->log("converting $path to static");
my %h = map {
my($key, $value) = /^(.*?):(.*?)$/;
$value =~ s{^\s+}{};
$value =~ s{\s+$}{};
($key => $value);
} grep /^(?:Libs|Cflags)(?:\.private)?:/, $path->lines;
$h{Cflags} = '' unless defined $h{Cflags};
$h{Libs} = '' unless defined $h{Libs};
$h{Cflags} .= ' ' . $h{"Cflags.private"} if defined $h{"Cflags.private"};
$h{Libs} .= ' ' . $h{"Libs.private"} if defined $h{"Libs.private"};
$h{"Cflags.private"} = '';
$h{"Libs.private"} = '';
$path->edit_lines(sub {
if(/^(.*?):/)
{
my $key = $1;
if(defined $h{$key})
{
s/^(.*?):.*$/$1: $h{$key} /;
delete $h{$key};
}
}
});
$path->append("$_: $h{$_}\n") foreach keys %h;
}
sub _recurse
{
my($self, $build, $dir) = @_;
foreach my $child ($dir->children)
{
if(-d $child)
{
$self->_recurse($build, $child);
}
elsif($child->basename =~ /\.pc$/)
{
$self->_convert($build, $child);
}
}
}
sub init
{
my($self, $meta) = @_;
$meta->add_requires('configure' => 'Alien::Build::Plugin::Build::SearchDep' => '0.35');
$meta->before_hook(
gather_share => sub {
my($build) = @_;
if($self->path)
{
$self->_convert($build, Path::Tiny->new($self->path)->absolute);
}
else
{
$self->_recurse($build, Path::Tiny->new(".")->absolute);
}
},
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::PkgConfig::MakeStatic - Convert .pc files into static
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'PkgConfig::MakeStatic' => (
path => 'lib/pkgconfig/foo.pc',
);
=head1 DESCRIPTION
Convert C<.pc> file to use static linkage by default. This is an experimental
plugin, so use with caution.
=head1 PROPERTIES
=head2 path
The path to the C<.pc> file. If not provided, all C<.pc> files in the stage
directory will be converted.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/PkgConfig/CommandLine.pm 0000444 00000016332 15157555522 0016121 0 ustar 00 package Alien::Build::Plugin::PkgConfig::CommandLine;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
# ABSTRACT: Probe system and determine library or tool properties using the pkg-config command line interface
our $VERSION = '2.84'; # VERSION
has '+pkg_name' => sub {
Carp::croak "pkg_name is a required property";
};
# NOT used, for compat with other PkgConfig plugins
has register_prereqs => 1;
sub _bin_name {
# We prefer pkgconf to pkg-config because it seems to be the future.
require File::Which;
File::Which::which($ENV{PKG_CONFIG})
? $ENV{PKG_CONFIG}
: File::Which::which('pkgconf')
? 'pkgconf'
: File::Which::which('pkg-config')
? 'pkg-config'
: undef;
};
has bin_name => \&_bin_name;
has atleast_version => undef;
has exact_version => undef;
has max_version => undef;
has minimum_version => undef;
sub _val
{
my($build, $args, $prop_name) = @_;
my $string = $args->{out};
chomp $string;
$string =~ s{^\s+}{};
if($prop_name =~ /version$/)
{ $string =~ s{\s*$}{} }
else
{ $string =~ s{\s*$}{ } }
if($prop_name =~ /^(.*?)\.(.*?)\.(.*?)$/)
{ $build->runtime_prop->{$1}->{$2}->{$3} = $string }
else
{ $build->runtime_prop->{$prop_name} = $string }
();
}
sub available
{
!!_bin_name();
}
sub init
{
my($self, $meta) = @_;
my @probe;
my @gather;
my $pkgconf = $self->bin_name;
unless(defined $meta->prop->{env}->{PKG_CONFIG})
{
$meta->prop->{env}->{PKG_CONFIG} = $pkgconf;
}
my($pkg_name, @alt_names) = (ref $self->pkg_name) ? (@{ $self->pkg_name }) : ($self->pkg_name);
push @probe, map { [$pkgconf, '--exists', $_] } ($pkg_name, @alt_names);
if(defined $self->minimum_version)
{
push @probe, [ $pkgconf, '--atleast-version=' . $self->minimum_version, $pkg_name ];
}
elsif(defined $self->atleast_version)
{
push @probe, [ $pkgconf, '--atleast-version=' . $self->atleast_version, $pkg_name ];
}
if(defined $self->exact_version)
{
push @probe, [ $pkgconf, '--exact-version=' . $self->exact_version, $pkg_name ];
}
if(defined $self->max_version)
{
push @probe, [ $pkgconf, '--max-version=' . $self->max_version, $pkg_name ];
}
push @probe, [ $pkgconf, '--modversion', $pkg_name, sub {
my($build, $args) = @_;
my $version = $args->{out};
$version =~ s{^\s+}{};
$version =~ s{\s*$}{};
$build->hook_prop->{version} = $version;
}];
unshift @probe, sub {
my($build) = @_;
$build->runtime_prop->{legacy}->{name} ||= $pkg_name;
$build->hook_prop->{probe_class} = __PACKAGE__;
$build->hook_prop->{probe_instance_id} = $self->instance_id;
};
$meta->register_hook(
probe => \@probe
);
push @gather, sub {
my($build) = @_;
die 'pkg-config command line probe does not match gather' if $build->hook_prop->{name} eq 'gather_system'
&& ($build->install_prop->{system_probe_instance_id} || '') ne $self->instance_id;
};
push @gather, map { [ $pkgconf, '--exists', $_] } ($pkg_name, @alt_names);
foreach my $prop_name (qw( cflags libs version ))
{
my $flag = $prop_name eq 'version' ? '--modversion' : "--$prop_name";
push @gather,
[ $pkgconf, $flag, $pkg_name, sub { _val @_, $prop_name } ];
if(@alt_names)
{
foreach my $alt ($pkg_name, @alt_names)
{
push @gather,
[ $pkgconf, $flag, $alt, sub { _val @_, "alt.$alt.$prop_name" } ];
}
}
}
foreach my $prop_name (qw( cflags libs ))
{
push @gather,
[ $pkgconf, '--static', "--$prop_name", $pkg_name, sub { _val @_, "${prop_name}_static" } ];
if(@alt_names)
{
foreach my $alt ($pkg_name, @alt_names)
{
push @gather,
[ $pkgconf, '--static', "--$prop_name", $alt, sub { _val @_, "alt.$alt.${prop_name}_static" } ];
}
}
}
$meta->register_hook(gather_system => [@gather]);
if($meta->prop->{platform}->{system_type} eq 'windows-mingw')
{
@gather = map {
if(ref $_ eq 'ARRAY') {
my($pkgconf, @rest) = @$_;
[$pkgconf, '--dont-define-prefix', @rest],
} else {
$_
}
} @gather;
}
$meta->register_hook(gather_share => [@gather]);
$meta->after_hook(
$_ => sub {
my($build) = @_;
if(keys %{ $build->runtime_prop->{alt} } < 2)
{
delete $build->runtime_prop->{alt};
}
},
) for qw( gather_system gather_share );
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::PkgConfig::CommandLine - Probe system and determine library or tool properties using the pkg-config command line interface
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'PkgConfig::CommandLine' => (
pkg_name => 'libfoo',
);
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::PkgConfig::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin provides Probe and Gather steps for pkg-config based packages. It uses
the best command line tools to accomplish this task.
=head1 PROPERTIES
=head2 pkg_name
The package name. If this is a list reference then .pc files with all those package
names must be present. The first name will be the primary and used by default once
installed. For the subsequent C<.pc> files you can use the
L<Alien::Base alt method|Alien::Base/alt> to retrieve the alternate configurations
once the L<Alien> is installed.
=head2 atleast_version
The minimum required version that is acceptable version as provided by the system.
=head2 exact_version
The exact required version that is acceptable version as provided by the system.
=head2 max_version
The max required version that is acceptable version as provided by the system.
=head2 minimum_version
Alias for C<atleast_version> for backward compatibility.
=head1 METHODS
=head2 available
my $bool = Alien::Build::Plugin::PkgConfig::CommandLine->available;
Returns true if the necessary prereqs for this plugin are I<already> installed.
=head1 SEE ALSO
L<Alien::Build::Plugin::PkgConfig::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/PkgConfig/LibPkgConf.pm 0000444 00000016747 15157555527 0015730 0 ustar 00 package Alien::Build::Plugin::PkgConfig::LibPkgConf;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
# ABSTRACT: Probe system and determine library or tool properties using PkgConfig::LibPkgConf
our $VERSION = '2.84'; # VERSION
has '+pkg_name' => sub {
Carp::croak "pkg_name is a required property";
};
has atleast_version => undef;
has exact_version => undef;
has max_version => undef;
has minimum_version => undef;
# private for now, used by negotiator
has register_prereqs => 1;
use constant _min_version => '0.04';
sub available
{
!!eval { require PkgConfig::LibPkgConf; PkgConfig::LibPkgConf->VERSION(_min_version) };
}
sub init
{
my($self, $meta) = @_;
unless(defined $meta->prop->{env}->{PKG_CONFIG})
{
# TODO: this doesn't yet find pkgconf in the bin dir of a share
# install.
my $command_line =
File::Which::which('pkgconf')
? 'pkgconf'
: File::Which::which('pkg-config')
? 'pkg-config'
: undef;
$meta->prop->{env}->{PKG_CONFIG} = $command_line
if defined $command_line;
}
if($self->register_prereqs)
{
# Also update in Neotiate.pm
$meta->add_requires('configure' => 'PkgConfig::LibPkgConf::Client' => _min_version);
if(defined $self->minimum_version || defined $self->atleast_version || defined $self->exact_version || defined $self->max_version)
{
$meta->add_requires('configure' => 'PkgConfig::LibPkgConf::Util' => _min_version);
}
}
my($pkg_name, @alt_names) = (ref $self->pkg_name) ? (@{ $self->pkg_name }) : ($self->pkg_name);
$meta->register_hook(
probe => sub {
my($build) = @_;
$build->runtime_prop->{legacy}->{name} ||= $pkg_name;
$build->hook_prop->{probe_class} = __PACKAGE__;
$build->hook_prop->{probe_instance_id} = $self->instance_id;
require PkgConfig::LibPkgConf::Client;
my $client = PkgConfig::LibPkgConf::Client->new;
my $pkg = $client->find($pkg_name);
die "package $pkg_name not found" unless $pkg;
$build->hook_prop->{version} = $pkg->version;
my $atleast_version = $self->atleast_version;
$atleast_version = $self->minimum_version unless defined $self->atleast_version;
if($atleast_version)
{
require PkgConfig::LibPkgConf::Util;
if(PkgConfig::LibPkgConf::Util::compare_version($pkg->version, $atleast_version) < 0)
{
die "package $pkg_name is version @{[ $pkg->version ]}, but at least $atleast_version is required.";
}
}
if($self->exact_version)
{
require PkgConfig::LibPkgConf::Util;
if(PkgConfig::LibPkgConf::Util::compare_version($pkg->version, $self->exact_version) != 0)
{
die "package $pkg_name is version @{[ $pkg->version ]}, but exactly @{[ $self->exact_version ]} is required.";
}
}
if($self->max_version)
{
require PkgConfig::LibPkgConf::Util;
if(PkgConfig::LibPkgConf::Util::compare_version($pkg->version, $self->max_version) > 0)
{
die "package $pkg_name is version @{[ $pkg->version ]}, but max @{[ $self->max_version ]} is required.";
}
}
foreach my $alt (@alt_names)
{
my $pkg = $client->find($alt);
die "package $alt not found" unless $pkg;
}
'system';
},
);
$meta->register_hook(
$_ => sub {
my($build) = @_;
return if $build->hook_prop->{name} eq 'gather_system'
&& ($build->install_prop->{system_probe_instance_id} || '') ne $self->instance_id;
require PkgConfig::LibPkgConf::Client;
my $client = PkgConfig::LibPkgConf::Client->new;
foreach my $name ($pkg_name, @alt_names)
{
my $pkg = $client->find($name);
die "reload of package $name failed" unless defined $pkg;
my %prop;
$prop{version} = $pkg->version;
$prop{cflags} = $pkg->cflags;
$prop{libs} = $pkg->libs;
$prop{cflags_static} = $pkg->cflags_static;
$prop{libs_static} = $pkg->libs_static;
$build->runtime_prop->{alt}->{$name} = \%prop;
}
foreach my $key (keys %{ $build->runtime_prop->{alt}->{$pkg_name} })
{
$build->runtime_prop->{$key} = $build->runtime_prop->{alt}->{$pkg_name}->{$key};
}
if(keys %{ $build->runtime_prop->{alt} } == 1)
{
delete $build->runtime_prop->{alt};
}
},
) for qw( gather_system gather_share );
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::PkgConfig::LibPkgConf - Probe system and determine library or tool properties using PkgConfig::LibPkgConf
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'PkgConfig::LibPkgConf' => (
pkg_name => 'libfoo',
);
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::PkgConfig::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin provides Probe and Gather steps for pkg-config based packages. It uses
L<PkgConfig::LibPkgConf> to accomplish this task.
This plugin is part of the Alien::Build core For Now, but may be removed in a future
date. While It Seemed Like A Good Idea at the time, it may not be appropriate to keep
it in core. If it is spun off it will get its own distribution some time in the future.
=head1 PROPERTIES
=head2 pkg_name
The package name. If this is a list reference then .pc files with all those package
names must be present. The first name will be the primary and used by default once
installed. For the subsequent C<.pc> files you can use the
L<Alien::Base alt method|Alien::Base/alt> to retrieve the alternate configurations
once the L<Alien> is installed.
=head2 atleast_version
The minimum required version that is acceptable version as provided by the system.
=head2 exact_version
The exact required version that is acceptable version as provided by the system.
=head2 max_version
The max required version that is acceptable version as provided by the system.
=head2 minimum_version
Alias for C<atleast_version> for backward compatibility.
=head1 METHODS
=head2 available
my $bool = Alien::Build::Plugin::PkgConfig::LibPkgConf->available;
Returns true if the necessary prereqs for this plugin are I<already> installed.
=head1 SEE ALSO
L<Alien::Build::Plugin::PkgConfig::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/PkgConfig/PP.pm 0000444 00000017543 15157555534 0014262 0 ustar 00 package Alien::Build::Plugin::PkgConfig::PP;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Carp ();
use File::Which ();
use Env qw( @PKG_CONFIG_PATH );
# ABSTRACT: Probe system and determine library or tool properties using PkgConfig.pm
our $VERSION = '2.84'; # VERSION
has '+pkg_name' => sub {
Carp::croak "pkg_name is a required property";
};
has atleast_version => undef;
has exact_version => undef;
has max_version => undef;
has minimum_version => undef;
use constant _min_version => '0.14026';
# private for now, used by negotiator
has register_prereqs => 1;
sub available
{
!!eval { require PkgConfig; PkgConfig->VERSION(_min_version) };
}
sub _cleanup
{
my($value) = @_;
$value =~ s{\s*$}{ };
$value;
}
sub init
{
my($self, $meta) = @_;
unless(defined $meta->prop->{env}->{PKG_CONFIG})
{
# TODO: Better would be to to "execute" lib/PkgConfig.pm
# as that should always be available, and will match the
# exact version of PkgConfig.pm that we are using here.
# there are a few corner cases to deal with before we
# can do this. What is here should handle most use cases.
my $command_line =
File::Which::which('ppkg-config')
? 'ppkg-config'
: File::Which::which('pkg-config.pl')
? 'pkg-config.pl'
: File::Which::which('pkg-config')
? 'pkg-config'
: undef;
$meta->prop->{env}->{PKG_CONFIG} = $command_line
if defined $command_line;
}
if($self->register_prereqs)
{
$meta->add_requires('configure' => 'PkgConfig' => _min_version);
}
my($pkg_name, @alt_names) = (ref $self->pkg_name) ? (@{ $self->pkg_name }) : ($self->pkg_name);
$meta->register_hook(
probe => sub {
my($build) = @_;
$build->runtime_prop->{legacy}->{name} ||= $pkg_name;
$build->hook_prop->{probe_class} = __PACKAGE__;
$build->hook_prop->{probe_instance_id} = $self->instance_id;
require PkgConfig;
my $pkg = PkgConfig->find($pkg_name);
die "package @{[ $pkg_name ]} not found" if $pkg->errmsg;
$build->hook_prop->{version} = $pkg->pkg_version;
my $version = PkgConfig::Version->new($pkg->pkg_version);
my $atleast_version = $self->atleast_version;
$atleast_version = $self->minimum_version unless defined $atleast_version;
if(defined $atleast_version)
{
my $need = PkgConfig::Version->new($atleast_version);
if($version < $need)
{
die "package @{[ $pkg_name ]} is @{[ $pkg->pkg_version ]}, but at least $atleast_version is required.";
}
}
if(defined $self->exact_version)
{
my $need = PkgConfig::Version->new($self->exact_version);
if($version != $need)
{
die "package @{[ $pkg_name ]} is @{[ $pkg->pkg_version ]}, but exactly @{[ $self->exact_version ]} is required.";
}
}
if(defined $self->max_version)
{
my $need = PkgConfig::Version->new($self->max_version);
if($version > $need)
{
die "package @{[ $pkg_name ]} is @{[ $pkg->pkg_version ]}, but max of @{[ $self->max_version ]} is required.";
}
}
foreach my $alt (@alt_names)
{
my $pkg = PkgConfig->find($alt);
die "package $alt not found" if $pkg->errmsg;
}
'system';
},
);
$meta->register_hook(
$_ => sub {
my($build) = @_;
return if $build->hook_prop->{name} eq 'gather_system'
&& ($build->install_prop->{system_probe_instance_id} || '') ne $self->instance_id;
require PkgConfig;
foreach my $name ($pkg_name, @alt_names)
{
require PkgConfig;
my $pkg = PkgConfig->find($name, search_path => [@PKG_CONFIG_PATH]);
if($pkg->errmsg)
{
$build->log("Trying to load the pkg-config information from the source code build");
$build->log("of your package failed");
$build->log("You are currently using the pure-perl implementation of pkg-config");
$build->log("(AB Plugin is named PkgConfig::PP, which uses PkgConfig.pm");
$build->log("It may work better with the real pkg-config.");
$build->log("Try installing your OS' version of pkg-config or unset ALIEN_BUILD_PKG_CONFIG");
die "second load of PkgConfig.pm @{[ $name ]} failed: @{[ $pkg->errmsg ]}"
}
my %prop;
$prop{cflags} = _cleanup scalar $pkg->get_cflags;
$prop{libs} = _cleanup scalar $pkg->get_ldflags;
$prop{version} = $pkg->pkg_version;
$pkg = PkgConfig->find($name, static => 1, search_path => [@PKG_CONFIG_PATH]);
$prop{cflags_static} = _cleanup scalar $pkg->get_cflags;
$prop{libs_static} = _cleanup scalar $pkg->get_ldflags;
$build->runtime_prop->{alt}->{$name} = \%prop;
}
foreach my $key (keys %{ $build->runtime_prop->{alt}->{$pkg_name} })
{
$build->runtime_prop->{$key} = $build->runtime_prop->{alt}->{$pkg_name}->{$key};
}
if(keys %{ $build->runtime_prop->{alt} } == 1)
{
delete $build->runtime_prop->{alt};
}
}
) for qw( gather_system gather_share );
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::PkgConfig::PP - Probe system and determine library or tool properties using PkgConfig.pm
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'PkgConfig::PP' => (
pkg_name => 'libfoo',
);
=head1 DESCRIPTION
Note: in most case you will want to use L<Alien::Build::Plugin::PkgConfig::Negotiate>
instead. It picks the appropriate fetch plugin based on your platform and environment.
In some cases you may need to use this plugin directly instead.
This plugin provides Probe and Gather steps for pkg-config based packages. It uses
L<PkgConfig> to accomplish this task.
=head1 PROPERTIES
=head2 pkg_name
The package name. If this is a list reference then .pc files with all those package
names must be present. The first name will be the primary and used by default once
installed. For the subsequent C<.pc> files you can use the
L<Alien::Base alt method|Alien::Base/alt> to retrieve the alternate configurations
once the L<Alien> is installed.
=head2 atleast_version
The minimum required version that is acceptable version as provided by the system.
=head2 exact_version
The exact required version that is acceptable version as provided by the system.
=head2 max_version
The max required version that is acceptable version as provided by the system.
=head2 minimum_version
Alias for C<atleast_version> for backward compatibility.
=head1 METHODS
=head2 available
my $bool = Alien::Build::Plugin::PkgConfig::PP->available;
Returns true if the necessary prereqs for this plugin are I<already> installed.
=head1 SEE ALSO
L<Alien::Build::Plugin::PkgConfig::Negotiate>, L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/PkgConfig/Negotiate.pm 0000444 00000012523 15157555542 0015652 0 ustar 00 package Alien::Build::Plugin::PkgConfig::Negotiate;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Alien::Build::Plugin::PkgConfig::PP;
use Alien::Build::Plugin::PkgConfig::LibPkgConf;
use Alien::Build::Plugin::PkgConfig::CommandLine;
use Alien::Build::Util qw( _perl_config );
use Carp ();
# ABSTRACT: Package configuration negotiation plugin
our $VERSION = '2.84'; # VERSION
has '+pkg_name' => sub {
Carp::croak "pkg_name is a required property";
};
has atleast_version => undef;
has exact_version => undef;
has max_version => undef;
has minimum_version => undef;
sub pick
{
my($class) = @_;
return $ENV{ALIEN_BUILD_PKG_CONFIG} if $ENV{ALIEN_BUILD_PKG_CONFIG};
if(Alien::Build::Plugin::PkgConfig::LibPkgConf->available)
{
return 'PkgConfig::LibPkgConf';
}
if(Alien::Build::Plugin::PkgConfig::CommandLine->available)
{
# TODO: determine environment or flags necessary for using pkg-config
# on solaris 64 bit.
# Some advice on pkg-config and 64 bit Solaris
# https://docs.oracle.com/cd/E53394_01/html/E61689/gplhi.html
my $is_solaris64 = (_perl_config('osname') eq 'solaris' && _perl_config('ptrsize') == 8);
# PkgConfig.pm is more reliable on windows
my $is_windows = _perl_config('osname') eq 'MSWin32';
if(!$is_solaris64 && !$is_windows)
{
return 'PkgConfig::CommandLine';
}
}
if(Alien::Build::Plugin::PkgConfig::PP->available)
{
return 'PkgConfig::PP';
}
else
{
# this is a fata error. because we check for a pkg-config implementation
# at configure time, we expect at least one of these to work. (and we
# fallback on installing PkgConfig.pm as a prereq if nothing else is avail).
# we therefore expect at least one of these to work, if not, then the configuration
# of the system has shifted from underneath us.
Carp::croak("Could not find an appropriate pkg-config or pkgconf implementation, please install PkgConfig.pm, PkgConfig::LibPkgConf, pkg-config or pkgconf");
}
}
sub init
{
my($self, $meta) = @_;
my $plugin = $self->pick;
Alien::Build->log("Using PkgConfig plugin: $plugin");
if(ref($self->pkg_name) eq 'ARRAY')
{
$meta->add_requires('configure', 'Alien::Build::Plugin::PkgConfig::Negotiate' => '0.79');
}
if($self->atleast_version || $self->exact_version || $self->max_version)
{
$meta->add_requires('configure', 'Alien::Build::Plugin::PkgConfig::Negotiate' => '1.53');
}
my @args;
push @args, pkg_name => $self->pkg_name;
push @args, register_prereqs => 0;
foreach my $method (map { "${_}_version" } qw( minimum atleast exact max ))
{
push @args, $method => $self->$method if defined $self->$method;
}
$meta->apply_plugin($plugin, @args);
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::PkgConfig::Negotiate - Package configuration negotiation plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
plugin 'PkgConfig' => (
pkg_name => 'libfoo',
);
=head1 DESCRIPTION
This plugin provides Probe and Gather steps for pkg-config based packages. It picks
the best C<PkgConfig> plugin depending your platform and environment.
=head1 PROPERTIES
=head2 pkg_name
The package name. If this is a list reference then .pc files with all those package
names must be present. The first name will be the primary and used by default once
installed. For the subsequent C<.pc> files you can use the
L<Alien::Base alt method|Alien::Base/alt> to retrieve the alternate configurations
once the L<Alien> is installed.
=head2 atleast_version
The minimum required version that is acceptable version as provided by the system.
=head2 exact_version
The exact required version that is acceptable version as provided by the system.
=head2 max_version
The max required version that is acceptable version as provided by the system.
=head2 minimum_version
Alias for C<atleast_version> for backward compatibility.
=head1 METHODS
=head2 pick
my $name = Alien::Build::Plugin::PkgConfig::Negotiate->pick;
Returns the name of the negotiated plugin.
=head1 ENVIRONMENT
=over 4
=item ALIEN_BUILD_PKG_CONFIG
If set, this plugin will be used instead of the build in logic
which attempts to automatically pick the best plugin.
=back
=head1 SEE ALSO
L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Core.pod 0000444 00000004202 15157555547 0013122 0 ustar 00 # PODNAME: Alien::Build::Plugin::Core
# ABSTRACT: Core Alien::Build plugins
# VERSION
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Core - Core Alien::Build plugins
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
# core plugins are already loaded
=head1 DESCRIPTION
Core plugins are special plugins that are always loaded, usually first.
=over 4
=item L<Alien::Build::Plugin::Core::CleanInstall>
=item L<Alien::Build::Plugin::Core::Download>
This contains the default machinery for downloading packages, if no
other download plugin or commands are provided.
=item L<Alien::Build::Plugin::Core::FFI>
=item L<Alien::Build::Plugin::Core::Gather>
=item L<Alien::Build::Plugin::Core::Legacy>
Add interoperability with L<Alien::Base::ModuleBuild>
=item L<Alien::Build::Plugin::Core::Override>
The machinery which allows you to override the type of install
with the C<ALIEN_INSTALL_TYPE> environment variable.
=item L<Alien::Build::Plugin::Core::Setup>
=item L<Alien::Build::Plugin::Core::Tail>
=back
=head1 SEE ALSO
L<Alien::Build>, L<Alien::Build::Plugin>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Download/GitLab.pm 0000444 00000013513 15157555561 0014776 0 ustar 00 package Alien::Build::Plugin::Download::GitLab;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use URI;
use JSON::PP qw( decode_json );
use URI::Escape qw( uri_escape );
use Alien::Build::Plugin;
use File::Basename qw( basename );
use Path::Tiny qw( path );
# ABSTRACT: Alien::Build plugin to download from GitLab
our $VERSION = '0.01'; # VERSION
has gitlab_host => 'https://gitlab.com';
has gitlab_user => undef;
has gitlab_project => undef;
has type => 'source'; # source or link
has format => 'tar.gz';
has version_from => 'tag_name'; # tag_name or name
has convert_version => undef;
has link_name => undef;
sub init
{
my($self, $meta) = @_;
croak("No gitlab_user provided") unless defined $self->gitlab_user;
croak("No gitlab_project provided") unless defined $self->gitlab_project;
croak("Don't set set a start_url with the Download::GitLab plugin") if defined $meta->prop->{start_url};
$meta->add_requires('configure' => 'Alien::Build::Plugin::Download::GitLab' => 0 );
my $url = URI->new($self->gitlab_host);
$url->path("/api/v4/projects/@{[ uri_escape(join '/', $self->gitlab_user, $self->gitlab_project) ]}/releases");
$meta->prop->{start_url} ||= "$url";
$meta->apply_plugin('Download');
$meta->apply_plugin('Extract', format => $self->format );
# we assume that GitLab returns the releases in reverse
# chronological order.
$meta->register_hook(
prefer => sub {
my($build, $res) = @_;
return $res;
},
);
croak "type must be one of source or link" if $self->type !~ /^(source|link)$/;
croak "version_from must be one of tag_name or name" if $self->version_from !~ /^(tag_name|name)$/;
## TODO insert tokens as header if possible
## This may help with rate limiting (or if not then don't bother)
# curl --header "PRIVATE-TOKEN: <your_access_token>" "https://gitlab.example.com/api/v4/projects/24/releases"
$meta->around_hook(
fetch => sub {
my $orig = shift;
my($build, $url, @the_rest) = @_;
# only modify the response if we are using the GitLab API
# to get the release list
return $orig->($build, $url, @the_rest)
if defined $url && $url ne $meta->prop->{start_url};
my $res = $orig->($build, $url, @the_rest);
my $res2 = {
type => 'list',
list => [],
};
$res2->{protocol} = $res->{protocol} if exists $res->{protocol};
my $rel;
if($res->{content})
{
$rel = decode_json $res->{content};
}
elsif($res->{path})
{
$rel = decode_json path($res->{path})->slurp_raw;
}
else
{
croak("malformed response object: no content or path");
}
foreach my $release (@$rel)
{
my $version = $self->version_from eq 'name' ? $release->{name} : $release->{tag_name};
$version = $self->convert_version->($version) if $self->convert_version;
if($self->type eq 'source')
{
foreach my $source (@{ $release->{assets}->{sources} })
{
next unless $source->{format} eq $self->format;
my $url = URI->new($source->{url});
my $filename = basename $url->path;
push @{ $res2->{list} }, {
filename => $filename,
url => $source->{url},
version => $version,
};
}
}
else # link
{
foreach my $link (@{ $release->{assets}->{links} })
{
my $url = URI->new($link->{url});
my $filename => basename $url->path;
if($self->link_name)
{
next unless $filename =~ $self->link_name;
}
push @{ $res2->{list} }, {
filename => $filename,
url => $link->{url},
version => $version,
};
}
}
}
return $res2;
},
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Download::GitLab - Alien::Build plugin to download from GitLab
=head1 VERSION
version 0.01
=head1 SYNOPSIS
use alienfile;
plugin 'Download::GitLab' => (
gitlab_user => 'plicease',
gitlab_project => 'dontpanic',
);
=head1 DESCRIPTION
This plugin is designed for downloading assets from a GitLab instance.
=head1 PROPERTIES
=head2 gitlab_host
The host to fetch from L<https://gitlab.com> by default.
=head2 gitlab_user
The user to fetch from.
=head2 gitlab_project
The project to fetch from.
=head2 type
The asset type to fetch. This must be one of C<source> or C<link>.
=head2 format
The expected format of the asset. This should be one that
L<Alien::Build::Plugin::Extract::Negotiate> understands. The
default is C<tar.gz>.
=head2 version_from
Where to compute the version from. This should be one of
C<tag_name> or C<name>. The default is C<tag_name>.
=head2 convert_version
This is an optional code reference, which can be used to modify
the version. For example, if tags have a C<v> prefix you could
remove it like so:
plugin 'Download::GitLab' => (
gitlab_user => 'plicease',
gitlab_project => 'dontpanic',
convert_version => sub {
my $version = shift;
$version =~ s/^v//;
return $version;
},
);
=head2 link_name
For C<link> types, this is a regular expression that filters the
asset filenames. For example, if there are multiple archive
formats provided, you can get just the gzip'd tarball by setting
this to C<qr/\.tar\.gz$/>.
=head1 SEE ALSO
=over 4
=item L<Alien>
=item L<Alien::Build::Plugin::Download::GitHub>
=item L<alienfile>
=item L<Alien::Build>
=back
=head1 AUTHOR
Graham Ollis <plicease@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin/Download/Negotiate.pm 0000444 00000022223 15157555566 0015556 0 ustar 00 package Alien::Build::Plugin::Download::Negotiate;
use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Alien::Build::Util qw( _has_ssl );
use Carp ();
# ABSTRACT: Download negotiation plugin
our $VERSION = '2.84'; # VERSION
has '+url' => undef;
has 'filter' => undef;
has 'version' => undef;
has 'ssl' => 0;
has 'passive' => 0;
has 'scheme' => undef;
has 'bootstrap_ssl' => 0;
has 'prefer' => 1;
has 'decoder' => undef;
sub pick
{
my($self) = @_;
my($fetch, @decoders) = $self->_pick;
if($self->decoder)
{
@decoders = ref $self->decoder ? @{ $self->decoder } : ($self->decoder);
}
($fetch, @decoders);
}
sub _pick_decoder
{
my($self) = @_;
if(eval { require Mojo::DOM58; Mojo::DOM58->VERSION(1.00); 1 })
{ return "Decode::Mojo" }
elsif(eval { require Mojo::DOM; require Mojolicious; Mojolicious->VERSION('7.00'); 1 })
{ return "Decode::Mojo" }
elsif(eval { require HTML::LinkExtor; 1; })
{ return "Decode::HTML" }
else
{ return "Decode::Mojo" }
}
sub _pick
{
my($self) = @_;
$self->scheme(
$self->url !~ m!(ftps?|https?|file):!i
? 'file'
: $self->url =~ m!^([a-z]+):!i
) unless defined $self->scheme;
if($self->scheme eq 'https' || ($self->scheme eq 'http' && $self->ssl))
{
if($self->bootstrap_ssl && ! _has_ssl)
{
return (['Fetch::CurlCommand','Fetch::Wget'], __PACKAGE__->_pick_decoder);
}
elsif(_has_ssl)
{
return ('Fetch::HTTPTiny', __PACKAGE__->_pick_decoder);
}
#elsif(do { require Alien::Build::Plugin::Fetch::CurlCommand; Alien::Build::Plugin::Fetch::CurlCommand->protocol_ok('https') })
#{
# return ('Fetch::CurlCommand', __PACKAGE__->_pick_decoder);
#}
else
{
return ('Fetch::HTTPTiny', __PACKAGE__->_pick_decoder);
}
}
elsif($self->scheme eq 'http')
{
return ('Fetch::HTTPTiny', __PACKAGE__->_pick_decoder);
}
elsif($self->scheme eq 'ftp')
{
if($ENV{ftp_proxy} || $ENV{all_proxy})
{
return $self->scheme =~ /^ftps?/
? ('Fetch::LWP', 'Decode::DirListing', __PACKAGE__->_pick_decoder)
: ('Fetch::LWP', __PACKAGE__->_pick_decoder);
}
else
{
return ('Fetch::NetFTP');
}
}
elsif($self->scheme eq 'file')
{
return ('Fetch::Local');
}
else
{
die "do not know how to handle scheme @{[ $self->scheme ]} for @{[ $self->url ]}";
}
}
sub init
{
my($self, $meta) = @_;
unless(defined $self->url)
{
if(defined $meta->prop->{start_url})
{
$self->url($meta->prop->{start_url});
}
else
{
Carp::croak "url is a required property unless you use the start_url directive";
}
}
if($self->url =~ /^http.*github.com.*releases$/)
{
Alien::Build->log('!! WARNING !! WARNING !!');
Alien::Build->log('!! WARNING !! It looks like this alien is using the regular download negotiator');
Alien::Build->log('plugin on a GitHub release page. This will typically not work due to changes');
Alien::Build->log('in the way GitHub release page works now. The Alien should instead be updated');
Alien::Build->log('to use the Download::GitHub plugin, which uses the GitHub API to find available');
Alien::Build->log('releases. See: https://metacpan.org/pod/Alien::Build::Plugin::Download::GitHub');
Alien::Build->log('!! WARNING !! WARNING !!');
}
$meta->add_requires('share' => 'Alien::Build::Plugin::Download::Negotiate' => '0.61')
if $self->passive;
$meta->prop->{plugin_download_negotiate_default_url} = $self->url;
my($fetch, @decoders) = $self->pick;
$fetch = [ $fetch ] unless ref $fetch;
foreach my $fetch (@$fetch)
{
my @args;
push @args, ssl => $self->ssl;
# For historical reasons, we pass the URL into older fetch plugins, because
# this used to be the interface. Using start_url is now preferred!
push @args, url => $self->url if $fetch =~ /^Fetch::(HTTPTiny|LWP|Local|LocalDir|NetFTP|CurlCommand)$/;
push @args, passive => $self->passive if $fetch eq 'Fetch::NetFTP';
push @args, bootstrap_ssl => $self->bootstrap_ssl if $self->bootstrap_ssl;
$meta->apply_plugin($fetch, @args);
}
if($self->version)
{
$meta->apply_plugin($_) for @decoders;
if(defined $self->prefer && ref($self->prefer) eq 'CODE')
{
$meta->add_requires('share' => 'Alien::Build::Plugin::Download::Negotiate' => '1.30');
$meta->register_hook(
prefer => $self->prefer,
);
}
elsif($self->prefer)
{
$meta->apply_plugin('Prefer::SortVersions',
(defined $self->filter ? (filter => $self->filter) : ()),
version => $self->version,
);
}
else
{
$meta->add_requires('share' => 'Alien::Build::Plugin::Download::Negotiate' => '1.30');
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin::Download::Negotiate - Download negotiation plugin
=head1 VERSION
version 2.84
=head1 SYNOPSIS
use alienfile;
share {
start_url 'http://ftp.gnu.org/gnu/make';
plugin 'Download' => (
filter => qr/^make-.*\.tar\.gz$/,
version => qr/([0-9\.]+)/,
);
};
=head1 DESCRIPTION
This is a negotiator plugin for downloading packages from the internet. This
plugin picks the best Fetch, Decode and Prefer plugins to do the actual work.
Which plugins are picked depend on the properties you specify, your platform
and environment. It is usually preferable to use a negotiator plugin rather
than the Fetch, Decode and Prefer plugins directly from your L<alienfile>.
=head1 PROPERTIES
=head2 url
[DEPRECATED] use C<start_url> instead.
The Initial URL for your package. This may be a directory listing (either in
HTML or ftp listing format) or the final tarball intended to be downloaded.
=head2 filter
This is a regular expression that lets you filter out files that you do not
want to consider downloading. For example, if the directory listing contained
tarballs and readme files like this:
foo-1.0.0.tar.gz
foo-1.0.0.readme
You could specify a filter of C<qr/\.tar\.gz$/> to make sure only tarballs are
considered for download.
=head2 version
Regular expression to parse out the version from a filename. The regular expression
should store the result in C<$1>.
Note: if you provide a C<version> property, this plugin will assume that you will
be downloading an initial index to select package downloads from. Depending on
the protocol (and typically this is the case for http and HTML) that may bring in
additional dependencies. If start_url points to a tarball or other archive directly
(without needing to do through an index selection process), it is recommended that
you not specify this property.
=head2 ssl
If your initial URL does not need SSL, but you know ahead of time that a subsequent
request will need it (for example, if your directory listing is on C<http>, but includes
links to C<https> URLs), then you can set this property to true, and the appropriate
Perl SSL modules will be loaded.
=head2 passive
If using FTP, attempt a passive mode transfer first, before trying an active mode transfer.
=head2 bootstrap_ssl
If set to true, then the download negotiator will avoid using plugins that have a dependency
on L<Net::SSLeay>, or other Perl SSL modules. The intent for this option is to allow
OpenSSL to be alienized and be a useful optional dependency for L<Net::SSLeay>.
The implementation may improve over time, but as of this writing, this option relies on you
having a working C<curl> or C<wget> with SSL support in your C<PATH>.
=head2 prefer
How to sort candidates for selection. This should be one of three types of values:
=over 4
=item code reference
This will be used as the prefer hook.
=item true value
Use L<Alien::Build::Plugin::Prefer::SortVersions>.
=item false value
Don't set any preference at all. A hook must be installed, or another prefer plugin specified.
=back
=head2 decoder
Override the detected decoder.
=head1 METHODS
=head2 pick
my($fetch, @decoders) = $plugin->pick;
Returns the fetch plugin and any optional decoders that should be used.
=head1 SEE ALSO
L<Alien::Build::Plugin::Prefer::BadVersion>, L<Alien::Build::Plugin::Prefer::GoodVersion>
L<Alien::Build>, L<alienfile>, L<Alien::Build::MM>, L<Alien>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/Plugin.pm 0000444 00000014651 15157555573 0012074 0 ustar 00 package Alien::Build::Plugin;
use strict;
use warnings;
use 5.008004;
use Data::Dumper ();
use Carp ();
use Digest::SHA ();
our @CARP_NOT = qw( alienfile Alien::Build Alien::Build::Meta );
# ABSTRACT: Plugin base class for Alien::Build
our $VERSION = '2.84'; # VERSION
sub new
{
my $class = shift;
my %args = @_ == 1 ? ($class->meta->default => $_[0]) : @_;
my $instance_id = Digest::SHA::sha1_hex(Data::Dumper->new([$class, \%args])->Sortkeys(1)->Dump);
my $self = bless { instance_id => $instance_id }, $class;
my $prop = $self->meta->prop;
foreach my $name (keys %$prop)
{
$self->{$name} = defined $args{$name}
? delete $args{$name}
: ref($prop->{$name}) eq 'CODE'
? $prop->{$name}->()
: $prop->{$name};
}
foreach my $name (keys %args)
{
Carp::carp "$class has no $name property";
}
$self;
}
sub instance_id { shift->{instance_id} }
sub init
{
my($self) = @_;
$self;
}
sub import
{
my($class) = @_;
return if $class ne __PACKAGE__;
my $caller = caller;
{ no strict 'refs'; @{ "${caller}::ISA" } = __PACKAGE__ }
my $meta = $caller->meta;
my $has = sub {
my($name, $default) = @_;
$meta->add_property($name, $default);
};
{ no strict 'refs'; *{ "${caller}::has" } = $has }
}
my %meta;
sub meta
{
my($class) = @_;
$class = ref $class if ref $class;
$meta{$class} ||= Alien::Build::PluginMeta->new( class => $class );
}
package Alien::Build::PluginMeta;
sub new
{
my($class, %args) = @_;
my $self = bless {
prop => {},
%args,
}, $class;
}
sub default
{
my($self) = @_;
$self->{default} || do {
Carp::croak "No default for @{[ $self->{class} ]}";
};
}
sub add_property
{
my($self, $name, $default) = @_;
my $single = $name =~ s{^(\+)}{};
$self->{default} = $name if $single;
$self->{prop}->{$name} = $default;
my $accessor = sub {
my($self, $new) = @_;
$self->{$name} = $new if defined $new;
$self->{$name};
};
# add the accessor
{ no strict 'refs'; *{ $self->{class} . '::' . $name} = $accessor }
$self;
}
sub prop
{
shift->{prop};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::Plugin - Plugin base class for Alien::Build
=head1 VERSION
version 2.84
=head1 SYNOPSIS
Create your plugin:
package Alien::Build::Plugin::Type::MyPlugin;
use Alien::Build::Plugin;
use Carp ();
has prop1 => 'default value';
has prop2 => sub { 'default value' };
has prop3 => sub { Carp::croak 'prop3 is a required property' };
sub init
{
my($self, $meta) = @_;
my $prop1 = $self->prop1;
my $prop2 = $self->prop2;
my $prop3 = $self->prop3;
$meta->register_hook(sub {
build => [ '%{make}', '%{make} install' ],
});
}
From your L<alienfile>
use alienfile;
plugin 'Type::MyPlugin' => (
prop2 => 'different value',
prop3 => 'need to provide since it is required',
);
=head1 DESCRIPTION
This document describes the L<Alien::Build> plugin base class. For details
on how to write a plugin, see L<Alien::Build::Manual::PluginAuthor>.
Listed are some common types of plugins:
=over 4
=item L<Alien::Build::Plugin::Build>
Tools for building.
=item L<Alien::Build::Plugin::Core>
Tools already included.
=item L<Alien::Build::Plugin::Decode>
Normally use Download plugins which will pick the correct Decode plugins.
=item L<Alien::Build::Plugin::Digest>
Tools for checking cryptographic signatures during a C<share> install.
=item L<Alien::Build::Plugin::Download>
Methods for retrieving from the internet.
=item L<Alien::Build::Plugin::Extract>
Extract from archives that have been downloaded.
=item L<Alien::Build::Plugin::Fetch>
Normally use Download plugins which will pick the correct Fetch plugins.
=item L<Alien::Build::Plugin::Gather>
Plugins that modify or enhance the gather step.
=item L<Alien::Build::Plugin::PkgConfig>
Plugins that work with C<pkg-config> or libraries that provide the same
functionality.
=item L<Alien::Build::Plugin::Prefer>
Normally use Download plugins which will pick the correct Prefer plugins.
=item L<Alien::Build::Plugin::Probe>
Look for packages already installed on the system.
=item L<Alien::Build::Plugin::Probe>
Plugins useful for unit testing L<Alien::Build> itself, or plugins for it.
=back
=head1 CONSTRUCTOR
=head2 new
my $plugin = Alien::Build::Plugin->new(%props);
=head2 PROPERTIES
=head2 instance_id
my $id = $plugin->instance_id;
Returns an instance id for the plugin. This is computed from the class and
arguments that are passed into the plugin constructor, so technically two
instances with the exact same arguments will have the same instance id, but
in practice you should never have two instances with the exact same arguments.
=head1 METHODS
=head2 init
$plugin->init($ab_class->meta); # $ab is an Alien::Build class name
You provide the implementation for this. The intent is to register
hooks and set meta properties on the L<Alien::Build> class.
=head2 has
has $prop_name;
has $prop_name => $default;
Specifies a property of the plugin. You may provide a default value as either
a string scalar, or a code reference. The code reference will be called to
compute the default value, and if you want the default to be a list or hash
reference, this is how you want to do it:
has foo => sub { [1,2,3] };
=head2 meta
my $meta = $plugin->meta;
Returns the plugin meta object.
=head1 SEE ALSO
L<Alien::Build>, L<alienfile>, L<Alien::Build::Manual::PluginAuthor>
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Build/rc.pm 0000444 00000005517 15157555600 0011232 0 ustar 00 package Alien::Build::rc;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Alien::Build local config
our $VERSION = '2.84'; # VERSION
sub logx ($)
{
unshift @_, 'Alien::Build';
goto &Alien::Build::log;
}
sub preload_plugin
{
my(@args) = @_;
push @Alien::Build::rc::PRELOAD, sub {
shift->apply_plugin(@args);
};
}
sub postload_plugin
{
my(@args) = @_;
push @Alien::Build::rc::POSTLOAD, sub {
shift->apply_plugin(@args);
};
}
sub preload ($)
{
push @Alien::Build::rc::PRELOAD, $_[0];
}
sub postload ($)
{
push @Alien::Build::rc::POSTLOAD, $_[0];
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Alien::Build::rc - Alien::Build local config
=head1 VERSION
version 2.84
=head1 SYNOPSIS
in your C<~/.alienbuild/rc.pl>:
preload 'Foo::Bar';
postload 'Baz::Frooble';
=head1 DESCRIPTION
L<Alien::Build> will load your C<~/.alienbuild/rc.pl> file, if it exists
before running the L<alienfile> recipe. This allows you to alter the
behavior of L<Alien::Build> based L<Alien>s if you have local configuration
requirements. For example you can prompt before downloading remote content
or fetch from a local mirror.
=head1 FUNCTIONS
=head2 logx
log $message;
Send a message to the L<Alien::Build> log.
=head2 preload_plugin
preload_plugin $plugin, @args;
Preload the given plugin, with arguments.
=head2 postload_plugin
postload_plugin $plugin, @args;
Postload the given plugin, with arguments.
=head2 preload
[deprecated]
preload $plugin;
Preload the given plugin.
=head2 postload
[deprecated]
postload $plugin;
Postload the given plugin.
=head1 SEE ALSO
=over 4
=item L<Alien::Build::Plugin::Fetch::Cache>
=item L<Alien::Build::Plugin::Fetch::Prompt>
=item L<Alien::Build::Plugin::Fetch::Rewrite>
=item L<Alien::Build::Plugin::Probe::Override>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Alien/Base.pm 0000444 00000071312 15157555612 0010440 0 ustar 00 package Alien::Base;
use strict;
use warnings;
use 5.008004;
use Carp;
use Path::Tiny ();
use Scalar::Util qw/blessed/;
use Capture::Tiny 0.17 qw/capture_stdout/;
use Text::ParseWords qw/shellwords/;
use Alien::Util;
# ABSTRACT: Base classes for Alien:: modules
our $VERSION = '2.84'; # VERSION
sub import {
my $class = shift;
return if $class eq __PACKAGE__;
return if $class->runtime_prop;
return if $class->install_type('system');
require DynaLoader;
# Sanity check in order to ensure that dist_dir can be found.
# This will throw an exception otherwise.
$class->dist_dir;
# get a reference to %Alien::MyLibrary::AlienLoaded
# which contains names of already loaded libraries
# this logic may be replaced by investigating the DynaLoader arrays
my $loaded = do {
no strict 'refs';
no warnings 'once';
\%{ $class . "::AlienLoaded" };
};
my @libs = $class->split_flags( $class->libs );
my @L = grep { s/^-L// } map { "$_" } @libs; ## no critic (ControlStructures::ProhibitMutatingListFunctions)
my @l = grep { /^-l/ } @libs;
unshift @DynaLoader::dl_library_path, @L;
my @libpaths;
foreach my $l (@l) {
next if $loaded->{$l};
my $path = DynaLoader::dl_findfile( $l );
unless ($path) {
carp "Could not resolve $l";
next;
}
push @libpaths, $path;
$loaded->{$l} = $path;
}
push @DynaLoader::dl_resolve_using, @libpaths;
my @librefs = map { DynaLoader::dl_load_file( $_, 0x01 ) } grep !/\.(a|lib)$/, @libpaths;
push @DynaLoader::dl_librefs, @librefs;
}
sub _dist_dir ($)
{
my($dist_name) = @_;
my @pm = split /-/, $dist_name;
$pm[-1] .= ".pm";
foreach my $inc (@INC)
{
my $pm = Path::Tiny->new($inc, @pm);
if(-f $pm)
{
my $share = Path::Tiny->new($inc, qw( auto share dist ), $dist_name );
if(-d $share)
{
return $share->absolute->stringify;
}
last;
}
}
Carp::croak("unable to find dist share directory for $dist_name");
}
sub dist_dir {
my $class = shift;
my $dist = blessed $class || $class;
$dist =~ s/::/-/g;
my $dist_dir =
$class->config('finished_installing')
? _dist_dir $dist
: $class->config('working_directory');
croak "Failed to find share dir for dist '$dist'"
unless defined $dist_dir && -d $dist_dir;
return $dist_dir;
}
sub new { return bless {}, $_[0] }
sub _flags
{
my($class, $key) = @_;
my $config = $class->runtime_prop;
my $flags = $config->{$key};
my $prefix = $config->{prefix};
$prefix =~ s{\\}{/}g if $^O =~ /^(MSWin32|msys)$/;
my $distdir = $config->{distdir};
$distdir =~ s{\\}{/}g if $^O =~ /^(MSWin32|msys)$/;
if(defined $flags && $prefix ne $distdir)
{
$flags = join ' ', map {
my $flag = $_;
$flag =~ s/^(-I|-L|-LIBPATH:)?\Q$prefix\E/$1$distdir/;
$flag =~ s/(\s)/\\$1/g;
$flag;
} $class->split_flags($flags);
}
$flags;
}
sub cflags {
my $class = shift;
return $class->runtime_prop ? $class->_flags('cflags') : $class->_pkgconfig_keyword('Cflags');
}
sub cflags_static {
my $class = shift;
return $class->runtime_prop ? $class->_flags('cflags_static') : $class->_pkgconfig_keyword('Cflags', 'static');
}
sub libs {
my $class = shift;
return $class->runtime_prop ? $class->_flags('libs') : $class->_pkgconfig_keyword('Libs');
}
sub libs_static {
my $class = shift;
return $class->runtime_prop ? $class->_flags('libs_static') : $class->_pkgconfig_keyword('Libs', 'static');
}
sub version {
my $self = shift;
return $self->runtime_prop
? $self->runtime_prop->{version}
: do {
my $version = $self->config('version');
chomp $version;
$version;
};
}
sub atleast_version {
my $self = shift;
my ($wantver) = @_;
defined(my $version = $self->version) or
croak "$self has no defined ->version";
return $self->version_cmp($version, $wantver) >= 0;
}
sub exact_version {
my $self = shift;
my ($wantver) = @_;
defined(my $version = $self->version) or
croak "$self has no defined ->version";
return $self->version_cmp($version, $wantver) == 0;
}
sub max_version {
my $self = shift;
my ($wantver) = @_;
defined(my $version = $self->version) or
croak "$self has no defined ->version";
return $self->version_cmp($version, $wantver) <= 0;
}
sub version_cmp {
shift;
goto &Alien::Util::version_cmp;
}
sub install_type {
my $self = shift;
my $type = $self->config('install_type');
return @_ ? $type eq $_[0] : $type;
}
sub is_system_install
{
my($self) = @_;
$self->install_type('system');
}
sub is_share_install
{
my($self) = @_;
$self->install_type('share');
}
sub _pkgconfig_keyword {
my $self = shift;
my $keyword = shift;
my $static = shift;
# use pkg-config if installed system-wide
if ($self->install_type('system')) {
my $name = $self->config('name');
require Alien::Base::PkgConfig;
my $command = Alien::Base::PkgConfig->pkg_config_command . " @{[ $static ? '--static' : '' ]} --\L$keyword\E $name";
$! = 0;
chomp ( my $pcdata = capture_stdout { system( $command ) } );
# if pkg-config fails for whatever reason, then we try to
# fallback on alien_provides_*
$pcdata = '' if $! || $?;
$pcdata =~ s/\s*$//;
if($self->config('system_provides')) {
if(my $system_provides = $self->config('system_provides')->{$keyword}) {
$pcdata = length $pcdata ? "$pcdata $system_provides" : $system_provides;
}
}
return $pcdata;
}
# use parsed info from build .pc file
my $dist_dir = $self->dist_dir;
my @pc = $self->_pkgconfig(@_);
my @strings =
grep defined,
map { $_->keyword($keyword,
#{ pcfiledir => $dist_dir }
) }
@pc;
if(defined $self->config('original_prefix') && $self->config('original_prefix') ne $self->dist_dir)
{
my $dist_dir = $self->dist_dir;
$dist_dir =~ s{\\}{/}g if $^O eq 'MSWin32';
my $old = quotemeta $self->config('original_prefix');
@strings = map {
my $flag = $_;
$flag =~ s{^(-I|-L|-LIBPATH:)?($old)}{$1.$dist_dir}e;
$flag =~ s/(\s)/\\$1/g;
$flag;
} map { $self->split_flags($_) } @strings;
}
return join( ' ', @strings );
}
sub _pkgconfig {
my $self = shift;
my %all = %{ $self->config('pkgconfig') };
# merge in found pc files
require File::Find;
my $wanted = sub {
return if ( -d or not /\.pc$/ );
require Alien::Base::PkgConfig;
my $pkg = Alien::Base::PkgConfig->new($_);
$all{$pkg->{package}} = $pkg;
};
File::Find::find( $wanted, $self->dist_dir );
croak "No Alien::Base::PkgConfig objects are stored!"
unless keys %all;
# Run through all pkgconfig objects and ensure that their modules are loaded:
for my $pkg_obj (values %all) {
my $perl_module_name = blessed $pkg_obj;
my $pm = "$perl_module_name.pm";
$pm =~ s/::/\//g;
eval { require $pm };
}
return @all{@_} if @_;
my $manual = delete $all{_manual};
if (keys %all) {
return values %all;
} else {
return $manual;
}
}
# helper method to call Alien::MyLib::ConfigData->config(@_)
sub config {
my $class = shift;
$class = blessed $class || $class;
if(my $ab_config = $class->runtime_prop)
{
my $key = shift;
return $ab_config->{legacy}->{$key};
}
my $config = $class . '::ConfigData';
my $pm = "$class/ConfigData.pm";
$pm =~ s{::}{/}g;
eval { require $pm };
if($@)
{
warn "Cannot find either a share directory or a ConfigData module for $class.\n";
my $pm = "$class.pm";
$pm =~ s{::}{/}g;
warn "($class loaded from $INC{$pm})\n" if $INC{$pm};
warn "Please see https://metacpan.org/pod/distribution/Alien-Build/lib/Alien/Build/Manual/FAQ.pod#Cannot-find-either-a-share-directory-or-a-ConfigData-module\n";
die $@;
}
return $config->config(@_);
}
# helper method to split flags based on the OS
sub split_flags {
my ($class, $line) = @_;
if( $^O eq 'MSWin32' ) {
$class->split_flags_windows($line);
} else {
# $os eq 'Unix'
$class->split_flags_unix($line);
}
}
sub split_flags_unix {
my ($class, $line) = @_;
shellwords($line);
}
sub split_flags_windows {
# NOTE a better approach would be to write a function that understands cmd.exe metacharacters.
my ($class, $line) = @_;
# Double the backslashes so that when they are unescaped by shellwords(),
# they become a single backslash. This should be fine on Windows since
# backslashes are not used to escape metacharacters in cmd.exe.
$line =~ s,\\,\\\\,g;
shellwords($line);
}
sub dynamic_libs {
my ($class) = @_;
require FFI::CheckLib;
my @find_lib_flags;
if($class->install_type('system')) {
if(my $prop = $class->runtime_prop)
{
if($prop->{ffi_checklib}->{system})
{
push @find_lib_flags, @{ $prop->{ffi_checklib}->{system} };
}
return FFI::CheckLib::find_lib( lib => $prop->{ffi_name}, @find_lib_flags )
if defined $prop->{ffi_name};
}
my $name = $class->config('ffi_name');
unless(defined $name)
{
$name = $class->config('name');
$name = '' unless defined $name;
# strip leading lib from things like libarchive or libffi
$name =~ s/^lib//;
# strip trailing version numbers
$name =~ s/-[0-9\.]+$//;
}
my @libpath;
if(defined $class->libs)
{
foreach my $flag ($class->split_flags($class->libs))
{
if($flag =~ /^-L(.*)$/)
{
push @libpath, $1;
}
}
}
return FFI::CheckLib::find_lib(lib => $name, libpath => \@libpath, @find_lib_flags );
} else {
my $dir = $class->dist_dir;
my $dynamic = Path::Tiny->new($class->dist_dir, 'dynamic');
if(my $prop = $class->runtime_prop)
{
if($prop->{ffi_checklib}->{share})
{
push @find_lib_flags, @{ $prop->{ffi_checklib}->{share_flags} };
}
}
if(-d $dynamic)
{
return FFI::CheckLib::find_lib(
lib => '*',
libpath => "$dynamic",
systempath => [],
);
}
return FFI::CheckLib::find_lib(
lib => '*',
libpath => $dir,
systempath => [],
recursive => 1,
);
}
}
sub bin_dir {
my ($class) = @_;
if($class->install_type('system'))
{
my $prop = $class->runtime_prop;
return () unless defined $prop;
return () unless defined $prop->{system_bin_dir};
return ref $prop->{system_bin_dir} ? @{ $prop->{system_bin_dir} } : ($prop->{system_bin_dir});
}
else
{
my $dir = Path::Tiny->new($class->dist_dir, 'bin');
return -d $dir ? ("$dir") : ();
}
}
sub dynamic_dir {
my ($class) = @_;
if($class->install_type('system'))
{
return ();
}
else
{
my $dir = Path::Tiny->new($class->dist_dir, 'dynamic');
return -d $dir ? ("$dir") : ();
}
}
sub alien_helper {
{};
}
sub inline_auto_include {
my ($class) = @_;
$class->runtime_prop->{inline_auto_include} || $class->config('inline_auto_include') || []
}
sub Inline {
my ($class, $language) = @_;
return unless defined $language;
return if $language !~ /^(C|CPP)$/;
my $config = {
# INC should arguably be for -I flags only, but
# this improves compat with ExtUtils::Depends.
# see gh#107, gh#108
INC => $class->cflags,
LIBS => $class->libs,
};
if (@{ $class->inline_auto_include } > 0) {
$config->{AUTO_INCLUDE} = join "\n", map { "#include \"$_\"" } @{ $class->inline_auto_include };
}
$config;
}
{
my %alien_build_config_cache;
sub runtime_prop
{
my($class) = @_;
if(ref($class))
{
# called as an instance method.
my $self = $class;
$class = ref $self;
return $self->{_alt}->{runtime_prop} if defined $self->{_alt};
}
return $alien_build_config_cache{$class} if
exists $alien_build_config_cache{$class};
$alien_build_config_cache{$class} ||= do {
my $dist = ref $class ? ref $class : $class;
$dist =~ s/::/-/g;
my $dist_dir = eval { _dist_dir $dist };
return if $@;
my $alien_json = Path::Tiny->new($dist_dir, '_alien', 'alien.json');
return unless -r $alien_json;
my $json = $alien_json->slurp;
require JSON::PP;
my $config = JSON::PP::decode_json($json);
$config->{distdir} = $dist_dir;
$config;
};
}
}
sub alt
{
my($old, $name) = @_;
my $new = ref $old ? (ref $old)->new : $old->new;
my $orig;
if(ref($old) && defined $old->{_alt})
{ $orig = $old->{_alt}->{orig} }
else
{ $orig = $old->runtime_prop }
require Storable;
my $runtime_prop = Storable::dclone($orig);
if($runtime_prop->{alt}->{$name})
{
foreach my $key (keys %{ $runtime_prop->{alt}->{$name} })
{
$runtime_prop->{$key} = $runtime_prop->{alt}->{$name}->{$key};
}
}
else
{
Carp::croak("no such alt: $name");
}
$new->{_alt} = {
runtime_prop => $runtime_prop,
orig => $orig,
};
$new;
}
sub alt_names
{
my($class) = @_;
my $alts = $class->runtime_prop->{alt};
defined $alts
? sort keys %$alts
: ();
}
sub alt_exists
{
my($class, $alt_name) = @_;
my $alts = $class->runtime_prop->{alt};
defined $alts
? exists $alts->{$alt_name} && defined $alts->{$alt_name}
: 0;
}
1;
=pod
=encoding UTF-8
=head1 NAME
Alien::Base - Base classes for Alien:: modules
=head1 VERSION
version 2.84
=head1 SYNOPSIS
package Alien::MyLibrary;
use strict;
use warnings;
use parent 'Alien::Base';
1;
(for details on the C<Makefile.PL> or C<Build.PL> and L<alienfile>
that should be bundled with your L<Alien::Base> subclass, please see
L<Alien::Build::Manual::AlienAuthor>).
Then a C<MyLibrary::XS> can use C<Alien::MyLibrary> in its C<Makefile.PL>:
use Alien::MyLibrary
use ExtUtils::MakeMaker;
use Alien::Base::Wrapper qw( Alien::MyLibrary !export );
use Config;
WriteMakefile(
...
Alien::Base::Wrapper->mm_args,
...
);
Or if you prefer L<Module::Build>, in its C<Build.PL>:
use Alien::MyLibrary;
use Module::Build 0.28; # need at least 0.28
use Alien::Base::Wrapper qw( Alien::MyLibrary !export );
my $builder = Module::Build->new(
...
Alien::Base::Wrapper->mb_args,
...
);
$builder->create_build_script;
Or if you are using L<ExtUtils::Depends>:
use ExtUtils::MakeMaker;
use ExtUtils::Depends;
my $eud = ExtUtils::Depends->new(qw( MyLibrary::XS Alien::MyLibrary ));
WriteMakefile(
...
$eud->get_makefile_vars
);
If you are using L<Alien::Base::ModuleBuild> instead of the recommended L<Alien::Build>
and L<alienfile>, then in your C<MyLibrary::XS> module, you may need something like
this in your main C<.pm> file IF your library uses dynamic libraries:
package MyLibrary::XS;
use Alien::MyLibrary; # may only be needed if you are using Alien::Base::ModuleBuild
...
Or you can use it from an FFI module:
package MyLibrary::FFI;
use Alien::MyLibrary;
use FFI::Platypus;
use FFI::CheckLib 0.28 qw( find_lib_or_die );
my $ffi = FFI::Platypus->new;
$ffi->lib(find_lib_or_die lib => 'mylib', alien => ['Alien::MyLibrary']);
$ffi->attach( 'my_library_function' => [] => 'void' );
You can even use it with L<Inline> (C and C++ languages are supported):
package MyLibrary::Inline;
use Alien::MyLibrary;
# Inline 0.56 or better is required
use Inline 0.56 with => 'Alien::MyLibrary';
...
=head1 DESCRIPTION
B<NOTE>: L<Alien::Base::ModuleBuild> is no longer bundled with L<Alien::Base> and has been spun off into a separate distribution.
L<Alien::Base::ModuleBuild> will be a prerequisite for L<Alien::Base> until October 1, 2017. If you are using L<Alien::Base::ModuleBuild>
you need to make sure it is declared as a C<configure_requires> in your C<Build.PL>. You may want to also consider using L<Alien::Base> and
L<alienfile> as a more modern alternative.
L<Alien::Base> comprises base classes to help in the construction of C<Alien::> modules. Modules in the L<Alien> namespace are used to locate and install (if necessary) external libraries needed by other Perl modules.
This is the documentation for the L<Alien::Base> module itself. If you
are starting out you probably want to do so from one of these documents:
=over 4
=item L<Alien::Build::Manual::AlienUser>
For users of an C<Alien::libfoo> that is implemented using L<Alien::Base>.
(The developer of C<Alien::libfoo> I<should> provide the documentation
necessary, but if not, this is the place to start).
=item L<Alien::Build::Manual::AlienAuthor>
If you are writing your own L<Alien> based on L<Alien::Build> and L<Alien::Base>.
=item L<Alien::Build::Manual::FAQ>
If you have a common question that has already been answered, like
"How do I use L<alienfile> with some build system".
=item L<Alien::Build::Manual::PluginAuthor>
This is for the brave souls who want to write plugins that will work with
L<Alien::Build> + L<alienfile>.
=back
Before using an L<Alien::Base> based L<Alien> directly, please consider the following advice:
If you are wanting to use an L<Alien::Base> based L<Alien> with an XS module using L<ExtUtils::MakeMaker> or L<Module::Build>, it is highly
recommended that you use L<Alien::Base::Wrapper>, rather than using the L<Alien> directly, because it handles a number of sharp edges and avoids
pitfalls common when trying to use an L<Alien> directly with L<ExtUtils::MakeMaker>.
In the same vein, if you are wanting to use an L<Alien::Base> based L<Alien> with an XS module using L<Dist::Zilla> it is highly recommended
that you use L<Dist::Zilla::Plugin::AlienBase::Wrapper> for the same reasons.
As of version 0.28, L<FFI::CheckLib> has a good interface for working with L<Alien::Base> based L<Alien>s in fallback mode, which is
recommended.
You should typically only be using an L<Alien::Base> based L<Alien> directly, if you need to integrate it with some other system, or if it
is a tool based L<Alien> that you don't need to link.
The above synopsis and linked manual documents will lead you down the right path, but it is worth knowing before you read further in this
document.
=head1 METHODS
In the example snippets here, C<Alien::MyLibrary> represents any
subclass of L<Alien::Base>.
=head2 dist_dir
my $dir = Alien::MyLibrary->dist_dir;
Returns the directory that contains the install root for
the packaged software, if it was built from install (i.e., if
C<install_type> is C<share>).
=head2 new
my $alien = Alien::MyLibrary->new;
Creates an instance of an L<Alien::Base> object. This is typically
unnecessary.
=head2 cflags
my $cflags = Alien::MyLibrary->cflags;
use Text::ParseWords qw( shellwords );
my @cflags = shellwords( Alien::MyLibrary->cflags );
Returns the C compiler flags necessary to compile an XS
module using the alien software. If you need this in list
form (for example if you are calling system with a list
argument) you can pass this value into C<shellwords> from
the Perl core L<Text::ParseWords> module.
=head2 cflags_static
my $cflags = Alien::MyLibrary->cflags_static;
Same as C<cflags> above, but gets the static compiler flags,
if they are different.
=head2 libs
my $libs = Alien::MyLibrary->libs;
use Text::ParseWords qw( shellwords );
my @cflags = shellwords( Alien::MyLibrary->libs );
Returns the library linker flags necessary to link an XS
module against the alien software. If you need this in list
form (for example if you are calling system with a list
argument) you can pass this value into C<shellwords> from
the Perl core L<Text::ParseWords> module.
=head2 libs_static
my $libs = Alien::MyLibrary->libs_static;
Same as C<libs> above, but gets the static linker flags,
if they are different.
=head2 version
my $version = Alien::MyLibrary->version;
Returns the version of the alienized library or tool that was
determined at install time.
=head2 atleast_version
=head2 exact_version
=head2 max_version
my $ok = Alien::MyLibrary->atleast_version($wanted_version);
my $ok = Alien::MyLibrary->exact_version($wanted_version);
my $ok = Alien::MyLibrary->max_version($wanted_version);
Returns true if the version of the alienized library or tool is at least,
exactly, or at most the version specified, respectively.
=head2 version_cmp
$cmp = Alien::MyLibrary->version_cmp($x, $y)
Comparison method used by L</atleast_version>, L</exact_version> and
L</max_version>. May be useful to implement custom comparisons, or for
subclasses to overload to get different version comparison semantics than the
default rules, for packages that have some other rules than the F<pkg-config>
behaviour.
Should return a number less than, equal to, or greater than zero; similar in
behaviour to the C<< <=> >> and C<cmp> operators.
=head2 install_type
my $install_type = Alien::MyLibrary->install_type;
my $bool = Alien::MyLibrary->install_type($install_type);
Returns the install type that was used when C<Alien::MyLibrary> was
installed.
If a type is provided (the second form in the synopsis)
returns true if the actual install type matches.
For this use case it is recommended to use C<is_system_install>
or C<is_share_install> instead as these are less prone to
typographical errors.
Types include:
=over 4
=item system
The library was provided by the operating system
=item share
The library was not available when C<Alien::MyLibrary> was installed, so
it was built from source code, either downloaded from the Internet
or bundled with C<Alien::MyLibrary>.
=back
=head2 is_system_install
my $type = $build->is_system_install;
Returns true if the alien is a system install type.
=head2 is_share_install
my $type = $build->is_share_install;
Returns true if the alien is a share install type.
=head2 config
my $value = Alien::MyLibrary->config($key);
Returns the configuration data as determined during the install
of C<Alien::MyLibrary>. For the appropriate config keys, see
L<Alien::Base::ModuleBuild::API/"CONFIG DATA">.
This is not typically used by L<Alien::Base> and L<alienfile>,
but a compatible interface will be provided.
=head2 dynamic_libs
my @dlls = Alien::MyLibrary->dynamic_libs;
my($dll) = Alien::MyLibrary->dynamic_libs;
Returns a list of the dynamic library or shared object files for the
alien software.
=head2 bin_dir
my(@dir) = Alien::MyLibrary->bin_dir
Returns a list of directories with executables in them. For a C<system>
install this will be an empty list. For a C<share> install this will be
a directory under C<dist_dir> named C<bin> if it exists. You may wish
to override the default behavior if you have executables or scripts that
get installed into non-standard locations.
Example usage:
use Env qw( @PATH );
unshift @PATH, Alien::MyLibrary->bin_dir;
=head2 dynamic_dir
my(@dir) = Alien::MyLibrary->dynamic_dir
Returns the dynamic dir for a dynamic build (if the main
build is static). For a C<share> install this will be a
directory under C<dist_dir> named C<dynamic> if it exists.
System builds return an empty list.
Example usage:
use Env qw( @PATH );
unshift @PATH, Alien::MyLibrary->dynamic_dir;
=head2 alien_helper
my $helpers = Alien::MyLibrary->alien_helper;
Returns a hash reference of helpers provided by the Alien module.
The keys are helper names and the values are code references. The
code references will be executed at command time and the return value
will be interpolated into the command before execution. The default
implementation returns an empty hash reference, and you are expected
to override the method to create your own helpers.
For use with commands specified in and L<alienfile> or in your C<Build.Pl>
when used with L<Alien::Base::ModuleBuild>.
Helpers allow users of your Alien module to use platform or environment
determined logic to compute command names or arguments in your installer
logic. Helpers allow you to do this without making your Alien module a
requirement when a build from source code is not necessary.
As a concrete example, consider L<Alien::gmake>, which provides the
helper C<gmake>:
package Alien::gmake;
...
sub alien_helper {
my($class) = @_;
return {
gmake => sub {
# return the executable name for GNU make,
# usually either make or gmake depending on
# the platform and environment
$class->exe;
}
},
}
Now consider L<Alien::nasm>. C<nasm> requires GNU Make to build from
source code, but if the system C<nasm> package is installed we don't
need it. From the L<alienfile> of C<Alien::nasm>:
use alienfile;
plugin 'Probe::CommandLine' => (
command => 'nasm',
args => ['-v'],
match => qr/NASM version/,
);
share {
...
plugin 'Extract' => 'tar.gz';
plugin 'Build::MSYS';
build [
'sh configure --prefix=%{alien.install.prefix}',
'%{gmake}',
'%{gmake} install',
];
};
...
=head2 inline_auto_include
my(@headers) = Alien::MyLibrary->inline_auto_include;
List of header files to automatically include in inline C and C++
code when using L<Inline::C> or L<Inline::CPP>. This is provided
as a public interface primarily so that it can be overridden at run
time. This can also be specified in your C<Build.PL> with
L<Alien::Base::ModuleBuild> using the C<alien_inline_auto_include>
property.
=head2 runtime_prop
my $hashref = Alien::MyLibrary->runtime_prop;
Returns a hash reference of the runtime properties computed by L<Alien::Build> during its
install process. If the L<Alien::Base> based L<Alien> was not built using L<Alien::Build>,
then this will return undef.
=head2 alt
my $new_alien = Alien::MyLibrary->alt($alt_name);
my $new_alien = $old_alien->alt($alt_name);
Returns an L<Alien::Base> instance with the alternate configuration.
Some packages come with multiple libraries, and multiple C<.pc> files to
use with them. This method can be used with C<pkg-config> plugins to
access different configurations. (It could also be used with non-pkg-config
based packages too, though there are not as of this writing any build
time plugins that take advantage of this feature).
From your L<alienfile>
use alienfile;
plugin 'PkgConfig' => (
pkg_name => [ 'libfoo', 'libbar', ],
);
Then in your base class works like normal:
package Alien::MyLibrary;
use parent qw( Alien::Base );
1;
Then you can use it:
use Alien::MyLibrary;
my $cflags = Alien::MyLibrary->alt('foo1')->cflags;
my $libs = Alien::MyLibrary->alt('foo1')->libs;
=head2 alt_names
my @alt_names = Alien::MyLibrary->alt_names
Returns the list of all available alternative configuration names.
=head2 alt_exists
my $bool = Alien::MyLibrary->alt_exists($alt_name)
Returns true if the given alternative configuration exists.
=head1 SUPPORT AND CONTRIBUTING
First check the L<Alien::Build::Manual::FAQ> for questions that have already been answered.
IRC: #native on irc.perl.org
L<(click for instant chatroom login)|http://chat.mibbit.com/#native@irc.perl.org>
If you find a bug, please report it on the projects issue tracker on GitHub:
=over 4
=item L<https://github.com/PerlAlien/Alien-Build/issues>
=back
Development is discussed on the projects google groups. This is also
a reasonable place to post a question if you don't want to open an issue
in GitHub.
=over 4
=item L<https://groups.google.com/forum/#!forum/perl5-alien>
=back
If you have implemented a new feature or fixed a bug, please open a pull
request.
=over 4
=item L<https://github.com/PerlAlien/Alien-Build/pulls>
=back
=head1 SEE ALSO
=over
=item *
L<Alien::Build>
=item *
L<alienfile>
=item *
L<Alien>
=item *
L<Alien::Build::Manual::FAQ>
=back
=head1 THANKS
C<Alien::Base> was originally written by Joel Berger, and that
code is still Copyright (C) 2012-2017 Joel Berger. It has the
same license as the rest of the L<Alien::Build>.
Special thanks for the early development of C<Alien::Base> go to:
=over
=item Christian Walde (Mithaldu)
For productive conversations about component interoperability.
=item kmx
For writing Alien::Tidyp from which I drew many of my initial ideas.
=item David Mertens (run4flat)
For productive conversations about implementation.
=item Mark Nunberg (mordy, mnunberg)
For graciously teaching me about rpath and dynamic loading,
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
__POD__
perl5/5.32/AppConfig.pm 0000444 00000077320 15157555625 0010415 0 ustar 00 #============================================================================
#
# AppConfig.pm
#
# Perl5 module for reading and parsing configuration files and command line
# arguments.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#==========================================================================
package AppConfig;
use 5.006;
use strict;
use warnings;
use base 'Exporter';
our $VERSION = '1.71';
# variable expansion constants
use constant EXPAND_NONE => 0;
use constant EXPAND_VAR => 1;
use constant EXPAND_UID => 2;
use constant EXPAND_ENV => 4;
use constant EXPAND_ALL => EXPAND_VAR | EXPAND_UID | EXPAND_ENV;
use constant EXPAND_WARN => 8;
# argument count types
use constant ARGCOUNT_NONE => 0;
use constant ARGCOUNT_ONE => 1;
use constant ARGCOUNT_LIST => 2;
use constant ARGCOUNT_HASH => 3;
# Exporter tagsets
our @EXPAND = qw(
EXPAND_NONE
EXPAND_VAR
EXPAND_UID
EXPAND_ENV
EXPAND_ALL
EXPAND_WARN
);
our @ARGCOUNT = qw(
ARGCOUNT_NONE
ARGCOUNT_ONE
ARGCOUNT_LIST
ARGCOUNT_HASH
);
our @EXPORT_OK = ( @EXPAND, @ARGCOUNT );
our %EXPORT_TAGS = (
expand => [ @EXPAND ],
argcount => [ @ARGCOUNT ],
);
our $AUTOLOAD;
require AppConfig::State;
#------------------------------------------------------------------------
# new(\%config, @vars)
#
# Module constructor. All parameters passed are forwarded onto the
# AppConfig::State constructor. Returns a reference to a newly created
# AppConfig object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
bless {
STATE => AppConfig::State->new(@_)
}, $class;
}
#------------------------------------------------------------------------
# file(@files)
#
# The file() method is called to parse configuration files. An
# AppConfig::File object is instantiated and stored internally for
# use in subsequent calls to file().
#------------------------------------------------------------------------
sub file {
my $self = shift;
my $state = $self->{ STATE };
my $file;
require AppConfig::File;
# create an AppConfig::File object if one isn't defined
$file = $self->{ FILE } ||= AppConfig::File->new($state);
# call on the AppConfig::File object to process files.
$file->parse(@_);
}
#------------------------------------------------------------------------
# args(\@args)
#
# The args() method is called to parse command line arguments. An
# AppConfig::Args object is instantiated and then stored internally for
# use in subsequent calls to args().
#------------------------------------------------------------------------
sub args {
my $self = shift;
my $state = $self->{ STATE };
my $args;
require AppConfig::Args;
# create an AppConfig::Args object if one isn't defined
$args = $self->{ ARGS } ||= AppConfig::Args->new($state);
# call on the AppConfig::Args object to process arguments.
$args->parse(shift);
}
#------------------------------------------------------------------------
# getopt(@config, \@args)
#
# The getopt() method is called to parse command line arguments. The
# AppConfig::Getopt module is require()'d and an AppConfig::Getopt object
# is created to parse the arguments.
#------------------------------------------------------------------------
sub getopt {
my $self = shift;
my $state = $self->{ STATE };
my $getopt;
require AppConfig::Getopt;
# create an AppConfig::Getopt object if one isn't defined
$getopt = $self->{ GETOPT } ||= AppConfig::Getopt->new($state);
# call on the AppConfig::Getopt object to process arguments.
$getopt->parse(@_);
}
#------------------------------------------------------------------------
# cgi($query)
#
# The cgi() method is called to parse a CGI query string. An
# AppConfig::CGI object is instantiated and then stored internally for
# use in subsequent calls to args().
#------------------------------------------------------------------------
sub cgi {
my $self = shift;
my $state = $self->{ STATE };
my $cgi;
require AppConfig::CGI;
# create an AppConfig::CGI object if one isn't defined
$cgi = $self->{ CGI } ||= AppConfig::CGI->new($state);
# call on the AppConfig::CGI object to process a query.
$cgi->parse(shift);
}
#------------------------------------------------------------------------
# AUTOLOAD
#
# Autoload function called whenever an unresolved object method is
# called. All methods are delegated to the $self->{ STATE }
# AppConfig::State object.
#
#------------------------------------------------------------------------
sub AUTOLOAD {
my $self = shift;
my $method;
# splat the leading package name
($method = $AUTOLOAD) =~ s/.*:://;
# ignore destructor
$method eq 'DESTROY' && return;
# delegate method call to AppConfig::State object in $self->{ STATE }
$self->{ STATE }->$method(@_);
}
1;
__END__
=head1 NAME
AppConfig - Perl5 module for reading configuration files and parsing command line arguments.
=head1 SYNOPSIS
use AppConfig;
# create a new AppConfig object
my $config = AppConfig->new( \%cfg );
# define a new variable
$config->define( $varname => \%varopts );
# create/define combined
my $config = AppConfig->new( \%cfg,
$varname => \%varopts,
$varname => \%varopts,
...
);
# set/get the value
$config->set( $varname, $value );
$config->get($varname);
# shortcut form
$config->varname($value);
$config->varname;
# read configuration file
$config->file($file);
# parse command line options
$config->args(\@args); # default to \@ARGV
# advanced command line options with Getopt::Long
$config->getopt(\@args); # default to \@ARGV
# parse CGI parameters (GET method)
$config->cgi($query); # default to $ENV{ QUERY_STRING }
=head1 OVERVIEW
AppConfig is a Perl5 module for managing application configuration
information. It maintains the state of any number of variables and
provides methods for parsing configuration files, command line
arguments and CGI script parameters.
Variables values may be set via configuration files. Variables may be
flags (On/Off), take a single value, or take multiple values stored as a
list or hash. The number of arguments a variable expects is determined
by its configuration when defined.
# flags
verbose
nohelp
debug = On
# single value
home = /home/abw/
# multiple list value
file = /tmp/file1
file = /tmp/file2
# multiple hash value
book camel = Programming Perl
book llama = Learning Perl
The '-' prefix can be used to reset a variable to its default value and
the '+' prefix can be used to set it to 1
-verbose
+debug
Variable, environment variable and tilde (home directory) expansions
can be applied (selectively, if necessary) to the values read from
configuration files:
home = ~ # home directory
nntp = ${NNTPSERVER} # environment variable
html = $home/html # internal variables
img = $html/images
Configuration files may be arranged in blocks as per the style of Win32
"INI" files.
[file]
site = kfs
src = ~/websrc/docs/$site
lib = ~/websrc/lib
dest = ~/public_html/$site
[page]
header = $lib/header
footer = $lib/footer
You can also use Perl's "heredoc" syntax to define a large block of
text in a configuration file.
multiline = <<FOOBAR
line 1
line 2
FOOBAR
paths exe = "${PATH}:${HOME}/.bin"
paths link = <<'FOO'
${LD_LIBARRAY_PATH}:${HOME}/lib
FOO
Variables may also be set by parsing command line arguments.
myapp -verbose -site kfs -file f1 -file f2
AppConfig provides a simple method (args()) for parsing command line
arguments. A second method (getopt()) allows more complex argument
processing by delegation to Johan Vroman's Getopt::Long module.
AppConfig also allows variables to be set by parameters passed to a
CGI script via the URL (GET method).
http://www.nowhere.com/cgi-bin/myapp?verbose&site=kfs
=head1 PREREQUISITES
AppConfig requires Perl 5.005 or later.
The L<Getopt::Long> and L<Test::More> modules should be installed.
If you are using a recent version of Perl (e.g. 5.8.0) then these
should already be installed.
=head1 OBTAINING AND INSTALLING THE AppConfig MODULE BUNDLE
The AppConfig module bundle is available from CPAN. As the 'perlmod'
manual page explains:
CPAN stands for the Comprehensive Perl Archive Network.
This is a globally replicated collection of all known Perl
materials, including hundreds of unbundled modules.
[...]
For an up-to-date listing of CPAN sites, see
http://www.perl.com/perl/ or ftp://ftp.perl.com/perl/ .
Within the CPAN archive, AppConfig is in the category:
12) Option, Argument, Parameter and Configuration File Processing
The module is available in the following directories:
/modules/by-module/AppConfig/AppConfig-<version>.tar.gz
/authors/id/ABW/AppConfig-<version>.tar.gz
AppConfig is distributed as a single gzipped tar archive file:
AppConfig-<version>.tar.gz
Note that "<version>" represents the current AppConfig version
number, of the form "n.nn", e.g. "3.14". See the REVISION section
below to determine the current version number for AppConfig.
Unpack the archive to create a AppConfig installation directory:
gunzip AppConfig-<version>.tar.gz
tar xvf AppConfig-<version>.tar
'cd' into that directory, make, test and install the modules:
cd AppConfig-<version>
perl Makefile.PL
make
make test
make install
The 't' sub-directory contains a number of test scripts that are run when
a 'make test' is run.
The 'make install' will install the module on your system. You may need
administrator privileges to perform this task. If you install the module
in a local directory (for example, by executing "perl Makefile.PL
LIB=~/lib" in the above - see C<perldoc MakeMaker> for full details), you
will need to ensure that the PERL5LIB environment variable is set to
include the location, or add a line to your scripts explicitly naming the
library location:
use lib '/local/path/to/lib';
The 'examples' sub-directory contains some simple examples of using the
AppConfig modules.
=head1 DESCRIPTION
=head2 USING THE AppConfig MODULE
To import and use the L<AppConfig> module the following line should
appear in your Perl script:
use AppConfig;
To import constants defined by the AppConfig module, specify the name of
one or more of the constant or tag sets as parameters to C<use>:
use AppConfig qw(:expand :argcount);
See L<CONSTANT DEFINITIONS> below for more information on the constant
tagsets defined by AppConfig.
AppConfig is implemented using object-oriented methods. A
new AppConfig object is created and initialized using the
new() method. This returns a reference to a new AppConfig
object.
my $config = AppConfig->new();
This will create and return a reference to a new AppConfig object.
In doing so, the AppConfig object also creates an internal reference
to an AppConfig::State object in which to store variable state. All
arguments passed into the AppConfig constructor are passed directly
to the AppConfig::State constructor.
The first (optional) parameter may be a reference to a hash array
containing configuration information.
my $config = AppConfig->new( {
CASE => 1,
ERROR => \&my_error,
GLOBAL => {
DEFAULT => "<unset>",
ARGCOUNT => ARGCOUNT_ONE,
},
} );
See L<AppConfig::State> for full details of the configuration options
available. These are, in brief:
=over 4
=item CASE
Used to set case sensitivity for variable names (default: off).
=item CREATE
Used to indicate that undefined variables should be created automatically
(default: off).
=item GLOBAL
Reference to a hash array of global values used by default when defining
variables. Valid global values are DEFAULT, ARGCOUNT, EXPAND, VALIDATE
and ACTION.
=item PEDANTIC
Used to indicate that command line and configuration file parsing routines
should return immediately on encountering an error.
=item ERROR
Used to provide a error handling routine. Arguments as per printf().
=back
Subsequent parameters may be variable definitions. These are passed
to the define() method, described below in L<DEFINING VARIABLES>.
my $config = AppConfig->new("foo", "bar", "baz");
my $config = AppConfig->new( { CASE => 1 }, qw(foo bar baz) );
Note that any unresolved method calls to AppConfig are automatically
delegated to the AppConfig::State object. In practice, it means that
it is possible to treat the AppConfig object as if it were an
AppConfig::State object:
# create AppConfig
my $config = AppConfig->new('foo', 'bar');
# methods get passed through to internal AppConfig::State
$config->foo(100);
$config->set('bar', 200);
$config->define('baz');
$config->baz(300);
=head2 DEFINING VARIABLES
The C<define()> method (delegated to AppConfig::State) is used to
pre-declare a variable and specify its configuration.
$config->define("foo");
Variables may also be defined directly from the AppConfig new()
constructor.
my $config = AppConfig->new("foo");
In both simple examples above, a new variable called "foo" is defined. A
reference to a hash array may also be passed to specify configuration
information for the variable:
$config->define("foo", {
DEFAULT => 99,
ALIAS => 'metavar1',
});
Configuration items specified in the GLOBAL option to the module
constructor are applied by default when variables are created. e.g.
my $config = AppConfig->new( {
GLOBAL => {
DEFAULT => "<undef>",
ARGCOUNT => ARGCOUNT_ONE,
}
} );
$config->define("foo");
$config->define("bar", { ARGCOUNT => ARGCOUNT_NONE } );
is equivalent to:
my $config = AppConfig->new();
$config->define( "foo", {
DEFAULT => "<undef>",
ARGCOUNT => ARGCOUNT_ONE,
} );
$config->define( "bar",
DEFAULT => "<undef>",
ARGCOUNT => ARGCOUNT_NONE,
} );
Multiple variables may be defined in the same call to define().
Configuration hashes for variables can be omitted.
$config->define("foo", "bar" => { ALIAS = "boozer" }, "baz");
See L<AppConfig::State> for full details of the configuration options
available when defining variables. These are, in brief:
=over
=item DEFAULT
The default value for the variable (default: undef).
=item ALIAS
One or more (list reference or "list|like|this") alternative names for the
variable.
=item ARGCOUNT
Specifies the number and type of arguments that the variable expects.
Constants in C<:expand> tag set define ARGCOUNT_NONE - simple on/off flag
(default), ARGCOUNT_ONE - single value, ARGCOUNT_LIST - multiple values
accessed via list reference, ARGCOUNT_HASH - hash table, "key=value",
accessed via hash reference.
=item ARGS
Used to provide an argument specification string to pass to Getopt::Long
via AppConfig::Getopt. E.g. "=i", ":s", "=s@". This can also be used to
implicitly set the ARGCOUNT value (C</^!/> = ARGCOUNT_NONE, C</@/> =
ARGCOUNT_LIST, C</%/> = ARGCOUNT_HASH, C</[=:].*/> = ARGCOUNT_ONE)
=item EXPAND
Specifies which variable expansion policies should be used when parsing
configuration files. Constants in C<:expand> tag set define:
EXPAND_NONE - no expansion (default)
EXPAND_VAR - expand C<$var> or C<$(var)> as other variables
EXPAND_UID - expand C<~> and C<~uid> as user's home directory
EXPAND_ENV - expand C<${var}> as environment variable
EXPAND_ALL - do all expansions.
=item VALIDATE
Regex which the intended variable value should match or code reference
which returns 1 to indicate successful validation (variable may now be set).
=item ACTION
Code reference to be called whenever variable value changes.
=back
=head2 COMPACT FORMAT DEFINITION
Variables can be specified using a compact format. This is identical to
the specification format of Getopt::Long and is of the form:
"name|alias|alias<argopts>"
The first element indicates the variable name and subsequent ALIAS
values may be added, each separated by a vertical bar '|'.
The E<lt>argoptsE<gt> element indicates the ARGCOUNT value and may be one of
the following;
! ARGCOUNT_NONE
=s ARGCOUNT_ONE
=s@ ARGCOUNT_LIST
=s% ARGCOUNT_HASH
Additional constructs supported by Getopt::Long may be specified instead
of the "=s" element (e.g. "=f"). The entire E<lt>argoptsE<gt> element
is stored in the ARGS parameter for the variable and is passed intact to
Getopt::Long when the getopt() method is called.
The following examples demonstrate use of the compact format, with their
equivalent full specifications:
$config->define("foo|bar|baz!");
$config->define(
"foo" => {
ALIAS => "bar|baz",
ARGCOUNT => ARGCOUNT_NONE,
});
$config->define("name=s");
$config->define(
"name" => {
ARGCOUNT => ARGCOUNT_ONE,
});
$config->define("file|filelist|f=s@");
$config->define(
"file" => {
ALIAS => "filelist|f",
ARGCOUNT => ARGCOUNT_LIST,
});
$config->define("user|u=s%");
$config->define(
"user" => {
ALIAS => "u",
ARGCOUNT => ARGCOUNT_HASH,
});
Additional configuration options may be specified by hash reference, as per
normal. The compact definition format will override any configuration
values provided for ARGS and ARGCOUNT.
$config->define("file|filelist|f=s@", { VALIDATE => \&check_file } );
=head2 READING AND MODIFYING VARIABLE VALUES
AppConfig defines two methods (via AppConfig::State) to manipulate variable
values
set($variable, $value);
get($variable);
Once defined, variables may be accessed directly as object methods where
the method name is the same as the variable name. i.e.
$config->set("verbose", 1);
is equivalent to
$config->verbose(1);
Note that AppConfig defines the following methods:
new();
file();
args();
getopt();
And also, through delegation to AppConfig::State:
define()
get()
set()
varlist()
If you define a variable with one of the above names, you will not be able
to access it directly as an object method. i.e.
$config->file();
This will call the file() method, instead of returning the value of the
'file' variable. You can work around this by explicitly calling get() and
set() on a variable whose name conflicts:
$config->get('file');
or by defining a "safe" alias by which the variable can be accessed:
$config->define("file", { ALIAS => "fileopt" });
or
$config->define("file|fileopt");
...
$config->fileopt();
Without parameters, the current value of the variable is returned. If
a parameter is specified, the variable is set to that value and the
result of the set() operation is returned.
$config->age(29); # sets 'age' to 29, returns 1 (ok)
print $config->age(); # prints "29"
The varlist() method can be used to extract a number of variables into
a hash array. The first parameter should be a regular expression
used for matching against the variable names.
my %vars = $config->varlist("^file"); # all "file*" variables
A second parameter may be specified (any true value) to indicate that
the part of the variable name matching the regex should be removed
when copied to the target hash.
$config->file_name("/tmp/file");
$config->file_path("/foo:/bar:/baz");
my %vars = $config->varlist("^file_", 1);
# %vars:
# name => /tmp/file
# path => "/foo:/bar:/baz"
=head2 READING CONFIGURATION FILES
The AppConfig module provides a streamlined interface for reading
configuration files with the AppConfig::File module. The file() method
automatically loads the AppConfig::File module and creates an object
to process the configuration file or files. Variables stored in the
internal AppConfig::State are automatically updated with values specified
in the configuration file.
$config->file($filename);
Multiple files may be passed to file() and should indicate the file name
or be a reference to an open file handle or glob.
$config->file($filename, $filehandle, \*STDIN, ...);
The file may contain blank lines and comments (prefixed by '#') which
are ignored. Continutation lines may be marked by ending the line with
a '\'.
# this is a comment
callsign = alpha bravo camel delta echo foxtrot golf hipowls \
india juliet kilo llama mike november oscar papa \
quebec romeo sierra tango umbrella victor whiskey \
x-ray yankee zebra
Variables that are simple flags and do not expect an argument (ARGCOUNT =
ARGCOUNT_NONE) can be specified without any value. They will be set with
the value 1, with any value explicitly specified (except "0" and "off")
being ignored. The variable may also be specified with a "no" prefix to
implicitly set the variable to 0.
verbose # on (1)
verbose = 1 # on (1)
verbose = 0 # off (0)
verbose off # off (0)
verbose on # on (1)
verbose mumble # on (1)
noverbose # off (0)
Variables that expect an argument (ARGCOUNT = ARGCOUNT_ONE) will be set to
whatever follows the variable name, up to the end of the current line
(including any continuation lines). An optional equals sign may be inserted
between the variable and value for clarity.
room = /home/kitchen
room /home/bedroom
Each subsequent re-definition of the variable value overwrites the previous
value.
print $config->room(); # prints "/home/bedroom"
Variables may be defined to accept multiple values (ARGCOUNT = ARGCOUNT_LIST).
Each subsequent definition of the variable adds the value to the list of
previously set values for the variable.
drink = coffee
drink = tea
A reference to a list of values is returned when the variable is requested.
my $beverages = $config->drink();
print join(", ", @$beverages); # prints "coffee, tea"
Variables may also be defined as hash lists (ARGCOUNT = ARGCOUNT_HASH).
Each subsequent definition creates a new key and value in the hash array.
alias l="ls -CF"
alias e="emacs"
A reference to the hash is returned when the variable is requested.
my $aliases = $config->alias();
foreach my $k (keys %$aliases) {
print "$k => $aliases->{ $k }\n";
}
The '-' prefix can be used to reset a variable to its default value and
the '+' prefix can be used to set it to 1
-verbose
+debug
=head2 VARIABLE EXPANSION
Variable values may contain references to other AppConfig variables,
environment variables and/or users' home directories. These will be
expanded depending on the EXPAND value for each variable or the GLOBAL
EXPAND value.
Three different expansion types may be applied:
bin = ~/bin # expand '~' to home dir if EXPAND_UID
tmp = ~abw/tmp # as above, but home dir for user 'abw'
perl = $bin/perl # expand value of 'bin' variable if EXPAND_VAR
ripl = $(bin)/ripl # as above with explicit parens
home = ${HOME} # expand HOME environment var if EXPAND_ENV
See L<AppConfig::State> for more information on expanding variable values.
The configuration files may have variables arranged in blocks. A block
header, consisting of the block name in square brackets, introduces a
configuration block. The block name and an underscore are then prefixed
to the names of all variables subsequently referenced in that block. The
block continues until the next block definition or to the end of the current
file.
[block1]
foo = 10 # block1_foo = 10
[block2]
foo = 20 # block2_foo = 20
=head2 PARSING COMMAND LINE OPTIONS
There are two methods for processing command line options. The first,
args(), is a small and efficient implementation which offers basic
functionality. The second, getopt(), offers a more powerful and complete
facility by delegating the task to Johan Vroman's Getopt::Long module.
The trade-off between args() and getopt() is essentially one of speed/size
against flexibility. Use as appropriate. Both implement on-demand loading
of modules and incur no overhead until used.
The args() method is used to parse simple command line options. It
automatically loads the AppConfig::Args module and creates an object
to process the command line arguments. Variables stored in the internal
AppConfig::State are automatically updated with values specified in the
arguments.
The method should be passed a reference to a list of arguments to parse.
The @ARGV array is used if args() is called without parameters.
$config->args(\@myargs);
$config->args(); # uses @ARGV
Arguments are read and shifted from the array until the first is
encountered that is not prefixed by '-' or '--'. At that point, the
method returns 1 to indicate success, leaving any unprocessed arguments
remaining in the list.
Each argument should be the name or alias of a variable prefixed by
'-' or '--'. Arguments that are not prefixed as such (and are not an
additional parameter to a previous argument) will cause a warning to be
raised. If the PEDANTIC option is set, the method will return 0
immediately. With PEDANTIC unset (default), the method will continue
to parse the rest of the arguments, returning 0 when done.
If the variable is a simple flag (ARGCOUNT = ARGCOUNT_NONE)
then it is set to the value 1. The variable may be prefixed by "no" to
set its value to 0.
myprog -verbose --debug -notaste # $config->verbose(1)
# $config->debug(1)
# $config->taste(0)
Variables that expect an additional argument (ARGCOUNT != 0) will be set to
the value of the argument following it.
myprog -f /tmp/myfile # $config->file('/tmp/file');
Variables that expect multiple values (ARGCOUNT = ARGCOUNT_LIST or
ARGCOUNT_HASH) will have successive values added each time the option
is encountered.
myprog -file /tmp/foo -file /tmp/bar # $config->file('/tmp/foo')
# $config->file('/tmp/bar')
# file => [ '/tmp/foo', '/tmp/bar' ]
myprog -door "jim=Jim Morrison" -door "ray=Ray Manzarek"
# $config->door("jim=Jim Morrison");
# $config->door("ray=Ray Manzarek");
# door => { 'jim' => 'Jim Morrison', 'ray' => 'Ray Manzarek' }
See L<AppConfig::Args> for further details on parsing command line
arguments.
The getopt() method provides a way to use the power and flexibility of
the Getopt::Long module to parse command line arguments and have the
internal values of the AppConfig object updates automatically.
The first (non-list reference) parameters may contain a number of
configuration string to pass to Getopt::Long::Configure. A reference
to a list of arguments may additionally be passed or @ARGV is used by
default.
$config->getopt(); # uses @ARGV
$config->getopt(\@myargs);
$config->getopt(qw(auto_abbrev debug)); # uses @ARGV
$config->getopt(qw(debug), \@myargs);
See Getopt::Long for details of the configuration options available.
The getopt() method constructs a specification string for each internal
variable and then initializes Getopt::Long with these values. The
specification string is constructed from the name, any aliases (delimited
by a vertical bar '|') and the value of the ARGS parameter.
$config->define("foo", {
ARGS => "=i",
ALIAS => "bar|baz",
});
# Getopt::Long specification: "foo|bar|baz=i"
Errors and warning generated by the Getopt::Long module are trapped and
handled by the AppConfig error handler. This may be a user-defined
routine installed with the ERROR configuration option.
Please note that the AppConfig::Getopt interface is still experimental
and may not be 100% operational. This is almost undoubtedly due to
problems in AppConfig::Getopt rather than Getopt::Long.
=head2 PARSING CGI PARAMETERS
The cgi() method provides an interface to the AppConfig::CGI module
for updating variable values based on the parameters appended to the
URL for a CGI script. This is commonly known as the CGI
"GET" method. The CGI "POST" method is currently not supported.
Parameter definitions are separated from the CGI script name by a
question mark and from each other by ampersands. Where variables
have specific values, these are appended to the variable with an
equals sign:
http://www.here.com/cgi-bin/myscript?foo=bar&baz=qux&verbose
# $config->foo('bar');
# $config->baz('qux');
# $config->verbose(1);
Certain values specified in a URL must be escaped in the appropriate
manner (see CGI specifications at http://www.w3c.org/ for full details).
The AppConfig::CGI module automatically unescapes the CGI query string
to restore the parameters to their intended values.
http://where.com/mycgi?title=%22The+Wrong+Trousers%22
# $config->title('"The Wrong Trousers"');
Please be considerate of the security implications of providing writable
access to script variables via CGI.
http://rebel.alliance.com/cgi-bin/...
.../send_report?file=%2Fetc%2Fpasswd&email=darth%40empire.com
To avoid any accidental or malicious changing of "private" variables,
define only the "public" variables before calling the cgi() (or any
other) method. Further variables can subsequently be defined which
can not be influenced by the CGI parameters.
$config->define('verbose', 'debug')
$config->cgi(); # can only set verbose and debug
$config->define('email', 'file');
$config->file($cfgfile); # can set verbose, debug, email + file
=head1 CONSTANT DEFINITIONS
A number of constants are defined by the AppConfig module. These may be
accessed directly (e.g. AppConfig::EXPAND_VARS) or by first importing them
into the caller's package. Constants are imported by specifying their
names as arguments to C<use AppConfig> or by importing a set of constants
identified by its "tag set" name.
use AppConfig qw(ARGCOUNT_NONE ARGCOUNT_ONE);
use AppConfig qw(:argcount);
The following tag sets are defined:
=over 4
=item :expand
The ':expand' tagset defines the following constants:
EXPAND_NONE
EXPAND_VAR
EXPAND_UID
EXPAND_ENV
EXPAND_ALL # EXPAND_VAR | EXPAND_UID | EXPAND_ENV
EXPAND_WARN
See AppConfig::File for full details of the use of these constants.
=item :argcount
The ':argcount' tagset defines the following constants:
ARGCOUNT_NONE
ARGCOUNT_ONE
ARGCOUNT_LIST
ARGCOUNT_HASH
See AppConfig::State for full details of the use of these constants.
=back
=head1 REPOSITORY
L<https://github.com/neilbowers/AppConfig>
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<gt>
With contributions from Dave Viner, Ijon Tichy, Axel Gerstmair and
many others whose names have been lost to the sands of time (reminders
welcome).
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<AppConfig::State>, L<AppConfig::File>, L<AppConfig::Args>, L<AppConfig::Getopt>,
L<AppConfig::CGI>, L<Getopt::Long>
=cut
perl5/5.32/XML/SAX/Expat.pm 0000555 00000046305 15157555644 0010726 0 ustar 00
###
# XML::SAX::Expat - SAX2 Driver for Expat (XML::Parser)
# Originally by Robin Berjon
###
package XML::SAX::Expat;
use strict;
use base qw(XML::SAX::Base);
use XML::NamespaceSupport qw();
use XML::Parser qw();
use vars qw($VERSION);
$VERSION = '0.51';
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#
#`,`, Variations on parse `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,#
#```````````````````````````````````````````````````````````````````#
#-------------------------------------------------------------------#
# CharacterStream
#-------------------------------------------------------------------#
sub _parse_characterstream {
my $p = shift;
my $xml = shift;
my $opt = shift;
my $expat = $p->_create_parser($opt);
my $result = $expat->parse($xml);
$p->_cleanup;
return $result;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# ByteStream
#-------------------------------------------------------------------#
sub _parse_bytestream {
my $p = shift;
my $xml = shift;
my $opt = shift;
my $expat = $p->_create_parser($opt);
my $result = $expat->parse($xml);
$p->_cleanup;
return $result;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# String
#-------------------------------------------------------------------#
sub _parse_string {
my $p = shift;
my $xml = shift;
my $opt = shift;
my $expat = $p->_create_parser($opt);
my $result = $expat->parse($xml);
$p->_cleanup;
return $result;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# SystemId
#-------------------------------------------------------------------#
sub _parse_systemid {
my $p = shift;
my $xml = shift;
my $opt = shift;
my $expat = $p->_create_parser($opt);
my $result = $expat->parsefile($xml);
$p->_cleanup;
return $result;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# $p->_create_parser(\%options)
#-------------------------------------------------------------------#
sub _create_parser {
my $self = shift;
my $opt = shift;
die "ParserReference: parser instance ($self) already parsing\n"
if $self->{_InParse};
my $featUri = 'http://xml.org/sax/features/';
my $ppe = ($self->get_feature($featUri . 'external-general-entities') or
$self->get_feature($featUri . 'external-parameter-entities') ) ? 1 : 0;
my $expat = XML::Parser->new( ParseParamEnt => $ppe );
$expat->{__XSE} = $self;
$expat->setHandlers(
Init => \&_handle_init,
Final => \&_handle_final,
Start => \&_handle_start,
End => \&_handle_end,
Char => \&_handle_char,
Comment => \&_handle_comment,
Proc => \&_handle_proc,
CdataStart => \&_handle_start_cdata,
CdataEnd => \&_handle_end_cdata,
Unparsed => \&_handle_unparsed_entity,
Notation => \&_handle_notation_decl,
#ExternEnt
#ExternEntFin
Entity => \&_handle_entity_decl,
Element => \&_handle_element_decl,
Attlist => \&_handle_attr_decl,
Doctype => \&_handle_start_doctype,
DoctypeFin => \&_handle_end_doctype,
XMLDecl => \&_handle_xml_decl,
);
$self->{_InParse} = 1;
$self->{_NodeStack} = [];
$self->{_NSStack} = [];
$self->{_NSHelper} = XML::NamespaceSupport->new({xmlns => 1});
$self->{_started} = 0;
return $expat;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# $p->_cleanup
#-------------------------------------------------------------------#
sub _cleanup {
my $self = shift;
$self->{_InParse} = 0;
delete $self->{_NodeStack};
}
#-------------------------------------------------------------------#
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#
#`,`, Expat Handlers ,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,#
#```````````````````````````````````````````````````````````````````#
#-------------------------------------------------------------------#
# _handle_init
#-------------------------------------------------------------------#
sub _handle_init {
#my $self = shift()->{__XSE};
#my $document = {};
#push @{$self->{_NodeStack}}, $document;
#$self->SUPER::start_document($document);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_final
#-------------------------------------------------------------------#
sub _handle_final {
my $self = shift()->{__XSE};
#my $document = pop @{$self->{_NodeStack}};
return $self->SUPER::end_document({});
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_start
#-------------------------------------------------------------------#
sub _handle_start {
my $self = shift()->{__XSE};
my $e_name = shift;
my %attr = @_;
# start_document data
$self->_handle_start_document({}) unless $self->{_started};
# take care of namespaces
my $nsh = $self->{_NSHelper};
$nsh->push_context;
my @new_ns;
for my $k (grep !index($_, 'xmlns'), keys %attr) {
$k =~ m/^xmlns(:(.*))?$/;
my $prefix = $2 || '';
$nsh->declare_prefix($prefix, $attr{$k});
my $ns = {
Prefix => $prefix,
NamespaceURI => $attr{$k},
};
push @new_ns, $ns;
$self->SUPER::start_prefix_mapping($ns);
}
push @{$self->{_NSStack}}, \@new_ns;
# create the attributes
my %saxattr;
map {
my ($ns,$prefix,$lname) = $nsh->process_attribute_name($_);
$saxattr{'{' . ($ns || '') . '}' . $lname} = {
Name => $_,
LocalName => $lname || '',
Prefix => $prefix || '',
Value => $attr{$_},
NamespaceURI => $ns || '',
};
} keys %attr;
# now the element
my ($ns,$prefix,$lname) = $nsh->process_element_name($e_name);
my $element = {
Name => $e_name,
LocalName => $lname || '',
Prefix => $prefix || '',
NamespaceURI => $ns || '',
Attributes => \%saxattr,
};
push @{$self->{_NodeStack}}, $element;
$self->SUPER::start_element($element);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_end
#-------------------------------------------------------------------#
sub _handle_end {
my $self = shift()->{__XSE};
my %element = %{pop @{$self->{_NodeStack}}};
delete $element{Attributes};
$self->SUPER::end_element(\%element);
my $prev_ns = pop @{$self->{_NSStack}};
for my $ns (@$prev_ns) {
$self->SUPER::end_prefix_mapping( { %$ns } );
}
$self->{_NSHelper}->pop_context;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_char
#-------------------------------------------------------------------#
sub _handle_char {
$_[0]->{__XSE}->_handle_start_document({}) unless $_[0]->{__XSE}->{_started};
$_[0]->{__XSE}->SUPER::characters({ Data => $_[1] });
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_comment
#-------------------------------------------------------------------#
sub _handle_comment {
$_[0]->{__XSE}->_handle_start_document({}) unless $_[0]->{__XSE}->{_started};
$_[0]->{__XSE}->SUPER::comment({ Data => $_[1] });
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_proc
#-------------------------------------------------------------------#
sub _handle_proc {
$_[0]->{__XSE}->_handle_start_document({}) unless $_[0]->{__XSE}->{_started};
$_[0]->{__XSE}->SUPER::processing_instruction({ Target => $_[1], Data => $_[2] });
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_start_cdata
#-------------------------------------------------------------------#
sub _handle_start_cdata {
$_[0]->{__XSE}->SUPER::start_cdata( {} );
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_end_cdata
#-------------------------------------------------------------------#
sub _handle_end_cdata {
$_[0]->{__XSE}->SUPER::end_cdata( {} );
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_xml_decl
#-------------------------------------------------------------------#
sub _handle_xml_decl {
my $self = shift()->{__XSE};
my $version = shift;
my $encoding = shift;
my $standalone = shift;
if (not defined $standalone) { $standalone = ''; }
elsif ($standalone) { $standalone = 'yes'; }
else { $standalone = 'no'; }
my $xd = {
Version => $version,
Encoding => $encoding,
Standalone => $standalone,
};
#$self->SUPER::xml_decl($xd);
$self->_handle_start_document($xd);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_notation_decl
#-------------------------------------------------------------------#
sub _handle_notation_decl {
my $self = shift()->{__XSE};
my $notation = shift;
shift;
my $system = shift;
my $public = shift;
my $not = {
Name => $notation,
PublicId => $public,
SystemId => $system,
};
$self->SUPER::notation_decl($not);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_unparsed_entity
#-------------------------------------------------------------------#
sub _handle_unparsed_entity {
my $self = shift()->{__XSE};
my $name = shift;
my $system = shift;
my $public = shift;
my $notation = shift;
my $ue = {
Name => $name,
PublicId => $public,
SystemId => $system,
Notation => $notation,
};
$self->SUPER::unparsed_entity_decl($ue);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_element_decl
#-------------------------------------------------------------------#
sub _handle_element_decl {
$_[0]->{__XSE}->SUPER::element_decl({ Name => $_[1], Model => "$_[2]" });
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_attr_decl
#-------------------------------------------------------------------#
sub _handle_attr_decl {
my $self = shift()->{__XSE};
my $ename = shift;
my $aname = shift;
my $type = shift;
my $default = shift;
my $fixed = shift;
my ($vd, $value);
if ($fixed) {
$vd = '#FIXED';
$default =~ s/^(?:"|')//; #"
$default =~ s/(?:"|')$//; #"
$value = $default;
}
else {
if ($default =~ m/^#/) {
$vd = $default;
$value = '';
}
else {
$vd = ''; # maybe there's a default ?
$default =~ s/^(?:"|')//; #"
$default =~ s/(?:"|')$//; #"
$value = $default;
}
}
my $at = {
eName => $ename,
aName => $aname,
Type => $type,
ValueDefault => $vd,
Value => $value,
};
$self->SUPER::attribute_decl($at);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_entity_decl
#-------------------------------------------------------------------#
sub _handle_entity_decl {
my $self = shift()->{__XSE};
my $name = shift;
my $val = shift;
my $sys = shift;
my $pub = shift;
my $ndata = shift;
my $isprm = shift;
# deal with param ents
if ($isprm) {
$name = '%' . $name;
}
# int vs ext
if ($val) {
my $ent = {
Name => $name,
Value => $val,
};
$self->SUPER::internal_entity_decl($ent);
}
else {
my $ent = {
Name => $name,
PublicId => $pub || '',
SystemId => $sys,
};
$self->SUPER::external_entity_decl($ent);
}
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_start_doctype
#-------------------------------------------------------------------#
sub _handle_start_doctype {
my $self = shift()->{__XSE};
my $name = shift;
my $sys = shift;
my $pub = shift;
$self->_handle_start_document({}) unless $self->{_started};
my $dtd = {
Name => $name,
SystemId => $sys,
PublicId => $pub,
};
$self->SUPER::start_dtd($dtd);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_end_doctype
#-------------------------------------------------------------------#
sub _handle_end_doctype {
$_[0]->{__XSE}->SUPER::end_dtd( {} );
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# _handle_start_document
#-------------------------------------------------------------------#
sub _handle_start_document {
$_[0]->SUPER::start_document($_[1]);
$_[0]->{_started} = 1;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# supported_features
#-------------------------------------------------------------------#
sub supported_features {
return (
$_[0]->SUPER::supported_features,
'http://xml.org/sax/features/external-general-entities',
'http://xml.org/sax/features/external-parameter-entities',
);
}
#-------------------------------------------------------------------#
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#
#`,`, Private Helpers `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,#
#```````````````````````````````````````````````````````````````````#
#-------------------------------------------------------------------#
# _create_node
#-------------------------------------------------------------------#
#sub _create_node {
# shift;
# # this may check for a factory later
# return {@_};
#}
#-------------------------------------------------------------------#
1;
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,#
#`,`, Documentation `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,#
#```````````````````````````````````````````````````````````````````#
=pod
=head1 NAME
XML::SAX::Expat - SAX2 Driver for Expat (XML::Parser)
=head1 SYNOPSIS
use XML::SAX::Expat;
use XML::SAX::MyFooHandler;
my $h = XML::SAX::MyFooHandler->new;
my $p = XML::SAX::Expat->new(Handler => $h);
$p->parse_file('/path/to/foo.xml');
=head1 DESCRIPTION
This is an implementation of a SAX2 driver sitting on top of Expat
(XML::Parser) which Ken MacLeod posted to perl-xml and which I have
updated.
It is still incomplete, though most of the basic SAX2 events should be
available. The SAX2 spec is currently available from L<http://perl-xml.sourceforge.net/perl-sax/>.
A more friendly URL as well as a PODification of the spec are in the
works.
=head1 METHODS
The methods defined in this class correspond to those listed in the
PerlSAX2 specification, available above.
=head1 FEATURES AND CAVEATS
=over 2
=item supported_features
Returns:
* http://xml.org/sax/features/external-general-entities
* http://xml.org/sax/features/external-parameter-entities
* [ Features supported by ancestors ]
Turning one of the first two on also turns the other on (this maps
to the XML::Parser ParseParamEnts option). This may be fixed in the
future, so don't rely on this behaviour.
=back
=head1 MISSING PARTS
XML::Parser has no listed callbacks for the following events, which
are therefore not presently generated (ways may be found in the
future):
* ignorable_whitespace
* skipped_entity
* start_entity / end_entity
* resolve_entity
Ways of signalling them are welcome. In addition to those,
set_document_locator is not yet called.
=head1 TODO
- reuse Ken's tests and add more
=head1 AUTHOR
Robin Berjon; stolen from Ken Macleod, ken@bitsko.slc.ut.us, and with
suggestions and feedback from perl-xml. Currently maintained by Bjoern
Hoehrmann, L<http://bjoern.hoehrmann.de/>.
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2001-2008 Robin Berjon. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
=head1 SEE ALSO
XML::Parser::PerlSAX
=cut
perl5/5.32/XML/SAX/ParserDetails.ini 0000644 00000000574 15157555651 0012545 0 ustar 00 [XML::SAX::PurePerl]
http://xml.org/sax/features/namespaces = 1
[XML::SAX::Expat]
http://xml.org/sax/features/namespaces = 1
http://xml.org/sax/features/external-parameter-entities = 1
http://xml.org/sax/features/external-general-entities = 1
[XML::LibXML::SAX::Parser]
http://xml.org/sax/features/namespaces = 1
[XML::LibXML::SAX]
http://xml.org/sax/features/namespaces = 1
perl5/5.32/XML/SAX/ParserFactory.pm 0000444 00000014607 15157555656 0012431 0 ustar 00 # $Id$
package XML::SAX::ParserFactory;
use strict;
use vars qw($VERSION);
$VERSION = '1.02';
use Symbol qw(gensym);
use XML::SAX;
use XML::SAX::Exception;
sub new {
my $class = shift;
my %params = @_; # TODO : Fix this in spec.
my $self = bless \%params, $class;
$self->{KnownParsers} = XML::SAX->parsers();
return $self;
}
sub parser {
my $self = shift;
my @parser_params = @_;
if (!ref($self)) {
$self = $self->new();
}
my $parser_class = $self->_parser_class();
my $version = '';
if ($parser_class =~ s/\s*\(([\d\.]+)\)\s*$//) {
$version = " $1";
}
if (!$parser_class->can('new')) {
eval "require $parser_class $version;";
die $@ if $@;
}
return $parser_class->new(@parser_params);
}
sub require_feature {
my $self = shift;
my ($feature) = @_;
$self->{RequiredFeatures}{$feature}++;
return $self;
}
sub _parser_class {
my $self = shift;
# First try ParserPackage
if ($XML::SAX::ParserPackage) {
return $XML::SAX::ParserPackage;
}
# Now check if required/preferred is there
if ($self->{RequiredFeatures}) {
my %required = %{$self->{RequiredFeatures}};
# note - we never go onto the next try (ParserDetails.ini),
# because if we can't provide the requested feature
# we need to throw an exception.
PARSER:
foreach my $parser (reverse @{$self->{KnownParsers}}) {
foreach my $feature (keys %required) {
if (!exists $parser->{Features}{$feature}) {
next PARSER;
}
}
# got here - all features must exist!
return $parser->{Name};
}
# TODO : should this be NotSupported() ?
throw XML::SAX::Exception (
Message => "Unable to provide required features",
);
}
# Next try SAX.ini
for my $dir (@INC) {
my $fh = gensym();
if (open($fh, "$dir/SAX.ini")) {
my $param_list = XML::SAX->_parse_ini_file($fh);
my $params = $param_list->[0]->{Features};
if ($params->{ParserPackage}) {
return $params->{ParserPackage};
}
else {
# we have required features (or nothing?)
PARSER:
foreach my $parser (reverse @{$self->{KnownParsers}}) {
foreach my $feature (keys %$params) {
if (!exists $parser->{Features}{$feature}) {
next PARSER;
}
}
return $parser->{Name};
}
XML::SAX->do_warn("Unable to provide SAX.ini required features. Using fallback\n");
}
last; # stop after first INI found
}
}
if (@{$self->{KnownParsers}}) {
return $self->{KnownParsers}[-1]{Name};
}
else {
return "XML::SAX::PurePerl"; # backup plan!
}
}
1;
__END__
=head1 NAME
XML::SAX::ParserFactory - Obtain a SAX parser
=head1 SYNOPSIS
use XML::SAX::ParserFactory;
use XML::SAX::XYZHandler;
my $handler = XML::SAX::XYZHandler->new();
my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
$p->parse_uri("foo.xml");
# or $p->parse_string("<foo/>") or $p->parse_file($fh);
=head1 DESCRIPTION
XML::SAX::ParserFactory is a factory class for providing an application
with a Perl SAX2 XML parser. It is akin to DBI - a front end for other
parser classes. Each new SAX2 parser installed will register itself
with XML::SAX, and then it will become available to all applications
that use XML::SAX::ParserFactory to obtain a SAX parser.
Unlike DBI however, XML/SAX parsers almost all work alike (especially
if they subclass XML::SAX::Base, as they should), so rather than
specifying the parser you want in the call to C<parser()>, XML::SAX
has several ways to automatically choose which parser to use:
=over 4
=item * $XML::SAX::ParserPackage
If this package variable is set, then this package is C<require()>d
and an instance of this package is returned by calling the C<new()>
class method in that package. If it cannot be loaded or there is
an error, an exception will be thrown. The variable can also contain
a version number:
$XML::SAX::ParserPackage = "XML::SAX::Expat (0.72)";
And the number will be treated as a minimum version number.
=item * Required features
It is possible to require features from the parsers. For example, you
may wish for a parser that supports validation via a DTD. To do that,
use the following code:
use XML::SAX::ParserFactory;
my $factory = XML::SAX::ParserFactory->new();
$factory->require_feature('http://xml.org/sax/features/validation');
my $parser = $factory->parser(...);
Alternatively, specify the required features in the call to the
ParserFactory constructor:
my $factory = XML::SAX::ParserFactory->new(
RequiredFeatures => {
'http://xml.org/sax/features/validation' => 1,
}
);
If the features you have asked for are unavailable (for example the
user might not have a validating parser installed), then an
exception will be thrown.
The list of known parsers is searched in reverse order, so it will
always return the last installed parser that supports all of your
requested features (Note: this is subject to change if someone
comes up with a better way of making this work).
=item * SAX.ini
ParserFactory will search @INC for a file called SAX.ini, which
is in a simple format:
# a comment looks like this,
; or like this, and are stripped anywhere in the file
key = value # SAX.in contains key/value pairs.
All whitespace is non-significant.
This file can contain either a line:
ParserPackage = MyParserModule (1.02)
Where MyParserModule is the module to load and use for the parser,
and the number in brackets is a minimum version to load.
Or you can list required features:
http://xml.org/sax/features/validation = 1
And each feature with a true value will be required.
=item * Fallback
If none of the above works, the last parser installed on the user's
system will be used. The XML::SAX package ships with a pure perl
XML parser, XML::SAX::PurePerl, so that there will always be a
fallback parser.
=back
=head1 AUTHOR
Matt Sergeant, matt@sergeant.org
=head1 LICENSE
This is free software, you may use it and distribute it under the same
terms as Perl itself.
=cut
perl5/5.32/XML/SAX/PurePerl/EncodingDetect.pm 0000444 00000005104 15157555671 0014247 0 ustar 00 # $Id$
package XML::SAX::PurePerl; # NB, not ::EncodingDetect!
use strict;
sub encoding_detect {
my ($parser, $reader) = @_;
my $error = "Invalid byte sequence at start of file";
my $data = $reader->data;
if ($data =~ /^\x00\x00\xFE\xFF/) {
# BO-UCS4-be
$reader->move_along(4);
$reader->set_encoding('UCS-4BE');
return;
}
elsif ($data =~ /^\x00\x00\xFF\xFE/) {
# BO-UCS-4-2143
$reader->move_along(4);
$reader->set_encoding('UCS-4-2143');
return;
}
elsif ($data =~ /^\x00\x00\x00\x3C/) {
$reader->set_encoding('UCS-4BE');
return;
}
elsif ($data =~ /^\x00\x00\x3C\x00/) {
$reader->set_encoding('UCS-4-2143');
return;
}
elsif ($data =~ /^\x00\x3C\x00\x00/) {
$reader->set_encoding('UCS-4-3412');
return;
}
elsif ($data =~ /^\x00\x3C\x00\x3F/) {
$reader->set_encoding('UTF-16BE');
return;
}
elsif ($data =~ /^\xFF\xFE\x00\x00/) {
# BO-UCS-4LE
$reader->move_along(4);
$reader->set_encoding('UCS-4LE');
return;
}
elsif ($data =~ /^\xFF\xFE/) {
$reader->move_along(2);
$reader->set_encoding('UTF-16LE');
return;
}
elsif ($data =~ /^\xFE\xFF\x00\x00/) {
$reader->move_along(4);
$reader->set_encoding('UCS-4-3412');
return;
}
elsif ($data =~ /^\xFE\xFF/) {
$reader->move_along(2);
$reader->set_encoding('UTF-16BE');
return;
}
elsif ($data =~ /^\xEF\xBB\xBF/) { # UTF-8 BOM
$reader->move_along(3);
$reader->set_encoding('UTF-8');
return;
}
elsif ($data =~ /^\x3C\x00\x00\x00/) {
$reader->set_encoding('UCS-4LE');
return;
}
elsif ($data =~ /^\x3C\x00\x3F\x00/) {
$reader->set_encoding('UTF-16LE');
return;
}
elsif ($data =~ /^\x3C\x3F\x78\x6D/) {
# $reader->set_encoding('UTF-8');
return;
}
elsif ($data =~ /^\x3C\x3F\x78/) {
# $reader->set_encoding('UTF-8');
return;
}
elsif ($data =~ /^\x3C\x3F/) {
# $reader->set_encoding('UTF-8');
return;
}
elsif ($data =~ /^\x3C/) {
# $reader->set_encoding('UTF-8');
return;
}
elsif ($data =~ /^[\x20\x09\x0A\x0D]+\x3C[^\x3F]/) {
# $reader->set_encoding('UTF-8');
return;
}
elsif ($data =~ /^\x4C\x6F\xA7\x94/) {
$reader->set_encoding('EBCDIC');
return;
}
warn("Unable to recognise encoding of this document");
return;
}
1;
perl5/5.32/XML/SAX/PurePerl/Reader.pm 0000444 00000004755 15157555676 0012612 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Reader;
use strict;
use XML::SAX::PurePerl::Reader::URI;
use Exporter ();
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(
EOF
BUFFER
LINE
COLUMN
ENCODING
XML_VERSION
);
use constant EOF => 0;
use constant BUFFER => 1;
use constant LINE => 2;
use constant COLUMN => 3;
use constant ENCODING => 4;
use constant SYSTEM_ID => 5;
use constant PUBLIC_ID => 6;
use constant XML_VERSION => 7;
require XML::SAX::PurePerl::Reader::Stream;
require XML::SAX::PurePerl::Reader::String;
if ($] >= 5.007002) {
require XML::SAX::PurePerl::Reader::UnicodeExt;
}
else {
require XML::SAX::PurePerl::Reader::NoUnicodeExt;
}
sub new {
my $class = shift;
my $thing = shift;
# try to figure if this $thing is a handle of some sort
if (ref($thing) && UNIVERSAL::isa($thing, 'IO::Handle')) {
return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
}
my $ioref;
if (tied($thing)) {
my $class = ref($thing);
no strict 'refs';
$ioref = $thing if defined &{"${class}::TIEHANDLE"};
}
else {
eval {
$ioref = *{$thing}{IO};
};
undef $@;
}
if ($ioref) {
return XML::SAX::PurePerl::Reader::Stream->new($thing)->init;
}
if ($thing =~ /</) {
# assume it's a string
return XML::SAX::PurePerl::Reader::String->new($thing)->init;
}
# assume it is a uri
return XML::SAX::PurePerl::Reader::URI->new($thing)->init;
}
sub init {
my $self = shift;
$self->[LINE] = 1;
$self->[COLUMN] = 1;
$self->read_more;
return $self;
}
sub data {
my ($self, $min_length) = (@_, 1);
if (length($self->[BUFFER]) < $min_length) {
$self->read_more;
}
return $self->[BUFFER];
}
sub match {
my ($self, $char) = @_;
my $data = $self->data;
if (substr($data, 0, 1) eq $char) {
$self->move_along(1);
return 1;
}
return 0;
}
sub public_id {
my $self = shift;
@_ and $self->[PUBLIC_ID] = shift;
$self->[PUBLIC_ID];
}
sub system_id {
my $self = shift;
@_ and $self->[SYSTEM_ID] = shift;
$self->[SYSTEM_ID];
}
sub line {
shift->[LINE];
}
sub column {
shift->[COLUMN];
}
sub get_encoding {
my $self = shift;
return $self->[ENCODING];
}
sub get_xml_version {
my $self = shift;
return $self->[XML_VERSION];
}
1;
__END__
=head1 NAME
XML::Parser::PurePerl::Reader - Abstract Reader factory class
=cut
perl5/5.32/XML/SAX/PurePerl/Productions.pm 0000444 00000014737 15157555703 0013711 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Productions;
use Exporter;
@ISA = ('Exporter');
@EXPORT_OK = qw($S $Char $VersionNum $BaseChar $Ideographic
$Extender $Digit $CombiningChar $EncNameStart $EncNameEnd $NameChar $CharMinusDash
$PubidChar $Any $SingleChar);
### WARNING!!! All productions here must *only* match a *single* character!!! ###
BEGIN {
$S = qr/[\x20\x09\x0D\x0A]/;
$CharMinusDash = qr/[^-]/x;
$Any = qr/ . /xms;
$VersionNum = qr/ [a-zA-Z0-9_.:-]+ /x;
$EncNameStart = qr/ [A-Za-z] /x;
$EncNameEnd = qr/ [A-Za-z0-9\._-] /x;
$PubidChar = qr/ [\x20\x0D\x0Aa-zA-Z0-9'()\+,.\/:=\?;!*\#@\$_\%-] /x;
if ($] < 5.006) {
eval <<' PERL';
$Char = qr/^ [\x09\x0A\x0D\x20-\x7F]|([\xC0-\xFD][\x80-\xBF]+) $/x;
$SingleChar = qr/^$Char$/;
$BaseChar = qr/ [\x41-\x5A\x61-\x7A]|([\xC0-\xFD][\x80-\xBF]+) /x;
$Extender = qr/ \xB7 /x;
$Digit = qr/ [\x30-\x39] /x;
# can't do this one without unicode
# $CombiningChar = qr/^$/msx;
$NameChar = qr/^ (?: $BaseChar | $Digit | [._:-] | $Extender )+ $/x;
PERL
die $@ if $@;
}
else {
eval <<' PERL';
use utf8; # for 5.6
$Char = qr/^ [\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}] $/x;
$SingleChar = qr/^$Char$/;
$BaseChar = qr/
[\x{0041}-\x{005A}\x{0061}-\x{007A}\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}] |
[\x{00F8}-\x{00FF}\x{0100}-\x{0131}\x{0134}-\x{013E}\x{0141}-\x{0148}] |
[\x{014A}-\x{017E}\x{0180}-\x{01C3}\x{01CD}-\x{01F0}\x{01F4}-\x{01F5}] |
[\x{01FA}-\x{0217}\x{0250}-\x{02A8}\x{02BB}-\x{02C1}\x{0386}\x{0388}-\x{038A}] |
[\x{038C}\x{038E}-\x{03A1}\x{03A3}-\x{03CE}\x{03D0}-\x{03D6}\x{03DA}] |
[\x{03DC}\x{03DE}\x{03E0}\x{03E2}-\x{03F3}\x{0401}-\x{040C}\x{040E}-\x{044F}] |
[\x{0451}-\x{045C}\x{045E}-\x{0481}\x{0490}-\x{04C4}\x{04C7}-\x{04C8}] |
[\x{04CB}-\x{04CC}\x{04D0}-\x{04EB}\x{04EE}-\x{04F5}\x{04F8}-\x{04F9}] |
[\x{0531}-\x{0556}\x{0559}\x{0561}-\x{0586}\x{05D0}-\x{05EA}\x{05F0}-\x{05F2}] |
[\x{0621}-\x{063A}\x{0641}-\x{064A}\x{0671}-\x{06B7}\x{06BA}-\x{06BE}] |
[\x{06C0}-\x{06CE}\x{06D0}-\x{06D3}\x{06D5}\x{06E5}-\x{06E6}\x{0905}-\x{0939}] |
[\x{093D}\x{0958}-\x{0961}\x{0985}-\x{098C}\x{098F}-\x{0990}] |
[\x{0993}-\x{09A8}\x{09AA}-\x{09B0}\x{09B2}\x{09B6}-\x{09B9}\x{09DC}-\x{09DD}] |
[\x{09DF}-\x{09E1}\x{09F0}-\x{09F1}\x{0A05}-\x{0A0A}\x{0A0F}-\x{0A10}] |
[\x{0A13}-\x{0A28}\x{0A2A}-\x{0A30}\x{0A32}-\x{0A33}\x{0A35}-\x{0A36}] |
[\x{0A38}-\x{0A39}\x{0A59}-\x{0A5C}\x{0A5E}\x{0A72}-\x{0A74}\x{0A85}-\x{0A8B}] |
[\x{0A8D}\x{0A8F}-\x{0A91}\x{0A93}-\x{0AA8}\x{0AAA}-\x{0AB0}] |
[\x{0AB2}-\x{0AB3}\x{0AB5}-\x{0AB9}\x{0ABD}\x{0AE0}\x{0B05}-\x{0B0C}] |
[\x{0B0F}-\x{0B10}\x{0B13}-\x{0B28}\x{0B2A}-\x{0B30}\x{0B32}-\x{0B33}] |
[\x{0B36}-\x{0B39}\x{0B3D}\x{0B5C}-\x{0B5D}\x{0B5F}-\x{0B61}\x{0B85}-\x{0B8A}] |
[\x{0B8E}-\x{0B90}\x{0B92}-\x{0B95}\x{0B99}-\x{0B9A}\x{0B9C}] |
[\x{0B9E}-\x{0B9F}\x{0BA3}-\x{0BA4}\x{0BA8}-\x{0BAA}\x{0BAE}-\x{0BB5}] |
[\x{0BB7}-\x{0BB9}\x{0C05}-\x{0C0C}\x{0C0E}-\x{0C10}\x{0C12}-\x{0C28}] |
[\x{0C2A}-\x{0C33}\x{0C35}-\x{0C39}\x{0C60}-\x{0C61}\x{0C85}-\x{0C8C}] |
[\x{0C8E}-\x{0C90}\x{0C92}-\x{0CA8}\x{0CAA}-\x{0CB3}\x{0CB5}-\x{0CB9}\x{0CDE}] |
[\x{0CE0}-\x{0CE1}\x{0D05}-\x{0D0C}\x{0D0E}-\x{0D10}\x{0D12}-\x{0D28}] |
[\x{0D2A}-\x{0D39}\x{0D60}-\x{0D61}\x{0E01}-\x{0E2E}\x{0E30}\x{0E32}-\x{0E33}] |
[\x{0E40}-\x{0E45}\x{0E81}-\x{0E82}\x{0E84}\x{0E87}-\x{0E88}\x{0E8A}] |
[\x{0E8D}\x{0E94}-\x{0E97}\x{0E99}-\x{0E9F}\x{0EA1}-\x{0EA3}\x{0EA5}\x{0EA7}] |
[\x{0EAA}-\x{0EAB}\x{0EAD}-\x{0EAE}\x{0EB0}\x{0EB2}-\x{0EB3}\x{0EBD}] |
[\x{0EC0}-\x{0EC4}\x{0F40}-\x{0F47}\x{0F49}-\x{0F69}\x{10A0}-\x{10C5}] |
[\x{10D0}-\x{10F6}\x{1100}\x{1102}-\x{1103}\x{1105}-\x{1107}\x{1109}] |
[\x{110B}-\x{110C}\x{110E}-\x{1112}\x{113C}\x{113E}\x{1140}\x{114C}\x{114E}] |
[\x{1150}\x{1154}-\x{1155}\x{1159}\x{115F}-\x{1161}\x{1163}\x{1165}] |
[\x{1167}\x{1169}\x{116D}-\x{116E}\x{1172}-\x{1173}\x{1175}\x{119E}\x{11A8}] |
[\x{11AB}\x{11AE}-\x{11AF}\x{11B7}-\x{11B8}\x{11BA}\x{11BC}-\x{11C2}] |
[\x{11EB}\x{11F0}\x{11F9}\x{1E00}-\x{1E9B}\x{1EA0}-\x{1EF9}\x{1F00}-\x{1F15}] |
[\x{1F18}-\x{1F1D}\x{1F20}-\x{1F45}\x{1F48}-\x{1F4D}\x{1F50}-\x{1F57}] |
[\x{1F59}\x{1F5B}\x{1F5D}\x{1F5F}-\x{1F7D}\x{1F80}-\x{1FB4}\x{1FB6}-\x{1FBC}] |
[\x{1FBE}\x{1FC2}-\x{1FC4}\x{1FC6}-\x{1FCC}\x{1FD0}-\x{1FD3}] |
[\x{1FD6}-\x{1FDB}\x{1FE0}-\x{1FEC}\x{1FF2}-\x{1FF4}\x{1FF6}-\x{1FFC}] |
[\x{2126}\x{212A}-\x{212B}\x{212E}\x{2180}-\x{2182}\x{3041}-\x{3094}] |
[\x{30A1}-\x{30FA}\x{3105}-\x{312C}\x{AC00}-\x{D7A3}]
/x;
$Extender = qr/
[\x{00B7}\x{02D0}\x{02D1}\x{0387}\x{0640}\x{0E46}\x{0EC6}\x{3005}\x{3031}-\x{3035}\x{309D}-\x{309E}\x{30FC}-\x{30FE}]
/x;
$Digit = qr/
[\x{0030}-\x{0039}\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{0966}-\x{096F}] |
[\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}] |
[\x{0BE7}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}] |
[\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}]
/x;
$CombiningChar = qr/
[\x{0300}-\x{0345}\x{0360}-\x{0361}\x{0483}-\x{0486}\x{0591}-\x{05A1}] |
[\x{05A3}-\x{05B9}\x{05BB}-\x{05BD}\x{05BF}\x{05C1}-\x{05C2}\x{05C4}] |
[\x{064B}-\x{0652}\x{0670}\x{06D6}-\x{06DC}\x{06DD}-\x{06DF}\x{06E0}-\x{06E4}] |
[\x{06E7}-\x{06E8}\x{06EA}-\x{06ED}\x{0901}-\x{0903}\x{093C}] |
[\x{093E}-\x{094C}\x{094D}\x{0951}-\x{0954}\x{0962}-\x{0963}\x{0981}-\x{0983}] |
[\x{09BC}\x{09BE}\x{09BF}\x{09C0}-\x{09C4}\x{09C7}-\x{09C8}] |
[\x{09CB}-\x{09CD}\x{09D7}\x{09E2}-\x{09E3}\x{0A02}\x{0A3C}\x{0A3E}\x{0A3F}] |
[\x{0A40}-\x{0A42}\x{0A47}-\x{0A48}\x{0A4B}-\x{0A4D}\x{0A70}-\x{0A71}] |
[\x{0A81}-\x{0A83}\x{0ABC}\x{0ABE}-\x{0AC5}\x{0AC7}-\x{0AC9}\x{0ACB}-\x{0ACD}] |
[\x{0B01}-\x{0B03}\x{0B3C}\x{0B3E}-\x{0B43}\x{0B47}-\x{0B48}] |
[\x{0B4B}-\x{0B4D}\x{0B56}-\x{0B57}\x{0B82}-\x{0B83}\x{0BBE}-\x{0BC2}] |
[\x{0BC6}-\x{0BC8}\x{0BCA}-\x{0BCD}\x{0BD7}\x{0C01}-\x{0C03}\x{0C3E}-\x{0C44}] |
[\x{0C46}-\x{0C48}\x{0C4A}-\x{0C4D}\x{0C55}-\x{0C56}\x{0C82}-\x{0C83}] |
[\x{0CBE}-\x{0CC4}\x{0CC6}-\x{0CC8}\x{0CCA}-\x{0CCD}\x{0CD5}-\x{0CD6}] |
[\x{0D02}-\x{0D03}\x{0D3E}-\x{0D43}\x{0D46}-\x{0D48}\x{0D4A}-\x{0D4D}\x{0D57}] |
[\x{0E31}\x{0E34}-\x{0E3A}\x{0E47}-\x{0E4E}\x{0EB1}\x{0EB4}-\x{0EB9}] |
[\x{0EBB}-\x{0EBC}\x{0EC8}-\x{0ECD}\x{0F18}-\x{0F19}\x{0F35}\x{0F37}\x{0F39}] |
[\x{0F3E}\x{0F3F}\x{0F71}-\x{0F84}\x{0F86}-\x{0F8B}\x{0F90}-\x{0F95}] |
[\x{0F97}\x{0F99}-\x{0FAD}\x{0FB1}-\x{0FB7}\x{0FB9}\x{20D0}-\x{20DC}\x{20E1}] |
[\x{302A}-\x{302F}\x{3099}\x{309A}]
/x;
$Ideographic = qr/
[\x{4E00}-\x{9FA5}\x{3007}\x{3021}-\x{3029}]
/x;
$NameChar = qr/^ (?: $BaseChar | $Ideographic | $Digit | [._:-] | $CombiningChar | $Extender )+ $/x;
PERL
die $@ if $@;
}
}
1;
perl5/5.32/XML/SAX/PurePerl/Reader/URI.pm 0000444 00000002666 15157555715 0013242 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Reader::URI;
use strict;
use XML::SAX::PurePerl::Reader;
use File::Temp qw(tempfile);
use Symbol;
## NOTE: This is *not* a subclass of Reader. It just returns Stream or String
## Reader objects depending on what it's capabilities are.
sub new {
my $class = shift;
my $uri = shift;
# request the URI
if (-e $uri && -f _) {
my $fh = gensym;
open($fh, $uri) || die "Cannot open file $uri : $!";
return XML::SAX::PurePerl::Reader::Stream->new($fh);
}
elsif ($uri =~ /^file:(.*)$/ && -e $1 && -f _) {
my $file = $1;
my $fh = gensym;
open($fh, $file) || die "Cannot open file $file : $!";
return XML::SAX::PurePerl::Reader::Stream->new($fh);
}
else {
# request URI, return String reader
require LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("Perl/XML/SAX/PurePerl/1.0 " . $ua->agent);
my $req = HTTP::Request->new(GET => $uri);
my $fh = tempfile();
my $callback = sub {
my ($data, $response, $protocol) = @_;
print $fh $data;
};
my $res = $ua->request($req, $callback, 4096);
if ($res->is_success) {
seek($fh, 0, 0);
return XML::SAX::PurePerl::Reader::Stream->new($fh);
}
else {
die "LWP Request Failed";
}
}
}
1;
perl5/5.32/XML/SAX/PurePerl/Reader/UnicodeExt.pm 0000444 00000000506 15157555722 0014637 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Reader;
use strict;
use Encode ();
sub set_raw_stream {
my ($fh) = @_;
binmode($fh, ":bytes");
}
sub switch_encoding_stream {
my ($fh, $encoding) = @_;
binmode($fh, ":encoding($encoding)");
}
sub switch_encoding_string {
$_[0] = Encode::decode($_[1], $_[0]);
}
1;
perl5/5.32/XML/SAX/PurePerl/Reader/String.pm 0000444 00000003233 15157555727 0014043 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Reader::String;
use strict;
use vars qw(@ISA);
use XML::SAX::PurePerl::Reader qw(
LINE
COLUMN
BUFFER
ENCODING
EOF
);
@ISA = ('XML::SAX::PurePerl::Reader');
use constant DISCARDED => 8;
use constant STRING => 9;
use constant USED => 10;
use constant CHUNK_SIZE => 2048;
sub new {
my $class = shift;
my $string = shift;
my @parts;
@parts[BUFFER, EOF, LINE, COLUMN, DISCARDED, STRING, USED] =
('', 0, 1, 0, 0, $string, 0);
return bless \@parts, $class;
}
sub read_more () {
my $self = shift;
if ($self->[USED] >= length($self->[STRING])) {
$self->[EOF]++;
return 0;
}
my $bytes = CHUNK_SIZE;
if ($bytes > (length($self->[STRING]) - $self->[USED])) {
$bytes = (length($self->[STRING]) - $self->[USED]);
}
$self->[BUFFER] .= substr($self->[STRING], $self->[USED], $bytes);
$self->[USED] += $bytes;
return 1;
}
sub move_along {
my($self, $bytes) = @_;
my $discarded = substr($self->[BUFFER], 0, $bytes, '');
$self->[DISCARDED] += length($discarded);
# Wish I could skip this lot - tells us where we are in the file
my $lines = $discarded =~ tr/\n//;
$self->[LINE] += $lines;
if ($lines) {
$discarded =~ /\n([^\n]*)$/;
$self->[COLUMN] = length($1);
}
else {
$self->[COLUMN] += $_[0];
}
}
sub set_encoding {
my $self = shift;
my ($encoding) = @_;
XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding, "utf-8");
$self->[ENCODING] = $encoding;
}
sub bytepos {
my $self = shift;
$self->[DISCARDED];
}
1;
perl5/5.32/XML/SAX/PurePerl/Reader/Stream.pm 0000444 00000003411 15157555734 0014024 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Reader::Stream;
use strict;
use vars qw(@ISA);
use XML::SAX::PurePerl::Reader qw(
EOF
BUFFER
LINE
COLUMN
ENCODING
XML_VERSION
);
use XML::SAX::Exception;
@ISA = ('XML::SAX::PurePerl::Reader');
# subclassed by adding 1 to last element
use constant FH => 8;
use constant BUFFER_SIZE => 4096;
sub new {
my $class = shift;
my $ioref = shift;
XML::SAX::PurePerl::Reader::set_raw_stream($ioref);
my @parts;
@parts[FH, LINE, COLUMN, BUFFER, EOF, XML_VERSION] =
($ioref, 1, 0, '', 0, '1.0');
return bless \@parts, $class;
}
sub read_more {
my $self = shift;
my $buf;
my $bytesread = read($self->[FH], $buf, BUFFER_SIZE);
if ($bytesread) {
$self->[BUFFER] .= $buf;
return 1;
}
elsif (defined($bytesread)) {
$self->[EOF]++;
return 0;
}
else {
throw XML::SAX::Exception::Parse(
Message => "Error reading from filehandle: $!",
);
}
}
sub move_along {
my $self = shift;
my $discarded = substr($self->[BUFFER], 0, $_[0], '');
# Wish I could skip this lot - tells us where we are in the file
my $lines = $discarded =~ tr/\n//;
$self->[LINE] += $lines;
if ($lines) {
$discarded =~ /\n([^\n]*)$/;
$self->[COLUMN] = length($1);
}
else {
$self->[COLUMN] += $_[0];
}
}
sub set_encoding {
my $self = shift;
my ($encoding) = @_;
# warn("set encoding to: $encoding\n");
XML::SAX::PurePerl::Reader::switch_encoding_stream($self->[FH], $encoding);
XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding);
$self->[ENCODING] = $encoding;
}
sub bytepos {
my $self = shift;
tell($self->[FH]);
}
1;
perl5/5.32/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm 0000444 00000001113 15157555742 0015131 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Reader;
use strict;
sub set_raw_stream {
# no-op
}
sub switch_encoding_stream {
my ($fh, $encoding) = @_;
throw XML::SAX::Exception::Parse (
Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
) if $encoding !~ /(ASCII|UTF\-?8)/i;
}
sub switch_encoding_string {
my (undef, $encoding) = @_;
throw XML::SAX::Exception::Parse (
Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
) if $encoding !~ /(ASCII|UTF\-?8)/i;
}
1;
perl5/5.32/XML/SAX/PurePerl/UnicodeExt.pm 0000444 00000000561 15157555747 0013445 0 ustar 00 # $Id$
package XML::SAX::PurePerl;
use strict;
no warnings 'utf8';
sub chr_ref {
return chr(shift);
}
if ($] >= 5.007002) {
require Encode;
Encode::define_alias( "UTF-16" => "UCS-2" );
Encode::define_alias( "UTF-16BE" => "UCS-2" );
Encode::define_alias( "UTF-16LE" => "ucs-2le" );
Encode::define_alias( "UTF16LE" => "ucs-2le" );
}
1;
perl5/5.32/XML/SAX/PurePerl/DocType.pm 0000444 00000011062 15157555754 0012741 0 ustar 00 # $Id$
package XML::SAX::PurePerl;
use strict;
use XML::SAX::PurePerl::Productions qw($PubidChar);
sub doctypedecl {
my ($self, $reader) = @_;
my $data = $reader->data(9);
if ($data =~ /^<!DOCTYPE/) {
$reader->move_along(9);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after doctype declaration", $reader);
my $root_name = $self->Name($reader) ||
$self->parser_error("Doctype declaration has no root element name", $reader);
if ($self->skip_whitespace($reader)) {
# might be externalid...
my %dtd = $self->ExternalID($reader);
# TODO: Call SAX event
}
$self->skip_whitespace($reader);
$self->InternalSubset($reader);
$reader->match('>') or $self->parser_error("Doctype not closed", $reader);
return 1;
}
return 0;
}
sub ExternalID {
my ($self, $reader) = @_;
my $data = $reader->data(6);
if ($data =~ /^SYSTEM/) {
$reader->move_along(6);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after SYSTEM identifier", $reader);
return (SYSTEM => $self->SystemLiteral($reader));
}
elsif ($data =~ /^PUBLIC/) {
$reader->move_along(6);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after PUBLIC identifier", $reader);
my $quote = $self->quote($reader) ||
$self->parser_error("Not a quote character in PUBLIC identifier", $reader);
my $data = $reader->data;
my $pubid = '';
while(1) {
$self->parser_error("EOF while looking for end of PUBLIC identifiier", $reader)
unless length($data);
if ($data =~ /^([^$quote]*)$quote/) {
$pubid .= $1;
$reader->move_along(length($1) + 1);
last;
}
else {
$pubid .= $data;
$reader->move_along(length($data));
$data = $reader->data;
}
}
if ($pubid !~ /^($PubidChar)+$/) {
$self->parser_error("Invalid characters in PUBLIC identifier", $reader);
}
$self->skip_whitespace($reader) ||
$self->parser_error("Not whitespace after PUBLIC ID in DOCTYPE", $reader);
return (PUBLIC => $pubid,
SYSTEM => $self->SystemLiteral($reader));
}
else {
return;
}
return 1;
}
sub SystemLiteral {
my ($self, $reader) = @_;
my $quote = $self->quote($reader);
my $data = $reader->data;
my $systemid = '';
while (1) {
$self->parser_error("EOF found while looking for end of System Literal", $reader)
unless length($data);
if ($data =~ /^([^$quote]*)$quote/) {
$systemid .= $1;
$reader->move_along(length($1) + 1);
return $systemid;
}
else {
$systemid .= $data;
$reader->move_along(length($data));
$data = $reader->data;
}
}
}
sub InternalSubset {
my ($self, $reader) = @_;
return 0 unless $reader->match('[');
1 while $self->IntSubsetDecl($reader);
$reader->match(']') or $self->parser_error("No close bracket on internal subset (found: " . $reader->data, $reader);
$self->skip_whitespace($reader);
return 1;
}
sub IntSubsetDecl {
my ($self, $reader) = @_;
return $self->DeclSep($reader) || $self->markupdecl($reader);
}
sub DeclSep {
my ($self, $reader) = @_;
if ($self->skip_whitespace($reader)) {
return 1;
}
if ($self->PEReference($reader)) {
return 1;
}
# if ($self->ParsedExtSubset($reader)) {
# return 1;
# }
return 0;
}
sub PEReference {
my ($self, $reader) = @_;
return 0 unless $reader->match('%');
my $peref = $self->Name($reader) ||
$self->parser_error("PEReference did not find a Name", $reader);
# TODO - load/parse the peref
$reader->match(';') or $self->parser_error("Invalid token in PEReference", $reader);
return 1;
}
sub markupdecl {
my ($self, $reader) = @_;
if ($self->elementdecl($reader) ||
$self->AttlistDecl($reader) ||
$self->EntityDecl($reader) ||
$self->NotationDecl($reader) ||
$self->PI($reader) ||
$self->Comment($reader))
{
return 1;
}
return 0;
}
1;
perl5/5.32/XML/SAX/PurePerl/DTDDecls.pm 0000444 00000041140 15157555761 0012756 0 ustar 00 # $Id$
package XML::SAX::PurePerl;
use strict;
use XML::SAX::PurePerl::Productions qw($SingleChar);
sub elementdecl {
my ($self, $reader) = @_;
my $data = $reader->data(9);
return 0 unless $data =~ /^<!ELEMENT/;
$reader->move_along(9);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after ELEMENT declaration", $reader);
my $name = $self->Name($reader);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after ELEMENT's name", $reader);
$self->contentspec($reader, $name);
$self->skip_whitespace($reader);
$reader->match('>') or $self->parser_error("Closing angle bracket not found on ELEMENT declaration", $reader);
return 1;
}
sub contentspec {
my ($self, $reader, $name) = @_;
my $data = $reader->data(5);
my $model;
if ($data =~ /^EMPTY/) {
$reader->move_along(5);
$model = 'EMPTY';
}
elsif ($data =~ /^ANY/) {
$reader->move_along(3);
$model = 'ANY';
}
else {
$model = $self->Mixed_or_children($reader);
}
if ($model) {
# call SAX callback now.
$self->element_decl({Name => $name, Model => $model});
return 1;
}
$self->parser_error("contentspec not found in ELEMENT declaration", $reader);
}
sub Mixed_or_children {
my ($self, $reader) = @_;
my $data = $reader->data(8);
$data =~ /^\(/ or return; # $self->parser_error("No opening bracket in Mixed or children", $reader);
if ($data =~ /^\(\s*\#PCDATA/) {
$reader->match('(');
$self->skip_whitespace($reader);
$reader->move_along(7);
my $model = $self->Mixed($reader);
return $model;
}
# not matched - must be Children
return $self->children($reader);
}
# Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' '*' )
# | ( '(' S* PCDATA S* ')' )
sub Mixed {
my ($self, $reader) = @_;
# Mixed_or_children already matched '(' S* '#PCDATA'
my $model = '(#PCDATA';
$self->skip_whitespace($reader);
my %seen;
while (1) {
last unless $reader->match('|');
$self->skip_whitespace($reader);
my $name = $self->Name($reader) ||
$self->parser_error("No 'Name' after Mixed content '|'", $reader);
if ($seen{$name}) {
$self->parser_error("Element '$name' has already appeared in this group", $reader);
}
$seen{$name}++;
$model .= "|$name";
$self->skip_whitespace($reader);
}
$reader->match(')') || $self->parser_error("no closing bracket on mixed content", $reader);
$model .= ")";
if ($reader->match('*')) {
$model .= "*";
}
return $model;
}
# [[47]] Children ::= ChoiceOrSeq Cardinality?
# [[48]] Cp ::= ( QName | ChoiceOrSeq ) Cardinality?
# ChoiceOrSeq ::= '(' S* Cp ( Choice | Seq )? S* ')'
# [[49]] Choice ::= ( S* '|' S* Cp )+
# [[50]] Seq ::= ( S* ',' S* Cp )+
# // Children ::= (Choice | Seq) Cardinality?
# // Cp ::= ( QName | Choice | Seq) Cardinality?
# // Choice ::= '(' S* Cp ( S* '|' S* Cp )+ S* ')'
# // Seq ::= '(' S* Cp ( S* ',' S* Cp )* S* ')'
# [[51]] Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' MixedCardinality )
# | ( '(' S* PCDATA S* ')' )
# Cardinality ::= '?' | '+' | '*'
# MixedCardinality ::= '*'
sub children {
my ($self, $reader) = @_;
return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader);
}
sub ChoiceOrSeq {
my ($self, $reader) = @_;
$reader->match('(') or $self->parser_error("choice/seq contains no opening bracket", $reader);
my $model = '(';
$self->skip_whitespace($reader);
$model .= $self->Cp($reader);
if (my $choice = $self->Choice($reader)) {
$model .= $choice;
}
else {
$model .= $self->Seq($reader);
}
$self->skip_whitespace($reader);
$reader->match(')') or $self->parser_error("choice/seq contains no closing bracket", $reader);
$model .= ')';
return $model;
}
sub Cardinality {
my ($self, $reader) = @_;
# cardinality is always optional
my $data = $reader->data;
if ($data =~ /^([\?\+\*])/) {
$reader->move_along(1);
return $1;
}
return '';
}
sub Cp {
my ($self, $reader) = @_;
my $model;
my $name = eval
{
if (my $name = $self->Name($reader)) {
return $name . $self->Cardinality($reader);
}
};
return $name if defined $name;
return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader);
}
sub Choice {
my ($self, $reader) = @_;
my $model = '';
$self->skip_whitespace($reader);
while ($reader->match('|')) {
$self->skip_whitespace($reader);
$model .= '|';
$model .= $self->Cp($reader);
$self->skip_whitespace($reader);
}
return $model;
}
sub Seq {
my ($self, $reader) = @_;
my $model = '';
$self->skip_whitespace($reader);
while ($reader->match(',')) {
$self->skip_whitespace($reader);
my $cp = $self->Cp($reader);
if ($cp) {
$model .= ',';
$model .= $cp;
}
$self->skip_whitespace($reader);
}
return $model;
}
sub AttlistDecl {
my ($self, $reader) = @_;
my $data = $reader->data(9);
if ($data =~ /^<!ATTLIST/) {
# It's an attlist
$reader->move_along(9);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after ATTLIST declaration", $reader);
my $name = $self->Name($reader);
$self->AttDefList($reader, $name);
$self->skip_whitespace($reader);
$reader->match('>') or $self->parser_error("Closing angle bracket not found on ATTLIST declaration", $reader);
return 1;
}
return 0;
}
sub AttDefList {
my ($self, $reader, $name) = @_;
1 while $self->AttDef($reader, $name);
}
sub AttDef {
my ($self, $reader, $el_name) = @_;
$self->skip_whitespace($reader) || return 0;
my $att_name = $self->Name($reader) || return 0;
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after Name in attribute definition", $reader);
my $att_type = $self->AttType($reader);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after AttType in attribute definition", $reader);
my ($mode, $value) = $self->DefaultDecl($reader);
# fire SAX event here!
$self->attribute_decl({
eName => $el_name,
aName => $att_name,
Type => $att_type,
Mode => $mode,
Value => $value,
});
return 1;
}
sub AttType {
my ($self, $reader) = @_;
return $self->StringType($reader) ||
$self->TokenizedType($reader) ||
$self->EnumeratedType($reader) ||
$self->parser_error("Can't match AttType", $reader);
}
sub StringType {
my ($self, $reader) = @_;
my $data = $reader->data(5);
return unless $data =~ /^CDATA/;
$reader->move_along(5);
return 'CDATA';
}
sub TokenizedType {
my ($self, $reader) = @_;
my $data = $reader->data(8);
if ($data =~ /^(IDREFS?|ID|ENTITIES|ENTITY|NMTOKENS?)/) {
$reader->move_along(length($1));
return $1;
}
return;
}
sub EnumeratedType {
my ($self, $reader) = @_;
return $self->NotationType($reader) || $self->Enumeration($reader);
}
sub NotationType {
my ($self, $reader) = @_;
my $data = $reader->data(8);
return unless $data =~ /^NOTATION/;
$reader->move_along(8);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after NOTATION", $reader);
$reader->match('(') or $self->parser_error("No opening bracket in notation section", $reader);
$self->skip_whitespace($reader);
my $model = 'NOTATION (';
my $name = $self->Name($reader) ||
$self->parser_error("No name in notation section", $reader);
$model .= $name;
$self->skip_whitespace($reader);
$data = $reader->data;
while ($data =~ /^\|/) {
$reader->move_along(1);
$model .= '|';
$self->skip_whitespace($reader);
my $name = $self->Name($reader) ||
$self->parser_error("No name in notation section", $reader);
$model .= $name;
$self->skip_whitespace($reader);
$data = $reader->data;
}
$data =~ /^\)/ or $self->parser_error("No closing bracket in notation section", $reader);
$reader->move_along(1);
$model .= ')';
return $model;
}
sub Enumeration {
my ($self, $reader) = @_;
return unless $reader->match('(');
$self->skip_whitespace($reader);
my $model = '(';
my $nmtoken = $self->Nmtoken($reader) ||
$self->parser_error("No Nmtoken in enumerated declaration", $reader);
$model .= $nmtoken;
$self->skip_whitespace($reader);
my $data = $reader->data;
while ($data =~ /^\|/) {
$model .= '|';
$reader->move_along(1);
$self->skip_whitespace($reader);
my $nmtoken = $self->Nmtoken($reader) ||
$self->parser_error("No Nmtoken in enumerated declaration", $reader);
$model .= $nmtoken;
$self->skip_whitespace($reader);
$data = $reader->data;
}
$data =~ /^\)/ or $self->parser_error("No closing bracket in enumerated declaration", $reader);
$reader->move_along(1);
$model .= ')';
return $model;
}
sub Nmtoken {
my ($self, $reader) = @_;
return $self->Name($reader);
}
sub DefaultDecl {
my ($self, $reader) = @_;
my $data = $reader->data(9);
if ($data =~ /^(\#REQUIRED|\#IMPLIED)/) {
$reader->move_along(length($1));
return $1;
}
my $model = '';
if ($data =~ /^\#FIXED/) {
$reader->move_along(6);
$self->skip_whitespace($reader) || $self->parser_error(
"no whitespace after FIXED specifier", $reader);
my $value = $self->AttValue($reader);
return "#FIXED", $value;
}
my $value = $self->AttValue($reader);
return undef, $value;
}
sub EntityDecl {
my ($self, $reader) = @_;
my $data = $reader->data(8);
return 0 unless $data =~ /^<!ENTITY/;
$reader->move_along(8);
$self->skip_whitespace($reader) || $self->parser_error(
"No whitespace after ENTITY declaration", $reader);
$self->PEDecl($reader) || $self->GEDecl($reader);
$self->skip_whitespace($reader);
$reader->match('>') or $self->parser_error("No closing '>' in entity definition", $reader);
return 1;
}
sub GEDecl {
my ($self, $reader) = @_;
my $name = $self->Name($reader) || $self->parser_error("No entity name given", $reader);
$self->skip_whitespace($reader) || $self->parser_error("No whitespace after entity name", $reader);
# TODO: ExternalID calls lexhandler method. Wrong place for it.
my $value;
if ($value = $self->ExternalID($reader)) {
$value .= $self->NDataDecl($reader);
}
else {
$value = $self->EntityValue($reader);
}
if ($self->{ParseOptions}{entities}{$name}) {
warn("entity $name already exists\n");
} else {
$self->{ParseOptions}{entities}{$name} = 1;
$self->{ParseOptions}{expanded_entity}{$name} = $value; # ???
}
# do callback?
return 1;
}
sub PEDecl {
my ($self, $reader) = @_;
return 0 unless $reader->match('%');
$self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity marker", $reader);
my $name = $self->Name($reader) || $self->parser_error("No parameter entity name given", $reader);
$self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity name", $reader);
my $value = $self->ExternalID($reader) ||
$self->EntityValue($reader) ||
$self->parser_error("PE is not a value or an external resource", $reader);
# do callback?
return 1;
}
my $quotre = qr/[^%&\"]/;
my $aposre = qr/[^%&\']/;
sub EntityValue {
my ($self, $reader) = @_;
my $data = $reader->data;
my $quote = '"';
my $re = $quotre;
if ($data !~ /^"/) {
$data =~ /^'/ or $self->parser_error("Not a quote character", $reader);
$quote = "'";
$re = $aposre;
}
$reader->move_along(1);
my $value = '';
while (1) {
my $data = $reader->data;
$self->parser_error("EOF found while reading entity value", $reader)
unless length($data);
if ($data =~ /^($re+)/) {
my $match = $1;
$value .= $match;
$reader->move_along(length($match));
}
elsif ($reader->match('&')) {
# if it's a char ref, expand now:
if ($reader->match('#')) {
my $char;
my $ref = '';
if ($reader->match('x')) {
my $data = $reader->data;
while (1) {
$self->parser_error("EOF looking for reference end", $reader)
unless length($data);
if ($data !~ /^([0-9a-fA-F]*)/) {
last;
}
$ref .= $1;
$reader->move_along(length($1));
if (length($1) == length($data)) {
$data = $reader->data;
}
else {
last;
}
}
$char = chr_ref(hex($ref));
$ref = "x$ref";
}
else {
my $data = $reader->data;
while (1) {
$self->parser_error("EOF looking for reference end", $reader)
unless length($data);
if ($data !~ /^([0-9]*)/) {
last;
}
$ref .= $1;
$reader->move_along(length($1));
if (length($1) == length($data)) {
$data = $reader->data;
}
else {
last;
}
}
$char = chr($ref);
}
$reader->match(';') ||
$self->parser_error("No semi-colon found after character reference", $reader);
if ($char !~ $SingleChar) { # match a single character
$self->parser_error("Character reference '&#$ref;' refers to an illegal XML character ($char)", $reader);
}
$value .= $char;
}
else {
# entity refs in entities get expanded later, so don't parse now.
$value .= '&';
}
}
elsif ($reader->match('%')) {
$value .= $self->PEReference($reader);
}
elsif ($reader->match($quote)) {
# end of attrib
last;
}
else {
$self->parser_error("Invalid character in attribute value: " . substr($reader->data, 0, 1), $reader);
}
}
return $value;
}
sub NDataDecl {
my ($self, $reader) = @_;
$self->skip_whitespace($reader) || return '';
my $data = $reader->data(5);
return '' unless $data =~ /^NDATA/;
$reader->move_along(5);
$self->skip_whitespace($reader) || $self->parser_error("No whitespace after NDATA declaration", $reader);
my $name = $self->Name($reader) || $self->parser_error("NDATA declaration lacks a proper Name", $reader);
return " NDATA $name";
}
sub NotationDecl {
my ($self, $reader) = @_;
my $data = $reader->data(10);
return 0 unless $data =~ /^<!NOTATION/;
$reader->move_along(10);
$self->skip_whitespace($reader) ||
$self->parser_error("No whitespace after NOTATION declaration", $reader);
$data = $reader->data;
my $value = '';
while(1) {
$self->parser_error("EOF found while looking for end of NotationDecl", $reader)
unless length($data);
if ($data =~ /^([^>]*)>/) {
$value .= $1;
$reader->move_along(length($1) + 1);
$self->notation_decl({Name => "FIXME", SystemId => "FIXME", PublicId => "FIXME" });
last;
}
else {
$value .= $data;
$reader->move_along(length($data));
$data = $reader->data;
}
}
return 1;
}
1;
perl5/5.32/XML/SAX/PurePerl/XMLDecl.pm 0000444 00000006475 15157555766 0012641 0 ustar 00 # $Id$
package XML::SAX::PurePerl;
use strict;
use XML::SAX::PurePerl::Productions qw($S $VersionNum $EncNameStart $EncNameEnd);
sub XMLDecl {
my ($self, $reader) = @_;
my $data = $reader->data(5);
# warn("Looking for xmldecl in: $data");
if ($data =~ /^<\?xml$S/o) {
$reader->move_along(5);
$self->skip_whitespace($reader);
# get version attribute
$self->VersionInfo($reader) ||
$self->parser_error("XML Declaration lacks required version attribute, or version attribute does not match XML specification", $reader);
if (!$self->skip_whitespace($reader)) {
my $data = $reader->data(2);
$data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
$reader->move_along(2);
return;
}
if ($self->EncodingDecl($reader)) {
if (!$self->skip_whitespace($reader)) {
my $data = $reader->data(2);
$data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
$reader->move_along(2);
return;
}
}
$self->SDDecl($reader);
$self->skip_whitespace($reader);
my $data = $reader->data(2);
$data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
$reader->move_along(2);
}
else {
# warn("first 5 bytes: ", join(',', unpack("CCCCC", $data)), "\n");
# no xml decl
if (!$reader->get_encoding) {
$reader->set_encoding("UTF-8");
}
}
}
sub VersionInfo {
my ($self, $reader) = @_;
my $data = $reader->data(11);
# warn("Looking for version in $data");
$data =~ /^(version$S*=$S*(["'])($VersionNum)\2)/o or return 0;
$reader->move_along(length($1));
my $vernum = $3;
if ($vernum ne "1.0") {
$self->parser_error("Only XML version 1.0 supported. Saw: '$vernum'", $reader);
}
return 1;
}
sub SDDecl {
my ($self, $reader) = @_;
my $data = $reader->data(15);
$data =~ /^(standalone$S*=$S*(["'])(yes|no)\2)/o or return 0;
$reader->move_along(length($1));
my $yesno = $3;
if ($yesno eq 'yes') {
$self->{standalone} = 1;
}
else {
$self->{standalone} = 0;
}
return 1;
}
sub EncodingDecl {
my ($self, $reader) = @_;
my $data = $reader->data(12);
$data =~ /^(encoding$S*=$S*(["'])($EncNameStart$EncNameEnd*)\2)/o or return 0;
$reader->move_along(length($1));
my $encoding = $3;
$reader->set_encoding($encoding);
return 1;
}
sub TextDecl {
my ($self, $reader) = @_;
my $data = $reader->data(6);
$data =~ /^<\?xml$S+/ or return;
$reader->move_along(5);
$self->skip_whitespace($reader);
if ($self->VersionInfo($reader)) {
$self->skip_whitespace($reader) ||
$self->parser_error("Lack of whitespace after version attribute in text declaration", $reader);
}
$self->EncodingDecl($reader) ||
$self->parser_error("Encoding declaration missing from external entity text declaration", $reader);
$self->skip_whitespace($reader);
$data = $reader->data(2);
$data =~ /^\?>/ or $self->parser_error("Syntax error", $reader);
return 1;
}
1;
perl5/5.32/XML/SAX/PurePerl/DebugHandler.pm 0000444 00000003527 15157555773 0013726 0 ustar 00 # $Id$
package XML::SAX::PurePerl::DebugHandler;
use strict;
sub new {
my $class = shift;
my %opts = @_;
return bless \%opts, $class;
}
# DocumentHandler
sub set_document_locator {
my $self = shift;
print "set_document_locator\n" if $ENV{DEBUG_XML};
$self->{seen}{set_document_locator}++;
}
sub start_document {
my $self = shift;
print "start_document\n" if $ENV{DEBUG_XML};
$self->{seen}{start_document}++;
}
sub end_document {
my $self = shift;
print "end_document\n" if $ENV{DEBUG_XML};
$self->{seen}{end_document}++;
}
sub start_element {
my $self = shift;
print "start_element\n" if $ENV{DEBUG_XML};
$self->{seen}{start_element}++;
}
sub end_element {
my $self = shift;
print "end_element\n" if $ENV{DEBUG_XML};
$self->{seen}{end_element}++;
}
sub characters {
my $self = shift;
print "characters\n" if $ENV{DEBUG_XML};
# warn "Char: ", $_[0]->{Data}, "\n";
$self->{seen}{characters}++;
}
sub processing_instruction {
my $self = shift;
print "processing_instruction\n" if $ENV{DEBUG_XML};
$self->{seen}{processing_instruction}++;
}
sub ignorable_whitespace {
my $self = shift;
print "ignorable_whitespace\n" if $ENV{DEBUG_XML};
$self->{seen}{ignorable_whitespace}++;
}
# LexHandler
sub comment {
my $self = shift;
print "comment\n" if $ENV{DEBUG_XML};
$self->{seen}{comment}++;
}
# DTDHandler
sub notation_decl {
my $self = shift;
print "notation_decl\n" if $ENV{DEBUG_XML};
$self->{seen}{notation_decl}++;
}
sub unparsed_entity_decl {
my $self = shift;
print "unparsed_entity_decl\n" if $ENV{DEBUG_XML};
$self->{seen}{entity_decl}++;
}
# EntityResolver
sub resolve_entity {
my $self = shift;
print "resolve_entity\n" if $ENV{DEBUG_XML};
$self->{seen}{resolve_entity}++;
return '';
}
1;
perl5/5.32/XML/SAX/PurePerl/Exception.pm 0000444 00000003253 15157556000 0013314 0 ustar 00 # $Id$
package XML::SAX::PurePerl::Exception;
use strict;
use overload '""' => "stringify";
use vars qw/$StackTrace/;
$StackTrace = $ENV{XML_DEBUG} || 0;
sub throw {
my $class = shift;
die $class->new(@_);
}
sub new {
my $class = shift;
my %opts = @_;
die "Invalid options" unless exists $opts{Message};
if ($opts{reader}) {
return bless { Message => $opts{Message},
Exception => undef, # not sure what this is for!!!
ColumnNumber => $opts{reader}->column,
LineNumber => $opts{reader}->line,
PublicId => $opts{reader}->public_id,
SystemId => $opts{reader}->system_id,
$StackTrace ? (StackTrace => stacktrace()) : (),
}, $class;
}
return bless { Message => $opts{Message},
Exception => undef, # not sure what this is for!!!
}, $class;
}
sub stringify {
my $self = shift;
local $^W;
return $self->{Message} . " [Ln: " . $self->{LineNumber} .
", Col: " . $self->{ColumnNumber} . "]" .
($StackTrace ? stackstring($self->{StackTrace}) : "") . "\n";
}
sub stacktrace {
my $i = 2;
my @fulltrace;
while (my @trace = caller($i++)) {
my %hash;
@hash{qw(Package Filename Line)} = @trace[0..2];
push @fulltrace, \%hash;
}
return \@fulltrace;
}
sub stackstring {
my $stacktrace = shift;
my $string = "\nFrom:\n";
foreach my $current (@$stacktrace) {
$string .= $current->{Filename} . " Line: " . $current->{Line} . "\n";
}
return $string;
}
1;
perl5/5.32/XML/SAX/PurePerl/NoUnicodeExt.pm 0000444 00000001164 15157556005 0013726 0 ustar 00 # $Id$
package XML::SAX::PurePerl;
use strict;
sub chr_ref {
my $n = shift;
if ($n < 0x80) {
return chr ($n);
}
elsif ($n < 0x800) {
return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
}
elsif ($n < 0x10000) {
return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
(($n & 0x3f) | 0x80));
}
elsif ($n < 0x110000)
{
return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
}
else {
return undef;
}
}
1;
perl5/5.32/XML/SAX/BuildSAXBase.pl 0000444 00000070017 15157556012 0012032 0 ustar 00 #!/usr/bin/perl
#
# This file is used to generate lib/XML/SAX/Base.pm. There is a pre-generated
# Base.pm file included in the distribution so you don't need to run this
# script unless you are attempting to modify the code.
#
# The code in this file was adapted from the Makefile.PL when XML::SAX::Base
# was split back out into its own distribution.
#
# You can manually run this file:
#
# perl ./BuildSAXBase.pl
#
# or better yet it will be invoked by automatically Dist::Zilla when building
# a release from the git repository.
#
# dzil build
#
package SAX::Base::Builder;
use strict;
use warnings;
use File::Spec;
write_xml_sax_base() unless caller();
sub build_xml_sax_base {
my $code = <<'EOHEADER';
package XML::SAX::Base;
# version 0.10 - Kip Hampton <khampton@totalcinema.com>
# version 0.13 - Robin Berjon <robin@knowscape.com>
# version 0.15 - Kip Hampton <khampton@totalcinema.com>
# version 0.17 - Kip Hampton <khampton@totalcinema.com>
# version 0.19 - Kip Hampton <khampton@totalcinema.com>
# version 0.21 - Kip Hampton <khampton@totalcinema.com>
# version 0.22 - Robin Berjon <robin@knowscape.com>
# version 0.23 - Matt Sergeant <matt@sergeant.org>
# version 0.24 - Robin Berjon <robin@knowscape.com>
# version 0.25 - Kip Hampton <khampton@totalcinema.com>
# version 1.00 - Kip Hampton <khampton@totalcinema.com>
# version 1.01 - Kip Hampton <khampton@totalcinema.com>
# version 1.02 - Robin Berjon <robin@knowscape.com>
# version 1.03 - Matt Sergeant <matt@sergeant.org>
# version 1.04 - Kip Hampton <khampton@totalcinema.com>
# version 1.05 - Grant McLean <grantm@cpan.org>
# version 1.06 - Grant McLean <grantm@cpan.org>
# version 1.07 - Grant McLean <grantm@cpan.org>
# version 1.08 - Grant McLean <grantm@cpan.org>
#-----------------------------------------------------#
# STOP!!!!!
#
# This file is generated by the 'BuildSAXBase.pl' file
# that ships with the XML::SAX::Base distribution.
# If you need to make changes, patch that file NOT
# XML/SAX/Base.pm Better yet, fork the git repository
# commit your changes and send a pull request:
# https://github.com/grantm/XML-SAX-Base
#-----------------------------------------------------#
use strict;
use XML::SAX::Exception qw();
EOHEADER
my %EVENT_SPEC = (
start_document => [qw(ContentHandler DocumentHandler Handler)],
end_document => [qw(ContentHandler DocumentHandler Handler)],
start_element => [qw(ContentHandler DocumentHandler Handler)],
end_element => [qw(ContentHandler DocumentHandler Handler)],
characters => [qw(ContentHandler DocumentHandler Handler)],
processing_instruction => [qw(ContentHandler DocumentHandler Handler)],
ignorable_whitespace => [qw(ContentHandler DocumentHandler Handler)],
set_document_locator => [qw(ContentHandler DocumentHandler Handler)],
start_prefix_mapping => [qw(ContentHandler Handler)],
end_prefix_mapping => [qw(ContentHandler Handler)],
skipped_entity => [qw(ContentHandler Handler)],
start_cdata => [qw(DocumentHandler LexicalHandler Handler)],
end_cdata => [qw(DocumentHandler LexicalHandler Handler)],
comment => [qw(DocumentHandler LexicalHandler Handler)],
entity_reference => [qw(DocumentHandler Handler)],
notation_decl => [qw(DTDHandler Handler)],
unparsed_entity_decl => [qw(DTDHandler Handler)],
element_decl => [qw(DeclHandler Handler)],
attlist_decl => [qw(DTDHandler Handler)],
doctype_decl => [qw(DTDHandler Handler)],
xml_decl => [qw(DTDHandler Handler)],
entity_decl => [qw(DTDHandler Handler)],
attribute_decl => [qw(DeclHandler Handler)],
internal_entity_decl => [qw(DeclHandler Handler)],
external_entity_decl => [qw(DeclHandler Handler)],
resolve_entity => [qw(EntityResolver Handler)],
start_dtd => [qw(LexicalHandler Handler)],
end_dtd => [qw(LexicalHandler Handler)],
start_entity => [qw(LexicalHandler Handler)],
end_entity => [qw(LexicalHandler Handler)],
warning => [qw(ErrorHandler Handler)],
error => [qw(ErrorHandler Handler)],
fatal_error => [qw(ErrorHandler Handler)],
);
for my $ev (keys %EVENT_SPEC) {
$code .= <<" EOTOPCODE";
sub $ev {
my \$self = shift;
if (defined \$self->{Methods}->{'$ev'}) {
\$self->{Methods}->{'$ev'}->(\@_);
}
else {
my \$method;
my \$callbacks;
if (exists \$self->{ParseOptions}) {
\$callbacks = \$self->{ParseOptions};
}
else {
\$callbacks = \$self;
}
if (0) { # dummy to make elsif's below compile
}
EOTOPCODE
my ($can_string, $aload_string);
for my $h (@{$EVENT_SPEC{$ev}}) {
$can_string .= <<" EOCANBLOCK";
elsif (defined \$callbacks->{'$h'} and \$method = \$callbacks->{'$h'}->can('$ev') ) {
my \$handler = \$callbacks->{'$h'};
\$self->{Methods}->{'$ev'} = sub { \$method->(\$handler, \@_) };
return \$method->(\$handler, \@_);
}
EOCANBLOCK
$aload_string .= <<" EOALOADBLOCK";
elsif (defined \$callbacks->{'$h'}
and \$callbacks->{'$h'}->can('AUTOLOAD')
and \$callbacks->{'$h'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '')
)
{
my \$res = eval { \$callbacks->{'$h'}->$ev(\@_) };
if (\$@) {
die \$@;
}
else {
# I think there's a buggette here...
# if the first call throws an exception, we don't set it up right.
# Not fatal, but we might want to address it.
my \$handler = \$callbacks->{'$h'};
\$self->{Methods}->{'$ev'} = sub { \$handler->$ev(\@_) };
}
return \$res;
}
EOALOADBLOCK
}
$code .= $can_string . $aload_string;
$code .= <<" EOFALLTHROUGH";
else {
\$self->{Methods}->{'$ev'} = sub { };
}
}
EOFALLTHROUGH
$code .= "\n}\n\n";
}
$code .= <<'BODY';
#-------------------------------------------------------------------#
# Class->new(%options)
#-------------------------------------------------------------------#
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $options = ($#_ == 0) ? shift : { @_ };
unless ( defined( $options->{Handler} ) or
defined( $options->{ContentHandler} ) or
defined( $options->{DTDHandler} ) or
defined( $options->{DocumentHandler} ) or
defined( $options->{LexicalHandler} ) or
defined( $options->{ErrorHandler} ) or
defined( $options->{DeclHandler} ) ) {
$options->{Handler} = XML::SAX::Base::NoHandler->new;
}
my $self = bless $options, $class;
# turn NS processing on by default
$self->set_feature('http://xml.org/sax/features/namespaces', 1);
return $self;
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# $p->parse(%options)
#-------------------------------------------------------------------#
sub parse {
my $self = shift;
my $parse_options = $self->get_options(@_);
local $self->{ParseOptions} = $parse_options;
if ($self->{Parent}) { # calling parse on a filter for some reason
return $self->{Parent}->parse($parse_options);
}
else {
my $method;
if (defined $parse_options->{Source}{CharacterStream} and $method = $self->can('_parse_characterstream')) {
warn("parse charstream???\n");
return $method->($self, $parse_options->{Source}{CharacterStream});
}
elsif (defined $parse_options->{Source}{ByteStream} and $method = $self->can('_parse_bytestream')) {
return $method->($self, $parse_options->{Source}{ByteStream});
}
elsif (defined $parse_options->{Source}{String} and $method = $self->can('_parse_string')) {
return $method->($self, $parse_options->{Source}{String});
}
elsif (defined $parse_options->{Source}{SystemId} and $method = $self->can('_parse_systemid')) {
return $method->($self, $parse_options->{Source}{SystemId});
}
else {
die "No _parse_* routine defined on this driver (If it is a filter, remember to set the Parent property. If you call the parse() method, make sure to set a Source. You may want to call parse_uri, parse_string or parse_file instead.) [$self]";
}
}
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# $p->parse_file(%options)
#-------------------------------------------------------------------#
sub parse_file {
my $self = shift;
my $file = shift;
return $self->parse_uri($file, @_) if ref(\$file) eq 'SCALAR';
my $parse_options = $self->get_options(@_);
$parse_options->{Source}{ByteStream} = $file;
return $self->parse($parse_options);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# $p->parse_uri(%options)
#-------------------------------------------------------------------#
sub parse_uri {
my $self = shift;
my $file = shift;
my $parse_options = $self->get_options(@_);
$parse_options->{Source}{SystemId} = $file;
return $self->parse($parse_options);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# $p->parse_string(%options)
#-------------------------------------------------------------------#
sub parse_string {
my $self = shift;
my $string = shift;
my $parse_options = $self->get_options(@_);
$parse_options->{Source}{String} = $string;
return $self->parse($parse_options);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# get_options
#-------------------------------------------------------------------#
sub get_options {
my $self = shift;
if (@_ == 1) {
return { %$self, %{$_[0]} };
} else {
return { %$self, @_ };
}
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# get_features
#-------------------------------------------------------------------#
sub get_features {
return (
'http://xml.org/sax/features/external-general-entities' => undef,
'http://xml.org/sax/features/external-parameter-entities' => undef,
'http://xml.org/sax/features/is-standalone' => undef,
'http://xml.org/sax/features/lexical-handler' => undef,
'http://xml.org/sax/features/parameter-entities' => undef,
'http://xml.org/sax/features/namespaces' => 1,
'http://xml.org/sax/features/namespace-prefixes' => 0,
'http://xml.org/sax/features/string-interning' => undef,
'http://xml.org/sax/features/use-attributes2' => undef,
'http://xml.org/sax/features/use-locator2' => undef,
'http://xml.org/sax/features/validation' => undef,
'http://xml.org/sax/properties/dom-node' => undef,
'http://xml.org/sax/properties/xml-string' => undef,
);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# get_feature
#-------------------------------------------------------------------#
sub get_feature {
my $self = shift;
my $feat = shift;
# check %FEATURES to see if it's there, and return it if so
# throw XML::SAX::Exception::NotRecognized if it's not there
# throw XML::SAX::Exception::NotSupported if it's there but we
# don't support it
my %features = $self->get_features();
if (exists $features{$feat}) {
my %supported = map { $_ => 1 } $self->supported_features();
if ($supported{$feat}) {
return $self->{__PACKAGE__ . "::Features"}{$feat};
}
throw XML::SAX::Exception::NotSupported(
Message => "The feature '$feat' is not supported by " . ref($self),
Exception => undef,
);
}
throw XML::SAX::Exception::NotRecognized(
Message => "The feature '$feat' is not recognized by " . ref($self),
Exception => undef,
);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# set_feature
#-------------------------------------------------------------------#
sub set_feature {
my $self = shift;
my $feat = shift;
my $value = shift;
# check %FEATURES to see if it's there, and set it if so
# throw XML::SAX::Exception::NotRecognized if it's not there
# throw XML::SAX::Exception::NotSupported if it's there but we
# don't support it
my %features = $self->get_features();
if (exists $features{$feat}) {
my %supported = map { $_ => 1 } $self->supported_features();
if ($supported{$feat}) {
return $self->{__PACKAGE__ . "::Features"}{$feat} = $value;
}
throw XML::SAX::Exception::NotSupported(
Message => "The feature '$feat' is not supported by " . ref($self),
Exception => undef,
);
}
throw XML::SAX::Exception::NotRecognized(
Message => "The feature '$feat' is not recognized by " . ref($self),
Exception => undef,
);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# get_handler and friends
#-------------------------------------------------------------------#
sub get_handler {
my $self = shift;
my $handler_type = shift;
$handler_type ||= 'Handler';
return defined( $self->{$handler_type} ) ? $self->{$handler_type} : undef;
}
sub get_document_handler {
my $self = shift;
return $self->get_handler('DocumentHandler', @_);
}
sub get_content_handler {
my $self = shift;
return $self->get_handler('ContentHandler', @_);
}
sub get_dtd_handler {
my $self = shift;
return $self->get_handler('DTDHandler', @_);
}
sub get_lexical_handler {
my $self = shift;
return $self->get_handler('LexicalHandler', @_);
}
sub get_decl_handler {
my $self = shift;
return $self->get_handler('DeclHandler', @_);
}
sub get_error_handler {
my $self = shift;
return $self->get_handler('ErrorHandler', @_);
}
sub get_entity_resolver {
my $self = shift;
return $self->get_handler('EntityResolver', @_);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# set_handler and friends
#-------------------------------------------------------------------#
sub set_handler {
my $self = shift;
my ($new_handler, $handler_type) = reverse @_;
$handler_type ||= 'Handler';
$self->{Methods} = {} if $self->{Methods};
$self->{$handler_type} = $new_handler;
$self->{ParseOptions}->{$handler_type} = $new_handler;
return 1;
}
sub set_document_handler {
my $self = shift;
return $self->set_handler('DocumentHandler', @_);
}
sub set_content_handler {
my $self = shift;
return $self->set_handler('ContentHandler', @_);
}
sub set_dtd_handler {
my $self = shift;
return $self->set_handler('DTDHandler', @_);
}
sub set_lexical_handler {
my $self = shift;
return $self->set_handler('LexicalHandler', @_);
}
sub set_decl_handler {
my $self = shift;
return $self->set_handler('DeclHandler', @_);
}
sub set_error_handler {
my $self = shift;
return $self->set_handler('ErrorHandler', @_);
}
sub set_entity_resolver {
my $self = shift;
return $self->set_handler('EntityResolver', @_);
}
#-------------------------------------------------------------------#
#-------------------------------------------------------------------#
# supported_features
#-------------------------------------------------------------------#
sub supported_features {
my $self = shift;
# Only namespaces are required by all parsers
return (
'http://xml.org/sax/features/namespaces',
);
}
#-------------------------------------------------------------------#
sub no_op {
# this space intentionally blank
}
package XML::SAX::Base::NoHandler;
# we need a fake handler that doesn't implement anything, this
# simplifies the code a lot (though given the recent changes,
# it may be better to do without)
sub new {
#warn "no handler called\n";
return bless {};
}
1;
BODY
$code .= "__END__\n";
$code .= <<'FOOTER';
=head1 NAME
XML::SAX::Base - Base class SAX Drivers and Filters
=head1 SYNOPSIS
package MyFilter;
use XML::SAX::Base;
@ISA = ('XML::SAX::Base');
=head1 DESCRIPTION
This module has a very simple task - to be a base class for PerlSAX
drivers and filters. It's default behaviour is to pass the input directly
to the output unchanged. It can be useful to use this module as a base class
so you don't have to, for example, implement the characters() callback.
The main advantages that it provides are easy dispatching of events the right
way (ie it takes care for you of checking that the handler has implemented
that method, or has defined an AUTOLOAD), and the guarantee that filters
will pass along events that they aren't implementing to handlers downstream
that might nevertheless be interested in them.
=head1 WRITING SAX DRIVERS AND FILTERS
The Perl Sax API Reference is at L<http://perl-xml.sourceforge.net/perl-sax/>.
Writing SAX Filters is tremendously easy: all you need to do is
inherit from this module, and define the events you want to handle. A
more detailed explanation can be found at
http://www.xml.com/pub/a/2001/10/10/sax-filters.html.
Writing Drivers is equally simple. The one thing you need to pay
attention to is B<NOT> to call events yourself (this applies to Filters
as well). For instance:
package MyFilter;
use base qw(XML::SAX::Base);
sub start_element {
my $self = shift;
my $data = shift;
# do something
$self->{Handler}->start_element($data); # BAD
}
The above example works well as precisely that: an example. But it has
several faults: 1) it doesn't test to see whether the handler defines
start_element. Perhaps it doesn't want to see that event, in which
case you shouldn't throw it (otherwise it'll die). 2) it doesn't check
ContentHandler and then Handler (ie it doesn't look to see that the
user hasn't requested events on a specific handler, and if not on the
default one), 3) if it did check all that, not only would the code be
cumbersome (see this module's source to get an idea) but it would also
probably have to check for a DocumentHandler (in case this were SAX1)
and for AUTOLOADs potentially defined in all these packages. As you can
tell, that would be fairly painful. Instead of going through that,
simply remember to use code similar to the following instead:
package MyFilter;
use base qw(XML::SAX::Base);
sub start_element {
my $self = shift;
my $data = shift;
# do something to filter
$self->SUPER::start_element($data); # GOOD (and easy) !
}
This way, once you've done your job you hand the ball back to
XML::SAX::Base and it takes care of all those problems for you!
Note that the above example doesn't apply to filters only, drivers
will benefit from the exact same feature.
=head1 METHODS
A number of methods are defined within this class for the purpose of
inheritance. Some probably don't need to be overridden (eg parse_file)
but some clearly should be (eg parse). Options for these methods are
described in the PerlSAX2 specification available from
http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html.
=over 4
=item * parse
The parse method is the main entry point to parsing documents. Internally
the parse method will detect what type of "thing" you are parsing, and
call the appropriate method in your implementation class. Here is the
mapping table of what is in the Source options (see the Perl SAX 2.0
specification for the meaning of these values):
Source Contains parse() calls
=============== =============
CharacterStream (*) _parse_characterstream($stream, $options)
ByteStream _parse_bytestream($stream, $options)
String _parse_string($string, $options)
SystemId _parse_systemid($string, $options)
However note that these methods may not be sensible if your driver class
is not for parsing XML. An example might be a DBI driver that generates
XML/SAX from a database table. If that is the case, you likely want to
write your own parse() method.
Also note that the Source may contain both a PublicId entry, and an
Encoding entry. To get at these, examine $options->{Source} as passed
to your method.
(*) A CharacterStream is a filehandle that does not need any encoding
translation done on it. This is implemented as a regular filehandle
and only works under Perl 5.7.2 or higher using PerlIO. To get a single
character, or number of characters from it, use the perl core read()
function. To get a single byte from it (or number of bytes), you can
use sysread(). The encoding of the stream should be in the Encoding
entry for the Source.
=item * parse_file, parse_uri, parse_string
These are all convenience variations on parse(), and in fact simply
set up the options before calling it. You probably don't need to
override these.
=item * get_options
This is a convenience method to get options in SAX2 style, or more
generically either as hashes or as hashrefs (it returns a hashref).
You will probably want to use this method in your own implementations
of parse() and of new().
=item * get_feature, set_feature
These simply get and set features, and throw the
appropriate exceptions defined in the specification if need be.
If your subclass defines features not defined in this one,
then you should override these methods in such a way that they check for
your features first, and then call the base class's methods
for features not defined by your class. An example would be:
sub get_feature {
my $self = shift;
my $feat = shift;
if (exists $MY_FEATURES{$feat}) {
# handle the feature in various ways
}
else {
return $self->SUPER::get_feature($feat);
}
}
Currently this part is unimplemented.
=item * set_handler
This method takes a handler type (Handler, ContentHandler, etc.) and a
handler object as arguments, and changes the current handler for that
handler type, while taking care of resetting the internal state that
needs to be reset. This allows one to change a handler during parse
without running into problems (changing it on the parser object
directly will most likely cause trouble).
=item * set_document_handler, set_content_handler, set_dtd_handler, set_lexical_handler, set_decl_handler, set_error_handler, set_entity_resolver
These are just simple wrappers around the former method, and take a
handler object as their argument. Internally they simply call
set_handler with the correct arguments.
=item * get_handler
The inverse of set_handler, this method takes a an optional string containing a handler type (DTDHandler,
ContentHandler, etc. 'Handler' is used if no type is passed). It returns a reference to the object that implements
that class, or undef if that handler type is not set for the current driver/filter.
=item * get_document_handler, get_content_handler, get_dtd_handler, get_lexical_handler, get_decl_handler,
get_error_handler, get_entity_resolver
These are just simple wrappers around the get_handler() method, and take no arguments. Internally
they simply call get_handler with the correct handler type name.
=back
It would be rather useless to describe all the methods that this
module implements here. They are all the methods supported in SAX1 and
SAX2. In case your memory is a little short, here is a list. The
apparent duplicates are there so that both versions of SAX can be
supported.
=over 4
=item * start_document
=item * end_document
=item * start_element
=item * start_document
=item * end_document
=item * start_element
=item * end_element
=item * characters
=item * processing_instruction
=item * ignorable_whitespace
=item * set_document_locator
=item * start_prefix_mapping
=item * end_prefix_mapping
=item * skipped_entity
=item * start_cdata
=item * end_cdata
=item * comment
=item * entity_reference
=item * notation_decl
=item * unparsed_entity_decl
=item * element_decl
=item * attlist_decl
=item * doctype_decl
=item * xml_decl
=item * entity_decl
=item * attribute_decl
=item * internal_entity_decl
=item * external_entity_decl
=item * resolve_entity
=item * start_dtd
=item * end_dtd
=item * start_entity
=item * end_entity
=item * warning
=item * error
=item * fatal_error
=back
=head1 TODO
- more tests
- conform to the "SAX Filters" and "Java and DOM compatibility"
sections of the SAX2 document.
=head1 AUTHOR
Kip Hampton (khampton@totalcinema.com) did most of the work, after porting
it from XML::Filter::Base.
Robin Berjon (robin@knowscape.com) pitched in with patches to make it
usable as a base for drivers as well as filters, along with other patches.
Matt Sergeant (matt@sergeant.org) wrote the original XML::Filter::Base,
and patched a few things here and there, and imported it into
the XML::SAX distribution.
=head1 SEE ALSO
L<XML::SAX>
=cut
FOOTER
return $code;
}
sub write_xml_sax_base {
confirm_forced_update();
my $path = File::Spec->catfile("lib", "XML", "SAX", "Base.pm");
save_original_xml_sax_base($path);
my $code = build_xml_sax_base();
$code = add_version_stanzas($code);
open my $fh, ">", $path or die "Cannot write $path: $!";
print $fh $code;
close $fh or die "Error writing $path: $!";
print "Wrote $path\n";
}
sub confirm_forced_update {
return if grep { $_ eq '--force' } @ARGV;
print <<'EOF';
*** WARNING ***
The BuildSAXBase.pl script is used to generate the lib/XML/SAX/Base.pm file.
However a pre-generated version of Base.pm is included in the distribution
so you do not need to run this script unless you intend to modify the code.
You must use the --force option to deliberately overwrite the distributed
version of lib/XML/SAX/Base.pm
EOF
exit;
}
sub save_original_xml_sax_base {
my($path) = @_;
return unless -e $path;
(my $save_path = $path) =~ s{Base}{Base-orig};
return if -e $save_path;
print "Saving $path to $save_path\n";
rename($path, $save_path);
}
sub add_version_stanzas {
my($code) = @_;
my $version = get_xml_sax_base_version();
$code =~ s<^(package\s+(\w[:\w]+).*?\n)>
<${1}BEGIN {\n \$${2}::VERSION = '$version';\n}\n>mg;
return $code;
}
sub get_xml_sax_base_version {
open my $fh, '<', 'dist.ini' or die "open(<dist.ini): $!";
while(<$fh>) {
m{^\s*version\s*=\s*(\S+)} && return $1;
}
die "Failed to find version in dist.ini";
}
perl5/5.32/XML/SAX/PurePerl.pm 0000444 00000050153 15157556020 0011361 0 ustar 00 # $Id$
package XML::SAX::PurePerl;
use strict;
use vars qw/$VERSION/;
$VERSION = '1.02';
use XML::SAX::PurePerl::Productions qw($NameChar $SingleChar);
use XML::SAX::PurePerl::Reader;
use XML::SAX::PurePerl::EncodingDetect ();
use XML::SAX::Exception;
use XML::SAX::PurePerl::DocType ();
use XML::SAX::PurePerl::DTDDecls ();
use XML::SAX::PurePerl::XMLDecl ();
use XML::SAX::DocumentLocator ();
use XML::SAX::Base ();
use XML::SAX qw(Namespaces);
use XML::NamespaceSupport ();
use IO::File;
if ($] < 5.006) {
require XML::SAX::PurePerl::NoUnicodeExt;
}
else {
require XML::SAX::PurePerl::UnicodeExt;
}
use vars qw(@ISA);
@ISA = ('XML::SAX::Base');
my %int_ents = (
amp => '&',
lt => '<',
gt => '>',
quot => '"',
apos => "'",
);
my $xmlns_ns = "http://www.w3.org/2000/xmlns/";
my $xml_ns = "http://www.w3.org/XML/1998/namespace";
use Carp;
sub _parse_characterstream {
my $self = shift;
my ($fh) = @_;
confess("CharacterStream is not yet correctly implemented");
my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh);
return $self->_parse($reader);
}
sub _parse_bytestream {
my $self = shift;
my ($fh) = @_;
my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh);
return $self->_parse($reader);
}
sub _parse_string {
my $self = shift;
my ($str) = @_;
my $reader = XML::SAX::PurePerl::Reader::String->new($str);
return $self->_parse($reader);
}
sub _parse_systemid {
my $self = shift;
my ($uri) = @_;
my $reader = XML::SAX::PurePerl::Reader::URI->new($uri);
return $self->_parse($reader);
}
sub _parse {
my ($self, $reader) = @_;
$reader->public_id($self->{ParseOptions}{Source}{PublicId});
$reader->system_id($self->{ParseOptions}{Source}{SystemId});
$self->{NSHelper} = XML::NamespaceSupport->new({xmlns => 1});
$self->set_document_locator(
XML::SAX::DocumentLocator->new(
sub { $reader->public_id },
sub { $reader->system_id },
sub { $reader->line },
sub { $reader->column },
sub { $reader->get_encoding },
sub { $reader->get_xml_version },
),
);
$self->start_document({});
if (defined $self->{ParseOptions}{Source}{Encoding}) {
$reader->set_encoding($self->{ParseOptions}{Source}{Encoding});
}
else {
$self->encoding_detect($reader);
}
# parse a document
$self->document($reader);
return $self->end_document({});
}
sub parser_error {
my $self = shift;
my ($error, $reader) = @_;
# warn("parser error: $error from ", $reader->line, " : ", $reader->column, "\n");
my $exception = XML::SAX::Exception::Parse->new(
Message => $error,
ColumnNumber => $reader->column,
LineNumber => $reader->line,
PublicId => $reader->public_id,
SystemId => $reader->system_id,
);
$self->fatal_error($exception);
$exception->throw;
}
sub document {
my ($self, $reader) = @_;
# document ::= prolog element Misc*
$self->prolog($reader);
$self->element($reader) ||
$self->parser_error("Document requires an element", $reader);
while(length($reader->data)) {
$self->Misc($reader) ||
$self->parser_error("Only Comments, PIs and whitespace allowed at end of document", $reader);
}
}
sub prolog {
my ($self, $reader) = @_;
$self->XMLDecl($reader);
# consume all misc bits
1 while($self->Misc($reader));
if ($self->doctypedecl($reader)) {
while (length($reader->data)) {
$self->Misc($reader) || last;
}
}
}
sub element {
my ($self, $reader) = @_;
return 0 unless $reader->match('<');
my $name = $self->Name($reader) || $self->parser_error("Invalid element name", $reader);
my %attribs;
while( my ($k, $v) = $self->Attribute($reader) ) {
$attribs{$k} = $v;
}
my $have_namespaces = $self->get_feature(Namespaces);
# Namespace processing
$self->{NSHelper}->push_context;
my @new_ns;
# my %attrs = @attribs;
# while (my ($k,$v) = each %attrs) {
if ($have_namespaces) {
while ( my ($k, $v) = each %attribs ) {
if ($k =~ m/^xmlns(:(.*))?$/) {
my $prefix = $2 || '';
$self->{NSHelper}->declare_prefix($prefix, $v);
my $ns =
{
Prefix => $prefix,
NamespaceURI => $v,
};
push @new_ns, $ns;
$self->SUPER::start_prefix_mapping($ns);
}
}
}
# Create element object and fire event
my %attrib_hash;
while (my ($name, $value) = each %attribs ) {
# TODO normalise value here
my ($ns, $prefix, $lname);
if ($have_namespaces) {
($ns, $prefix, $lname) = $self->{NSHelper}->process_attribute_name($name);
}
$ns ||= ''; $prefix ||= ''; $lname ||= '';
$attrib_hash{"{$ns}$lname"} = {
Name => $name,
LocalName => $lname,
Prefix => $prefix,
NamespaceURI => $ns,
Value => $value,
};
}
%attribs = (); # lose the memory since we recurse deep
my ($ns, $prefix, $lname);
if ($self->get_feature(Namespaces)) {
($ns, $prefix, $lname) = $self->{NSHelper}->process_element_name($name);
}
else {
$lname = $name;
}
$ns ||= ''; $prefix ||= ''; $lname ||= '';
# Process remainder of start_element
$self->skip_whitespace($reader);
my $have_content;
my $data = $reader->data(2);
if ($data =~ /^\/>/) {
$reader->move_along(2);
}
else {
$data =~ /^>/ or $self->parser_error("No close element tag", $reader);
$reader->move_along(1);
$have_content++;
}
my $el =
{
Name => $name,
LocalName => $lname,
Prefix => $prefix,
NamespaceURI => $ns,
Attributes => \%attrib_hash,
};
$self->start_element($el);
# warn("($name\n");
if ($have_content) {
$self->content($reader);
my $data = $reader->data(2);
$data =~ /^<\// or $self->parser_error("No close tag marker", $reader);
$reader->move_along(2);
my $end_name = $self->Name($reader);
$end_name eq $name || $self->parser_error("End tag mismatch ($end_name != $name)", $reader);
$self->skip_whitespace($reader);
$reader->match('>') or $self->parser_error("No close '>' on end tag", $reader);
}
my %end_el = %$el;
delete $end_el{Attributes};
$self->end_element(\%end_el);
for my $ns (@new_ns) {
$self->end_prefix_mapping($ns);
}
$self->{NSHelper}->pop_context;
return 1;
}
sub content {
my ($self, $reader) = @_;
while (1) {
$self->CharData($reader);
my $data = $reader->data(2);
if ($data =~ /^<\//) {
return 1;
}
elsif ($data =~ /^&/) {
$self->Reference($reader) or $self->parser_error("bare & not allowed in content", $reader);
next;
}
elsif ($data =~ /^<!/) {
($self->CDSect($reader)
or
$self->Comment($reader))
and next;
}
elsif ($data =~ /^<\?/) {
$self->PI($reader) and next;
}
elsif ($data =~ /^</) {
$self->element($reader) and next;
}
last;
}
return 1;
}
sub CDSect {
my ($self, $reader) = @_;
my $data = $reader->data(9);
return 0 unless $data =~ /^<!\[CDATA\[/;
$reader->move_along(9);
$self->start_cdata({});
$data = $reader->data;
while (1) {
$self->parser_error("EOF looking for CDATA section end", $reader)
unless length($data);
if ($data =~ /^(.*?)\]\]>/s) {
my $chars = $1;
$reader->move_along(length($chars) + 3);
$self->characters({Data => $chars});
last;
}
else {
$self->characters({Data => $data});
$reader->move_along(length($data));
$data = $reader->data;
}
}
$self->end_cdata({});
return 1;
}
sub CharData {
my ($self, $reader) = @_;
my $data = $reader->data;
while (1) {
return unless length($data);
if ($data =~ /^([^<&]*)[<&]/s) {
my $chars = $1;
$self->parser_error("String ']]>' not allowed in character data", $reader)
if $chars =~ /\]\]>/;
$reader->move_along(length($chars));
$self->characters({Data => $chars}) if length($chars);
last;
}
else {
$self->characters({Data => $data});
$reader->move_along(length($data));
$data = $reader->data;
}
}
}
sub Misc {
my ($self, $reader) = @_;
if ($self->Comment($reader)) {
return 1;
}
elsif ($self->PI($reader)) {
return 1;
}
elsif ($self->skip_whitespace($reader)) {
return 1;
}
return 0;
}
sub Reference {
my ($self, $reader) = @_;
return 0 unless $reader->match('&');
my $data = $reader->data;
# Fetch more data if we have an incomplete numeric reference
if ($data =~ /^(#\d*|#x[0-9a-fA-F]*)$/) {
$data = $reader->data(length($data) + 6);
}
if ($data =~ /^#x([0-9a-fA-F]+);/) {
my $ref = $1;
$reader->move_along(length($ref) + 3);
my $char = chr_ref(hex($ref));
$self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader)
unless $char =~ /$SingleChar/o;
$self->characters({ Data => $char });
return 1;
}
elsif ($data =~ /^#([0-9]+);/) {
my $ref = $1;
$reader->move_along(length($ref) + 2);
my $char = chr_ref($ref);
$self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader)
unless $char =~ /$SingleChar/o;
$self->characters({ Data => $char });
return 1;
}
else {
# EntityRef
my $name = $self->Name($reader)
|| $self->parser_error("Invalid name in entity", $reader);
$reader->match(';') or $self->parser_error("No semi-colon found after entity name", $reader);
# warn("got entity: \&$name;\n");
# expand it
if ($self->_is_entity($name)) {
if ($self->_is_external($name)) {
my $value = $self->_get_entity($name);
my $ent_reader = XML::SAX::PurePerl::Reader::URI->new($value);
$self->encoding_detect($ent_reader);
$self->extParsedEnt($ent_reader);
}
else {
my $value = $self->_stringify_entity($name);
my $ent_reader = XML::SAX::PurePerl::Reader::String->new($value);
$self->content($ent_reader);
}
return 1;
}
elsif ($name =~ /^(?:amp|gt|lt|quot|apos)$/) {
$self->characters({ Data => $int_ents{$name} });
return 1;
}
else {
$self->parser_error("Undeclared entity", $reader);
}
}
}
sub AttReference {
my ($self, $name, $reader) = @_;
if ($name =~ /^#x([0-9a-fA-F]+)$/) {
my $chr = chr_ref(hex($1));
$chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader);
return $chr;
}
elsif ($name =~ /^#([0-9]+)$/) {
my $chr = chr_ref($1);
$chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader);
return $chr;
}
else {
if ($self->_is_entity($name)) {
if ($self->_is_external($name)) {
$self->parser_error("No external entity references allowed in attribute values", $reader);
}
else {
my $value = $self->_stringify_entity($name);
return $value;
}
}
elsif ($name =~ /^(?:amp|lt|gt|quot|apos)$/) {
return $int_ents{$name};
}
else {
$self->parser_error("Undeclared entity '$name'", $reader);
}
}
}
sub extParsedEnt {
my ($self, $reader) = @_;
$self->TextDecl($reader);
$self->content($reader);
}
sub _is_external {
my ($self, $name) = @_;
# TODO: Fix this to use $reader to store the entities perhaps.
if ($self->{ParseOptions}{external_entities}{$name}) {
return 1;
}
return ;
}
sub _is_entity {
my ($self, $name) = @_;
# TODO: ditto above
if (exists $self->{ParseOptions}{entities}{$name}) {
return 1;
}
return 0;
}
sub _stringify_entity {
my ($self, $name) = @_;
# TODO: ditto above
if (exists $self->{ParseOptions}{expanded_entity}{$name}) {
return $self->{ParseOptions}{expanded_entity}{$name};
}
# expand
my $reader = XML::SAX::PurePerl::Reader::URI->new($self->{ParseOptions}{entities}{$name});
my $ent = '';
while(1) {
my $data = $reader->data;
$ent .= $data;
$reader->move_along(length($data)) or last;
}
return $self->{ParseOptions}{expanded_entity}{$name} = $ent;
}
sub _get_entity {
my ($self, $name) = @_;
# TODO: ditto above
return $self->{ParseOptions}{entities}{$name};
}
sub skip_whitespace {
my ($self, $reader) = @_;
my $data = $reader->data;
my $found = 0;
while ($data =~ s/^([\x20\x0A\x0D\x09]*)//) {
last unless length($1);
$found++;
$reader->move_along(length($1));
$data = $reader->data;
}
return $found;
}
sub Attribute {
my ($self, $reader) = @_;
$self->skip_whitespace($reader) || return;
my $data = $reader->data(2);
return if $data =~ /^\/?>/;
if (my $name = $self->Name($reader)) {
$self->skip_whitespace($reader);
$reader->match('=') or $self->parser_error("No '=' in Attribute", $reader);
$self->skip_whitespace($reader);
my $value = $self->AttValue($reader);
if (!$self->cdata_attrib($name)) {
$value =~ s/^\x20*//; # discard leading spaces
$value =~ s/\x20*$//; # discard trailing spaces
$value =~ s/ {1,}/ /g; # all >1 space to single space
}
return $name, $value;
}
return;
}
sub cdata_attrib {
# TODO implement this!
return 1;
}
sub AttValue {
my ($self, $reader) = @_;
my $quote = $self->quote($reader);
my $value = '';
while (1) {
my $data = $reader->data;
$self->parser_error("EOF found while looking for the end of attribute value", $reader)
unless length($data);
if ($data =~ /^([^$quote]*)$quote/) {
$reader->move_along(length($1) + 1);
$value .= $1;
last;
}
else {
$value .= $data;
$reader->move_along(length($data));
}
}
if ($value =~ /</) {
$self->parser_error("< character not allowed in attribute values", $reader);
}
$value =~ s/[\x09\x0A\x0D]/\x20/g;
$value =~ s/&(#(x[0-9a-fA-F]+)|#([0-9]+)|\w+);/$self->AttReference($1, $reader)/geo;
return $value;
}
sub Comment {
my ($self, $reader) = @_;
my $data = $reader->data(4);
if ($data =~ /^<!--/) {
$reader->move_along(4);
my $comment_str = '';
while (1) {
my $data = $reader->data;
$self->parser_error("End of data seen while looking for close comment marker", $reader)
unless length($data);
if ($data =~ /^(.*?)-->/s) {
$comment_str .= $1;
$self->parser_error("Invalid comment (dash)", $reader) if $comment_str =~ /-$/;
$reader->move_along(length($1) + 3);
last;
}
else {
$comment_str .= $data;
$reader->move_along(length($data));
}
}
$self->comment({ Data => $comment_str });
return 1;
}
return 0;
}
sub PI {
my ($self, $reader) = @_;
my $data = $reader->data(2);
if ($data =~ /^<\?/) {
$reader->move_along(2);
my ($target);
$target = $self->Name($reader) ||
$self->parser_error("PI has no target", $reader);
my $pi_data = '';
if ($self->skip_whitespace($reader)) {
while (1) {
my $data = $reader->data;
$self->parser_error("End of data seen while looking for close PI marker", $reader)
unless length($data);
if ($data =~ /^(.*?)\?>/s) {
$pi_data .= $1;
$reader->move_along(length($1) + 2);
last;
}
else {
$pi_data .= $data;
$reader->move_along(length($data));
}
}
}
else {
my $data = $reader->data(2);
$data =~ /^\?>/ or $self->parser_error("PI closing sequence not found", $reader);
$reader->move_along(2);
}
$self->processing_instruction({ Target => $target, Data => $pi_data });
return 1;
}
return 0;
}
sub Name {
my ($self, $reader) = @_;
my $name = '';
while(1) {
my $data = $reader->data;
return unless length($data);
$data =~ /^([^\s>\/&\?;=<\)\(\[\],\%\#\!\*\|]*)/ or return;
$name .= $1;
my $len = length($1);
$reader->move_along($len);
last if ($len != length($data));
}
return unless length($name);
$name =~ /$NameChar/o or $self->parser_error("Name <$name> does not match NameChar production", $reader);
return $name;
}
sub quote {
my ($self, $reader) = @_;
my $data = $reader->data;
$data =~ /^(['"])/ or $self->parser_error("Invalid quote token", $reader);
$reader->move_along(1);
return $1;
}
1;
__END__
=head1 NAME
XML::SAX::PurePerl - Pure Perl XML Parser with SAX2 interface
=head1 SYNOPSIS
use XML::Handler::Foo;
use XML::SAX::PurePerl;
my $handler = XML::Handler::Foo->new();
my $parser = XML::SAX::PurePerl->new(Handler => $handler);
$parser->parse_uri("myfile.xml");
=head1 DESCRIPTION
This module implements an XML parser in pure perl. It is written around the
upcoming perl 5.8's unicode support and support for multiple document
encodings (using the PerlIO layer), however it has been ported to work with
ASCII/UTF8 documents under lower perl versions.
The SAX2 API is described in detail at http://sourceforge.net/projects/perl-xml/, in
the CVS archive, under libxml-perl/docs. Hopefully those documents will be in a
better location soon.
Please refer to the SAX2 documentation for how to use this module - it is merely a
front end to SAX2, and implements nothing that is not in that spec (or at least tries
not to - please email me if you find errors in this implementation).
=head1 BUGS
XML::SAX::PurePerl is B<slow>. Very slow. I suggest you use something else
in fact. However it is great as a fallback parser for XML::SAX, where the
user might not be able to install an XS based parser or C library.
Currently lots, probably. At the moment the weakest area is parsing DOCTYPE declarations,
though the code is in place to start doing this. Also parsing parameter entity
references is causing me much confusion, since it's not exactly what I would call
trivial, or well documented in the XML grammar. XML documents with internal subsets
are likely to fail.
I am however trying to work towards full conformance using the Oasis test suite.
=head1 AUTHOR
Matt Sergeant, matt@sergeant.org. Copyright 2001.
Please report all bugs to the Perl-XML mailing list at perl-xml@listserv.activestate.com.
=head1 LICENSE
This is free software. You may use it or redistribute it under the same terms as
Perl 5.7.2 itself.
=cut
perl5/5.32/XML/SAX/Base.pm 0000444 00000360025 15157556025 0010504 0 ustar 00 perl5/5.32/XML/SAX/DocumentLocator.pm 0000444 00000005502 15157556032 0012726 0 ustar 00 # $Id$
package XML::SAX::DocumentLocator;
use strict;
sub new {
my $class = shift;
my %object;
tie %object, $class, @_;
return bless \%object, $class;
}
sub TIEHASH {
my $class = shift;
my ($pubmeth, $sysmeth, $linemeth, $colmeth, $encmeth, $xmlvmeth) = @_;
return bless {
pubmeth => $pubmeth,
sysmeth => $sysmeth,
linemeth => $linemeth,
colmeth => $colmeth,
encmeth => $encmeth,
xmlvmeth => $xmlvmeth,
}, $class;
}
sub FETCH {
my ($self, $key) = @_;
my $method;
if ($key eq 'PublicId') {
$method = $self->{pubmeth};
}
elsif ($key eq 'SystemId') {
$method = $self->{sysmeth};
}
elsif ($key eq 'LineNumber') {
$method = $self->{linemeth};
}
elsif ($key eq 'ColumnNumber') {
$method = $self->{colmeth};
}
elsif ($key eq 'Encoding') {
$method = $self->{encmeth};
}
elsif ($key eq 'XMLVersion') {
$method = $self->{xmlvmeth};
}
if ($method) {
my $value = $method->($key);
return $value;
}
return undef;
}
sub EXISTS {
my ($self, $key) = @_;
if ($key =~ /^(PublicId|SystemId|LineNumber|ColumnNumber|Encoding|XMLVersion)$/) {
return 1;
}
return 0;
}
sub STORE {
my ($self, $key, $value) = @_;
}
sub DELETE {
my ($self, $key) = @_;
}
sub CLEAR {
my ($self) = @_;
}
sub FIRSTKEY {
my ($self) = @_;
# assignment resets.
$self->{keys} = {
PublicId => 1,
SystemId => 1,
LineNumber => 1,
ColumnNumber => 1,
Encoding => 1,
XMLVersion => 1,
};
return each %{$self->{keys}};
}
sub NEXTKEY {
my ($self, $lastkey) = @_;
return each %{$self->{keys}};
}
1;
__END__
=head1 NAME
XML::SAX::DocumentLocator - Helper class for document locators
=head1 SYNOPSIS
my $locator = XML::SAX::DocumentLocator->new(
sub { $object->get_public_id },
sub { $object->get_system_id },
sub { $reader->current_line },
sub { $reader->current_column },
sub { $reader->get_encoding },
sub { $reader->get_xml_version },
);
=head1 DESCRIPTION
This module gives you a tied hash reference that calls the
specified closures when asked for PublicId, SystemId,
LineNumber and ColumnNumber.
It is useful for writing SAX Parsers so that you don't have
to constantly update the line numbers in a hash reference on
the object you pass to set_document_locator(). See the source
code for XML::SAX::PurePerl for a usage example.
=head1 API
There is only 1 method: C<new>. Simply pass it a list of
closures that when called will return the PublicId, the
SystemId, the LineNumber, the ColumnNumber, the Encoding
and the XMLVersion respectively.
The closures are passed a single parameter, the key being
requested. But you're free to ignore that.
=cut
perl5/5.32/XML/SAX/Exception.pm 0000444 00000005731 15157556037 0011573 0 ustar 00 package XML::SAX::Exception;
$XML::SAX::Exception::VERSION = '1.09';
use strict;
use overload '""' => "stringify",
'fallback' => 1;
use vars qw($StackTrace);
use Carp;
$StackTrace = $ENV{XML_DEBUG} || 0;
# Other exception classes:
@XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception');
@XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception');
@XML::SAX::Exception::Parse::ISA = ('XML::SAX::Exception');
sub throw {
my $class = shift;
if (ref($class)) {
die $class;
}
die $class->new(@_);
}
sub new {
my $class = shift;
my %opts = @_;
confess "Invalid options: " . join(', ', keys %opts) unless exists $opts{Message};
bless { ($StackTrace ? (StackTrace => stacktrace()) : ()), %opts },
$class;
}
sub stringify {
my $self = shift;
local $^W;
my $error;
if (exists $self->{LineNumber}) {
$error = $self->{Message} . " [Ln: " . $self->{LineNumber} .
", Col: " . $self->{ColumnNumber} . "]";
}
else {
$error = $self->{Message};
}
if ($StackTrace) {
$error .= stackstring($self->{StackTrace});
}
$error .= "\n";
return $error;
}
sub stacktrace {
my $i = 2;
my @fulltrace;
while (my @trace = caller($i++)) {
my %hash;
@hash{qw(Package Filename Line)} = @trace[0..2];
push @fulltrace, \%hash;
}
return \@fulltrace;
}
sub stackstring {
my $stacktrace = shift;
my $string = "\nFrom:\n";
foreach my $current (@$stacktrace) {
$string .= $current->{Filename} . " Line: " . $current->{Line} . "\n";
}
return $string;
}
1;
__END__
=head1 NAME
XML::SAX::Exception - Exception classes for XML::SAX
=head1 SYNOPSIS
throw XML::SAX::Exception::NotSupported(
Message => "The foo feature is not supported",
);
=head1 DESCRIPTION
This module is the base class for all SAX Exceptions, those defined in
the spec as well as those that one may create for one's own SAX errors.
There are three subclasses included, corresponding to those of the SAX
spec:
XML::SAX::Exception::NotSupported
XML::SAX::Exception::NotRecognized
XML::SAX::Exception::Parse
Use them wherever you want, and as much as possible when you encounter
such errors. SAX is meant to use exceptions as much as possible to
flag problems.
=head1 CREATING NEW EXCEPTION CLASSES
All you need to do to create a new exception class is:
@XML::SAX::Exception::MyException::ISA = ('XML::SAX::Exception')
The given package doesn't need to exist, it'll behave correctly this
way. If your exception refines an existing exception class, then you
may also inherit from that instead of from the base class.
=head1 THROWING EXCEPTIONS
This is as simple as exemplified in the SYNOPSIS. In fact, there's
nothing more to know. All you have to do is:
throw XML::SAX::Exception::MyException( Message => 'Something went wrong' );
and voila, you've thrown an exception which can be caught in an eval block.
=cut
perl5/5.32/XML/SAX/Intro.pod 0000444 00000034741 15157556044 0011077 0 ustar 00 =head1 NAME
XML::SAX::Intro - An Introduction to SAX Parsing with Perl
=head1 Introduction
XML::SAX is a new way to work with XML Parsers in Perl. In this article
we'll discuss why you should be using SAX, why you should be using
XML::SAX, and we'll see some of the finer implementation details. The
text below assumes some familiarity with callback, or push based
parsing, but if you are unfamiliar with these techniques then a good
place to start is Kip Hampton's excellent series of articles on XML.com.
=head1 Replacing XML::Parser
The de-facto way of parsing XML under perl is to use Larry Wall and
Clark Cooper's XML::Parser. This module is a Perl and XS wrapper around
the expat XML parser library by James Clark. It has been a hugely
successful project, but suffers from a couple of rather major flaws.
Firstly it is a proprietary API, designed before the SAX API was
conceived, which means that it is not easily replaceable by other
streaming parsers. Secondly it's callbacks are subrefs. This doesn't
sound like much of an issue, but unfortunately leads to code like:
sub handle_start {
my ($e, $el, %attrs) = @_;
if ($el eq 'foo') {
$e->{inside_foo}++; # BAD! $e is an XML::Parser::Expat object.
}
}
As you can see, we're using the $e object to hold our state
information, which is a bad idea because we don't own that object - we
didn't create it. It's an internal object of XML::Parser, that happens
to be a hashref. We could all too easily overwrite XML::Parser internal
state variables by using this, or Clark could change it to an array ref
(not that he would, because it would break so much code, but he could).
The only way currently with XML::Parser to safely maintain state is to
use a closure:
my $state = MyState->new();
$parser->setHandlers(Start => sub { handle_start($state, @_) });
This closure traps the $state variable, which now gets passed as the
first parameter to your callback. Unfortunately very few people use
this technique, as it is not documented in the XML::Parser POD files.
Another reason you might not want to use XML::Parser is because you
need some feature that it doesn't provide (such as validation), or you
might need to use a library that doesn't use expat, due to it not being
installed on your system, or due to having a restrictive ISP. Using SAX
allows you to work around these restrictions.
=head1 Introducing SAX
SAX stands for the Simple API for XML. And simple it really is.
Constructing a SAX parser and passing events to handlers is done as
simply as:
use XML::SAX;
use MySAXHandler;
my $parser = XML::SAX::ParserFactory->parser(
Handler => MySAXHandler->new
);
$parser->parse_uri("foo.xml");
The important concept to grasp here is that SAX uses a factory class
called XML::SAX::ParserFactory to create a new parser instance. The
reason for this is so that you can support other underlying
parser implementations for different feature sets. This is one thing
that XML::Parser has always sorely lacked.
In the code above we see the parse_uri method used, but we could
have equally well
called parse_file, parse_string, or parse(). Please see XML::SAX::Base
for what these methods take as parameters, but don't be fooled into
believing parse_file takes a filename. No, it takes a file handle, a
glob, or a subclass of IO::Handle. Beware.
SAX works very similarly to XML::Parser's default callback method,
except it has one major difference: rather than setting individual
callbacks, you create a new class in which to receive the callbacks.
Each callback is called as a method call on an instance of that handler
class. An example will best demonstrate this:
package MySAXHandler;
use base qw(XML::SAX::Base);
sub start_document {
my ($self, $doc) = @_;
# process document start event
}
sub start_element {
my ($self, $el) = @_;
# process element start event
}
Now, when we instantiate this as above, and parse some XML with this as
the handler, the methods start_document and start_element will be
called as method calls, so this would be the equivalent of directly
calling:
$object->start_element($el);
Notice how this is different to XML::Parser's calling style, which
calls:
start_element($e, $name, %attribs);
It's the difference between function calling and method calling which
allows you to subclass SAX handlers which contributes to SAX being a
powerful solution.
As you can see, unlike XML::Parser, we have to define a new package in
which to do our processing (there are hacks you can do to make this
uneccessary, but I'll leave figuring those out to the experts). The
biggest benefit of this is that you maintain your own state variable
($self in the above example) thus freeing you of the concerns listed
above. It is also an improvement in maintainability - you can place the
code in a separate file if you wish to, and your callback methods are
always called the same thing, rather than having to choose a suitable
name for them as you had to with XML::Parser. This is an obvious win.
SAX parsers are also very flexible in how you pass a handler to them.
You can use a constructor parameter as we saw above, or we can pass the
handler directly in the call to one of the parse methods:
$parser->parse(Handler => $handler,
Source => { SystemId => "foo.xml" });
# or...
$parser->parse_file($fh, Handler => $handler);
This flexibility allows for one parser to be used in many different
scenarios throughout your script (though one shouldn't feel pressure to
use this method, as parser construction is generally not a time
consuming process).
=head1 Callback Parameters
The only other thing you need to know to understand basic SAX is the
structure of the parameters passed to each of the callbacks. In
XML::Parser, all parameters are passed as multiple options to the
callbacks, so for example the Start callback would be called as
my_start($e, $name, %attributes), and the PI callback would be called
as my_processing_instruction($e, $target, $data). In SAX, every
callback is passed a hash reference, containing entries that define our
"node". The key callbacks and the structures they receive are:
=head2 start_element
The start_element handler is called whenever a parser sees an opening
tag. It is passed an element structure consisting of:
=over 4
=item LocalName
The name of the element minus any namespace prefix it may
have come with in the document.
=item NamespaceURI
The URI of the namespace associated with this element,
or the empty string for none.
=item Attributes
A set of attributes as described below.
=item Name
The name of the element as it was seen in the document (i.e.
including any prefix associated with it)
=item Prefix
The prefix used to qualify this element's namespace, or the
empty string if none.
=back
The B<Attributes> are a hash reference, keyed by what we have called
"James Clark" notation. This means that the attribute name has been
expanded to include any associated namespace URI, and put together as
{ns}name, where "ns" is the expanded namespace URI of the attribute if
and only if the attribute had a prefix, and "name" is the LocalName of
the attribute.
The value of each entry in the attributes hash is another hash
structure consisting of:
=over 4
=item LocalName
The name of the attribute minus any namespace prefix it may have
come with in the document.
=item NamespaceURI
The URI of the namespace associated with this attribute. If the
attribute had no prefix, then this consists of just the empty string.
=item Name
The attribute's name as it appeared in the document, including any
namespace prefix.
=item Prefix
The prefix used to qualify this attribute's namepace, or the
empty string if none.
=item Value
The value of the attribute.
=back
So a full example, as output by Data::Dumper might be:
....
=head2 end_element
The end_element handler is called either when a parser sees a closing
tag, or after start_element has been called for an empty element (do
note however that a parser may if it is so inclined call characters
with an empty string when it sees an empty element. There is no simple
way in SAX to determine if the parser in fact saw an empty element, a
start and end element with no content..
The end_element handler receives exactly the same structure as
start_element, minus the Attributes entry. One must note though that it
should not be a reference to the same data as start_element receives,
so you may change the values in start_element but this will not affect
the values later seen by end_element.
=head2 characters
The characters callback may be called in serveral circumstances. The
most obvious one is when seeing ordinary character data in the markup.
But it is also called for text in a CDATA section, and is also called
in other situations. A SAX parser has to make no guarantees whatsoever
about how many times it may call characters for a stretch of text in an
XML document - it may call once, or it may call once for every
character in the text. In order to work around this it is often
important for the SAX developer to use a bundling technique, where text
is gathered up and processed in one of the other callbacks. This is not
always necessary, but it is a worthwhile technique to learn, which we
will cover in XML::SAX::Advanced (when I get around to writing it).
The characters handler is called with a very simple structure - a hash
reference consisting of just one entry:
=over 4
=item Data
The text data that was received.
=back
=head2 comment
The comment callback is called for comment text. Unlike with
C<characters()>, the comment callback *must* be invoked just once for an
entire comment string. It receives a single simple structure - a hash
reference containing just one entry:
=over 4
=item Data
The text of the comment.
=back
=head2 processing_instruction
The processing instruction handler is called for all processing
instructions in the document. Note that these processing instructions
may appear before the document root element, or after it, or anywhere
where text and elements would normally appear within the document,
according to the XML specification.
The handler is passed a structure containing just two entries:
=over 4
=item Target
The target of the processing instrcution
=item Data
The text data in the processing instruction. Can be an empty
string for a processing instruction that has no data element.
For example E<lt>?wiggle?E<gt> is a perfectly valid processing instruction.
=back
=head1 Tip of the iceberg
What we have discussed above is really the tip of the SAX iceberg. And
so far it looks like there's not much of interest to SAX beyond what we
have seen with XML::Parser. But it does go much further than that, I
promise.
People who hate Object Oriented code for the sake of it may be thinking
here that creating a new package just to parse something is a waste
when they've been parsing things just fine up to now using procedural
code. But there's reason to all this madness. And that reason is SAX
Filters.
As you saw right at the very start, to let the parser know about our
class, we pass it an instance of our class as the Handler to the
parser. But now imagine what would happen if our class could also take
a Handler option, and simply do some processing and pass on our data
further down the line? That in a nutshell is how SAX filters work. It's
Unix pipes for the 21st century!
There are two downsides to this. Number 1 - writing SAX filters can be
tricky. If you look into the future and read the advanced tutorial I'm
writing, you'll see that Handler can come in several shapes and sizes.
So making sure your filter does the right thing can be tricky.
Secondly, constructing complex filter chains can be difficult, and
simple thinking tells us that we only get one pass at our document,
when often we'll need more than that.
Luckily though, those downsides have been fixed by the release of two
very cool modules. What's even better is that I didn't write either of
them!
The first module is XML::SAX::Base. This is a VITAL SAX module that
acts as a base class for all SAX parsers and filters. It provides an
abstraction away from calling the handler methods, that makes sure your
filter or parser does the right thing, and it does it FAST. So, if you
ever need to write a SAX filter, which if you're processing XML -> XML,
or XML -> HTML, then you probably do, then you need to be writing it as
a subclass of XML::SAX::Base. Really - this is advice not to ignore
lightly. I will not go into the details of writing a SAX filter here.
Kip Hampton, the author of XML::SAX::Base has covered this nicely in
his article on XML.com here <URI>.
To construct SAX pipelines, Barrie Slaymaker, a long time Perl hacker
whose modules you will probably have heard of or used, wrote a very
clever module called XML::SAX::Machines. This combines some really
clever SAX filter-type modules, with a construction toolkit for filters
that makes building pipelines easy. But before we see how it makes
things easy, first lets see how tricky it looks to build complex SAX
filter pipelines.
use XML::SAX::ParserFactory;
use XML::Filter::Filter1;
use XML::Filter::Filter2;
use XML::SAX::Writer;
my $output_string;
my $writer = XML::SAX::Writer->new(Output => \$output_string);
my $filter2 = XML::SAX::Filter2->new(Handler => $writer);
my $filter1 = XML::SAX::Filter1->new(Handler => $filter2);
my $parser = XML::SAX::ParserFactory->parser(Handler => $filter1);
$parser->parse_uri("foo.xml");
This is a lot easier with XML::SAX::Machines:
use XML::SAX::Machines qw(Pipeline);
my $output_string;
my $parser = Pipeline(
XML::SAX::Filter1 => XML::SAX::Filter2 => \$output_string
);
$parser->parse_uri("foo.xml");
One of the main benefits of XML::SAX::Machines is that the pipelines
are constructed in natural order, rather than the reverse order we saw
with manual pipeline construction. XML::SAX::Machines takes care of all
the internals of pipe construction, providing you at the end with just
a parser you can use (and you can re-use the same parser as many times
as you need to).
Just a final tip. If you ever get stuck and are confused about what is
being passed from one SAX filter or parser to the next, then
Devel::TraceSAX will come to your rescue. This perl debugger plugin
will allow you to dump the SAX stream of events as it goes by. Usage is
really very simple just call your perl script that uses SAX as follows:
$ perl -d:TraceSAX <scriptname>
And preferably pipe the output to a pager of some sort, such as more or
less. The output is extremely verbose, but should help clear some
issues up.
=head1 AUTHOR
Matt Sergeant, matt@sergeant.org
$Id$
=cut
perl5/5.32/XML/Simple.pm 0000444 00000305420 15157556051 0010425 0 ustar 00 package XML::Simple;
$XML::Simple::VERSION = '2.25';
=head1 NAME
XML::Simple - An API for simple XML files
=head1 SYNOPSIS
PLEASE DO NOT USE THIS MODULE IN NEW CODE. If you ignore this
warning and use it anyway, the C<qw(:strict)> mode will save you a little pain.
use XML::Simple qw(:strict);
my $ref = XMLin([<xml file or string>] [, <options>]);
my $xml = XMLout($hashref [, <options>]);
Or the object oriented way:
require XML::Simple qw(:strict);
my $xs = XML::Simple->new([<options>]);
my $ref = $xs->XMLin([<xml file or string>] [, <options>]);
my $xml = $xs->XMLout($hashref [, <options>]);
(or see L<"SAX SUPPORT"> for 'the SAX way').
Note, in these examples, the square brackets are used to denote optional items
not to imply items should be supplied in arrayrefs.
=cut
# See after __END__ for more POD documentation
# Load essentials here, other modules loaded on demand later
use strict;
use warnings;
use warnings::register;
use Carp;
use Scalar::Util qw();
require Exporter;
##############################################################################
# Define some constants
#
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $PREFERRED_PARSER);
@ISA = qw(Exporter);
@EXPORT = qw(XMLin XMLout);
@EXPORT_OK = qw(xml_in xml_out);
my %StrictMode = ();
my @KnownOptIn = qw(keyattr keeproot forcecontent contentkey noattr
searchpath forcearray cache suppressempty parseropts
grouptags nsexpand datahandler varattr variables
normalisespace normalizespace valueattr strictmode);
my @KnownOptOut = qw(keyattr keeproot contentkey noattr
rootname xmldecl outputfile noescape suppressempty
grouptags nsexpand handler noindent attrindent nosort
valueattr numericescape strictmode);
my @DefKeyAttr = qw(name key id);
my $DefRootName = qq(opt);
my $DefContentKey = qq(content);
my $DefXmlDecl = qq(<?xml version='1.0' standalone='yes'?>);
my $xmlns_ns = 'http://www.w3.org/2000/xmlns/';
my $bad_def_ns_jcn = '{' . $xmlns_ns . '}'; # LibXML::SAX workaround
##############################################################################
# Globals for use by caching routines
#
my %MemShareCache = ();
my %MemCopyCache = ();
##############################################################################
# Wrapper for Exporter - handles ':strict'
#
sub import {
# Handle the :strict tag
my($calling_package) = caller();
_strict_mode_for_caller(1) if grep(/^:strict$/, @_);
# Pass everything else to Exporter.pm
@_ = grep(!/^:strict$/, @_);
goto &Exporter::import;
}
##############################################################################
# Constructor for optional object interface.
#
sub new {
my $class = shift;
if(@_ % 2) {
croak "Default options must be name=>value pairs (odd number supplied)";
}
my %known_opt;
@known_opt{@KnownOptIn, @KnownOptOut} = ();
my %raw_opt = @_;
$raw_opt{strictmode} = _strict_mode_for_caller()
unless exists $raw_opt{strictmode};
my %def_opt;
while(my($key, $val) = each %raw_opt) {
my $lkey = lc($key);
$lkey =~ s/_//g;
croak "Unrecognised option: $key" unless(exists($known_opt{$lkey}));
$def_opt{$lkey} = $val;
}
my $self = { def_opt => \%def_opt };
return(bless($self, $class));
}
##############################################################################
# Sub: _strict_mode_for_caller()
#
# Gets or sets the XML::Simple :strict mode flag for the calling namespace.
# Walks back through call stack to find the calling namespace and sets the
# :strict mode flag for that namespace if an argument was supplied and returns
# the flag value if not.
#
sub _strict_mode_for_caller {
my $set_mode = @_;
my $frame = 1;
while(my($package) = caller($frame++)) {
next if $package eq 'XML::Simple';
$StrictMode{$package} = 1 if $set_mode;
return $StrictMode{$package};
}
return(0);
}
##############################################################################
# Sub: _get_object()
#
# Helper routine called from XMLin() and XMLout() to create an object if none
# was provided. Note, this routine does mess with the caller's @_ array.
#
sub _get_object {
my $self;
if($_[0] and UNIVERSAL::isa($_[0], 'XML::Simple')) {
$self = shift;
}
else {
$self = XML::Simple->new();
}
return $self;
}
##############################################################################
# Sub/Method: XMLin()
#
# Exported routine for slurping XML into a hashref - see pod for info.
#
# May be called as object method or as a plain function.
#
# Expects one arg for the source XML, optionally followed by a number of
# name => value option pairs.
#
sub XMLin {
my $self = &_get_object; # note, @_ is passed implicitly
my $target = shift;
# Work out whether to parse a string, a file or a filehandle
if(not defined $target) {
return $self->parse_file(undef, @_);
}
elsif($target eq '-') {
local($/) = undef;
$target = <STDIN>;
return $self->parse_string(\$target, @_);
}
elsif(my $type = ref($target)) {
if($type eq 'SCALAR') {
return $self->parse_string($target, @_);
}
else {
return $self->parse_fh($target, @_);
}
}
elsif($target =~ m{<.*?>}s) {
return $self->parse_string(\$target, @_);
}
else {
return $self->parse_file($target, @_);
}
}
##############################################################################
# Sub/Method: parse_file()
#
# Same as XMLin, but only parses from a named file.
#
sub parse_file {
my $self = &_get_object; # note, @_ is passed implicitly
my $filename = shift;
$self->handle_options('in', @_);
$filename = $self->default_config_file if not defined $filename;
$filename = $self->find_xml_file($filename, @{$self->{opt}->{searchpath}});
# Check cache for previous parse
if($self->{opt}->{cache}) {
foreach my $scheme (@{$self->{opt}->{cache}}) {
my $method = 'cache_read_' . $scheme;
my $opt = $self->$method($filename);
return($opt) if($opt);
}
}
my $ref = $self->build_simple_tree($filename, undef);
if($self->{opt}->{cache}) {
my $method = 'cache_write_' . $self->{opt}->{cache}->[0];
$self->$method($ref, $filename);
}
return $ref;
}
##############################################################################
# Sub/Method: parse_fh()
#
# Same as XMLin, but only parses from a filehandle.
#
sub parse_fh {
my $self = &_get_object; # note, @_ is passed implicitly
my $fh = shift;
croak "Can't use " . (defined $fh ? qq{string ("$fh")} : 'undef') .
" as a filehandle" unless ref $fh;
$self->handle_options('in', @_);
return $self->build_simple_tree(undef, $fh);
}
##############################################################################
# Sub/Method: parse_string()
#
# Same as XMLin, but only parses from a string or a reference to a string.
#
sub parse_string {
my $self = &_get_object; # note, @_ is passed implicitly
my $string = shift;
$self->handle_options('in', @_);
return $self->build_simple_tree(undef, ref $string ? $string : \$string);
}
##############################################################################
# Method: default_config_file()
#
# Returns the name of the XML file to parse if no filename (or XML string)
# was provided.
#
sub default_config_file {
my $self = shift;
require File::Basename;
my($basename, $script_dir, $ext) = File::Basename::fileparse($0, '\.[^\.]+');
# Add script directory to searchpath
if($script_dir) {
unshift(@{$self->{opt}->{searchpath}}, $script_dir);
}
return $basename . '.xml';
}
##############################################################################
# Method: build_simple_tree()
#
# Builds a 'tree' data structure as provided by XML::Parser and then
# 'simplifies' it as specified by the various options in effect.
#
sub build_simple_tree {
my $self = shift;
my $tree = eval {
$self->build_tree(@_);
};
Carp::croak("$@XML::Simple called") if $@;
return $self->{opt}->{keeproot}
? $self->collapse({}, @$tree)
: $self->collapse(@{$tree->[1]});
}
##############################################################################
# Method: build_tree()
#
# This routine will be called if there is no suitable pre-parsed tree in a
# cache. It parses the XML and returns an XML::Parser 'Tree' style data
# structure (summarised in the comments for the collapse() routine below).
#
# XML::Simple requires the services of another module that knows how to parse
# XML. If XML::SAX is installed, the default SAX parser will be used,
# otherwise XML::Parser will be used.
#
# This routine expects to be passed a filename as argument 1 or a 'string' as
# argument 2. The 'string' might be a string of XML (passed by reference to
# save memory) or it might be a reference to an IO::Handle. (This
# non-intuitive mess results in part from the way XML::Parser works but that's
# really no excuse).
#
sub build_tree {
my $self = shift;
my $filename = shift;
my $string = shift;
my $preferred_parser = $PREFERRED_PARSER;
unless(defined($preferred_parser)) {
$preferred_parser = $ENV{XML_SIMPLE_PREFERRED_PARSER} || '';
}
if($preferred_parser eq 'XML::Parser') {
return($self->build_tree_xml_parser($filename, $string));
}
eval { require XML::SAX; }; # We didn't need it until now
if($@) { # No XML::SAX - fall back to XML::Parser
if($preferred_parser) { # unless a SAX parser was expressly requested
croak "XMLin() could not load XML::SAX";
}
return($self->build_tree_xml_parser($filename, $string));
}
$XML::SAX::ParserPackage = $preferred_parser if($preferred_parser);
my $sp = XML::SAX::ParserFactory->parser(Handler => $self);
$self->{nocollapse} = 1;
my($tree);
if($filename) {
$tree = $sp->parse_uri($filename);
}
else {
if(ref($string) && ref($string) ne 'SCALAR') {
$tree = $sp->parse_file($string);
}
else {
$tree = $sp->parse_string($$string);
}
}
return($tree);
}
##############################################################################
# Method: build_tree_xml_parser()
#
# This routine will be called if XML::SAX is not installed, or if XML::Parser
# was specifically requested. It takes the same arguments as build_tree() and
# returns the same data structure (XML::Parser 'Tree' style).
#
sub build_tree_xml_parser {
my $self = shift;
my $filename = shift;
my $string = shift;
eval {
local($^W) = 0; # Suppress warning from Expat.pm re File::Spec::load()
require XML::Parser; # We didn't need it until now
};
if($@) {
croak "XMLin() requires either XML::SAX or XML::Parser";
}
if($self->{opt}->{nsexpand}) {
carp "'nsexpand' option requires XML::SAX";
}
my $xp = $self->new_xml_parser();
my($tree);
if($filename) {
# $tree = $xp->parsefile($filename); # Changed due to prob w/mod_perl
open(my $xfh, '<', $filename) || croak qq($filename - $!);
$tree = $xp->parse($xfh);
}
else {
$tree = $xp->parse($$string);
}
return($tree);
}
##############################################################################
# Method: new_xml_parser()
#
# Simply calls the XML::Parser constructor. Override this method to customise
# the behaviour of the parser.
#
sub new_xml_parser {
my($self) = @_;
my $xp = XML::Parser->new(Style => 'Tree', @{$self->{opt}->{parseropts}});
$xp->setHandlers(ExternEnt => sub {return $_[2]});
return $xp;
}
##############################################################################
# Method: cache_write_storable()
#
# Wrapper routine for invoking Storable::nstore() to cache a parsed data
# structure.
#
sub cache_write_storable {
my($self, $data, $filename) = @_;
my $cachefile = $self->storable_filename($filename);
require Storable; # We didn't need it until now
if ('VMS' eq $^O) {
Storable::nstore($data, $cachefile);
}
else {
# If the following line fails for you, your Storable.pm is old - upgrade
Storable::lock_nstore($data, $cachefile);
}
}
##############################################################################
# Method: cache_read_storable()
#
# Wrapper routine for invoking Storable::retrieve() to read a cached parsed
# data structure. Only returns cached data if the cache file exists and is
# newer than the source XML file.
#
sub cache_read_storable {
my($self, $filename) = @_;
my $cachefile = $self->storable_filename($filename);
return unless(-r $cachefile);
return unless((stat($cachefile))[9] > (stat($filename))[9]);
require Storable; # We didn't need it until now
if ('VMS' eq $^O) {
return(Storable::retrieve($cachefile));
}
else {
return(Storable::lock_retrieve($cachefile));
}
}
##############################################################################
# Method: storable_filename()
#
# Translates the supplied source XML filename into a filename for the storable
# cached data. A '.stor' suffix is added after stripping an optional '.xml'
# suffix.
#
sub storable_filename {
my($self, $cachefile) = @_;
$cachefile =~ s{(\.xml)?$}{.stor};
return $cachefile;
}
##############################################################################
# Method: cache_write_memshare()
#
# Takes the supplied data structure reference and stores it away in a global
# hash structure.
#
sub cache_write_memshare {
my($self, $data, $filename) = @_;
$MemShareCache{$filename} = [time(), $data];
}
##############################################################################
# Method: cache_read_memshare()
#
# Takes a filename and looks in a global hash for a cached parsed version.
#
sub cache_read_memshare {
my($self, $filename) = @_;
return unless($MemShareCache{$filename});
return unless($MemShareCache{$filename}->[0] > (stat($filename))[9]);
return($MemShareCache{$filename}->[1]);
}
##############################################################################
# Method: cache_write_memcopy()
#
# Takes the supplied data structure and stores a copy of it in a global hash
# structure.
#
sub cache_write_memcopy {
my($self, $data, $filename) = @_;
require Storable; # We didn't need it until now
$MemCopyCache{$filename} = [time(), Storable::dclone($data)];
}
##############################################################################
# Method: cache_read_memcopy()
#
# Takes a filename and looks in a global hash for a cached parsed version.
# Returns a reference to a copy of that data structure.
#
sub cache_read_memcopy {
my($self, $filename) = @_;
return unless($MemCopyCache{$filename});
return unless($MemCopyCache{$filename}->[0] > (stat($filename))[9]);
return(Storable::dclone($MemCopyCache{$filename}->[1]));
}
##############################################################################
# Sub/Method: XMLout()
#
# Exported routine for 'unslurping' a data structure out to XML.
#
# Expects a reference to a data structure and an optional list of option
# name => value pairs.
#
sub XMLout {
my $self = &_get_object; # note, @_ is passed implicitly
croak "XMLout() requires at least one argument" unless(@_);
my $ref = shift;
$self->handle_options('out', @_);
# If namespace expansion is set, XML::NamespaceSupport is required
if($self->{opt}->{nsexpand}) {
require XML::NamespaceSupport;
$self->{nsup} = XML::NamespaceSupport->new();
$self->{ns_prefix} = 'aaa';
}
# Wrap top level arrayref in a hash
if(UNIVERSAL::isa($ref, 'ARRAY')) {
$ref = { anon => $ref };
}
# Extract rootname from top level hash if keeproot enabled
if($self->{opt}->{keeproot}) {
my(@keys) = keys(%$ref);
if(@keys == 1) {
$ref = $ref->{$keys[0]};
$self->{opt}->{rootname} = $keys[0];
}
}
# Ensure there are no top level attributes if we're not adding root elements
elsif($self->{opt}->{rootname} eq '') {
if(UNIVERSAL::isa($ref, 'HASH')) {
my $refsave = $ref;
$ref = {};
foreach (keys(%$refsave)) {
if(ref($refsave->{$_})) {
$ref->{$_} = $refsave->{$_};
}
else {
$ref->{$_} = [ $refsave->{$_} ];
}
}
}
}
# Encode the hashref and write to file if necessary
$self->{_ancestors} = {};
my $xml = $self->value_to_xml($ref, $self->{opt}->{rootname}, '');
delete $self->{_ancestors};
if($self->{opt}->{xmldecl}) {
$xml = $self->{opt}->{xmldecl} . "\n" . $xml;
}
if($self->{opt}->{outputfile}) {
if(ref($self->{opt}->{outputfile})) {
my $fh = $self->{opt}->{outputfile};
if(UNIVERSAL::isa($fh, 'GLOB') and !UNIVERSAL::can($fh, 'print')) {
eval { require IO::Handle; };
croak $@ if $@;
}
return($fh->print($xml));
}
else {
open(my $out, '>', "$self->{opt}->{outputfile}") ||
croak "open($self->{opt}->{outputfile}): $!";
binmode($out, ':utf8') if($] >= 5.008);
print $out $xml or croak "print: $!";
close $out or croak "close: $!";
}
}
elsif($self->{opt}->{handler}) {
require XML::SAX;
my $sp = XML::SAX::ParserFactory->parser(
Handler => $self->{opt}->{handler}
);
return($sp->parse_string($xml));
}
else {
return($xml);
}
}
##############################################################################
# Method: handle_options()
#
# Helper routine for both XMLin() and XMLout(). Both routines handle their
# first argument and assume all other args are options handled by this routine.
# Saves a hash of options in $self->{opt}.
#
# If default options were passed to the constructor, they will be retrieved
# here and merged with options supplied to the method call.
#
# First argument should be the string 'in' or the string 'out'.
#
# Remaining arguments should be name=>value pairs. Sets up default values
# for options not supplied. Unrecognised options are a fatal error.
#
sub handle_options {
my $self = shift;
my $dirn = shift;
# Determine valid options based on context
my %known_opt;
if($dirn eq 'in') {
@known_opt{@KnownOptIn} = @KnownOptIn;
}
else {
@known_opt{@KnownOptOut} = @KnownOptOut;
}
# Store supplied options in hashref and weed out invalid ones
if(@_ % 2) {
croak "Options must be name=>value pairs (odd number supplied)";
}
my %raw_opt = @_;
my $opt = {};
$self->{opt} = $opt;
while(my($key, $val) = each %raw_opt) {
my $lkey = lc($key);
$lkey =~ s/_//g;
croak "Unrecognised option: $key" unless($known_opt{$lkey});
$opt->{$lkey} = $val;
}
# Merge in options passed to constructor
foreach (keys(%known_opt)) {
unless(exists($opt->{$_})) {
if(exists($self->{def_opt}->{$_})) {
$opt->{$_} = $self->{def_opt}->{$_};
}
}
}
# Set sensible defaults if not supplied
if(exists($opt->{rootname})) {
unless(defined($opt->{rootname})) {
$opt->{rootname} = '';
}
}
else {
$opt->{rootname} = $DefRootName;
}
if($opt->{xmldecl} and $opt->{xmldecl} eq '1') {
$opt->{xmldecl} = $DefXmlDecl;
}
if(exists($opt->{contentkey})) {
if($opt->{contentkey} =~ m{^-(.*)$}) {
$opt->{contentkey} = $1;
$opt->{collapseagain} = 1;
}
}
else {
$opt->{contentkey} = $DefContentKey;
}
unless(exists($opt->{normalisespace})) {
$opt->{normalisespace} = $opt->{normalizespace};
}
$opt->{normalisespace} = 0 unless(defined($opt->{normalisespace}));
# Cleanups for values assumed to be arrays later
if($opt->{searchpath}) {
unless(ref($opt->{searchpath})) {
$opt->{searchpath} = [ $opt->{searchpath} ];
}
}
else {
$opt->{searchpath} = [ ];
}
if($opt->{cache} and !ref($opt->{cache})) {
$opt->{cache} = [ $opt->{cache} ];
}
if($opt->{cache}) {
$_ = lc($_) foreach (@{$opt->{cache}});
foreach my $scheme (@{$opt->{cache}}) {
my $method = 'cache_read_' . $scheme;
croak "Unsupported caching scheme: $scheme"
unless($self->can($method));
}
}
if(exists($opt->{parseropts})) {
if(warnings::enabled()) {
carp "Warning: " .
"'ParserOpts' is deprecated, contact the author if you need it";
}
}
else {
$opt->{parseropts} = [ ];
}
# Special cleanup for {forcearray} which could be regex, arrayref or boolean
# or left to default to 0
if(exists($opt->{forcearray})) {
if(ref($opt->{forcearray}) eq 'Regexp') {
$opt->{forcearray} = [ $opt->{forcearray} ];
}
if(ref($opt->{forcearray}) eq 'ARRAY') {
my @force_list = @{$opt->{forcearray}};
if(@force_list) {
$opt->{forcearray} = {};
foreach my $tag (@force_list) {
if(ref($tag) eq 'Regexp') {
push @{$opt->{forcearray}->{_regex}}, $tag;
}
else {
$opt->{forcearray}->{$tag} = 1;
}
}
}
else {
$opt->{forcearray} = 0;
}
}
else {
$opt->{forcearray} = ( $opt->{forcearray} ? 1 : 0 );
}
}
else {
if($opt->{strictmode} and $dirn eq 'in') {
croak "No value specified for 'ForceArray' option in call to XML$dirn()";
}
$opt->{forcearray} = 0;
}
# Special cleanup for {keyattr} which could be arrayref or hashref or left
# to default to arrayref
if(exists($opt->{keyattr})) {
if(ref($opt->{keyattr})) {
if(ref($opt->{keyattr}) eq 'HASH') {
# Make a copy so we can mess with it
$opt->{keyattr} = { %{$opt->{keyattr}} };
# Convert keyattr => { elem => '+attr' }
# to keyattr => { elem => [ 'attr', '+' ] }
foreach my $el (keys(%{$opt->{keyattr}})) {
if($opt->{keyattr}->{$el} =~ /^(\+|-)?(.*)$/) {
$opt->{keyattr}->{$el} = [ $2, ($1 ? $1 : '') ];
if($opt->{strictmode} and $dirn eq 'in') {
next if($opt->{forcearray} == 1);
next if(ref($opt->{forcearray}) eq 'HASH'
and $opt->{forcearray}->{$el});
croak "<$el> set in KeyAttr but not in ForceArray";
}
}
else {
delete($opt->{keyattr}->{$el}); # Never reached (famous last words?)
}
}
}
else {
if(@{$opt->{keyattr}} == 0) {
delete($opt->{keyattr});
}
}
}
else {
$opt->{keyattr} = [ $opt->{keyattr} ];
}
}
else {
if($opt->{strictmode}) {
croak "No value specified for 'KeyAttr' option in call to XML$dirn()";
}
$opt->{keyattr} = [ @DefKeyAttr ];
}
# Special cleanup for {valueattr} which could be arrayref or hashref
if(exists($opt->{valueattr})) {
if(ref($opt->{valueattr}) eq 'ARRAY') {
$opt->{valueattrlist} = {};
$opt->{valueattrlist}->{$_} = 1 foreach(@{ delete $opt->{valueattr} });
}
}
# make sure there's nothing weird in {grouptags}
if($opt->{grouptags}) {
croak "Illegal value for 'GroupTags' option - expected a hashref"
unless UNIVERSAL::isa($opt->{grouptags}, 'HASH');
while(my($key, $val) = each %{$opt->{grouptags}}) {
next if $key ne $val;
croak "Bad value in GroupTags: '$key' => '$val'";
}
}
# Check the {variables} option is valid and initialise variables hash
if($opt->{variables} and !UNIVERSAL::isa($opt->{variables}, 'HASH')) {
croak "Illegal value for 'Variables' option - expected a hashref";
}
if($opt->{variables}) {
$self->{_var_values} = { %{$opt->{variables}} };
}
elsif($opt->{varattr}) {
$self->{_var_values} = {};
}
}
##############################################################################
# Method: find_xml_file()
#
# Helper routine for XMLin().
# Takes a filename, and a list of directories, attempts to locate the file in
# the directories listed.
# Returns a full pathname on success; croaks on failure.
#
sub find_xml_file {
my $self = shift;
my $file = shift;
my @search_path = @_;
require File::Basename;
require File::Spec;
my($filename, $filedir) = File::Basename::fileparse($file);
if($filename ne $file) { # Ignore searchpath if dir component
return($file) if(-e $file);
}
else {
my($path);
foreach $path (@search_path) {
my $fullpath = File::Spec->catfile($path, $file);
return($fullpath) if(-e $fullpath);
}
}
# If user did not supply a search path, default to current directory
if(!@search_path) {
return($file) if(-e $file);
croak "File does not exist: $file";
}
croak "Could not find $file in ", join(':', @search_path);
}
##############################################################################
# Method: collapse()
#
# Helper routine for XMLin(). This routine really comprises the 'smarts' (or
# value add) of this module.
#
# Takes the parse tree that XML::Parser produced from the supplied XML and
# recurses through it 'collapsing' unnecessary levels of indirection (nested
# arrays etc) to produce a data structure that is easier to work with.
#
# Elements in the original parser tree are represented as an element name
# followed by an arrayref. The first element of the array is a hashref
# containing the attributes. The rest of the array contains a list of any
# nested elements as name+arrayref pairs:
#
# <element name>, [ { <attribute hashref> }, <element name>, [ ... ], ... ]
#
# The special element name '0' (zero) flags text content.
#
# This routine cuts down the noise by discarding any text content consisting of
# only whitespace and then moves the nested elements into the attribute hash
# using the name of the nested element as the hash key and the collapsed
# version of the nested element as the value. Multiple nested elements with
# the same name will initially be represented as an arrayref, but this may be
# 'folded' into a hashref depending on the value of the keyattr option.
#
sub collapse {
my $self = shift;
# Start with the hash of attributes
my $attr = shift;
if($self->{opt}->{noattr}) { # Discard if 'noattr' set
$attr = $self->new_hashref;
}
elsif($self->{opt}->{normalisespace} == 2) {
while(my($key, $value) = each %$attr) {
$attr->{$key} = $self->normalise_space($value)
}
}
# Do variable substitutions
if(my $var = $self->{_var_values}) {
while(my($key, $val) = each(%$attr)) {
$val =~ s^\$\{([\w.]+)\}^ $self->get_var($1) ^ge;
$attr->{$key} = $val;
}
}
# Roll up 'value' attributes (but only if no nested elements)
if(!@_ and keys %$attr == 1) {
my($k) = keys %$attr;
if($self->{opt}->{valueattrlist} and $self->{opt}->{valueattrlist}->{$k}) {
return $attr->{$k};
}
}
# Add any nested elements
my($key, $val);
while(@_) {
$key = shift;
$val = shift;
$val = '' if not defined $val;
if(ref($val)) {
$val = $self->collapse(@$val);
next if(!defined($val) and $self->{opt}->{suppressempty});
}
elsif($key eq '0') {
next if($val =~ m{^\s*$}s); # Skip all whitespace content
$val = $self->normalise_space($val)
if($self->{opt}->{normalisespace} == 2);
# do variable substitutions
if(my $var = $self->{_var_values}) {
$val =~ s^\$\{(\w+)\}^ $self->get_var($1) ^ge;
}
# look for variable definitions
if(my $var = $self->{opt}->{varattr}) {
if(exists $attr->{$var}) {
$self->set_var($attr->{$var}, $val);
}
}
# Collapse text content in element with no attributes to a string
if(!%$attr and !@_) {
return($self->{opt}->{forcecontent} ?
{ $self->{opt}->{contentkey} => $val } : $val
);
}
$key = $self->{opt}->{contentkey};
}
# Combine duplicate attributes into arrayref if required
if(exists($attr->{$key})) {
if(UNIVERSAL::isa($attr->{$key}, 'ARRAY')) {
push(@{$attr->{$key}}, $val);
}
else {
$attr->{$key} = [ $attr->{$key}, $val ];
}
}
elsif(defined($val) and UNIVERSAL::isa($val, 'ARRAY')) {
$attr->{$key} = [ $val ];
}
else {
if( $key ne $self->{opt}->{contentkey}
and (
($self->{opt}->{forcearray} == 1)
or (
(ref($self->{opt}->{forcearray}) eq 'HASH')
and (
$self->{opt}->{forcearray}->{$key}
or (grep $key =~ $_, @{$self->{opt}->{forcearray}->{_regex}})
)
)
)
) {
$attr->{$key} = [ $val ];
}
else {
$attr->{$key} = $val;
}
}
}
# Turn arrayrefs into hashrefs if key fields present
if($self->{opt}->{keyattr}) {
while(($key,$val) = each %$attr) {
if(defined($val) and UNIVERSAL::isa($val, 'ARRAY')) {
$attr->{$key} = $self->array_to_hash($key, $val);
}
}
}
# disintermediate grouped tags
if($self->{opt}->{grouptags}) {
while(my($key, $val) = each(%$attr)) {
next unless(UNIVERSAL::isa($val, 'HASH') and (keys %$val == 1));
next unless(exists($self->{opt}->{grouptags}->{$key}));
my($child_key, $child_val) = %$val;
if($self->{opt}->{grouptags}->{$key} eq $child_key) {
$attr->{$key}= $child_val;
}
}
}
# Fold hashes containing a single anonymous array up into just the array
my $count = scalar keys %$attr;
if($count == 1
and exists $attr->{anon}
and UNIVERSAL::isa($attr->{anon}, 'ARRAY')
) {
return($attr->{anon});
}
# Do the right thing if hash is empty, otherwise just return it
if(!%$attr and exists($self->{opt}->{suppressempty})) {
if(defined($self->{opt}->{suppressempty}) and
$self->{opt}->{suppressempty} eq '') {
return('');
}
return(undef);
}
# Roll up named elements with named nested 'value' attributes
if($self->{opt}->{valueattr}) {
while(my($key, $val) = each(%$attr)) {
next unless($self->{opt}->{valueattr}->{$key});
next unless(UNIVERSAL::isa($val, 'HASH') and (keys %$val == 1));
my($k) = keys %$val;
next unless($k eq $self->{opt}->{valueattr}->{$key});
$attr->{$key} = $val->{$k};
}
}
return($attr)
}
##############################################################################
# Method: set_var()
#
# Called when a variable definition is encountered in the XML. (A variable
# definition looks like <element attrname="name">value</element> where attrname
# matches the varattr setting).
#
sub set_var {
my($self, $name, $value) = @_;
$self->{_var_values}->{$name} = $value;
}
##############################################################################
# Method: get_var()
#
# Called during variable substitution to get the value for the named variable.
#
sub get_var {
my($self, $name) = @_;
my $value = $self->{_var_values}->{$name};
return $value if(defined($value));
return '${' . $name . '}';
}
##############################################################################
# Method: normalise_space()
#
# Strips leading and trailing whitespace and collapses sequences of whitespace
# characters to a single space.
#
sub normalise_space {
my($self, $text) = @_;
$text =~ s/^\s+//s;
$text =~ s/\s+$//s;
$text =~ s/\s\s+/ /sg;
return $text;
}
##############################################################################
# Method: array_to_hash()
#
# Helper routine for collapse().
# Attempts to 'fold' an array of hashes into an hash of hashes. Returns a
# reference to the hash on success or the original array if folding is
# not possible. Behaviour is controlled by 'keyattr' option.
#
sub array_to_hash {
my $self = shift;
my $name = shift;
my $arrayref = shift;
my $hashref = $self->new_hashref;
my($i, $key, $val, $flag);
# Handle keyattr => { .... }
if(ref($self->{opt}->{keyattr}) eq 'HASH') {
return($arrayref) unless(exists($self->{opt}->{keyattr}->{$name}));
($key, $flag) = @{$self->{opt}->{keyattr}->{$name}};
for($i = 0; $i < @$arrayref; $i++) {
if(UNIVERSAL::isa($arrayref->[$i], 'HASH') and
exists($arrayref->[$i]->{$key})
) {
$val = $arrayref->[$i]->{$key};
if(ref($val)) {
$self->die_or_warn("<$name> element has non-scalar '$key' key attribute");
return($arrayref);
}
$val = $self->normalise_space($val)
if($self->{opt}->{normalisespace} == 1);
$self->die_or_warn("<$name> element has non-unique value in '$key' key attribute: $val")
if(exists($hashref->{$val}));
$hashref->{$val} = $self->new_hashref( %{$arrayref->[$i]} );
$hashref->{$val}->{"-$key"} = $hashref->{$val}->{$key} if($flag eq '-');
delete $hashref->{$val}->{$key} unless($flag eq '+');
}
else {
$self->die_or_warn("<$name> element has no '$key' key attribute");
return($arrayref);
}
}
}
# Or assume keyattr => [ .... ]
else {
my $default_keys =
join(',', @DefKeyAttr) eq join(',', @{$self->{opt}->{keyattr}});
ELEMENT: for($i = 0; $i < @$arrayref; $i++) {
return($arrayref) unless(UNIVERSAL::isa($arrayref->[$i], 'HASH'));
foreach $key (@{$self->{opt}->{keyattr}}) {
if(defined($arrayref->[$i]->{$key})) {
$val = $arrayref->[$i]->{$key};
if(ref($val)) {
$self->die_or_warn("<$name> element has non-scalar '$key' key attribute")
if not $default_keys;
return($arrayref);
}
$val = $self->normalise_space($val)
if($self->{opt}->{normalisespace} == 1);
$self->die_or_warn("<$name> element has non-unique value in '$key' key attribute: $val")
if(exists($hashref->{$val}));
$hashref->{$val} = $self->new_hashref( %{$arrayref->[$i]} );
delete $hashref->{$val}->{$key};
next ELEMENT;
}
}
return($arrayref); # No keyfield matched
}
}
# collapse any hashes which now only have a 'content' key
if($self->{opt}->{collapseagain}) {
$hashref = $self->collapse_content($hashref);
}
return($hashref);
}
##############################################################################
# Method: die_or_warn()
#
# Takes a diagnostic message and does one of three things:
# 1. dies if strict mode is enabled
# 2. warns if warnings are enabled but strict mode is not
# 3. ignores message and returns silently if neither strict mode nor warnings
# are enabled
#
sub die_or_warn {
my $self = shift;
my $msg = shift;
croak $msg if($self->{opt}->{strictmode});
if(warnings::enabled()) {
carp "Warning: $msg";
}
}
##############################################################################
# Method: new_hashref()
#
# This is a hook routine for overriding in a sub-class. Some people believe
# that using Tie::IxHash here will solve order-loss problems.
#
sub new_hashref {
my $self = shift;
return { @_ };
}
##############################################################################
# Method: collapse_content()
#
# Helper routine for array_to_hash
#
# Arguments expected are:
# - an XML::Simple object
# - a hashref
# the hashref is a former array, turned into a hash by array_to_hash because
# of the presence of key attributes
# at this point collapse_content avoids over-complicated structures like
# dir => { libexecdir => { content => '$exec_prefix/libexec' },
# localstatedir => { content => '$prefix' },
# }
# into
# dir => { libexecdir => '$exec_prefix/libexec',
# localstatedir => '$prefix',
# }
sub collapse_content {
my $self = shift;
my $hashref = shift;
my $contentkey = $self->{opt}->{contentkey};
# first go through the values,checking that they are fit to collapse
foreach my $val (values %$hashref) {
return $hashref unless ( (ref($val) eq 'HASH')
and (keys %$val == 1)
and (exists $val->{$contentkey})
);
}
# now collapse them
foreach my $key (keys %$hashref) {
$hashref->{$key}= $hashref->{$key}->{$contentkey};
}
return $hashref;
}
##############################################################################
# Method: value_to_xml()
#
# Helper routine for XMLout() - recurses through a data structure building up
# and returning an XML representation of that structure as a string.
#
# Arguments expected are:
# - the data structure to be encoded (usually a reference)
# - the XML tag name to use for this item
# - a string of spaces for use as the current indent level
#
sub value_to_xml {
my $self = shift;;
# Grab the other arguments
my($ref, $name, $indent) = @_;
my $named = (defined($name) and $name ne '' ? 1 : 0);
my $nl = "\n";
my $is_root = $indent eq '' ? 1 : 0; # Warning, dirty hack!
if($self->{opt}->{noindent}) {
$indent = '';
$nl = '';
}
# Convert to XML
my $refaddr = Scalar::Util::refaddr($ref);
if($refaddr) {
croak "circular data structures not supported"
if $self->{_ancestors}->{$refaddr};
$self->{_ancestors}->{$refaddr} = $ref; # keep ref alive until we delete it
}
else {
if($named) {
return(join('',
$indent, '<', $name, '>',
($self->{opt}->{noescape} ? $ref : $self->escape_value($ref)),
'</', $name, ">", $nl
));
}
else {
return("$ref$nl");
}
}
# Unfold hash to array if possible
if(UNIVERSAL::isa($ref, 'HASH') # It is a hash
and keys %$ref # and it's not empty
and $self->{opt}->{keyattr} # and folding is enabled
and !$is_root # and its not the root element
) {
$ref = $self->hash_to_array($name, $ref);
}
my @result = ();
my($key, $value);
# Handle hashrefs
if(UNIVERSAL::isa($ref, 'HASH')) {
# Reintermediate grouped values if applicable
if($self->{opt}->{grouptags}) {
$ref = $self->copy_hash($ref);
while(my($key, $val) = each %$ref) {
if($self->{opt}->{grouptags}->{$key}) {
$ref->{$key} = $self->new_hashref(
$self->{opt}->{grouptags}->{$key} => $val
);
}
}
}
# Scan for namespace declaration attributes
my $nsdecls = '';
my $default_ns_uri;
if($self->{nsup}) {
$ref = $self->copy_hash($ref);
$self->{nsup}->push_context();
# Look for default namespace declaration first
if(exists($ref->{xmlns})) {
$self->{nsup}->declare_prefix('', $ref->{xmlns});
$nsdecls .= qq( xmlns="$ref->{xmlns}");
delete($ref->{xmlns});
}
$default_ns_uri = $self->{nsup}->get_uri('');
# Then check all the other keys
foreach my $qname (keys(%$ref)) {
my($uri, $lname) = $self->{nsup}->parse_jclark_notation($qname);
if($uri) {
if($uri eq $xmlns_ns) {
$self->{nsup}->declare_prefix($lname, $ref->{$qname});
$nsdecls .= qq( xmlns:$lname="$ref->{$qname}");
delete($ref->{$qname});
}
}
}
# Translate any remaining Clarkian names
foreach my $qname (keys(%$ref)) {
my($uri, $lname) = $self->{nsup}->parse_jclark_notation($qname);
if($uri) {
if($default_ns_uri and $uri eq $default_ns_uri) {
$ref->{$lname} = $ref->{$qname};
delete($ref->{$qname});
}
else {
my $prefix = $self->{nsup}->get_prefix($uri);
unless($prefix) {
# $self->{nsup}->declare_prefix(undef, $uri);
# $prefix = $self->{nsup}->get_prefix($uri);
$prefix = $self->{ns_prefix}++;
$self->{nsup}->declare_prefix($prefix, $uri);
$nsdecls .= qq( xmlns:$prefix="$uri");
}
$ref->{"$prefix:$lname"} = $ref->{$qname};
delete($ref->{$qname});
}
}
}
}
my @nested = ();
my $text_content = undef;
if($named) {
push @result, $indent, '<', $name, $nsdecls;
}
if(keys %$ref) {
my $first_arg = 1;
foreach my $key ($self->sorted_keys($name, $ref)) {
my $value = $ref->{$key};
next if(substr($key, 0, 1) eq '-');
if(!defined($value)) {
next if $self->{opt}->{suppressempty};
unless(exists($self->{opt}->{suppressempty})
and !defined($self->{opt}->{suppressempty})
) {
carp 'Use of uninitialized value' if warnings::enabled();
}
if($key eq $self->{opt}->{contentkey}) {
$text_content = '';
}
else {
$value = exists($self->{opt}->{suppressempty}) ? {} : '';
}
}
if(!ref($value)
and $self->{opt}->{valueattr}
and $self->{opt}->{valueattr}->{$key}
) {
$value = $self->new_hashref(
$self->{opt}->{valueattr}->{$key} => $value
);
}
if(ref($value) or $self->{opt}->{noattr}) {
push @nested,
$self->value_to_xml($value, $key, "$indent ");
}
else {
if($key eq $self->{opt}->{contentkey}) {
$value = $self->escape_value($value) unless($self->{opt}->{noescape});
$text_content = $value;
}
else {
$value = $self->escape_attr($value) unless($self->{opt}->{noescape});
push @result, "\n$indent " . ' ' x length($name)
if($self->{opt}->{attrindent} and !$first_arg);
push @result, ' ', $key, '="', $value , '"';
$first_arg = 0;
}
}
}
}
else {
$text_content = '';
}
if(@nested or defined($text_content)) {
if($named) {
push @result, ">";
if(defined($text_content)) {
push @result, $text_content;
$nested[0] =~ s/^\s+// if(@nested);
}
else {
push @result, $nl;
}
if(@nested) {
push @result, @nested, $indent;
}
push @result, '</', $name, ">", $nl;
}
else {
push @result, @nested; # Special case if no root elements
}
}
else {
push @result, " />", $nl;
}
$self->{nsup}->pop_context() if($self->{nsup});
}
# Handle arrayrefs
elsif(UNIVERSAL::isa($ref, 'ARRAY')) {
foreach $value (@$ref) {
next if !defined($value) and $self->{opt}->{suppressempty};
if(!ref($value)) {
push @result,
$indent, '<', $name, '>',
($self->{opt}->{noescape} ? $value : $self->escape_value($value)),
'</', $name, ">$nl";
}
elsif(UNIVERSAL::isa($value, 'HASH')) {
push @result, $self->value_to_xml($value, $name, $indent);
}
else {
push @result,
$indent, '<', $name, ">$nl",
$self->value_to_xml($value, 'anon', "$indent "),
$indent, '</', $name, ">$nl";
}
}
}
else {
croak "Can't encode a value of type: " . ref($ref);
}
delete $self->{_ancestors}->{$refaddr};
return(join('', @result));
}
##############################################################################
# Method: sorted_keys()
#
# Returns the keys of the referenced hash sorted into alphabetical order, but
# with the 'key' key (as in KeyAttr) first, if there is one.
#
sub sorted_keys {
my($self, $name, $ref) = @_;
return keys %$ref if $self->{opt}->{nosort};
my %hash = %$ref;
my $keyattr = $self->{opt}->{keyattr};
my @key;
if(ref $keyattr eq 'HASH') {
if(exists $keyattr->{$name} and exists $hash{$keyattr->{$name}->[0]}) {
push @key, $keyattr->{$name}->[0];
delete $hash{$keyattr->{$name}->[0]};
}
}
elsif(ref $keyattr eq 'ARRAY') {
foreach (@{$keyattr}) {
if(exists $hash{$_}) {
push @key, $_;
delete $hash{$_};
last;
}
}
}
return(@key, sort keys %hash);
}
##############################################################################
# Method: escape_value()
#
# Helper routine for automatically escaping values for XMLout().
# Expects a scalar data value. Returns escaped version.
#
sub escape_value {
my($self, $data) = @_;
return '' unless(defined($data));
$data =~ s/&/&/sg;
$data =~ s/</</sg;
$data =~ s/>/>/sg;
$data =~ s/"/"/sg;
my $level = $self->{opt}->{numericescape} or return $data;
return $self->numeric_escape($data, $level);
}
sub numeric_escape {
my($self, $data, $level) = @_;
if($self->{opt}->{numericescape} eq '2') {
$data =~ s/([^\x00-\x7F])/'&#' . ord($1) . ';'/gse;
}
else {
$data =~ s/([^\x00-\xFF])/'&#' . ord($1) . ';'/gse;
}
return $data;
}
##############################################################################
# Method: escape_attr()
#
# Helper routine for escaping attribute values. Defaults to escape_value(),
# but may be overridden by a subclass to customise behaviour.
#
sub escape_attr {
my $self = shift;
return $self->escape_value(@_);
}
##############################################################################
# Method: hash_to_array()
#
# Helper routine for value_to_xml().
# Attempts to 'unfold' a hash of hashes into an array of hashes. Returns a
# reference to the array on success or the original hash if unfolding is
# not possible.
#
sub hash_to_array {
my $self = shift;
my $parent = shift;
my $hashref = shift;
my $arrayref = [];
my($key, $value);
my @keys = $self->{opt}->{nosort} ? keys %$hashref : sort keys %$hashref;
foreach $key (@keys) {
$value = $hashref->{$key};
return($hashref) unless(UNIVERSAL::isa($value, 'HASH'));
if(ref($self->{opt}->{keyattr}) eq 'HASH') {
return($hashref) unless(defined($self->{opt}->{keyattr}->{$parent}));
push @$arrayref, $self->copy_hash(
$value, $self->{opt}->{keyattr}->{$parent}->[0] => $key
);
}
else {
push(@$arrayref, { $self->{opt}->{keyattr}->[0] => $key, %$value });
}
}
return($arrayref);
}
##############################################################################
# Method: copy_hash()
#
# Helper routine for hash_to_array(). When unfolding a hash of hashes into
# an array of hashes, we need to copy the key from the outer hash into the
# inner hash. This routine makes a copy of the original hash so we don't
# destroy the original data structure. You might wish to override this
# method if you're using tied hashes and don't want them to get untied.
#
sub copy_hash {
my($self, $orig, @extra) = @_;
return { @extra, %$orig };
}
##############################################################################
# Methods required for building trees from SAX events
##############################################################################
sub start_document {
my $self = shift;
$self->handle_options('in') unless($self->{opt});
$self->{lists} = [];
$self->{curlist} = $self->{tree} = [];
}
sub start_element {
my $self = shift;
my $element = shift;
my $name = $element->{Name};
if($self->{opt}->{nsexpand}) {
$name = $element->{LocalName} || '';
if($element->{NamespaceURI}) {
$name = '{' . $element->{NamespaceURI} . '}' . $name;
}
}
my $attributes = {};
if($element->{Attributes}) { # Might be undef
foreach my $attr (values %{$element->{Attributes}}) {
if($self->{opt}->{nsexpand}) {
my $name = $attr->{LocalName} || '';
if($attr->{NamespaceURI}) {
$name = '{' . $attr->{NamespaceURI} . '}' . $name
}
$name = 'xmlns' if($name eq $bad_def_ns_jcn);
$attributes->{$name} = $attr->{Value};
}
else {
$attributes->{$attr->{Name}} = $attr->{Value};
}
}
}
my $newlist = [ $attributes ];
push @{ $self->{lists} }, $self->{curlist};
push @{ $self->{curlist} }, $name => $newlist;
$self->{curlist} = $newlist;
}
sub characters {
my $self = shift;
my $chars = shift;
my $text = $chars->{Data};
my $clist = $self->{curlist};
my $pos = $#$clist;
if ($pos > 0 and $clist->[$pos - 1] eq '0') {
$clist->[$pos] .= $text;
}
else {
push @$clist, 0 => $text;
}
}
sub end_element {
my $self = shift;
$self->{curlist} = pop @{ $self->{lists} };
}
sub end_document {
my $self = shift;
delete($self->{curlist});
delete($self->{lists});
my $tree = $self->{tree};
delete($self->{tree});
# Return tree as-is to XMLin()
return($tree) if($self->{nocollapse});
# Or collapse it before returning it to SAX parser class
if($self->{opt}->{keeproot}) {
$tree = $self->collapse({}, @$tree);
}
else {
$tree = $self->collapse(@{$tree->[1]});
}
if($self->{opt}->{datahandler}) {
return($self->{opt}->{datahandler}->($self, $tree));
}
return($tree);
}
*xml_in = \&XMLin;
*xml_out = \&XMLout;
1;
__END__
=head1 STATUS OF THIS MODULE
The use of this module in new code is B<strongly discouraged>. Other modules
are available which provide more straightforward and consistent interfaces. In
particular, L<XML::LibXML> is highly recommended and you can refer to
L<Perl XML::LibXML by Example|http://grantm.github.io/perl-libxml-by-example/>
for a tutorial introduction.
L<XML::Twig> is another excellent alternative.
The major problems with this module are the large number of options (some of
which have unfortunate defaults) and the arbitrary ways in which these options
interact - often producing unexpected results.
Patches with bug fixes and documentation fixes are welcome, but new features
are unlikely to be added.
=head1 QUICK START
Say you have a script called B<foo> and a file of configuration options
called B<foo.xml> containing the following:
<config logdir="/var/log/foo/" debugfile="/tmp/foo.debug">
<server name="sahara" osname="solaris" osversion="2.6">
<address>10.0.0.101</address>
<address>10.0.1.101</address>
</server>
<server name="gobi" osname="irix" osversion="6.5">
<address>10.0.0.102</address>
</server>
<server name="kalahari" osname="linux" osversion="2.0.34">
<address>10.0.0.103</address>
<address>10.0.1.103</address>
</server>
</config>
The following lines of code in B<foo>:
use XML::Simple qw(:strict);
my $config = XMLin(undef, KeyAttr => { server => 'name' }, ForceArray => [ 'server', 'address' ]);
will 'slurp' the configuration options into the hashref $config (because no
filename or XML string was passed as the first argument to C<XMLin()> the name
and location of the XML file will be inferred from name and location of the
script). You can dump out the contents of the hashref using Data::Dumper:
use Data::Dumper;
print Dumper($config);
which will produce something like this (formatting has been adjusted for
brevity):
{
'logdir' => '/var/log/foo/',
'debugfile' => '/tmp/foo.debug',
'server' => {
'sahara' => {
'osversion' => '2.6',
'osname' => 'solaris',
'address' => [ '10.0.0.101', '10.0.1.101' ]
},
'gobi' => {
'osversion' => '6.5',
'osname' => 'irix',
'address' => [ '10.0.0.102' ]
},
'kalahari' => {
'osversion' => '2.0.34',
'osname' => 'linux',
'address' => [ '10.0.0.103', '10.0.1.103' ]
}
}
}
Your script could then access the name of the log directory like this:
print $config->{logdir};
similarly, the second address on the server 'kalahari' could be referenced as:
print $config->{server}->{kalahari}->{address}->[1];
Note: If the mapping between the output of Data::Dumper and the print
statements above is not obvious to you, then please refer to the 'references'
tutorial (AKA: "Mark's very short tutorial about references") at L<perlreftut>.
In this example, the C<< ForceArray >> option was used to list elements that
might occur multiple times and should therefore be represented as arrayrefs
(even when only one element is present).
The C<< KeyAttr >> option was used to indicate that each C<< <server> >>
element has a unique identifier in the C<< name >> attribute. This allows you
to index directly to a particular server record using the name as a hash key
(as shown above).
For simple requirements, that's really all there is to it. If you want to
store your XML in a different directory or file, or pass it in as a string or
even pass it in via some derivative of an IO::Handle, you'll need to check out
L<"OPTIONS">. If you want to turn off or tweak the array folding feature (that
neat little transformation that produced $config->{server}) you'll find options
for that as well.
If you want to generate XML (for example to write a modified version of
$config back out as XML), check out C<XMLout()>.
If your needs are not so simple, this may not be the module for you. In that
case, you might want to read L<"WHERE TO FROM HERE?">.
=head1 DESCRIPTION
The XML::Simple module provides a simple API layer on top of an underlying XML
parsing module (either XML::Parser or one of the SAX2 parser modules). Two
functions are exported: C<XMLin()> and C<XMLout()>. Note: you can explicitly
request the lower case versions of the function names: C<xml_in()> and
C<xml_out()>.
The simplest approach is to call these two functions directly, but an
optional object oriented interface (see L<"OPTIONAL OO INTERFACE"> below)
allows them to be called as methods of an B<XML::Simple> object. The object
interface can also be used at either end of a SAX pipeline.
=head2 XMLin()
Parses XML formatted data and returns a reference to a data structure which
contains the same information in a more readily accessible form. (Skip
down to L<"EXAMPLES"> below, for more sample code).
C<XMLin()> accepts an optional XML specifier followed by zero or more 'name =>
value' option pairs. The XML specifier can be one of the following:
=over 4
=item A filename
If the filename contains no directory components C<XMLin()> will look for the
file in each directory in the SearchPath (see L<"OPTIONS"> below) or in the
current directory if the SearchPath option is not defined. eg:
$ref = XMLin('/etc/params.xml');
Note, the filename '-' can be used to parse from STDIN.
=item undef
If there is no XML specifier, C<XMLin()> will check the script directory and
each of the SearchPath directories for a file with the same name as the script
but with the extension '.xml'. Note: if you wish to specify options, you
must specify the value 'undef'. eg:
$ref = XMLin(undef, ForceArray => 1);
=item A string of XML
A string containing XML (recognised by the presence of '<' and '>' characters)
will be parsed directly. eg:
$ref = XMLin('<opt username="bob" password="flurp" />');
=item An IO::Handle object
An IO::Handle object will be read to EOF and its contents parsed. eg:
$fh = IO::File->new('/etc/params.xml');
$ref = XMLin($fh);
=back
=head2 XMLout()
Takes a data structure (generally a hashref) and returns an XML encoding of
that structure. If the resulting XML is parsed using C<XMLin()>, it should
return a data structure equivalent to the original (see caveats below).
The C<XMLout()> function can also be used to output the XML as SAX events
see the C<Handler> option and L<"SAX SUPPORT"> for more details).
When translating hashes to XML, hash keys which have a leading '-' will be
silently skipped. This is the approved method for marking elements of a
data structure which should be ignored by C<XMLout>. (Note: If these items
were not skipped the key names would be emitted as element or attribute names
with a leading '-' which would not be valid XML).
=head2 Caveats
Some care is required in creating data structures which will be passed to
C<XMLout()>. Hash keys from the data structure will be encoded as either XML
element names or attribute names. Therefore, you should use hash key names
which conform to the relatively strict XML naming rules:
Names in XML must begin with a letter. The remaining characters may be
letters, digits, hyphens (-), underscores (_) or full stops (.). It is also
allowable to include one colon (:) in an element name but this should only be
used when working with namespaces (B<XML::Simple> can only usefully work with
namespaces when teamed with a SAX Parser).
You can use other punctuation characters in hash values (just not in hash
keys) however B<XML::Simple> does not support dumping binary data.
If you break these rules, the current implementation of C<XMLout()> will
simply emit non-compliant XML which will be rejected if you try to read it
back in. (A later version of B<XML::Simple> might take a more proactive
approach).
Note also that although you can nest hashes and arrays to arbitrary levels,
circular data structures are not supported and will cause C<XMLout()> to die.
If you wish to 'round-trip' arbitrary data structures from Perl to XML and back
to Perl, then you should probably disable array folding (using the KeyAttr
option) both with C<XMLout()> and with C<XMLin()>. If you still don't get the
expected results, you may prefer to use L<XML::Dumper> which is designed for
exactly that purpose.
Refer to L<"WHERE TO FROM HERE?"> if C<XMLout()> is too simple for your needs.
=head1 OPTIONS
B<XML::Simple> supports a number of options (in fact as each release of
B<XML::Simple> adds more options, the module's claim to the name 'Simple'
becomes increasingly tenuous). If you find yourself repeatedly having to
specify the same options, you might like to investigate L<"OPTIONAL OO
INTERFACE"> below.
If you can't be bothered reading the documentation, refer to
L<"STRICT MODE"> to automatically catch common mistakes.
Because there are so many options, it's hard for new users to know which ones
are important, so here are the two you really need to know about:
=over 4
=item *
check out C<ForceArray> because you'll almost certainly want to turn it on
=item *
make sure you know what the C<KeyAttr> option does and what its default value is
because it may surprise you otherwise (note in particular that 'KeyAttr'
affects both C<XMLin> and C<XMLout>)
=back
The option name headings below have a trailing 'comment' - a hash followed by
two pieces of metadata:
=over 4
=item *
Options are marked with 'I<in>' if they are recognised by C<XMLin()> and
'I<out>' if they are recognised by C<XMLout()>.
=item *
Each option is also flagged to indicate whether it is:
'important' - don't use the module until you understand this one
'handy' - you can skip this on the first time through
'advanced' - you can skip this on the second time through
'SAX only' - don't worry about this unless you're using SAX (or
alternatively if you need this, you also need SAX)
'seldom used' - you'll probably never use this unless you were the
person that requested the feature
=back
The options are listed alphabetically:
Note: option names are no longer case sensitive so you can use the mixed case
versions shown here; all lower case as required by versions 2.03 and earlier;
or you can add underscores between the words (eg: key_attr).
=head2 AttrIndent => 1 I<# out - handy>
When you are using C<XMLout()>, enable this option to have attributes printed
one-per-line with sensible indentation rather than all on one line.
=head2 Cache => [ cache schemes ] I<# in - advanced>
Because loading the B<XML::Parser> module and parsing an XML file can consume a
significant number of CPU cycles, it is often desirable to cache the output of
C<XMLin()> for later reuse.
When parsing from a named file, B<XML::Simple> supports a number of caching
schemes. The 'Cache' option may be used to specify one or more schemes (using
an anonymous array). Each scheme will be tried in turn in the hope of finding
a cached pre-parsed representation of the XML file. If no cached copy is
found, the file will be parsed and the first cache scheme in the list will be
used to save a copy of the results. The following cache schemes have been
implemented:
=over 4
=item storable
Utilises B<Storable.pm> to read/write a cache file with the same name as the
XML file but with the extension .stor
=item memshare
When a file is first parsed, a copy of the resulting data structure is retained
in memory in the B<XML::Simple> module's namespace. Subsequent calls to parse
the same file will return a reference to this structure. This cached version
will persist only for the life of the Perl interpreter (which in the case of
mod_perl for example, may be some significant time).
Because each caller receives a reference to the same data structure, a change
made by one caller will be visible to all. For this reason, the reference
returned should be treated as read-only.
=item memcopy
This scheme works identically to 'memshare' (above) except that each caller
receives a reference to a new data structure which is a copy of the cached
version. Copying the data structure will add a little processing overhead,
therefore this scheme should only be used where the caller intends to modify
the data structure (or wishes to protect itself from others who might). This
scheme uses B<Storable.pm> to perform the copy.
=back
Warning! The memory-based caching schemes compare the timestamp on the file to
the time when it was last parsed. If the file is stored on an NFS filesystem
(or other network share) and the clock on the file server is not exactly
synchronised with the clock where your script is run, updates to the source XML
file may appear to be ignored.
=head2 ContentKey => 'keyname' I<# in+out - seldom used>
When text content is parsed to a hash value, this option lets you specify a
name for the hash key to override the default 'content'. So for example:
XMLin('<opt one="1">Text</opt>', ContentKey => 'text')
will parse to:
{ 'one' => 1, 'text' => 'Text' }
instead of:
{ 'one' => 1, 'content' => 'Text' }
C<XMLout()> will also honour the value of this option when converting a hashref
to XML.
You can also prefix your selected key name with a '-' character to have
C<XMLin()> try a little harder to eliminate unnecessary 'content' keys after
array folding. For example:
XMLin(
'<opt><item name="one">First</item><item name="two">Second</item></opt>',
KeyAttr => {item => 'name'},
ForceArray => [ 'item' ],
ContentKey => '-content'
)
will parse to:
{
'item' => {
'one' => 'First'
'two' => 'Second'
}
}
rather than this (without the '-'):
{
'item' => {
'one' => { 'content' => 'First' }
'two' => { 'content' => 'Second' }
}
}
=head2 DataHandler => code_ref I<# in - SAX only>
When you use an B<XML::Simple> object as a SAX handler, it will return a
'simple tree' data structure in the same format as C<XMLin()> would return. If
this option is set (to a subroutine reference), then when the tree is built the
subroutine will be called and passed two arguments: a reference to the
B<XML::Simple> object and a reference to the data tree. The return value from
the subroutine will be returned to the SAX driver. (See L<"SAX SUPPORT"> for
more details).
=head2 ForceArray => 1 I<# in - important>
This option should be set to '1' to force nested elements to be represented
as arrays even when there is only one. Eg, with ForceArray enabled, this
XML:
<opt>
<name>value</name>
</opt>
would parse to this:
{
'name' => [
'value'
]
}
instead of this (the default):
{
'name' => 'value'
}
This option is especially useful if the data structure is likely to be written
back out as XML and the default behaviour of rolling single nested elements up
into attributes is not desirable.
If you are using the array folding feature, you should almost certainly enable
this option. If you do not, single nested elements will not be parsed to
arrays and therefore will not be candidates for folding to a hash. (Given that
the default value of 'KeyAttr' enables array folding, the default value of this
option should probably also have been enabled too - sorry).
=head2 ForceArray => [ names ] I<# in - important>
This alternative (and preferred) form of the 'ForceArray' option allows you to
specify a list of element names which should always be forced into an array
representation, rather than the 'all or nothing' approach above.
It is also possible (since version 2.05) to include compiled regular
expressions in the list - any element names which match the pattern will be
forced to arrays. If the list contains only a single regex, then it is not
necessary to enclose it in an arrayref. Eg:
ForceArray => qr/_list$/
=head2 ForceContent => 1 I<# in - seldom used>
When C<XMLin()> parses elements which have text content as well as attributes,
the text content must be represented as a hash value rather than a simple
scalar. This option allows you to force text content to always parse to
a hash value even when there are no attributes. So for example:
XMLin('<opt><x>text1</x><y a="2">text2</y></opt>', ForceContent => 1)
will parse to:
{
'x' => { 'content' => 'text1' },
'y' => { 'a' => 2, 'content' => 'text2' }
}
instead of:
{
'x' => 'text1',
'y' => { 'a' => 2, 'content' => 'text2' }
}
=head2 GroupTags => { grouping tag => grouped tag } I<# in+out - handy>
You can use this option to eliminate extra levels of indirection in your Perl
data structure. For example this XML:
<opt>
<searchpath>
<dir>/usr/bin</dir>
<dir>/usr/local/bin</dir>
<dir>/usr/X11/bin</dir>
</searchpath>
</opt>
Would normally be read into a structure like this:
{
searchpath => {
dir => [ '/usr/bin', '/usr/local/bin', '/usr/X11/bin' ]
}
}
But when read in with the appropriate value for 'GroupTags':
my $opt = XMLin($xml, GroupTags => { searchpath => 'dir' });
It will return this simpler structure:
{
searchpath => [ '/usr/bin', '/usr/local/bin', '/usr/X11/bin' ]
}
The grouping element (C<< <searchpath> >> in the example) must not contain any
attributes or elements other than the grouped element.
You can specify multiple 'grouping element' to 'grouped element' mappings in
the same hashref. If this option is combined with C<KeyAttr>, the array
folding will occur first and then the grouped element names will be eliminated.
C<XMLout> will also use the grouptag mappings to re-introduce the tags around
the grouped elements. Beware though that this will occur in all places that
the 'grouping tag' name occurs - you probably don't want to use the same name
for elements as well as attributes.
=head2 Handler => object_ref I<# out - SAX only>
Use the 'Handler' option to have C<XMLout()> generate SAX events rather than
returning a string of XML. For more details see L<"SAX SUPPORT"> below.
Note: the current implementation of this option generates a string of XML
and uses a SAX parser to translate it into SAX events. The normal encoding
rules apply here - your data must be UTF8 encoded unless you specify an
alternative encoding via the 'XMLDecl' option; and by the time the data reaches
the handler object, it will be in UTF8 form regardless of the encoding you
supply. A future implementation of this option may generate the events
directly.
=head2 KeepRoot => 1 I<# in+out - handy>
In its attempt to return a data structure free of superfluous detail and
unnecessary levels of indirection, C<XMLin()> normally discards the root
element name. Setting the 'KeepRoot' option to '1' will cause the root element
name to be retained. So after executing this code:
$config = XMLin('<config tempdir="/tmp" />', KeepRoot => 1)
You'll be able to reference the tempdir as
C<$config-E<gt>{config}-E<gt>{tempdir}> instead of the default
C<$config-E<gt>{tempdir}>.
Similarly, setting the 'KeepRoot' option to '1' will tell C<XMLout()> that the
data structure already contains a root element name and it is not necessary to
add another.
=head2 KeyAttr => [ list ] I<# in+out - important>
This option controls the 'array folding' feature which translates nested
elements from an array to a hash. It also controls the 'unfolding' of hashes
to arrays.
For example, this XML:
<opt>
<user login="grep" fullname="Gary R Epstein" />
<user login="stty" fullname="Simon T Tyson" />
</opt>
would, by default, parse to this:
{
'user' => [
{
'login' => 'grep',
'fullname' => 'Gary R Epstein'
},
{
'login' => 'stty',
'fullname' => 'Simon T Tyson'
}
]
}
If the option 'KeyAttr => "login"' were used to specify that the 'login'
attribute is a key, the same XML would parse to:
{
'user' => {
'stty' => {
'fullname' => 'Simon T Tyson'
},
'grep' => {
'fullname' => 'Gary R Epstein'
}
}
}
The key attribute names should be supplied in an arrayref if there is more
than one. C<XMLin()> will attempt to match attribute names in the order
supplied. C<XMLout()> will use the first attribute name supplied when
'unfolding' a hash into an array.
Note 1: The default value for 'KeyAttr' is ['name', 'key', 'id']. If you do
not want folding on input or unfolding on output you must set this option
to an empty list to disable the feature.
Note 2: If you wish to use this option, you should also enable the
C<ForceArray> option. Without 'ForceArray', a single nested element will be
rolled up into a scalar rather than an array and therefore will not be folded
(since only arrays get folded).
=head2 KeyAttr => { list } I<# in+out - important>
This alternative (and preferred) method of specifying the key attributes
allows more fine grained control over which elements are folded and on which
attributes. For example the option 'KeyAttr => { package => 'id' } will cause
any package elements to be folded on the 'id' attribute. No other elements
which have an 'id' attribute will be folded at all.
Note: C<XMLin()> will generate a warning (or a fatal error in L<"STRICT MODE">)
if this syntax is used and an element which does not have the specified key
attribute is encountered (eg: a 'package' element without an 'id' attribute, to
use the example above). Warnings can be suppressed with the lexical
C<no warnings;> pragma or C<no warnings 'XML::Simple';>.
Two further variations are made possible by prefixing a '+' or a '-' character
to the attribute name:
The option 'KeyAttr => { user => "+login" }' will cause this XML:
<opt>
<user login="grep" fullname="Gary R Epstein" />
<user login="stty" fullname="Simon T Tyson" />
</opt>
to parse to this data structure:
{
'user' => {
'stty' => {
'fullname' => 'Simon T Tyson',
'login' => 'stty'
},
'grep' => {
'fullname' => 'Gary R Epstein',
'login' => 'grep'
}
}
}
The '+' indicates that the value of the key attribute should be copied rather
than moved to the folded hash key.
A '-' prefix would produce this result:
{
'user' => {
'stty' => {
'fullname' => 'Simon T Tyson',
'-login' => 'stty'
},
'grep' => {
'fullname' => 'Gary R Epstein',
'-login' => 'grep'
}
}
}
As described earlier, C<XMLout> will ignore hash keys starting with a '-'.
=head2 NoAttr => 1 I<# in+out - handy>
When used with C<XMLout()>, the generated XML will contain no attributes.
All hash key/values will be represented as nested elements instead.
When used with C<XMLin()>, any attributes in the XML will be ignored.
=head2 NoEscape => 1 I<# out - seldom used>
By default, C<XMLout()> will translate the characters 'E<lt>', 'E<gt>', '&' and
'"' to '<', '>', '&' and '"' respectively. Use this option to
suppress escaping (presumably because you've already escaped the data in some
more sophisticated manner).
=head2 NoIndent => 1 I<# out - seldom used>
Set this option to 1 to disable C<XMLout()>'s default 'pretty printing' mode.
With this option enabled, the XML output will all be on one line (unless there
are newlines in the data) - this may be easier for downstream processing.
=head2 NoSort => 1 I<# out - seldom used>
Newer versions of XML::Simple sort elements and attributes alphabetically (*),
by default. Enable this option to suppress the sorting - possibly for
backwards compatibility.
* Actually, sorting is alphabetical but 'key' attribute or element names (as in
'KeyAttr') sort first. Also, when a hash of hashes is 'unfolded', the elements
are sorted alphabetically by the value of the key field.
=head2 NormaliseSpace => 0 | 1 | 2 I<# in - handy>
This option controls how whitespace in text content is handled. Recognised
values for the option are:
=over 4
=item *
0 = (default) whitespace is passed through unaltered (except of course for the
normalisation of whitespace in attribute values which is mandated by the XML
recommendation)
=item *
1 = whitespace is normalised in any value used as a hash key (normalising means
removing leading and trailing whitespace and collapsing sequences of whitespace
characters to a single space)
=item *
2 = whitespace is normalised in all text content
=back
Note: you can spell this option with a 'z' if that is more natural for you.
=head2 NSExpand => 1 I<# in+out handy - SAX only>
This option controls namespace expansion - the translation of element and
attribute names of the form 'prefix:name' to '{uri}name'. For example the
element name 'xsl:template' might be expanded to:
'{http://www.w3.org/1999/XSL/Transform}template'.
By default, C<XMLin()> will return element names and attribute names exactly as
they appear in the XML. Setting this option to 1 will cause all element and
attribute names to be expanded to include their namespace prefix.
I<Note: You must be using a SAX parser for this option to work (ie: it does not
work with XML::Parser)>.
This option also controls whether C<XMLout()> performs the reverse translation
from '{uri}name' back to 'prefix:name'. The default is no translation. If
your data contains expanded names, you should set this option to 1 otherwise
C<XMLout> will emit XML which is not well formed.
I<Note: You must have the XML::NamespaceSupport module installed if you want
C<XMLout()> to translate URIs back to prefixes>.
=head2 NumericEscape => 0 | 1 | 2 I<# out - handy>
Use this option to have 'high' (non-ASCII) characters in your Perl data
structure converted to numeric entities (eg: €) in the XML output. Three
levels are possible:
0 - default: no numeric escaping (OK if you're writing out UTF8)
1 - only characters above 0xFF are escaped (ie: characters in the 0x80-FF range are not escaped), possibly useful with ISO8859-1 output
2 - all characters above 0x7F are escaped (good for plain ASCII output)
=head2 OutputFile => <file specifier> I<# out - handy>
The default behaviour of C<XMLout()> is to return the XML as a string. If you
wish to write the XML to a file, simply supply the filename using the
'OutputFile' option.
This option also accepts an IO handle object - especially useful in Perl 5.8.0
and later for output using an encoding other than UTF-8, eg:
open my $fh, '>:encoding(iso-8859-1)', $path or die "open($path): $!";
XMLout($ref, OutputFile => $fh);
Note, XML::Simple does not require that the object you pass in to the
OutputFile option inherits from L<IO::Handle> - it simply assumes the object
supports a C<print> method.
=head2 ParserOpts => [ XML::Parser Options ] I<# in - don't use this>
I<Note: This option is now officially deprecated. If you find it useful, email
the author with an example of what you use it for. Do not use this option to
set the ProtocolEncoding, that's just plain wrong - fix the XML>.
This option allows you to pass parameters to the constructor of the underlying
XML::Parser object (which of course assumes you're not using SAX).
=head2 RootName => 'string' I<# out - handy>
By default, when C<XMLout()> generates XML, the root element will be named
'opt'. This option allows you to specify an alternative name.
Specifying either undef or the empty string for the RootName option will
produce XML with no root elements. In most cases the resulting XML fragment
will not be 'well formed' and therefore could not be read back in by C<XMLin()>.
Nevertheless, the option has been found to be useful in certain circumstances.
=head2 SearchPath => [ list ] I<# in - handy>
If you pass C<XMLin()> a filename, but the filename include no directory
component, you can use this option to specify which directories should be
searched to locate the file. You might use this option to search first in the
user's home directory, then in a global directory such as /etc.
If a filename is provided to C<XMLin()> but SearchPath is not defined, the
file is assumed to be in the current directory.
If the first parameter to C<XMLin()> is undefined, the default SearchPath
will contain only the directory in which the script itself is located.
Otherwise the default SearchPath will be empty.
=head2 StrictMode => 1 | 0 I<# in+out seldom used>
This option allows you to turn L<STRICT MODE> on or off for a particular call,
regardless of whether it was enabled at the time XML::Simple was loaded.
=head2 SuppressEmpty => 1 | '' | undef I<# in+out - handy>
This option controls what C<XMLin()> should do with empty elements (no
attributes and no content). The default behaviour is to represent them as
empty hashes. Setting this option to a true value (eg: 1) will cause empty
elements to be skipped altogether. Setting the option to 'undef' or the empty
string will cause empty elements to be represented as the undefined value or
the empty string respectively. The latter two alternatives are a little
easier to test for in your code than a hash with no keys.
The option also controls what C<XMLout()> does with undefined values. Setting
the option to undef causes undefined values to be output as empty elements
(rather than empty attributes), it also suppresses the generation of warnings
about undefined values. Setting the option to a true value (eg: 1) causes
undefined values to be skipped altogether on output.
=head2 ValueAttr => [ names ] I<# in - handy>
Use this option to deal elements which always have a single attribute and no
content. Eg:
<opt>
<colour value="red" />
<size value="XXL" />
</opt>
Setting C<< ValueAttr => [ 'value' ] >> will cause the above XML to parse to:
{
colour => 'red',
size => 'XXL'
}
instead of this (the default):
{
colour => { value => 'red' },
size => { value => 'XXL' }
}
Note: This form of the ValueAttr option is not compatible with C<XMLout()> -
since the attribute name is discarded at parse time, the original XML cannot be
reconstructed.
=head2 ValueAttr => { element => attribute, ... } I<# in+out - handy>
This (preferred) form of the ValueAttr option requires you to specify both
the element and the attribute names. This is not only safer, it also allows
the original XML to be reconstructed by C<XMLout()>.
Note: You probably don't want to use this option and the NoAttr option at the
same time.
=head2 Variables => { name => value } I<# in - handy>
This option allows variables in the XML to be expanded when the file is read.
(there is no facility for putting the variable names back if you regenerate
XML using C<XMLout>).
A 'variable' is any text of the form C<${name}> which occurs in an attribute
value or in the text content of an element. If 'name' matches a key in the
supplied hashref, C<${name}> will be replaced with the corresponding value from
the hashref. If no matching key is found, the variable will not be replaced.
Names must match the regex: C<[\w.]+> (ie: only 'word' characters and dots are
allowed).
=head2 VarAttr => 'attr_name' I<# in - handy>
In addition to the variables defined using C<Variables>, this option allows
variables to be defined in the XML. A variable definition consists of an
element with an attribute called 'attr_name' (the value of the C<VarAttr>
option). The value of the attribute will be used as the variable name and the
text content of the element will be used as the value. A variable defined in
this way will override a variable defined using the C<Variables> option. For
example:
XMLin( '<opt>
<dir name="prefix">/usr/local/apache</dir>
<dir name="exec_prefix">${prefix}</dir>
<dir name="bindir">${exec_prefix}/bin</dir>
</opt>',
VarAttr => 'name', ContentKey => '-content'
);
produces the following data structure:
{
dir => {
prefix => '/usr/local/apache',
exec_prefix => '/usr/local/apache',
bindir => '/usr/local/apache/bin',
}
}
=head2 XMLDecl => 1 or XMLDecl => 'string' I<# out - handy>
If you want the output from C<XMLout()> to start with the optional XML
declaration, simply set the option to '1'. The default XML declaration is:
<?xml version='1.0' standalone='yes'?>
If you want some other string (for example to declare an encoding value), set
the value of this option to the complete string you require.
=head1 OPTIONAL OO INTERFACE
The procedural interface is both simple and convenient however there are a
couple of reasons why you might prefer to use the object oriented (OO)
interface:
=over 4
=item *
to define a set of default values which should be used on all subsequent calls
to C<XMLin()> or C<XMLout()>
=item *
to override methods in B<XML::Simple> to provide customised behaviour
=back
The default values for the options described above are unlikely to suit
everyone. The OO interface allows you to effectively override B<XML::Simple>'s
defaults with your preferred values. It works like this:
First create an XML::Simple parser object with your preferred defaults:
my $xs = XML::Simple->new(ForceArray => 1, KeepRoot => 1);
then call C<XMLin()> or C<XMLout()> as a method of that object:
my $ref = $xs->XMLin($xml);
my $xml = $xs->XMLout($ref);
You can also specify options when you make the method calls and these values
will be merged with the values specified when the object was created. Values
specified in a method call take precedence.
Note: when called as methods, the C<XMLin()> and C<XMLout()> routines may be
called as C<xml_in()> or C<xml_out()>. The method names are aliased so the
only difference is the aesthetics.
=head2 Parsing Methods
You can explicitly call one of the following methods rather than rely on the
C<xml_in()> method automatically determining whether the target to be parsed is
a string, a file or a filehandle:
=over 4
=item parse_string(text)
Works exactly like the C<xml_in()> method but assumes the first argument is
a string of XML (or a reference to a scalar containing a string of XML).
=item parse_file(filename)
Works exactly like the C<xml_in()> method but assumes the first argument is
the name of a file containing XML.
=item parse_fh(file_handle)
Works exactly like the C<xml_in()> method but assumes the first argument is
a filehandle which can be read to get XML.
=back
=head2 Hook Methods
You can make your own class which inherits from XML::Simple and overrides
certain behaviours. The following methods may provide useful 'hooks' upon
which to hang your modified behaviour. You may find other undocumented methods
by examining the source, but those may be subject to change in future releases.
=over 4
=item new_xml_parser()
This method will be called when a new XML::Parser object must be constructed
(either because XML::SAX is not installed or XML::Parser is preferred).
=item handle_options(direction, name => value ...)
This method will be called when one of the parsing methods or the C<XMLout()>
method is called. The initial argument will be a string (either 'in' or 'out')
and the remaining arguments will be name value pairs.
=item default_config_file()
Calculates and returns the name of the file which should be parsed if no
filename is passed to C<XMLin()> (default: C<$0.xml>).
=item build_simple_tree(filename, string)
Called from C<XMLin()> or any of the parsing methods. Takes either a file name
as the first argument or C<undef> followed by a 'string' as the second
argument. Returns a simple tree data structure. You could override this
method to apply your own transformations before the data structure is returned
to the caller.
=item new_hashref()
When the 'simple tree' data structure is being built, this method will be
called to create any required anonymous hashrefs.
=item sorted_keys(name, hashref)
Called when C<XMLout()> is translating a hashref to XML. This routine returns
a list of hash keys in the order that the corresponding attributes/elements
should appear in the output.
=item escape_value(string)
Called from C<XMLout()>, takes a string and returns a copy of the string with
XML character escaping rules applied.
=item escape_attr(string)
Called from C<XMLout()>, to handle attribute values. By default, just calls
C<escape_value()>, but you can override this method if you want attributes
escaped differently than text content.
=item numeric_escape(string)
Called from C<escape_value()>, to handle non-ASCII characters (depending on the
value of the NumericEscape option).
=item copy_hash(hashref, extra_key => value, ...)
Called from C<XMLout()>, when 'unfolding' a hash of hashes into an array of
hashes. You might wish to override this method if you're using tied hashes and
don't want them to get untied.
=back
=head2 Cache Methods
XML::Simple implements three caching schemes ('storable', 'memshare' and
'memcopy'). You can implement a custom caching scheme by implementing
two methods - one for reading from the cache and one for writing to it.
For example, you might implement a new 'dbm' scheme that stores cached data
structures using the L<MLDBM> module. First, you would add a
C<cache_read_dbm()> method which accepted a filename for use as a lookup key
and returned a data structure on success, or undef on failure. Then, you would
implement a C<cache_read_dbm()> method which accepted a data structure and a
filename.
You would use this caching scheme by specifying the option:
Cache => [ 'dbm' ]
=head1 STRICT MODE
If you import the B<XML::Simple> routines like this:
use XML::Simple qw(:strict);
the following common mistakes will be detected and treated as fatal errors
=over 4
=item *
Failing to explicitly set the C<KeyAttr> option - if you can't be bothered
reading about this option, turn it off with: KeyAttr => [ ]
=item *
Failing to explicitly set the C<ForceArray> option - if you can't be bothered
reading about this option, set it to the safest mode with: ForceArray => 1
=item *
Setting ForceArray to an array, but failing to list all the elements from the
KeyAttr hash.
=item *
Data error - KeyAttr is set to say { part => 'partnum' } but the XML contains
one or more E<lt>partE<gt> elements without a 'partnum' attribute (or nested
element). Note: if strict mode is not set but C<use warnings;> is in force,
this condition triggers a warning.
=item *
Data error - as above, but non-unique values are present in the key attribute
(eg: more than one E<lt>partE<gt> element with the same partnum). This will
also trigger a warning if strict mode is not enabled.
=item *
Data error - as above, but value of key attribute (eg: partnum) is not a
scalar string (due to nested elements etc). This will also trigger a warning
if strict mode is not enabled.
=back
=head1 SAX SUPPORT
From version 1.08_01, B<XML::Simple> includes support for SAX (the Simple API
for XML) - specifically SAX2.
In a typical SAX application, an XML parser (or SAX 'driver') module generates
SAX events (start of element, character data, end of element, etc) as it parses
an XML document and a 'handler' module processes the events to extract the
required data. This simple model allows for some interesting and powerful
possibilities:
=over 4
=item *
Applications written to the SAX API can extract data from huge XML documents
without the memory overheads of a DOM or tree API.
=item *
The SAX API allows for plug and play interchange of parser modules without
having to change your code to fit a new module's API. A number of SAX parsers
are available with capabilities ranging from extreme portability to blazing
performance.
=item *
A SAX 'filter' module can implement both a handler interface for receiving
data and a generator interface for passing modified data on to a downstream
handler. Filters can be chained together in 'pipelines'.
=item *
One filter module might split a data stream to direct data to two or more
downstream handlers.
=item *
Generating SAX events is not the exclusive preserve of XML parsing modules.
For example, a module might extract data from a relational database using DBI
and pass it on to a SAX pipeline for filtering and formatting.
=back
B<XML::Simple> can operate at either end of a SAX pipeline. For example,
you can take a data structure in the form of a hashref and pass it into a
SAX pipeline using the 'Handler' option on C<XMLout()>:
use XML::Simple;
use Some::SAX::Filter;
use XML::SAX::Writer;
my $ref = {
.... # your data here
};
my $writer = XML::SAX::Writer->new();
my $filter = Some::SAX::Filter->new(Handler => $writer);
my $simple = XML::Simple->new(Handler => $filter);
$simple->XMLout($ref);
You can also put B<XML::Simple> at the opposite end of the pipeline to take
advantage of the simple 'tree' data structure once the relevant data has been
isolated through filtering:
use XML::SAX;
use Some::SAX::Filter;
use XML::Simple;
my $simple = XML::Simple->new(ForceArray => 1, KeyAttr => ['partnum']);
my $filter = Some::SAX::Filter->new(Handler => $simple);
my $parser = XML::SAX::ParserFactory->parser(Handler => $filter);
my $ref = $parser->parse_uri('some_huge_file.xml');
print $ref->{part}->{'555-1234'};
You can build a filter by using an XML::Simple object as a handler and setting
its DataHandler option to point to a routine which takes the resulting tree,
modifies it and sends it off as SAX events to a downstream handler:
my $writer = XML::SAX::Writer->new();
my $filter = XML::Simple->new(
DataHandler => sub {
my $simple = shift;
my $data = shift;
# Modify $data here
$simple->XMLout($data, Handler => $writer);
}
);
my $parser = XML::SAX::ParserFactory->parser(Handler => $filter);
$parser->parse_uri($filename);
I<Note: In this last example, the 'Handler' option was specified in the call to
C<XMLout()> but it could also have been specified in the constructor>.
=head1 ENVIRONMENT
If you don't care which parser module B<XML::Simple> uses then skip this
section entirely (it looks more complicated than it really is).
B<XML::Simple> will default to using a B<SAX> parser if one is available or
B<XML::Parser> if SAX is not available.
You can dictate which parser module is used by setting either the environment
variable 'XML_SIMPLE_PREFERRED_PARSER' or the package variable
$XML::Simple::PREFERRED_PARSER to contain the module name. The following rules
are used:
=over 4
=item *
The package variable takes precedence over the environment variable if both are defined. To force B<XML::Simple> to ignore the environment settings and use
its default rules, you can set the package variable to an empty string.
=item *
If the 'preferred parser' is set to the string 'XML::Parser', then
L<XML::Parser> will be used (or C<XMLin()> will die if L<XML::Parser> is not
installed).
=item *
If the 'preferred parser' is set to some other value, then it is assumed to be
the name of a SAX parser module and is passed to L<XML::SAX::ParserFactory>.
If L<XML::SAX> is not installed, or the requested parser module is not
installed, then C<XMLin()> will die.
=item *
If the 'preferred parser' is not defined at all (the normal default
state), an attempt will be made to load L<XML::SAX>. If L<XML::SAX> is
installed, then a parser module will be selected according to
L<XML::SAX::ParserFactory>'s normal rules (which typically means the last SAX
parser installed).
=item *
if the 'preferred parser' is not defined and B<XML::SAX> is not
installed, then B<XML::Parser> will be used. C<XMLin()> will die if
L<XML::Parser> is not installed.
=back
Note: The B<XML::SAX> distribution includes an XML parser written entirely in
Perl. It is very portable but it is not very fast. You should consider
installing L<XML::LibXML> or L<XML::SAX::Expat> if they are available for your
platform.
=head1 ERROR HANDLING
The XML standard is very clear on the issue of non-compliant documents. An
error in parsing any single element (for example a missing end tag) must cause
the whole document to be rejected. B<XML::Simple> will die with an appropriate
message if it encounters a parsing error.
If dying is not appropriate for your application, you should arrange to call
C<XMLin()> in an eval block and look for errors in $@. eg:
my $config = eval { XMLin() };
PopUpMessage($@) if($@);
Note, there is a common misconception that use of B<eval> will significantly
slow down a script. While that may be true when the code being eval'd is in a
string, it is not true of code like the sample above.
=head1 EXAMPLES
When C<XMLin()> reads the following very simple piece of XML:
<opt username="testuser" password="frodo"></opt>
it returns the following data structure:
{
'username' => 'testuser',
'password' => 'frodo'
}
The identical result could have been produced with this alternative XML:
<opt username="testuser" password="frodo" />
Or this (although see 'ForceArray' option for variations):
<opt>
<username>testuser</username>
<password>frodo</password>
</opt>
Repeated nested elements are represented as anonymous arrays:
<opt>
<person firstname="Joe" lastname="Smith">
<email>joe@smith.com</email>
<email>jsmith@yahoo.com</email>
</person>
<person firstname="Bob" lastname="Smith">
<email>bob@smith.com</email>
</person>
</opt>
{
'person' => [
{
'email' => [
'joe@smith.com',
'jsmith@yahoo.com'
],
'firstname' => 'Joe',
'lastname' => 'Smith'
},
{
'email' => 'bob@smith.com',
'firstname' => 'Bob',
'lastname' => 'Smith'
}
]
}
Nested elements with a recognised key attribute are transformed (folded) from
an array into a hash keyed on the value of that attribute (see the C<KeyAttr>
option):
<opt>
<person key="jsmith" firstname="Joe" lastname="Smith" />
<person key="tsmith" firstname="Tom" lastname="Smith" />
<person key="jbloggs" firstname="Joe" lastname="Bloggs" />
</opt>
{
'person' => {
'jbloggs' => {
'firstname' => 'Joe',
'lastname' => 'Bloggs'
},
'tsmith' => {
'firstname' => 'Tom',
'lastname' => 'Smith'
},
'jsmith' => {
'firstname' => 'Joe',
'lastname' => 'Smith'
}
}
}
The <anon> tag can be used to form anonymous arrays:
<opt>
<head><anon>Col 1</anon><anon>Col 2</anon><anon>Col 3</anon></head>
<data><anon>R1C1</anon><anon>R1C2</anon><anon>R1C3</anon></data>
<data><anon>R2C1</anon><anon>R2C2</anon><anon>R2C3</anon></data>
<data><anon>R3C1</anon><anon>R3C2</anon><anon>R3C3</anon></data>
</opt>
{
'head' => [
[ 'Col 1', 'Col 2', 'Col 3' ]
],
'data' => [
[ 'R1C1', 'R1C2', 'R1C3' ],
[ 'R2C1', 'R2C2', 'R2C3' ],
[ 'R3C1', 'R3C2', 'R3C3' ]
]
}
Anonymous arrays can be nested to arbitrary levels and as a special case, if
the surrounding tags for an XML document contain only an anonymous array the
arrayref will be returned directly rather than the usual hashref:
<opt>
<anon><anon>Col 1</anon><anon>Col 2</anon></anon>
<anon><anon>R1C1</anon><anon>R1C2</anon></anon>
<anon><anon>R2C1</anon><anon>R2C2</anon></anon>
</opt>
[
[ 'Col 1', 'Col 2' ],
[ 'R1C1', 'R1C2' ],
[ 'R2C1', 'R2C2' ]
]
Elements which only contain text content will simply be represented as a
scalar. Where an element has both attributes and text content, the element
will be represented as a hashref with the text content in the 'content' key
(see the C<ContentKey> option):
<opt>
<one>first</one>
<two attr="value">second</two>
</opt>
{
'one' => 'first',
'two' => { 'attr' => 'value', 'content' => 'second' }
}
Mixed content (elements which contain both text content and nested elements)
will be not be represented in a useful way - element order and significant
whitespace will be lost. If you need to work with mixed content, then
XML::Simple is not the right tool for your job - check out the next section.
=head1 WHERE TO FROM HERE?
B<XML::Simple> is able to present a simple API because it makes some
assumptions on your behalf. These include:
=over 4
=item *
You're not interested in text content consisting only of whitespace
=item *
You don't mind that when things get slurped into a hash the order is lost
=item *
You don't want fine-grained control of the formatting of generated XML
=item *
You would never use a hash key that was not a legal XML element name
=item *
You don't need help converting between different encodings
=back
In a serious XML project, you'll probably outgrow these assumptions fairly
quickly. This section of the document used to offer some advice on choosing a
more powerful option. That advice has now grown into the 'Perl-XML FAQ'
document which you can find at: L<http://perl-xml.sourceforge.net/faq/>
The advice in the FAQ boils down to a quick explanation of tree versus
event based parsers and then recommends:
For event based parsing, use SAX (do not set out to write any new code for
XML::Parser's handler API - it is obsolete).
For tree-based parsing, you could choose between the 'Perlish' approach of
L<XML::Twig> and more standards based DOM implementations - preferably one with
XPath support such as L<XML::LibXML>.
=head1 SEE ALSO
B<XML::Simple> requires either L<XML::Parser> or L<XML::SAX>.
To generate documents with namespaces, L<XML::NamespaceSupport> is required.
The optional caching functions require L<Storable>.
Answers to Frequently Asked Questions about XML::Simple are bundled with this
distribution as: L<XML::Simple::FAQ>
=head1 COPYRIGHT
Copyright 1999-2004 Grant McLean E<lt>grantm@cpan.orgE<gt>
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/XML/SAX.pm 0000444 00000022065 15157556056 0007635 0 ustar 00 # $Id$
package XML::SAX;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = '1.02';
use Exporter ();
@ISA = ('Exporter');
@EXPORT_OK = qw(Namespaces Validation);
use File::Basename qw(dirname);
use File::Spec ();
use Symbol qw(gensym);
use XML::SAX::ParserFactory (); # loaded for simplicity
use constant PARSER_DETAILS => "ParserDetails.ini";
use constant Namespaces => "http://xml.org/sax/features/namespaces";
use constant Validation => "http://xml.org/sax/features/validation";
my $known_parsers = undef;
# load_parsers takes the ParserDetails.ini file out of the same directory
# that XML::SAX is in, and looks at it. Format in POD below
=begin EXAMPLE
[XML::SAX::PurePerl]
http://xml.org/sax/features/namespaces = 1
http://xml.org/sax/features/validation = 0
# a comment
# blank lines ignored
[XML::SAX::AnotherParser]
http://xml.org/sax/features/namespaces = 0
http://xml.org/sax/features/validation = 1
=end EXAMPLE
=cut
sub load_parsers {
my $class = shift;
my $dir = shift;
# reset parsers
$known_parsers = [];
# get directory from wherever XML::SAX is installed
if (!$dir) {
$dir = $INC{'XML/SAX.pm'};
$dir = dirname($dir);
}
my $fh = gensym();
if (!open($fh, File::Spec->catfile($dir, "SAX", PARSER_DETAILS))) {
XML::SAX->do_warn("could not find " . PARSER_DETAILS . " in $dir/SAX\n");
return $class;
}
$known_parsers = $class->_parse_ini_file($fh);
return $class;
}
sub _parse_ini_file {
my $class = shift;
my ($fh) = @_;
my @config;
my $lineno = 0;
while (defined(my $line = <$fh>)) {
$lineno++;
my $original = $line;
# strip whitespace
$line =~ s/\s*$//m;
$line =~ s/^\s*//m;
# strip comments
$line =~ s/[#;].*$//m;
# ignore blanks
next if $line =~ /^$/m;
# heading
if ($line =~ /^\[\s*(.*)\s*\]$/m) {
push @config, { Name => $1 };
next;
}
# instruction
elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) {
unless(@config) {
push @config, { Name => '' };
}
$config[-1]{Features}{$1} = $2;
}
# not whitespace, comment, or instruction
else {
die "Invalid line in ini: $lineno\n>>> $original\n";
}
}
return \@config;
}
sub parsers {
my $class = shift;
if (!$known_parsers) {
$class->load_parsers();
}
return $known_parsers;
}
sub remove_parser {
my $class = shift;
my ($parser_module) = @_;
if (!$known_parsers) {
$class->load_parsers();
}
@$known_parsers = grep { $_->{Name} ne $parser_module } @$known_parsers;
return $class;
}
sub add_parser {
my $class = shift;
my ($parser_module) = @_;
if (!$known_parsers) {
$class->load_parsers();
}
# first load module, then query features, then push onto known_parsers,
my $parser_file = $parser_module;
$parser_file =~ s/::/\//g;
$parser_file .= ".pm";
require $parser_file;
my @features = $parser_module->supported_features();
my $new = { Name => $parser_module };
foreach my $feature (@features) {
$new->{Features}{$feature} = 1;
}
# If exists in list already, move to end.
my $done = 0;
my $pos = undef;
for (my $i = 0; $i < @$known_parsers; $i++) {
my $p = $known_parsers->[$i];
if ($p->{Name} eq $parser_module) {
$pos = $i;
}
}
if (defined $pos) {
splice(@$known_parsers, $pos, 1);
push @$known_parsers, $new;
$done++;
}
# Otherwise (not in list), add at end of list.
if (!$done) {
push @$known_parsers, $new;
}
return $class;
}
sub save_parsers {
my $class = shift;
# get directory from wherever XML::SAX is installed
my $dir = $INC{'XML/SAX.pm'};
$dir = dirname($dir);
my $file = File::Spec->catfile($dir, "SAX", PARSER_DETAILS);
chmod 0644, $file;
unlink($file);
my $fh = gensym();
open($fh, ">$file") ||
die "Cannot write to $file: $!";
foreach my $p (@$known_parsers) {
print $fh "[$p->{Name}]\n";
foreach my $key (keys %{$p->{Features}}) {
print $fh "$key = $p->{Features}{$key}\n";
}
print $fh "\n";
}
print $fh "\n";
close $fh;
return $class;
}
sub do_warn {
my $class = shift;
# Don't output warnings if running under Test::Harness
warn(@_) unless $ENV{HARNESS_ACTIVE};
}
1;
__END__
=head1 NAME
XML::SAX - Simple API for XML
=head1 SYNOPSIS
use XML::SAX;
# get a list of known parsers
my $parsers = XML::SAX->parsers();
# add/update a parser
XML::SAX->add_parser(q(XML::SAX::PurePerl));
# remove parser
XML::SAX->remove_parser(q(XML::SAX::Foodelberry));
# save parsers
XML::SAX->save_parsers();
=head1 DESCRIPTION
XML::SAX is a SAX parser access API for Perl. It includes classes
and APIs required for implementing SAX drivers, along with a factory
class for returning any SAX parser installed on the user's system.
=head1 USING A SAX2 PARSER
The factory class is XML::SAX::ParserFactory. Please see the
documentation of that module for how to instantiate a SAX parser:
L<XML::SAX::ParserFactory>. However if you don't want to load up
another manual page, here's a short synopsis:
use XML::SAX::ParserFactory;
use XML::SAX::XYZHandler;
my $handler = XML::SAX::XYZHandler->new();
my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
$p->parse_uri("foo.xml");
# or $p->parse_string("<foo/>") or $p->parse_file($fh);
This will automatically load a SAX2 parser (defaulting to
XML::SAX::PurePerl if no others are found) and return it to you.
In order to learn how to use SAX to parse XML, you will need to read
L<XML::SAX::Intro> and for reference, L<XML::SAX::Specification>.
=head1 WRITING A SAX2 PARSER
The first thing to remember in writing a SAX2 parser is to subclass
XML::SAX::Base. This will make your life infinitely easier, by providing
a number of methods automagically for you. See L<XML::SAX::Base> for more
details.
When writing a SAX2 parser that is compatible with XML::SAX, you need
to inform XML::SAX of the presence of that driver when you install it.
In order to do that, XML::SAX contains methods for saving the fact that
the parser exists on your system to a "INI" file, which is then loaded
to determine which parsers are installed.
The best way to do this is to follow these rules:
=over 4
=item * Add XML::SAX as a prerequisite in Makefile.PL:
WriteMakefile(
...
PREREQ_PM => { 'XML::SAX' => 0 },
...
);
Alternatively you may wish to check for it in other ways that will
cause more than just a warning.
=item * Add the following code snippet to your Makefile.PL:
sub MY::install {
package MY;
my $script = shift->SUPER::install(@_);
if (ExtUtils::MakeMaker::prompt(
"Do you want to modify ParserDetails.ini?", 'Y')
=~ /^y/i) {
$script =~ s/install :: (.*)$/install :: $1 install_sax_driver/m;
$script .= <<"INSTALL";
install_sax_driver :
\t\@\$(PERL) -MXML::SAX -e "XML::SAX->add_parser(q(\$(NAME)))->save_parsers()"
INSTALL
}
return $script;
}
Note that you should check the output of this - \$(NAME) will use the name of
your distribution, which may not be exactly what you want. For example XML::LibXML
has a driver called XML::LibXML::SAX::Generator, which is used in place of
\$(NAME) in the above.
=item * Add an XML::SAX test:
A test file should be added to your t/ directory containing something like the
following:
use Test;
BEGIN { plan tests => 3 }
use XML::SAX;
use XML::SAX::PurePerl::DebugHandler;
XML::SAX->add_parser(q(XML::SAX::MyDriver));
local $XML::SAX::ParserPackage = 'XML::SAX::MyDriver';
eval {
my $handler = XML::SAX::PurePerl::DebugHandler->new();
ok($handler);
my $parser = XML::SAX::ParserFactory->parser(Handler => $handler);
ok($parser);
ok($parser->isa('XML::SAX::MyDriver');
$parser->parse_string("<tag/>");
ok($handler->{seen}{start_element});
};
=back
=head1 EXPORTS
By default, XML::SAX exports nothing into the caller's namespace. However you
can request the symbols C<Namespaces> and C<Validation> which are the
URIs for those features, allowing an easier way to request those features
via ParserFactory:
use XML::SAX qw(Namespaces Validation);
my $factory = XML::SAX::ParserFactory->new();
$factory->require_feature(Namespaces);
$factory->require_feature(Validation);
my $parser = $factory->parser();
=head1 AUTHOR
Current maintainer: Grant McLean, grantm@cpan.org
Originally written by:
Matt Sergeant, matt@sergeant.org
Kip Hampton, khampton@totalcinema.com
Robin Berjon, robin@knowscape.com
=head1 LICENSE
This is free software, you may use it and distribute it under
the same terms as Perl itself.
=head1 SEE ALSO
L<XML::SAX::Base> for writing SAX Filters and Parsers
L<XML::SAX::PurePerl> for an XML parser written in 100%
pure perl.
L<XML::SAX::Exception> for details on exception handling
=cut
perl5/5.32/XML/NamespaceSupport.pm 0000444 00000046752 15157556063 0012502 0 ustar 00 package XML::NamespaceSupport;
use strict;
our $VERSION = '1.12'; # VERSION
# ABSTRACT: A simple generic namespace processor
use constant FATALS => 0; # root object
use constant NSMAP => 1;
use constant UNKNOWN_PREF => 2;
use constant AUTO_PREFIX => 3;
use constant XMLNS_11 => 4;
use constant DEFAULT => 0; # maps
use constant PREFIX_MAP => 1;
use constant DECLARATIONS => 2;
use vars qw($NS_XMLNS $NS_XML);
$NS_XMLNS = 'http://www.w3.org/2000/xmlns/';
$NS_XML = 'http://www.w3.org/XML/1998/namespace';
# add the ns stuff that baud wants based on Java's xml-writer
#-------------------------------------------------------------------#
# constructor
#-------------------------------------------------------------------#
sub new {
my $class = ref($_[0]) ? ref(shift) : shift;
my $options = shift;
my $self = [
1, # FATALS
[[ # NSMAP
undef, # DEFAULT
{ xml => $NS_XML }, # PREFIX_MAP
undef, # DECLARATIONS
]],
'aaa', # UNKNOWN_PREF
0, # AUTO_PREFIX
1, # XML_11
];
$self->[NSMAP]->[0]->[PREFIX_MAP]->{xmlns} = $NS_XMLNS if $options->{xmlns};
$self->[FATALS] = $options->{fatal_errors} if defined $options->{fatal_errors};
$self->[AUTO_PREFIX] = $options->{auto_prefix} if defined $options->{auto_prefix};
$self->[XMLNS_11] = $options->{xmlns_11} if defined $options->{xmlns_11};
return bless $self, $class;
}
#-------------------------------------------------------------------#
# reset() - return to the original state (for reuse)
#-------------------------------------------------------------------#
sub reset {
my $self = shift;
$#{$self->[NSMAP]} = 0;
}
#-------------------------------------------------------------------#
# push_context() - add a new empty context to the stack
#-------------------------------------------------------------------#
sub push_context {
my $self = shift;
push @{$self->[NSMAP]}, [
$self->[NSMAP]->[-1]->[DEFAULT],
{ %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} },
[],
];
}
#-------------------------------------------------------------------#
# pop_context() - remove the topmost context from the stack
#-------------------------------------------------------------------#
sub pop_context {
my $self = shift;
die 'Trying to pop context without push context' unless @{$self->[NSMAP]} > 1;
pop @{$self->[NSMAP]};
}
#-------------------------------------------------------------------#
# declare_prefix() - declare a prefix in the current scope
#-------------------------------------------------------------------#
sub declare_prefix {
my $self = shift;
my $prefix = shift;
my $value = shift;
warn <<' EOWARN' unless defined $prefix or $self->[AUTO_PREFIX];
Prefix was undefined.
If you wish to set the default namespace, use the empty string ''.
If you wish to autogenerate prefixes, set the auto_prefix option
to a true value.
EOWARN
no warnings 'uninitialized';
if ($prefix eq 'xml' and $value ne $NS_XML) {
die "The xml prefix can only be bound to the $NS_XML namespace."
}
elsif ($value eq $NS_XML and $prefix ne 'xml') {
die "the $NS_XML namespace can only be bound to the xml prefix.";
}
elsif ($value eq $NS_XML and $prefix eq 'xml') {
return 1;
}
return 0 if index(lc($prefix), 'xml') == 0;
use warnings 'uninitialized';
if (defined $prefix and $prefix eq '') {
$self->[NSMAP]->[-1]->[DEFAULT] = $value;
}
else {
die "Cannot declare prefix $prefix" if $value eq '' and not $self->[XMLNS_11];
if (not defined $prefix and $self->[AUTO_PREFIX]) {
while (1) {
$prefix = $self->[UNKNOWN_PREF]++;
last if not exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
}
}
elsif (not defined $prefix and not $self->[AUTO_PREFIX]) {
return 0;
}
$self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} = $value;
}
push @{$self->[NSMAP]->[-1]->[DECLARATIONS]}, $prefix;
return 1;
}
#-------------------------------------------------------------------#
# declare_prefixes() - declare several prefixes in the current scope
#-------------------------------------------------------------------#
sub declare_prefixes {
my $self = shift;
my %prefixes = @_;
while (my ($k,$v) = each %prefixes) {
$self->declare_prefix($k,$v);
}
}
#-------------------------------------------------------------------#
# undeclare_prefix
#-------------------------------------------------------------------#
sub undeclare_prefix {
my $self = shift;
my $prefix = shift;
return if not defined($prefix);
return unless exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
my ( $tfix ) = grep { $_ eq $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]};
if ( not defined $tfix ) {
die "prefix $prefix not declared in this context\n";
}
@{$self->[NSMAP]->[-1]->[DECLARATIONS]} = grep { $_ ne $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]};
delete $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
}
#-------------------------------------------------------------------#
# get_prefix() - get a (random) prefix for a given URI
#-------------------------------------------------------------------#
sub get_prefix {
my $self = shift;
my $uri = shift;
# we have to iterate over the whole hash here because if we don't
# the iterator isn't reset and the next pass will fail
my $pref;
while (my ($k, $v) = each %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}) {
$pref = $k if $v eq $uri;
}
return $pref;
}
#-------------------------------------------------------------------#
# get_prefixes() - get all the prefixes for a given URI
#-------------------------------------------------------------------#
sub get_prefixes {
my $self = shift;
my $uri = shift;
return keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} unless defined $uri;
return grep { $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$_} eq $uri } keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]};
}
#-------------------------------------------------------------------#
# get_declared_prefixes() - get all prefixes declared in the last context
#-------------------------------------------------------------------#
sub get_declared_prefixes {
my $declarations = $_[0]->[NSMAP]->[-1]->[DECLARATIONS];
die "At least one context must be pushed onto stack with push_context()\n",
"before calling get_declared_prefixes()"
if not defined $declarations;
return @{$_[0]->[NSMAP]->[-1]->[DECLARATIONS]};
}
#-------------------------------------------------------------------#
# get_uri() - get a URI given a prefix
#-------------------------------------------------------------------#
sub get_uri {
my $self = shift;
my $prefix = shift;
warn "Prefix must not be undef in get_uri(). The emtpy prefix must be ''" unless defined $prefix;
return $self->[NSMAP]->[-1]->[DEFAULT] if $prefix eq '';
return $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} if exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix};
return undef;
}
#-------------------------------------------------------------------#
# process_name() - provide details on a name
#-------------------------------------------------------------------#
sub process_name {
my $self = shift;
my $qname = shift;
my $aflag = shift;
if ($self->[FATALS]) {
return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname );
}
else {
eval { return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); }
}
}
#-------------------------------------------------------------------#
# process_element_name() - provide details on a element's name
#-------------------------------------------------------------------#
sub process_element_name {
my $self = shift;
my $qname = shift;
if ($self->[FATALS]) {
return $self->_get_ns_details($qname, 0);
}
else {
eval { return $self->_get_ns_details($qname, 0); }
}
}
#-------------------------------------------------------------------#
# process_attribute_name() - provide details on a attribute's name
#-------------------------------------------------------------------#
sub process_attribute_name {
my $self = shift;
my $qname = shift;
if ($self->[FATALS]) {
return $self->_get_ns_details($qname, 1);
}
else {
eval { return $self->_get_ns_details($qname, 1); }
}
}
#-------------------------------------------------------------------#
# ($ns, $prefix, $lname) = $self->_get_ns_details($qname, $f_attr)
# returns ns, prefix, and lname for a given attribute name
# >> the $f_attr flag, if set to one, will work for an attribute
#-------------------------------------------------------------------#
sub _get_ns_details {
my $self = shift;
my $qname = shift;
my $aflag = shift;
my ($ns, $prefix, $lname);
(my ($tmp_prefix, $tmp_lname) = split /:/, $qname, 3)
< 3 or die "Invalid QName: $qname";
# no prefix
my $cur_map = $self->[NSMAP]->[-1];
if (not defined($tmp_lname)) {
$prefix = undef;
$lname = $qname;
# attr don't have a default namespace
$ns = ($aflag) ? undef : $cur_map->[DEFAULT];
}
# prefix
else {
if (exists $cur_map->[PREFIX_MAP]->{$tmp_prefix}) {
$prefix = $tmp_prefix;
$lname = $tmp_lname;
$ns = $cur_map->[PREFIX_MAP]->{$prefix}
}
else { # no ns -> lname == name, all rest undef
die "Undeclared prefix: $tmp_prefix";
}
}
return ($ns, $prefix, $lname);
}
#-------------------------------------------------------------------#
# parse_jclark_notation() - parse the Clarkian notation
#-------------------------------------------------------------------#
sub parse_jclark_notation {
shift;
my $jc = shift;
$jc =~ m/^\{(.*)\}([^}]+)$/;
return $1, $2;
}
#-------------------------------------------------------------------#
# Java names mapping
#-------------------------------------------------------------------#
*XML::NamespaceSupport::pushContext = \&push_context;
*XML::NamespaceSupport::popContext = \&pop_context;
*XML::NamespaceSupport::declarePrefix = \&declare_prefix;
*XML::NamespaceSupport::declarePrefixes = \&declare_prefixes;
*XML::NamespaceSupport::getPrefix = \&get_prefix;
*XML::NamespaceSupport::getPrefixes = \&get_prefixes;
*XML::NamespaceSupport::getDeclaredPrefixes = \&get_declared_prefixes;
*XML::NamespaceSupport::getURI = \&get_uri;
*XML::NamespaceSupport::processName = \&process_name;
*XML::NamespaceSupport::processElementName = \&process_element_name;
*XML::NamespaceSupport::processAttributeName = \&process_attribute_name;
*XML::NamespaceSupport::parseJClarkNotation = \&parse_jclark_notation;
*XML::NamespaceSupport::undeclarePrefix = \&undeclare_prefix;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
XML::NamespaceSupport - A simple generic namespace processor
=head1 VERSION
version 1.12
=head1 SYNOPSIS
use XML::NamespaceSupport;
my $nsup = XML::NamespaceSupport->new;
# add a new empty context
$nsup->push_context;
# declare a few prefixes
$nsup->declare_prefix($prefix1, $uri1);
$nsup->declare_prefix($prefix2, $uri2);
# the same shorter
$nsup->declare_prefixes($prefix1 => $uri1, $prefix2 => $uri2);
# get a single prefix for a URI (randomly)
$prefix = $nsup->get_prefix($uri);
# get all prefixes for a URI (probably better)
@prefixes = $nsup->get_prefixes($uri);
# get all prefixes in scope
@prefixes = $nsup->get_prefixes();
# get all prefixes that were declared for the current scope
@prefixes = $nsup->get_declared_prefixes;
# get a URI for a given prefix
$uri = $nsup->get_uri($prefix);
# get info on a qname (java-ish way, it's a bit weird)
($ns_uri, $local_name, $qname) = $nsup->process_name($qname, $is_attr);
# the same, more perlish
($ns_uri, $prefix, $local_name) = $nsup->process_element_name($qname);
($ns_uri, $prefix, $local_name) = $nsup->process_attribute_name($qname);
# remove the current context
$nsup->pop_context;
# reset the object for reuse in another document
$nsup->reset;
# a simple helper to process Clarkian Notation
my ($ns, $lname) = $nsup->parse_jclark_notation('{http://foo}bar');
# or (given that it doesn't care about the object
my ($ns, $lname) = XML::NamespaceSupport->parse_jclark_notation('{http://foo}bar');
=head1 DESCRIPTION
This module offers a simple to process namespaced XML names (unames)
from within any application that may need them. It also helps maintain
a prefix to namespace URI map, and provides a number of basic checks.
The model for this module is SAX2's NamespaceSupport class, readable at
http://www.saxproject.org/namespaces.html
It adds a few perlisations where we thought it appropriate.
=head1 NAME
XML::NamespaceSupport - a simple generic namespace support class
=head1 METHODS
=over 4
=item * XML::NamespaceSupport->new(\%options)
A simple constructor.
The options are C<xmlns>, C<fatal_errors>, and C<auto_prefix>
If C<xmlns> is turned on (it is off by default) the mapping from the
xmlns prefix to the URI defined for it in DOM level 2 is added to the
list of predefined mappings (which normally only contains the xml
prefix mapping).
If C<fatal_errors> is turned off (it is on by default) a number of
validity errors will simply be flagged as failures, instead of
die()ing.
If C<auto_prefix> is turned on (it is off by default) when one
provides a prefix of C<undef> to C<declare_prefix> it will generate a
random prefix mapped to that namespace. Otherwise an undef prefix will
trigger a warning (you should probably know what you're doing if you
turn this option on).
If C<xmlns_11> us turned off, it becomes illegal to undeclare namespace
prefixes. It is on by default. This behaviour is compliant with Namespaces
in XML 1.1, turning it off reverts you to version 1.0.
=item * $nsup->push_context
Adds a new empty context to the stack. You can then populate it with
new prefixes defined at this level.
=item * $nsup->pop_context
Removes the topmost context in the stack and reverts to the previous
one. It will die() if you try to pop more than you have pushed.
=item * $nsup->declare_prefix($prefix, $uri)
Declares a mapping of $prefix to $uri, at the current level.
Note that with C<auto_prefix> turned on, if you declare a prefix
mapping in which $prefix is undef(), you will get an automatic prefix
selected for you. If it is off you will get a warning.
This is useful when you deal with code that hasn't kept prefixes around
and need to reserialize the nodes. It also means that if you want to
set the default namespace (i.e. with an empty prefix) you must use the
empty string instead of undef. This behaviour is consistent with the
SAX 2.0 specification.
=item * $nsup->declare_prefixes(%prefixes2uris)
Declares a mapping of several prefixes to URIs, at the current level.
=item * $nsup->get_prefix($uri)
Returns a prefix given a URI. Note that as several prefixes may be
mapped to the same URI, it returns an arbitrary one. It'll return
undef on failure.
=item * $nsup->get_prefixes($uri)
Returns an array of prefixes given a URI. It'll return all the
prefixes if the uri is undef.
=item * $nsup->get_declared_prefixes
Returns an array of all the prefixes that have been declared within
this context, ie those that were declared on the last element, not
those that were declared above and are simply in scope.
Note that at least one context must be added to the stack via
C<push_context> before this method can be called.
=item * $nsup->get_uri($prefix)
Returns a URI for a given prefix. Returns undef on failure.
=item * $nsup->process_name($qname, $is_attr)
Given a qualified name and a boolean indicating whether this is an
attribute or another type of name (those are differently affected by
default namespaces), it returns a namespace URI, local name, qualified
name tuple. I know that that is a rather abnormal list to return, but
it is so for compatibility with the Java spec. See below for more
Perlish alternatives.
If the prefix is not declared, or if the name is not valid, it'll
either die or return undef depending on the current setting of
C<fatal_errors>.
=item * $nsup->undeclare_prefix($prefix);
Removes a namespace prefix from the current context. This function may
be used in SAX's end_prefix_mapping when there is fear that a namespace
declaration might be available outside their scope (which shouldn't
normally happen, but you never know ;) ). This may be needed in order
to properly support Namespace 1.1.
=item * $nsup->process_element_name($qname)
Given a qualified name, it returns a namespace URI, prefix, and local
name tuple. This method applies to element names.
If the prefix is not declared, or if the name is not valid, it'll
either die or return undef depending on the current setting of
C<fatal_errors>.
=item * $nsup->process_attribute_name($qname)
Given a qualified name, it returns a namespace URI, prefix, and local
name tuple. This method applies to attribute names.
If the prefix is not declared, or if the name is not valid, it'll
either die or return undef depending on the current setting of
C<fatal_errors>.
=item * $nsup->reset
Resets the object so that it can be reused on another document.
=back
All methods of the interface have an alias that is the name used in
the original Java specification. You can use either name
interchangeably. Here is the mapping:
Java name Perl name
---------------------------------------------------
pushContext push_context
popContext pop_context
declarePrefix declare_prefix
declarePrefixes declare_prefixes
getPrefix get_prefix
getPrefixes get_prefixes
getDeclaredPrefixes get_declared_prefixes
getURI get_uri
processName process_name
processElementName process_element_name
processAttributeName process_attribute_name
parseJClarkNotation parse_jclark_notation
undeclarePrefix undeclare_prefix
=head1 VARIABLES
Two global variables are made available to you. They used to be constants but
simple scalars are easier to use in a number of contexts. They are not
exported but can easily be accessed from any package, or copied into it.
=over 4
=item * C<$NS_XMLNS>
The namespace for xmlns prefixes, http://www.w3.org/2000/xmlns/.
=item * C<$NS_XML>
The namespace for xml prefixes, http://www.w3.org/XML/1998/namespace.
=back
=head1 TODO
- add more tests
- optimise here and there
=head1 SEE ALSO
XML::Parser::PerlSAX
=head1 AUTHORS
=over 4
=item *
Robin Berjon <robin@knowscape.com>
=item *
Chris Prather <chris@prather.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Robin Berjon.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 CONTRIBUTORS
=for stopwords Chris Prather David Steinbrunner Paul Cochrane Paulo Custodio
=over 4
=item *
Chris Prather <cprather@hdpublishing.com>
=item *
David Steinbrunner <dsteinbrunner@pobox.com>
=item *
Paul Cochrane <paul@liekut.de>
=item *
Paulo Custodio <pauloscustodio@gmail.com>
=back
=cut
perl5/5.32/XML/Simple/FAQ.pod 0000444 00000050660 15157556076 0011214 0 ustar 00
=head1 NAME
XML::Simple::FAQ - Frequently Asked Questions about XML::Simple
=head1 Basics
=head2 What should I use XML::Simple for?
Nothing!
It's as simple as that.
Choose a better module. See
L<Perl XML::LibXML by Example|http://grantm.github.io/perl-libxml-by-example/>
for a gentle introduction to L<XML::LibXML> with lots of examples.
=head2 What was XML::Simple designed to be used for?
XML::Simple is a Perl module that was originally developed as a tool for
reading and writing configuration data in XML format. You could use it for
other purposes that involve storing and retrieving structured data in
XML but it's likely to be a frustrating experience.
=head2 Why store configuration data in XML anyway?
It seemed like a good idea at the time. Now, I use and recommend
L<Config::General> which uses a format similar to that used by the Apache web
server. This is easier to read than XML while still allowing advanced concepts
such as nested sections.
At the time XML::Simple was written, the advantages of using XML format for
configuration data were thought to include:
=over 4
=item *
Using existing XML parsing tools requires less development time, is easier
and more robust than developing your own config file parsing code
=item *
XML can represent relationships between pieces of data, such as nesting of
sections to arbitrary levels (not easily done with .INI files for example)
=item *
XML is basically just text, so you can easily edit a config file (easier than
editing a Win32 registry)
=item *
XML provides standard solutions for handling character sets and encoding
beyond basic ASCII (important for internationalization)
=item *
If it becomes necessary to change your configuration file format, there are
many tools available for performing transformations on XML files
=item *
XML is an open standard (the world does not need more proprietary binary
file formats)
=item *
Taking the extra step of developing a DTD allows the format of configuration
files to be validated before your program reads them (not directly supported
by XML::Simple)
=item *
Combining a DTD with a good XML editor can give you a GUI config editor for
minimal coding effort
=back
=head2 What isn't XML::Simple good for?
The main limitation of XML::Simple is that it does not work with 'mixed
content' (see the next question). If you consider your XML files contain
marked up text rather than structured data, you should probably use another
module.
If your source XML documents change regularly, it's likely that you will
experience intermittent failures. In particular, failure to properly use the
ForceArray and KeyAttr options will produce code that works when you get a list
of elements with the same name, but fails when there's only one item in the
list. These types of problems can be avoided by not using XML::Simple in the
first place.
If you are working with very large XML files, XML::Simple's approach of
representing the whole file in memory as a 'tree' data structure may not be
suitable.
=head2 What is mixed content?
Consider this example XML:
<document>
<para>This is <em>mixed</em> content.</para>
</document>
This is said to be mixed content, because the E<lt>paraE<gt> element contains
both character data (text content) and nested elements.
Here's some more XML:
<person>
<first_name>Joe</first_name>
<last_name>Bloggs</last_name>
<dob>25-April-1969</dob>
</person>
This second example is not generally considered to be mixed content. The
E<lt>first_nameE<gt>, E<lt>last_nameE<gt> and E<lt>dobE<gt> elements contain
only character data and the E<lt>personE<gt> element contains only nested
elements. (Note: Strictly speaking, the whitespace between the nested
elements is character data, but it is ignored by XML::Simple).
=head2 Why doesn't XML::Simple handle mixed content?
Because if it did, it would no longer be simple :-)
Seriously though, there are plenty of excellent modules that allow you to
work with mixed content in a variety of ways. Handling mixed content
correctly is not easy and by ignoring these issues, XML::Simple is able to
present an API without a steep learning curve.
=head2 Which Perl modules do handle mixed content?
Every one of them except XML::Simple :-)
If you're looking for a recommendation, I'd suggest you look at the Perl-XML
FAQ at:
http://perl-xml.sourceforge.net/faq/
=head1 Installation
=head2 How do I install XML::Simple?
If you're running ActiveState Perl, or
L<Strawberry Perl|http://strawberryperl.com/> you've probably already got
XML::Simple and therefore do not need to install it at all. But you probably
also have L<XML::LibXML>, which is a much better module, so just use that.
If you do need to install XML::Simple, you'll need to install an XML parser
module first. Install either XML::Parser (which you may have already) or
XML::SAX. If you install both, XML::SAX will be used by default.
Once you have a parser installed ...
On Unix systems, try:
perl -MCPAN -e 'install XML::Simple'
If that doesn't work, download the latest distribution from
ftp://ftp.cpan.org/pub/CPAN/authors/id/G/GR/GRANTM , unpack it and run these
commands:
perl Makefile.PL
make
make test
make install
On Win32, if you have a recent build of ActiveState Perl (618 or better) try
this command:
ppm install XML::Simple
If that doesn't work, you really only need the Simple.pm file, so extract it
from the .tar.gz file (eg: using WinZIP) and save it in the \site\lib\XML
directory under your Perl installation (typically C:\Perl).
=head2 I'm trying to install XML::Simple and 'make test' fails
Is the directory where you've unpacked XML::Simple mounted from a file server
using NFS, SMB or some other network file sharing? If so, that may cause
errors in the following test scripts:
3_Storable.t
4_MemShare.t
5_MemCopy.t
The test suite is designed to exercise the boundary conditions of all
XML::Simple's functionality and these three scripts exercise the caching
functions. If XML::Simple is asked to parse a file for which it has a cached
copy of a previous parse, then it compares the timestamp on the XML file with
the timestamp on the cached copy. If the cached copy is *newer* then it will
be used. If the cached copy is older or the same age then the file is
re-parsed. The test scripts will get confused by networked filesystems if
the workstation and server system clocks are not synchronised (to the
second).
If you get an error in one of these three test scripts but you don't plan to
use the caching options (they're not enabled by default), then go right ahead
and run 'make install'. If you do plan to use caching, then try unpacking
the distribution on local disk and doing the build/test there.
It's probably not a good idea to use the caching options with networked
filesystems in production. If the file server's clock is ahead of the local
clock, XML::Simple will re-parse files when it could have used the cached
copy. However if the local clock is ahead of the file server clock and a
file is changed immediately after it is cached, the old cached copy will be
used.
Is one of the three test scripts (above) failing but you're not running on
a network filesystem? Are you running Win32? If so, you may be seeing a bug
in Win32 where writes to a file do not affect its modification timestamp.
If none of these scenarios match your situation, please confirm you're
running the latest version of XML::Simple and then email the output of
'make test' to me at grantm@cpan.org
=head2 Why is XML::Simple so slow?
If you find that XML::Simple is very slow reading XML, the most likely reason
is that you have XML::SAX installed but no additional SAX parser module. The
XML::SAX distribution includes an XML parser written entirely in Perl. This is
very portable but not very fast. For better performance install either
XML::SAX::Expat or XML::LibXML.
=head1 Usage
=head2 How do I use XML::Simple?
If you don't know how to use XML::Simple then the best approach is to
L<learn to use XML::LibXML|http://grantm.github.io/perl-libxml-by-example/>
instead. Stop reading this document and use that one instead.
If you are determined to use XML::Simple, it come with copious documentation,
so L<read that|XML::Simple>.
=head2 There are so many options, which ones do I really need to know about?
Although you can get by without using any options, you shouldn't even
consider using XML::Simple in production until you know what these two
options do:
=over 4
=item *
forcearray
=item *
keyattr
=back
The reason you really need to read about them is because the default values
for these options will trip you up if you don't. Although everyone agrees
that these defaults are not ideal, there is not wide agreement on what they
should be changed to. The answer therefore is to read about them (see below)
and select values which are right for you.
=head2 What is the forcearray option all about?
Consider this XML in a file called ./person.xml:
<person>
<first_name>Joe</first_name>
<last_name>Bloggs</last_name>
<hobbie>bungy jumping</hobbie>
<hobbie>sky diving</hobbie>
<hobbie>knitting</hobbie>
</person>
You could read it in with this line:
my $person = XMLin('./person.xml');
Which would give you a data structure like this:
$person = {
'first_name' => 'Joe',
'last_name' => 'Bloggs',
'hobbie' => [ 'bungy jumping', 'sky diving', 'knitting' ]
};
The E<lt>first_nameE<gt> and E<lt>last_nameE<gt> elements are represented as
simple scalar values which you could refer to like this:
print "$person->{first_name} $person->{last_name}\n";
The E<lt>hobbieE<gt> elements are represented as an array - since there is
more than one. You could refer to the first one like this:
print $person->{hobbie}->[0], "\n";
Or the whole lot like this:
print join(', ', @{$person->{hobbie}} ), "\n";
The catch is, that these last two lines of code will only work for people
who have more than one hobbie. If there is only one E<lt>hobbieE<gt>
element, it will be represented as a simple scalar (just like
E<lt>first_nameE<gt> and E<lt>last_nameE<gt>). Which might lead you to write
code like this:
if(ref($person->{hobbie})) {
print join(', ', @{$person->{hobbie}} ), "\n";
}
else {
print $person->{hobbie}, "\n";
}
Don't do that.
One alternative approach is to set the forcearray option to a true value:
my $person = XMLin('./person.xml', forcearray => 1);
Which will give you a data structure like this:
$person = {
'first_name' => [ 'Joe' ],
'last_name' => [ 'Bloggs' ],
'hobbie' => [ 'bungy jumping', 'sky diving', 'knitting' ]
};
Then you can use this line to refer to all the list of hobbies even if there
was only one:
print join(', ', @{$person->{hobbie}} ), "\n";
The downside of this approach is that the E<lt>first_nameE<gt> and
E<lt>last_nameE<gt> elements will also always be represented as arrays even
though there will never be more than one:
print "$person->{first_name}->[0] $person->{last_name}->[0]\n";
This might be OK if you change the XML to use attributes for things that
will always be singular and nested elements for things that may be plural:
<person first_name="Jane" last_name="Bloggs">
<hobbie>motorcycle maintenance</hobbie>
</person>
On the other hand, if you prefer not to use attributes, then you could
specify that any E<lt>hobbieE<gt> elements should always be represented as
arrays and all other nested elements should be simple scalar values unless
there is more than one:
my $person = XMLin('./person.xml', forcearray => [ 'hobbie' ]);
The forcearray option accepts a list of element names which should always
be forced to an array representation:
forcearray => [ qw(hobbie qualification childs_name) ]
See the XML::Simple manual page for more information.
=head2 What is the keyattr option all about?
Consider this sample XML:
<catalog>
<part partnum="1842334" desc="High pressure flange" price="24.50" />
<part partnum="9344675" desc="Threaded gasket" price="9.25" />
<part partnum="5634896" desc="Low voltage washer" price="12.00" />
</catalog>
You could slurp it in with this code:
my $catalog = XMLin('./catalog.xml');
Which would return a data structure like this:
$catalog = {
'part' => [
{
'partnum' => '1842334',
'desc' => 'High pressure flange',
'price' => '24.50'
},
{
'partnum' => '9344675',
'desc' => 'Threaded gasket',
'price' => '9.25'
},
{
'partnum' => '5634896',
'desc' => 'Low voltage washer',
'price' => '12.00'
}
]
};
Then you could access the description of the first part in the catalog
with this code:
print $catalog->{part}->[0]->{desc}, "\n";
However, if you wanted to access the description of the part with the
part number of "9344675" then you'd have to code a loop like this:
foreach my $part (@{$catalog->{part}}) {
if($part->{partnum} eq '9344675') {
print $part->{desc}, "\n";
last;
}
}
The knowledge that each E<lt>partE<gt> element has a unique partnum attribute
allows you to eliminate this search. You can pass this knowledge on to
XML::Simple like this:
my $catalog = XMLin($xml, keyattr => ['partnum']);
Which will return a data structure like this:
$catalog = {
'part' => {
'5634896' => { 'desc' => 'Low voltage washer', 'price' => '12.00' },
'1842334' => { 'desc' => 'High pressure flange', 'price' => '24.50' },
'9344675' => { 'desc' => 'Threaded gasket', 'price' => '9.25' }
}
};
XML::Simple has been able to transform $catalog->{part} from an arrayref to
a hashref (keyed on partnum). This transformation is called 'array folding'.
Through the use of array folding, you can now index directly to the
description of the part you want:
print $catalog->{part}->{9344675}->{desc}, "\n";
The 'keyattr' option also enables array folding when the unique key is in a
nested element rather than an attribute. eg:
<catalog>
<part>
<partnum>1842334</partnum>
<desc>High pressure flange</desc>
<price>24.50</price>
</part>
<part>
<partnum>9344675</partnum>
<desc>Threaded gasket</desc>
<price>9.25</price>
</part>
<part>
<partnum>5634896</partnum>
<desc>Low voltage washer</desc>
<price>12.00</price>
</part>
</catalog>
See the XML::Simple manual page for more information.
=head2 So what's the catch with 'keyattr'?
One thing to watch out for is that you might get array folding even if you
don't supply the keyattr option. The default value for this option is:
[ 'name', 'key', 'id']
Which means if your XML elements have a 'name', 'key' or 'id' attribute (or
nested element) then they may get folded on those values. This means that
you can take advantage of array folding simply through careful choice of
attribute names. On the hand, if you really don't want array folding at all,
you'll need to set 'key attr to an empty list:
my $ref = XMLin($xml, keyattr => []);
A second 'gotcha' is that array folding only works on arrays. That might
seem obvious, but if there's only one record in your XML and you didn't set
the 'forcearray' option then it won't be represented as an array and
consequently won't get folded into a hash. The moral is that if you're
using array folding, you should always turn on the forcearray option.
You probably want to be as specific as you can be too. For instance, the
safest way to parse the E<lt>catalogE<gt> example above would be:
my $catalog = XMLin($xml, keyattr => { part => 'partnum'},
forcearray => ['part']);
By using the hashref for keyattr, you can specify that only E<lt>partE<gt>
elements should be folded on the 'partnum' attribute (and that the
E<lt>partE<gt> elements should not be folded on any other attribute).
By supplying a list of element names for forcearray, you're ensuring that
folding will work even if there's only one E<lt>partE<gt>. You're also
ensuring that if the 'partnum' unique key is supplied in a nested element
then that element won't get forced to an array too.
=head2 How do I know what my data structure should look like?
The rules are fairly straightforward:
=over 4
=item *
each element gets represented as a hash
=item *
unless it contains only text, in which case it'll be a simple scalar value
=item *
or unless there's more than one element with the same name, in which case
they'll be represented as an array
=item *
unless you've got array folding enabled, in which case they'll be folded into
a hash
=item *
empty elements (no text contents B<and> no attributes) will either be
represented as an empty hash, an empty string or undef - depending on the value
of the 'suppressempty' option.
=back
If you're in any doubt, use Data::Dumper, eg:
use XML::Simple;
use Data::Dumper;
my $ref = XMLin($xml);
print Dumper($ref);
=head2 I'm getting 'Use of uninitialized value' warnings
You're probably trying to index into a non-existant hash key - try
Data::Dumper.
=head2 I'm getting a 'Not an ARRAY reference' error
Something that you expect to be an array is not. The two most likely causes
are that you forgot to use 'forcearray' or that the array got folded into a
hash - try Data::Dumper.
=head2 I'm getting a 'No such array field' error
Something that you expect to be a hash is actually an array. Perhaps array
folding failed because one element was missing the key attribute - try
Data::Dumper.
=head2 I'm getting an 'Out of memory' error
Something in the data structure is not as you expect and Perl may be trying
unsuccessfully to autovivify things - try Data::Dumper.
If you're already using Data::Dumper, try calling Dumper() immediately after
XMLin() - ie: before you attempt to access anything in the data structure.
=head2 My element order is getting jumbled up
If you read an XML file with XMLin() and then write it back out with
XMLout(), the order of the elements will likely be different. (However, if
you read the file back in with XMLin() you'll get the same Perl data
structure).
The reordering happens because XML::Simple uses hashrefs to store your data
and Perl hashes do not really have any order.
It is possible that a future version of XML::Simple will use Tie::IxHash
to store the data in hashrefs which do retain the order. However this will
not fix all cases of element order being lost.
If your application really is sensitive to element order, don't use
XML::Simple (and don't put order-sensitive values in attributes).
=head2 XML::Simple turns nested elements into attributes
If you read an XML file with XMLin() and then write it back out with
XMLout(), some data which was originally stored in nested elements may end up
in attributes. (However, if you read the file back in with XMLin() you'll
get the same Perl data structure).
There are a number of ways you might handle this:
=over 4
=item *
use the 'forcearray' option with XMLin()
=item *
use the 'noattr' option with XMLout()
=item *
live with it
=item *
don't use XML::Simple
=back
=head2 Why does XMLout() insert E<lt>nameE<gt> elements (or attributes)?
Try setting keyattr => [].
When you call XMLin() to read XML, the 'keyattr' option controls whether arrays
get 'folded' into hashes. Similarly, when you call XMLout(), the 'keyattr'
option controls whether hashes get 'unfolded' into arrays. As described above,
'keyattr' is enabled by default.
=head2 Why are empty elements represented as empty hashes?
An element is always represented as a hash unless it contains only text, in
which case it is represented as a scalar string.
If you would prefer empty elements to be represented as empty strings or the
undefined value, set the 'suppressempty' option to '' or undef respectively.
=head2 Why is ParserOpts deprecated?
The C<ParserOpts> option is a remnant of the time when XML::Simple only worked
with the XML::Parser API. Its value is completely ignored if you're using a
SAX parser, so writing code which relied on it would bar you from taking
advantage of SAX.
Even if you are using XML::Parser, it is seldom necessary to pass options to
the parser object. A number of people have written to say they use this option
to set XML::Parser's C<ProtocolEncoding> option. Don't do that, it's wrong,
Wrong, WRONG! Fix the XML document so that it's well-formed and you won't have
a problem.
Having said all of that, as long as XML::Simple continues to support the
XML::Parser API, this option will not be removed. There are currently no plans
to remove support for the XML::Parser API.
=cut
perl5/5.32/alienfile.pm 0000444 00000040751 15157556110 0010463 0 ustar 00 package alienfile;
use strict;
use warnings;
use 5.008004;
use Alien::Build;
use Exporter ();
use Path::Tiny ();
use Carp ();
sub _path { Path::Tiny::path(@_) }
# ABSTRACT: Specification for defining an external dependency for CPAN
our $VERSION = '2.84'; # VERSION
our @EXPORT = qw( requires on plugin probe configure share sys download fetch decode prefer extract patch patch_ffi build build_ffi gather gather_ffi meta_prop ffi log test start_url before after digest );
sub requires
{
my($module, $version) = @_;
$version ||= 0;
my $caller = caller;
my $meta = $caller->meta;
$meta->add_requires($meta->{phase}, $module, $version);
();
}
sub plugin
{
my($name, @args) = @_;
my $caller = caller;
$caller->meta->apply_plugin($name, @args);
return;
}
sub probe
{
my($instr) = @_;
my $caller = caller;
if(my $phase = $caller->meta->{phase})
{
Carp::croak "probe must not be in a $phase block" if $phase ne 'any';
}
$caller->meta->register_hook(probe => $instr);
return;
}
sub _phase
{
my($code, $phase) = @_;
my $caller = caller(1);
my $meta = $caller->meta;
local $meta->{phase} = $phase;
$code->();
return;
}
sub configure (&)
{
_phase($_[0], 'configure');
}
sub sys (&)
{
_phase($_[0], 'system');
}
sub share (&)
{
_phase($_[0], 'share');
}
sub _in_phase
{
my($phase) = @_;
my $caller = caller(1);
my(undef, undef, undef, $sub) = caller(1);
my $meta = $caller->meta;
$sub =~ s/^.*:://;
Carp::croak "$sub must be in a $phase block"
unless $meta->{phase} eq $phase;
}
sub start_url
{
my($url) = @_;
_in_phase 'share';
my $caller = caller;
my $meta = $caller->meta;
$meta->prop->{start_url} = $url;
$meta->add_requires('configure' => 'Alien::Build' => '1.19');
return;
}
sub digest
{
my($algo, $digest) = @_;
my $caller = caller;
$caller->meta->apply_plugin('Digest', [$algo, $digest]);
return;
}
sub download
{
my($instr) = @_;
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(download => $instr);
return;
}
sub fetch
{
my($instr) = @_;
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(fetch => $instr);
return;
}
sub decode
{
my($instr) = @_;
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(decode => $instr);
return;
}
sub prefer
{
my($instr) = @_;
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(prefer => $instr);
return;
}
sub extract
{
my($instr) = @_;
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(extract => $instr);
return;
}
sub patch
{
my($instr) = @_;
_in_phase 'share';
my $caller = caller;
my $suffix = $caller->meta->{build_suffix};
$caller->meta->register_hook("patch$suffix" => $instr);
return;
}
sub patch_ffi
{
my($instr) = @_;
Carp::carp("patch_ffi is deprecated, use ffi { patch ... } } instead");
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(patch_ffi => $instr);
return;
}
sub build
{
my($instr) = @_;
_in_phase 'share';
my $caller = caller;
my $suffix = $caller->meta->{build_suffix};
$caller->meta->register_hook("build$suffix" => $instr);
return;
}
sub build_ffi
{
my($instr) = @_;
Carp::carp("build_ffi is deprecated, use ffi { build ... } } instead");
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(build_ffi => $instr);
return;
}
sub gather
{
my($instr) = @_;
my $caller = caller;
my $meta = $caller->meta;
my $phase = $meta->{phase};
Carp::croak "gather is not allowed in configure block"
if $phase eq 'configure';
my $suffix = $caller->meta->{build_suffix};
if($suffix eq '_ffi')
{
$meta->register_hook(gather_ffi => $instr)
}
else
{
$meta->register_hook(gather_system => $instr) if $phase =~ /^(any|system)$/;
$meta->register_hook(gather_share => $instr) if $phase =~ /^(any|share)$/;
}
return;
}
sub gather_ffi
{
my($instr) = @_;
Carp::carp("gather_ffi is deprecated, use ffi { gather ... } } instead");
_in_phase 'share';
my $caller = caller;
$caller->meta->register_hook(gather_ffi => $instr);
return;
}
sub ffi (&)
{
my($code) = @_;
_in_phase 'share';
my $caller = caller;
local $caller->meta->{build_suffix} = '_ffi';
$code->();
return;
}
sub meta_prop
{
my $caller = caller;
my $meta = $caller->meta;
$meta->prop;
}
sub log
{
unshift @_, 'Alien::Build';
goto &Alien::Build::log;
}
sub test
{
my($instr) = @_;
my $caller = caller;
my $meta = $caller->meta;
my $phase = $meta->{phase};
Carp::croak "test is not allowed in $phase block"
if $phase eq 'any' || $phase eq 'configure';
$meta->add_requires('configure' => 'Alien::Build' => '1.14');
if($phase eq 'share')
{
my $suffix = $caller->meta->{build_suffix} || '_share';
$meta->register_hook(
"test$suffix" => $instr,
);
}
elsif($phase eq 'system')
{
$meta->register_hook(
"test_system" => $instr,
);
}
else
{
die "unknown phase: $phase";
}
}
my %modifiers = (
probe => { any => 'probe' },
download => { share => 'download' },
fetch => { share => 'fetch' },
decode => { share => 'fetch' },
prefer => { share => 'prefer' },
extract => { share => 'extract' },
patch => { share => 'patch$' },
build => { share => 'build$' },
test => { share => 'test$' },
# Note: below special case gather_ffi for the ffi block :P
gather => { share => 'gather_share', system => 'gather_system', any => 'gather_share,gather_system' },
);
sub _add_modifier
{
my($type, $stage, $sub) = @_;
my $method = "${type}_hook";
Carp::croak "No such stage $stage" unless defined $modifiers{$stage};
Carp::croak "$type $stage argument must be a code reference" unless defined $sub && ref($sub) eq 'CODE';
my $caller = caller;
my $meta = $caller->meta;
Carp::croak "$type $stage is not allowed in sys block" unless defined $modifiers{$stage}->{$meta->{phase}};
$meta->add_requires('configure' => 'Alien::Build' => '1.40');
my $suffix = $meta->{build_suffix};
if($suffix eq '_ffi' && $stage eq 'gather')
{
$meta->$method('gather_ffi' => $sub);
}
foreach my $hook (
map { split /,/, $_ } # split on , for when multiple hooks must be attached (gather in any)
map { my $x = $_ ; $x =~ s/\$/$suffix/; $x } # substitute $ at the end for a suffix (_ffi) if any
$modifiers{$stage}->{$meta->{phase}}) # get the list of modifiers
{
$meta->$method($hook => $sub);
}
return;
}
sub before
{
my($stage, $sub) = @_;
@_ = ('before', @_);
goto &alienfile::_add_modifier;
}
sub after
{
my($stage, $sub) = @_;
@_ = ('after', @_);
goto &alienfile::_add_modifier;
}
sub import
{
strict->import;
warnings->import;
goto &Exporter::import;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
alienfile - Specification for defining an external dependency for CPAN
=head1 VERSION
version 2.84
=head1 SYNOPSIS
Do-it-yourself approach:
use alienfile;
probe [ 'pkg-config --exists libarchive' ];
share {
start_url 'http://libarchive.org/downloads/libarchive-3.2.2.tar.gz';
# the first one which succeeds will be used
download [ 'wget %{.meta.start_url}' ];
download [ 'curl -o %{.meta.start_url}' ];
extract [ 'tar xf %{.install.download}' ];
build [
# Note: will not work on Windows, better to use Build::Autoconf plugin
# if you need windows support
'./configure --prefix=%{.install.prefix} --disable-shared',
'%{make}',
'%{make} install',
];
}
gather [
[ 'pkg-config', '--modversion', 'libarchive', \'%{.runtime.version}' ],
[ 'pkg-config', '--cflags', 'libarchive', \'%{.runtime.cflags}' ],
[ 'pkg-config', '--libs', 'libarchive', \'%{.runtime.libs}' ],
];
With plugins (better):
use alienfile;
plugin 'PkgConfig' => 'libarchive';
share {
start_url 'http://libarchive.org/downloads/';
plugin Download => (
filter => qr/^libarchive-.*\.tar\.gz$/,
version => qr/([0-9\.]+)/,
);
plugin Extract => 'tar.gz';
plugin 'Build::Autoconf';
plugin 'Gather::IsolateDynamic';
build [
'%{configure}',
'%{make}',
'%{make} install',
];
};
=head1 DESCRIPTION
An alienfile is a recipe used by L<Alien::Build> to, probe for system libraries or download from the internet, and build source
for those libraries. This document acts as reference for the alienfile system, but if you are starting out writing your own Alien
you should read L<Alien::Build::Manual::AlienAuthor>, which will teach you how to write your own complete Alien using alienfile +
L<Alien::Build> + L<ExtUtils::MakeMaker>. Special attention should be taken to the section "a note about dynamic vs. static
libraries".
=head1 DIRECTIVES
=head2 requires
"any" requirement (either share or system):
requires $module;
requires $module => $version;
configure time requirement:
configure {
requires $module;
requires $module => $version;
};
system requirement:
sys {
requires $module;
requires $module => $version;
};
share requirement:
share {
requires $module;
requires $module => $version;
};
specifies a requirement. L<Alien::Build> takes advantage of dynamic requirements, so only
modules that are needed for the specific type of install need to be loaded. Here are the
different types of requirements:
=over
=item configure
Configure requirements should already be installed before the alienfile is loaded.
=item any
"Any" requirements are those that are needed either for the probe stage, or in either the
system or share installs.
=item share
Share requirements are those modules needed when downloading and building from source.
=item system
System requirements are those modules needed when the system provides the library or tool.
=back
=head2 plugin
plugin $name => (%args);
plugin $name => $arg;
Load the given plugin. If you prefix the plugin name with an C<=> sign,
then it will be assumed to be a fully qualified path name. Otherwise the
plugin will be assumed to live in the C<Alien::Build::Plugin> namespace.
If there is an appropriate negotiate plugin, that one will be loaded.
Examples:
# Loads Alien::Build::Plugin::Fetch::Negotiate
# which will pick the best Alien::Build::Plugin::Fetch
# plugin based on the URL, and system configuration
plugin 'Fetch' => 'http://ftp.gnu.org/gnu/gcc';
# loads the plugin with the badly named class!
plugin '=Badly::Named::Plugin::Not::In::Alien::Build::Namespace';
# explicitly loads Alien::Build::Plugin::Prefer::SortVersions
plugin 'Prefer::SortVersions' => (
filter => qr/^gcc-.*\.tar\.gz$/,
version => qr/([0-9\.]+)/,
);
=head2 probe
probe \&code;
probe \@commandlist;
Instructions for the probe stage. May be either a code reference, or a command list.
Multiple probes and probe plugins can be given. These will be used in sequence,
stopping at the first that detects a system installation. L<Alien::Build> will use
a share install if no system installation is detected by the probes.
=head2 configure
configure {
...
};
Configure block. The only directive allowed in a configure block is
requires.
=head2 sys
sys {
...
};
System block. Allowed directives are: requires and gather.
=head2 share
share {
...
};
System block. Allowed directives are: download, fetch, decode, prefer, extract, build, gather.
=head2 start_url
share {
start_url $url;
};
Set the start URL for download. This should be the URL to an index page, or the actual tarball of the source.
=head2 digest
[experimental]
share {
digest $algorithm, $digest;
};
Check fetched and downloaded files against the given algorithm and
digest. Typically you will want to use SHA256 as the algorithm.
=head2 download
share {
download \&code;
download \@commandlist;
};
Instructions for the download stage. May be either a
code reference, or a command list.
=head2 fetch
share {
fetch \&code;
fetch \@commandlist;
};
Instructions for the fetch stage. May be either a
code reference, or a command list.
=head2 decode
share {
decode \&code;
decode \@commandlist;
};
Instructions for the decode stage. May be either a
code reference, or a command list.
=head2 prefer
share {
prefer \&code;
prefer \@commandlist;
};
Instructions for the prefer stage. May be either a
code reference, or a command list.
=head2 extract
share {
extract \&code;
extract \@commandlist;
};
Instructions for the extract stage. May be either a
code reference, or a command list.
=head2 patch
share {
patch \&code;
patch \@commandlist;
};
Instructions for the patch stage. May be either a
code reference, or a command list.
=head2 patch_ffi
share {
patch_ffi \&code;
patch_ffi \@commandlist;
};
[DEPRECATED]
Instructions for the patch_ffi stage. May be either a
code reference, or a command list.
=head2 build
share {
build \&code;
build \@commandlist;
};
Instructions for the build stage. May be either a
code reference, or a command list.
=head2 build_ffi
share {
build \&code;
build \@commandlist;
};
[DEPRECATED]
Instructions for the build FFI stage. Builds shared libraries instead of static.
This is optional, and is only necessary if a fresh and separate build needs to be
done for FFI.
=head2 gather
gather \&code;
gather \@commandlist;
share {
gather \&code;
gather \@commandlist;
};
sys {
gather \&code;
gather \@commandlist;
};
Instructions for the gather stage. May be either a code reference, or a command list.
In the root block of the alienfile it will trigger in both share and system build.
In the share or sys block it will only trigger in the corresponding build.
=head2 gather_ffi
share {
gather_ffi \&code;
gather_ffi \@commandlist;
}
[DEPRECATED]
Gather specific to C<build_ffi>. Not usually necessary.
=head2 ffi
share {
ffi {
patch \&code;
patch \@commandlist;
build \&code;
build \@commandlist;
gather \&code;
gather \@commandlist;
}
}
Specify patch, build or gather stages related to FFI.
=head2 meta_prop
my $hash = meta_prop;
Get the meta_prop hash reference.
=head2 meta
my $meta = meta;
Returns the meta object for your L<alienfile>. For methods that can be used on the
meta object, see L<Alien::Build/"META METHODS">.
=head2 log
log($message);
Prints the given log to stdout.
=head2 test
share {
test \&code;
test \@commandlist;
};
sys {
test \&code;
test \@commandlist;
};
Run the tests
=head2 before
before $stage => \&code;
Execute the given code before the given stage. Stage should be one of
C<probe>, C<download>, C<fetch>, C<decode>, C<prefer>, C<extract>,
C<patch>, C<build>, C<test>, and C<gather>.
The before directive is only legal in the same blocks as the stage would
normally be legal in. For example, you can't do this:
use alienfile;
sys {
before 'build' => sub {
...
};
};
Because a C<build> wouldn't be legal inside a C<sys> block.
=head2 after
after $stage => \&code;
Execute the given code after the given stage. Stage should be one of
C<probe>, C<download>, C<fetch>, C<decode>, C<prefer>, C<extract>,
C<patch>, C<build>, C<test>, and C<gather>.
The after directive is only legal in the same blocks as the stage would
normally be legal in. For example, you can't do this:
use alienfile;
sys {
after 'build' => sub {
...
};
};
Because a C<build> wouldn't be legal inside a C<sys> block.
=head1 SEE ALSO
=over 4
=item L<Alien>
=item L<Alien::Build>
=item L<Alien::Build::MM>
=item L<Alien::Base>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Diab Jerius (DJERIUS)
Roy Storey (KIWIROY)
Ilya Pavlov
David Mertens (run4flat)
Mark Nunberg (mordy, mnunberg)
Christian Walde (Mithaldu)
Brian Wightman (MidLifeXis)
Zaki Mughal (zmughal)
mohawk (mohawk2, ETJ)
Vikas N Kumar (vikasnkumar)
Flavio Poletti (polettix)
Salvador Fandiño (salva)
Gianni Ceccarelli (dakkar)
Pavel Shaydo (zwon, trinitum)
Kang-min Liu (劉康民, gugod)
Nicholas Shipp (nshp)
Juan Julián Merelo Guervós (JJ)
Joel Berger (JBERGER)
Petr Písař (ppisar)
Lance Wicks (LANCEW)
Ahmad Fatoum (a3f, ATHREEF)
José Joaquín Atria (JJATRIA)
Duke Leto (LETO)
Shoichi Kaji (SKAJI)
Shawn Laffan (SLAFFAN)
Paul Evans (leonerd, PEVANS)
Håkon Hægland (hakonhagland, HAKONH)
nick nauwelaerts (INPHOBIA)
Florian Weimer
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/Path/Tiny.pm 0000444 00000373402 15157556122 0010357 0 ustar 00 use 5.008001;
use strict;
use warnings;
package Path::Tiny;
# ABSTRACT: File path utility
our $VERSION = '0.146';
# Dependencies
use Config;
use Exporter 5.57 (qw/import/);
use File::Spec 0.86 (); # shipped with 5.8.1
use Carp ();
our @EXPORT = qw/path/;
our @EXPORT_OK = qw/cwd rootdir tempfile tempdir/;
use constant {
PATH => 0,
CANON => 1,
VOL => 2,
DIR => 3,
FILE => 4,
TEMP => 5,
IS_WIN32 => ( $^O eq 'MSWin32' ),
};
use overload (
q{""} => 'stringify',
bool => sub () { 1 },
fallback => 1,
);
# FREEZE/THAW per Sereal/CBOR/Types::Serialiser protocol
sub THAW { return path( $_[2] ) }
{ no warnings 'once'; *TO_JSON = *FREEZE = \&stringify };
my $HAS_UU; # has Unicode::UTF8; lazily populated
sub _check_UU {
local $SIG{__DIE__}; # prevent outer handler from being called
!!eval {
require Unicode::UTF8;
Unicode::UTF8->VERSION(0.58);
1;
};
}
my $HAS_PU; # has PerlIO::utf8_strict; lazily populated
sub _check_PU {
local $SIG{__DIE__}; # prevent outer handler from being called
!!eval {
# MUST preload Encode or $SIG{__DIE__} localization fails
# on some Perl 5.8.8 (maybe other 5.8.*) compiled with -O2.
require Encode;
require PerlIO::utf8_strict;
PerlIO::utf8_strict->VERSION(0.003);
1;
};
}
my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
# notions of "root" directories differ on Win32: \\server\dir\ or C:\ or \
my $SLASH = qr{[\\/]};
my $NOTSLASH = qr{[^\\/]};
my $DRV_VOL = qr{[a-z]:}i;
my $UNC_VOL = qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x;
my $WIN32_ROOT = qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;
sub _win32_vol {
my ( $path, $drv ) = @_;
require Cwd;
my $dcwd = eval { Cwd::getdcwd($drv) }; # C: -> C:\some\cwd
# getdcwd on non-existent drive returns empty string
# so just use the original drive Z: -> Z:
$dcwd = "$drv" unless defined $dcwd && length $dcwd;
# normalize dwcd to end with a slash: might be C:\some\cwd or D:\ or Z:
$dcwd =~ s{$SLASH?\z}{/};
# make the path absolute with dcwd
$path =~ s{^$DRV_VOL}{$dcwd};
return $path;
}
# This is a string test for before we have the object; see is_rootdir for well-formed
# object test
sub _is_root {
return IS_WIN32() ? ( $_[0] =~ /^$WIN32_ROOT\z/ ) : ( $_[0] eq '/' );
}
BEGIN {
*_same = IS_WIN32() ? sub { lc( $_[0] ) eq lc( $_[1] ) } : sub { $_[0] eq $_[1] };
}
# mode bits encoded for chmod in symbolic mode
my %MODEBITS = ( om => 0007, gm => 0070, um => 0700 ); ## no critic
{ my $m = 0; $MODEBITS{$_} = ( 1 << $m++ ) for qw/ox ow or gx gw gr ux uw ur/ };
sub _symbolic_chmod {
my ( $mode, $symbolic ) = @_;
for my $clause ( split /,\s*/, $symbolic ) {
if ( $clause =~ m{\A([augo]+)([=+-])([rwx]+)\z} ) {
my ( $who, $action, $perms ) = ( $1, $2, $3 );
$who =~ s/a/ugo/g;
for my $w ( split //, $who ) {
my $p = 0;
$p |= $MODEBITS{"$w$_"} for split //, $perms;
if ( $action eq '=' ) {
$mode = ( $mode & ~$MODEBITS{"${w}m"} ) | $p;
}
else {
$mode = $action eq "+" ? ( $mode | $p ) : ( $mode & ~$p );
}
}
}
else {
Carp::croak("Invalid mode clause '$clause' for chmod()");
}
}
return $mode;
}
# flock doesn't work on NFS on BSD or on some filesystems like lustre.
# Since program authors often can't control or detect that, we warn once
# instead of being fatal if we can detect it and people who need it strict
# can fatalize the 'flock' category
#<<< No perltidy
{ package flock; use warnings::register }
#>>>
my $WARNED_NO_FLOCK = 0;
sub _throw {
my ( $self, $function, $file, $msg ) = @_;
if ( $function =~ /^flock/
&& $! =~ /operation not supported|function not implemented/i
&& !warnings::fatal_enabled('flock') )
{
if ( !$WARNED_NO_FLOCK ) {
warnings::warn( flock => "Flock not available: '$!': continuing in unsafe mode" );
$WARNED_NO_FLOCK++;
}
}
else {
$msg = $! unless defined $msg;
Path::Tiny::Error->throw( $function, ( defined $file ? $file : $self->[PATH] ),
$msg );
}
return;
}
# cheapo option validation
sub _get_args {
my ( $raw, @valid ) = @_;
if ( defined($raw) && ref($raw) ne 'HASH' ) {
my ( undef, undef, undef, $called_as ) = caller(1);
$called_as =~ s{^.*::}{};
Carp::croak("Options for $called_as must be a hash reference");
}
my $cooked = {};
for my $k (@valid) {
$cooked->{$k} = delete $raw->{$k} if exists $raw->{$k};
}
if ( keys %$raw ) {
my ( undef, undef, undef, $called_as ) = caller(1);
$called_as =~ s{^.*::}{};
Carp::croak( "Invalid option(s) for $called_as: " . join( ", ", keys %$raw ) );
}
return $cooked;
}
#--------------------------------------------------------------------------#
# Constructors
#--------------------------------------------------------------------------#
#pod =construct path
#pod
#pod $path = path("foo/bar");
#pod $path = path("/tmp", "file.txt"); # list
#pod $path = path("."); # cwd
#pod
#pod Constructs a C<Path::Tiny> object. It doesn't matter if you give a file or
#pod directory path. It's still up to you to call directory-like methods only on
#pod directories and file-like methods only on files. This function is exported
#pod automatically by default.
#pod
#pod The first argument must be defined and have non-zero length or an exception
#pod will be thrown. This prevents subtle, dangerous errors with code like
#pod C<< path( maybe_undef() )->remove_tree >>.
#pod
#pod B<DEPRECATED>: If and only if the B<first> character of the B<first> argument
#pod to C<path> is a tilde ('~'), then tilde replacement will be applied to the
#pod first path segment. A single tilde will be replaced with C<glob('~')> and a
#pod tilde followed by a username will be replaced with output of
#pod C<glob('~username')>. B<No other method does tilde expansion on its arguments>.
#pod See L</Tilde expansion (deprecated)> for more.
#pod
#pod On Windows, if the path consists of a drive identifier without a path component
#pod (C<C:> or C<D:>), it will be expanded to the absolute path of the current
#pod directory on that volume using C<Cwd::getdcwd()>.
#pod
#pod If called with a single C<Path::Tiny> argument, the original is returned unless
#pod the original is holding a temporary file or directory reference in which case a
#pod stringified copy is made.
#pod
#pod $path = path("foo/bar");
#pod $temp = Path::Tiny->tempfile;
#pod
#pod $p2 = path($path); # like $p2 = $path
#pod $t2 = path($temp); # like $t2 = path( "$temp" )
#pod
#pod This optimizes copies without proliferating references unexpectedly if a copy is
#pod made by code outside your control.
#pod
#pod Current API available since 0.017.
#pod
#pod =cut
sub path {
my $path = shift;
Carp::croak("Path::Tiny paths require defined, positive-length parts")
unless 1 + @_ == grep { defined && length } $path, @_;
# non-temp Path::Tiny objects are effectively immutable and can be reused
if ( !@_ && ref($path) eq __PACKAGE__ && !$path->[TEMP] ) {
return $path;
}
# stringify objects
$path = "$path";
# do any tilde expansions
my ($tilde) = $path =~ m{^(~[^/]*)};
if ( defined $tilde ) {
# Escape File::Glob metacharacters
(my $escaped = $tilde) =~ s/([\[\{\*\?\\])/\\$1/g;
require File::Glob;
my ($homedir) = File::Glob::bsd_glob($escaped);
if (defined $homedir && ! $File::Glob::ERROR) {
$homedir =~ tr[\\][/] if IS_WIN32();
$path =~ s{^\Q$tilde\E}{$homedir};
}
}
unshift @_, $path;
goto &_pathify;
}
# _path is like path but without tilde expansion
sub _path {
my $path = shift;
Carp::croak("Path::Tiny paths require defined, positive-length parts")
unless 1 + @_ == grep { defined && length } $path, @_;
# non-temp Path::Tiny objects are effectively immutable and can be reused
if ( !@_ && ref($path) eq __PACKAGE__ && !$path->[TEMP] ) {
return $path;
}
# stringify objects
$path = "$path";
unshift @_, $path;
goto &_pathify;
}
# _pathify expects one or more string arguments, then joins and canonicalizes
# them into an object.
sub _pathify {
my $path = shift;
# expand relative volume paths on windows; put trailing slash on UNC root
if ( IS_WIN32() ) {
$path = _win32_vol( $path, $1 ) if $path =~ m{^($DRV_VOL)(?:$NOTSLASH|\z)};
$path .= "/" if $path =~ m{^$UNC_VOL\z};
}
# concatenations stringifies objects, too
if (@_) {
$path .= ( _is_root($path) ? "" : "/" ) . join( "/", @_ );
}
# canonicalize, but with unix slashes and put back trailing volume slash
my $cpath = $path = File::Spec->canonpath($path);
$path =~ tr[\\][/] if IS_WIN32();
$path = "/" if $path eq '/..'; # for old File::Spec
$path .= "/" if IS_WIN32() && $path =~ m{^$UNC_VOL\z};
# root paths must always have a trailing slash, but other paths must not
if ( _is_root($path) ) {
$path =~ s{/?\z}{/};
}
else {
$path =~ s{/\z}{};
}
bless [ $path, $cpath ], __PACKAGE__;
}
#pod =construct new
#pod
#pod $path = Path::Tiny->new("foo/bar");
#pod
#pod This is just like C<path>, but with method call overhead. (Why would you
#pod do that?)
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
sub new { shift; path(@_) }
#pod =construct cwd
#pod
#pod $path = Path::Tiny->cwd; # path( Cwd::getcwd )
#pod $path = cwd; # optional export
#pod
#pod Gives you the absolute path to the current directory as a C<Path::Tiny> object.
#pod This is slightly faster than C<< path(".")->absolute >>.
#pod
#pod C<cwd> may be exported on request and used as a function instead of as a
#pod method.
#pod
#pod Current API available since 0.018.
#pod
#pod =cut
sub cwd {
require Cwd;
return _path( Cwd::getcwd() );
}
#pod =construct rootdir
#pod
#pod $path = Path::Tiny->rootdir; # /
#pod $path = rootdir; # optional export
#pod
#pod Gives you C<< File::Spec->rootdir >> as a C<Path::Tiny> object if you're too
#pod picky for C<path("/")>.
#pod
#pod C<rootdir> may be exported on request and used as a function instead of as a
#pod method.
#pod
#pod Current API available since 0.018.
#pod
#pod =cut
sub rootdir { _path( File::Spec->rootdir ) }
#pod =construct tempfile, tempdir
#pod
#pod $temp = Path::Tiny->tempfile( @options );
#pod $temp = Path::Tiny->tempdir( @options );
#pod $temp = $dirpath->tempfile( @options );
#pod $temp = $dirpath->tempdir( @options );
#pod $temp = tempfile( @options ); # optional export
#pod $temp = tempdir( @options ); # optional export
#pod
#pod C<tempfile> passes the options to C<< File::Temp->new >> and returns a
#pod C<Path::Tiny> object with the file name. The C<TMPDIR> option will be enabled
#pod by default, but you can override that by passing C<< TMPDIR => 0 >> along with
#pod the options. (If you use an absolute C<TEMPLATE> option, you will want to
#pod disable C<TMPDIR>.)
#pod
#pod The resulting C<File::Temp> object is cached. When the C<Path::Tiny> object is
#pod destroyed, the C<File::Temp> object will be as well.
#pod
#pod C<File::Temp> annoyingly requires you to specify a custom template in slightly
#pod different ways depending on which function or method you call, but
#pod C<Path::Tiny> lets you ignore that and can take either a leading template or a
#pod C<TEMPLATE> option and does the right thing.
#pod
#pod $temp = Path::Tiny->tempfile( "customXXXXXXXX" ); # ok
#pod $temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok
#pod
#pod The tempfile path object will be normalized to have an absolute path, even if
#pod created in a relative directory using C<DIR>. If you want it to have
#pod the C<realpath> instead, pass a leading options hash like this:
#pod
#pod $real_temp = tempfile({realpath => 1}, @options);
#pod
#pod C<tempdir> is just like C<tempfile>, except it calls
#pod C<< File::Temp->newdir >> instead.
#pod
#pod Both C<tempfile> and C<tempdir> may be exported on request and used as
#pod functions instead of as methods.
#pod
#pod The methods can be called on an instances representing a
#pod directory. In this case, the directory is used as the base to create the
#pod temporary file/directory, setting the C<DIR> option in File::Temp.
#pod
#pod my $target_dir = path('/to/destination');
#pod my $tempfile = $target_dir->tempfile('foobarXXXXXX');
#pod $tempfile->spew('A lot of data...'); # not atomic
#pod $tempfile->move($target_dir->child('foobar')); # hopefully atomic
#pod
#pod In this case, any value set for option C<DIR> is ignored.
#pod
#pod B<Note>: for tempfiles, the filehandles from File::Temp are closed and not
#pod reused. This is not as secure as using File::Temp handles directly, but is
#pod less prone to deadlocks or access problems on some platforms. Think of what
#pod C<Path::Tiny> gives you to be just a temporary file B<name> that gets cleaned
#pod up.
#pod
#pod B<Note 2>: if you don't want these cleaned up automatically when the object
#pod is destroyed, File::Temp requires different options for directories and
#pod files. Use C<< CLEANUP => 0 >> for directories and C<< UNLINK => 0 >> for
#pod files.
#pod
#pod B<Note 3>: Don't lose the temporary object by chaining a method call instead
#pod of storing it:
#pod
#pod my $lost = tempdir()->child("foo"); # tempdir cleaned up right away
#pod
#pod B<Note 4>: The cached object may be accessed with the L</cached_temp> method.
#pod Keeping a reference to, or modifying the cached object may break the
#pod behavior documented above and is not supported. Use at your own risk.
#pod
#pod Current API available since 0.119.
#pod
#pod =cut
sub tempfile {
my ( $opts, $maybe_template, $args )
= _parse_file_temp_args(tempfile => @_);
# File::Temp->new demands TEMPLATE
$args->{TEMPLATE} = $maybe_template->[0] if @$maybe_template;
require File::Temp;
my $temp = File::Temp->new( TMPDIR => 1, %$args );
close $temp;
my $self = $opts->{realpath} ? _path($temp)->realpath : _path($temp)->absolute;
$self->[TEMP] = $temp; # keep object alive while we are
return $self;
}
sub tempdir {
my ( $opts, $maybe_template, $args )
= _parse_file_temp_args(tempdir => @_);
require File::Temp;
my $temp = File::Temp->newdir( @$maybe_template, TMPDIR => 1, %$args );
my $self = $opts->{realpath} ? _path($temp)->realpath : _path($temp)->absolute;
$self->[TEMP] = $temp; # keep object alive while we are
# Some ActiveState Perls for Windows break Cwd in ways that lead
# File::Temp to get confused about what path to remove; this
# monkey-patches the object with our own view of the absolute path
$temp->{REALNAME} = $self->[CANON] if IS_WIN32;
return $self;
}
# normalize the various ways File::Temp does templates
sub _parse_file_temp_args {
my $called_as = shift;
if ( @_ && $_[0] eq 'Path::Tiny' ) { shift } # class method
elsif ( @_ && eval{$_[0]->isa('Path::Tiny')} ) {
my $dir = shift;
if (! $dir->is_dir) {
$dir->_throw( $called_as, $dir, "is not a directory object" );
}
push @_, DIR => $dir->stringify; # no overriding
}
my $opts = ( @_ && ref $_[0] eq 'HASH' ) ? shift @_ : {};
$opts = _get_args( $opts, qw/realpath/ );
my $leading_template = ( scalar(@_) % 2 == 1 ? shift(@_) : '' );
my %args = @_;
%args = map { uc($_), $args{$_} } keys %args;
my @template = (
exists $args{TEMPLATE} ? delete $args{TEMPLATE}
: $leading_template ? $leading_template
: ()
);
return ( $opts, \@template, \%args );
}
#--------------------------------------------------------------------------#
# Private methods
#--------------------------------------------------------------------------#
sub _splitpath {
my ($self) = @_;
@{$self}[ VOL, DIR, FILE ] = File::Spec->splitpath( $self->[PATH] );
}
sub _resolve_symlinks {
my ($self) = @_;
my $new = $self;
my ( $count, %seen ) = 0;
while ( -l $new->[PATH] ) {
if ( $seen{ $new->[PATH] }++ ) {
$self->_throw( 'readlink', $self->[PATH], "symlink loop detected" );
}
if ( ++$count > 100 ) {
$self->_throw( 'readlink', $self->[PATH], "maximum symlink depth exceeded" );
}
my $resolved = readlink $new->[PATH];
$new->_throw( 'readlink', $new->[PATH] ) unless defined $resolved;
$resolved = _path($resolved);
$new = $resolved->is_absolute ? $resolved : $new->sibling($resolved);
}
return $new;
}
sub _replacment_path {
my ($self) = @_;
my $unique_suffix = $$ . int( rand( 2**31 ) );
my $temp = _path( $self . $unique_suffix );
# If filename with process+random suffix is too long, use a shorter
# version that doesn't preserve the basename.
if ( length $temp->basename > 255 ) {
$temp = $self->sibling( "temp" . $unique_suffix );
}
return $temp;
}
#--------------------------------------------------------------------------#
# Public methods
#--------------------------------------------------------------------------#
#pod =method absolute
#pod
#pod $abs = path("foo/bar")->absolute;
#pod $abs = path("foo/bar")->absolute("/tmp");
#pod
#pod Returns a new C<Path::Tiny> object with an absolute path (or itself if already
#pod absolute). If no argument is given, the current directory is used as the
#pod absolute base path. If an argument is given, it will be converted to an
#pod absolute path (if it is not already) and used as the absolute base path.
#pod
#pod This will not resolve upward directories ("foo/../bar") unless C<canonpath>
#pod in L<File::Spec> would normally do so on your platform. If you need them
#pod resolved, you must call the more expensive C<realpath> method instead.
#pod
#pod On Windows, an absolute path without a volume component will have it added
#pod based on the current drive.
#pod
#pod Current API available since 0.101.
#pod
#pod =cut
sub absolute {
my ( $self, $base ) = @_;
# absolute paths handled differently by OS
if (IS_WIN32) {
return $self if length $self->volume;
# add missing volume
if ( $self->is_absolute ) {
require Cwd;
# use Win32::GetCwd not Cwd::getdcwd because we're sure
# to have the former but not necessarily the latter
my ($drv) = Win32::GetCwd() =~ /^($DRV_VOL | $UNC_VOL)/x;
return _path( $drv . $self->[PATH] );
}
}
else {
return $self if $self->is_absolute;
}
# no base means use current directory as base
require Cwd;
return _path( Cwd::getcwd(), $_[0]->[PATH] ) unless defined $base;
# relative base should be made absolute; we check is_absolute rather
# than unconditionally make base absolute so that "/foo" doesn't become
# "C:/foo" on Windows.
$base = _path($base);
return _path( ( $base->is_absolute ? $base : $base->absolute ), $_[0]->[PATH] );
}
#pod =method append, append_raw, append_utf8
#pod
#pod path("foo.txt")->append(@data);
#pod path("foo.txt")->append(\@data);
#pod path("foo.txt")->append({binmode => ":raw"}, @data);
#pod path("foo.txt")->append_raw(@data);
#pod path("foo.txt")->append_utf8(@data);
#pod
#pod Appends data to a file. The file is locked with C<flock> prior to writing
#pod and closed afterwards. An optional hash reference may be used to pass
#pod options. Valid options are:
#pod
#pod =for :list
#pod * C<binmode>: passed to C<binmode()> on the handle used for writing.
#pod * C<truncate>: truncates the file after locking and before appending
#pod
#pod The C<truncate> option is a way to replace the contents of a file
#pod B<in place>, unlike L</spew> which writes to a temporary file and then
#pod replaces the original (if it exists).
#pod
#pod C<append_raw> is like C<append> with a C<binmode> of C<:unix> for a fast,
#pod unbuffered, raw write.
#pod
#pod C<append_utf8> is like C<append> with an unbuffered C<binmode>
#pod C<:unix:encoding(UTF-8)> (or C<:unix:utf8_strict> with
#pod L<PerlIO::utf8_strict>). If L<Unicode::UTF8> 0.58+ is installed, an
#pod unbuffered, raw append will be done instead on the data encoded with
#pod C<Unicode::UTF8>.
#pod
#pod Current API available since 0.060.
#pod
#pod =cut
sub append {
my ( $self, @data ) = @_;
my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
$args = _get_args( $args, qw/binmode truncate/ );
my $binmode = $args->{binmode};
$binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
my $mode = $args->{truncate} ? ">" : ">>";
my $fh = $self->filehandle( { locked => 1 }, $mode, $binmode );
print( {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data ) or self->_throw('print');
close $fh or $self->_throw('close');
}
sub append_raw {
my ( $self, @data ) = @_;
my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
$args = _get_args( $args, qw/binmode truncate/ );
$args->{binmode} = ':unix';
append( $self, $args, @data );
}
sub append_utf8 {
my ( $self, @data ) = @_;
my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
$args = _get_args( $args, qw/binmode truncate/ );
if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
$args->{binmode} = ":unix";
append( $self, $args, map { Unicode::UTF8::encode_utf8($_) } @data );
}
elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
$args->{binmode} = ":unix:utf8_strict";
append( $self, $args, @data );
}
else {
$args->{binmode} = ":unix:encoding(UTF-8)";
append( $self, $args, @data );
}
}
#pod =method assert
#pod
#pod $path = path("foo.txt")->assert( sub { $_->exists } );
#pod
#pod Returns the invocant after asserting that a code reference argument returns
#pod true. When the assertion code reference runs, it will have the invocant
#pod object in the C<$_> variable. If it returns false, an exception will be
#pod thrown. The assertion code reference may also throw its own exception.
#pod
#pod If no assertion is provided, the invocant is returned without error.
#pod
#pod Current API available since 0.062.
#pod
#pod =cut
sub assert {
my ( $self, $assertion ) = @_;
return $self unless $assertion;
if ( ref $assertion eq 'CODE' ) {
local $_ = $self;
$assertion->()
or Path::Tiny::Error->throw( "assert", $self->[PATH], "failed assertion" );
}
else {
Carp::croak("argument to assert must be a code reference argument");
}
return $self;
}
#pod =method basename
#pod
#pod $name = path("foo/bar.txt")->basename; # bar.txt
#pod $name = path("foo.txt")->basename('.txt'); # foo
#pod $name = path("foo.txt")->basename(qr/.txt/); # foo
#pod $name = path("foo.txt")->basename(@suffixes);
#pod
#pod Returns the file portion or last directory portion of a path.
#pod
#pod Given a list of suffixes as strings or regular expressions, any that match at
#pod the end of the file portion or last directory portion will be removed before
#pod the result is returned.
#pod
#pod Current API available since 0.054.
#pod
#pod =cut
sub basename {
my ( $self, @suffixes ) = @_;
$self->_splitpath unless defined $self->[FILE];
my $file = $self->[FILE];
for my $s (@suffixes) {
my $re = ref($s) eq 'Regexp' ? qr/$s\z/ : qr/\Q$s\E\z/;
last if $file =~ s/$re//;
}
return $file;
}
#pod =method canonpath
#pod
#pod $canonical = path("foo/bar")->canonpath; # foo\bar on Windows
#pod
#pod Returns a string with the canonical format of the path name for
#pod the platform. In particular, this means directory separators
#pod will be C<\> on Windows.
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
sub canonpath { $_[0]->[CANON] }
#pod =method cached_temp
#pod
#pod Returns the cached C<File::Temp> or C<File::Temp::Dir> object if the
#pod C<Path::Tiny> object was created with C</tempfile> or C</tempdir>.
#pod If there is no such object, this method throws.
#pod
#pod B<WARNING>: Keeping a reference to, or modifying the cached object may
#pod break the behavior documented for temporary files and directories created
#pod with C<Path::Tiny> and is not supported. Use at your own risk.
#pod
#pod Current API available since 0.101.
#pod
#pod =cut
sub cached_temp {
my $self = shift;
$self->_throw( "cached_temp", $self, "has no cached File::Temp object" )
unless defined $self->[TEMP];
return $self->[TEMP];
}
#pod =method child
#pod
#pod $file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt"
#pod $file = path("/tmp")->child(@parts);
#pod
#pod Returns a new C<Path::Tiny> object relative to the original. Works
#pod like C<catfile> or C<catdir> from File::Spec, but without caring about
#pod file or directories.
#pod
#pod B<WARNING>: because the argument could contain C<..> or refer to symlinks,
#pod there is no guarantee that the new path refers to an actual descendent of
#pod the original. If this is important to you, transform parent and child with
#pod L</realpath> and check them with L</subsumes>.
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
sub child {
my ( $self, @parts ) = @_;
return _path( $self->[PATH], @parts );
}
#pod =method children
#pod
#pod @paths = path("/tmp")->children;
#pod @paths = path("/tmp")->children( qr/\.txt\z/ );
#pod
#pod Returns a list of C<Path::Tiny> objects for all files and directories
#pod within a directory. Excludes "." and ".." automatically.
#pod
#pod If an optional C<qr//> argument is provided, it only returns objects for child
#pod names that match the given regular expression. Only the base name is used
#pod for matching:
#pod
#pod @paths = path("/tmp")->children( qr/^foo/ );
#pod # matches children like the glob foo*
#pod
#pod Current API available since 0.028.
#pod
#pod =cut
sub children {
my ( $self, $filter ) = @_;
my $dh;
opendir $dh, $self->[PATH] or $self->_throw('opendir');
my @children = readdir $dh;
closedir $dh or $self->_throw('closedir');
if ( not defined $filter ) {
@children = grep { $_ ne '.' && $_ ne '..' } @children;
}
elsif ( $filter && ref($filter) eq 'Regexp' ) {
@children = grep { $_ ne '.' && $_ ne '..' && $_ =~ $filter } @children;
}
else {
Carp::croak("Invalid argument '$filter' for children()");
}
return map { _path( $self->[PATH], $_ ) } @children;
}
#pod =method chmod
#pod
#pod path("foo.txt")->chmod(0777);
#pod path("foo.txt")->chmod("0755");
#pod path("foo.txt")->chmod("go-w");
#pod path("foo.txt")->chmod("a=r,u+wx");
#pod
#pod Sets file or directory permissions. The argument can be a numeric mode, a
#pod octal string beginning with a "0" or a limited subset of the symbolic mode use
#pod by F</bin/chmod>.
#pod
#pod The symbolic mode must be a comma-delimited list of mode clauses. Clauses must
#pod match C<< qr/\A([augo]+)([=+-])([rwx]+)\z/ >>, which defines "who", "op" and
#pod "perms" parameters for each clause. Unlike F</bin/chmod>, all three parameters
#pod are required for each clause, multiple ops are not allowed and permissions
#pod C<stugoX> are not supported. (See L<File::chmod> for more complex needs.)
#pod
#pod Current API available since 0.053.
#pod
#pod =cut
sub chmod {
my ( $self, $new_mode ) = @_;
my $mode;
if ( $new_mode =~ /\d/ ) {
$mode = ( $new_mode =~ /^0/ ? oct($new_mode) : $new_mode );
}
elsif ( $new_mode =~ /[=+-]/ ) {
$mode = _symbolic_chmod( $self->stat->mode & 07777, $new_mode ); ## no critic
}
else {
Carp::croak("Invalid mode argument '$new_mode' for chmod()");
}
CORE::chmod( $mode, $self->[PATH] ) or $self->_throw("chmod");
return 1;
}
#pod =method copy
#pod
#pod path("/tmp/foo.txt")->copy("/tmp/bar.txt");
#pod
#pod Copies the current path to the given destination using L<File::Copy>'s
#pod C<copy> function. Upon success, returns the C<Path::Tiny> object for the
#pod newly copied file.
#pod
#pod Current API available since 0.070.
#pod
#pod =cut
# XXX do recursively for directories?
sub copy {
my ( $self, $dest ) = @_;
require File::Copy;
File::Copy::copy( $self->[PATH], $dest )
or Carp::croak("copy failed for $self to $dest: $!");
return -d $dest ? _path( $dest, $self->basename ) : _path($dest);
}
#pod =method digest
#pod
#pod $obj = path("/tmp/foo.txt")->digest; # SHA-256
#pod $obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected
#pod $obj = path("/tmp/foo.txt")->digest( { chunk_size => 1e6 }, "MD5" );
#pod
#pod Returns a hexadecimal digest for a file. An optional hash reference of options may
#pod be given. The only option is C<chunk_size>. If C<chunk_size> is given, that many
#pod bytes will be read at a time. If not provided, the entire file will be slurped
#pod into memory to compute the digest.
#pod
#pod Any subsequent arguments are passed to the constructor for L<Digest> to select
#pod an algorithm. If no arguments are given, the default is SHA-256.
#pod
#pod Current API available since 0.056.
#pod
#pod =cut
sub digest {
my ( $self, @opts ) = @_;
my $args = ( @opts && ref $opts[0] eq 'HASH' ) ? shift @opts : {};
$args = _get_args( $args, qw/chunk_size/ );
unshift @opts, 'SHA-256' unless @opts;
require Digest;
my $digest = Digest->new(@opts);
if ( $args->{chunk_size} ) {
my $fh = $self->filehandle( { locked => 1 }, "<", ":unix" );
my $buf;
while (!eof($fh)) {
my $rc = read $fh, $buf, $args->{chunk_size};
$self->_throw('read') unless defined $rc;
$digest->add($buf);
}
}
else {
$digest->add( $self->slurp_raw );
}
return $digest->hexdigest;
}
#pod =method dirname (deprecated)
#pod
#pod $name = path("/tmp/foo.txt")->dirname; # "/tmp/"
#pod
#pod Returns the directory portion you would get from calling
#pod C<< File::Spec->splitpath( $path->stringify ) >> or C<"."> for a path without a
#pod parent directory portion. Because L<File::Spec> is inconsistent, the result
#pod might or might not have a trailing slash. Because of this, this method is
#pod B<deprecated>.
#pod
#pod A better, more consistently approach is likely C<< $path->parent->stringify >>,
#pod which will not have a trailing slash except for a root directory.
#pod
#pod Deprecated in 0.056.
#pod
#pod =cut
sub dirname {
my ($self) = @_;
$self->_splitpath unless defined $self->[DIR];
return length $self->[DIR] ? $self->[DIR] : ".";
}
#pod =method edit, edit_raw, edit_utf8
#pod
#pod path("foo.txt")->edit( \&callback, $options );
#pod path("foo.txt")->edit_utf8( \&callback );
#pod path("foo.txt")->edit_raw( \&callback );
#pod
#pod These are convenience methods that allow "editing" a file using a single
#pod callback argument. They slurp the file using C<slurp>, place the contents
#pod inside a localized C<$_> variable, call the callback function (without
#pod arguments), and then write C<$_> (presumably mutated) back to the
#pod file with C<spew>.
#pod
#pod An optional hash reference may be used to pass options. The only option is
#pod C<binmode>, which is passed to C<slurp> and C<spew>.
#pod
#pod C<edit_utf8> and C<edit_raw> act like their respective C<slurp_*> and
#pod C<spew_*> methods.
#pod
#pod Current API available since 0.077.
#pod
#pod =cut
sub edit {
my $self = shift;
my $cb = shift;
my $args = _get_args( shift, qw/binmode/ );
Carp::croak("Callback for edit() must be a code reference")
unless defined($cb) && ref($cb) eq 'CODE';
local $_ =
$self->slurp( exists( $args->{binmode} ) ? { binmode => $args->{binmode} } : () );
$cb->();
$self->spew( $args, $_ );
return;
}
# this is done long-hand to benefit from slurp_utf8 optimizations
sub edit_utf8 {
my ( $self, $cb ) = @_;
Carp::croak("Callback for edit_utf8() must be a code reference")
unless defined($cb) && ref($cb) eq 'CODE';
local $_ = $self->slurp_utf8;
$cb->();
$self->spew_utf8($_);
return;
}
sub edit_raw { $_[2] = { binmode => ":unix" }; goto &edit }
#pod =method edit_lines, edit_lines_utf8, edit_lines_raw
#pod
#pod path("foo.txt")->edit_lines( \&callback, $options );
#pod path("foo.txt")->edit_lines_utf8( \&callback );
#pod path("foo.txt")->edit_lines_raw( \&callback );
#pod
#pod These are convenience methods that allow "editing" a file's lines using a
#pod single callback argument. They iterate over the file: for each line, the
#pod line is put into a localized C<$_> variable, the callback function is
#pod executed (without arguments) and then C<$_> is written to a temporary file.
#pod When iteration is finished, the temporary file is atomically renamed over
#pod the original.
#pod
#pod An optional hash reference may be used to pass options. The only option is
#pod C<binmode>, which is passed to the method that open handles for reading and
#pod writing.
#pod
#pod C<edit_lines_raw> is like C<edit_lines> with a buffered C<binmode> of
#pod C<:raw>.
#pod
#pod C<edit_lines_utf8> is like C<edit_lines> with a buffered C<binmode>
#pod C<:raw:encoding(UTF-8)> (or C<:raw:utf8_strict> with
#pod L<PerlIO::utf8_strict>).
#pod
#pod Current API available since 0.077.
#pod
#pod =cut
sub edit_lines {
my $self = shift;
my $cb = shift;
my $args = _get_args( shift, qw/binmode/ );
Carp::croak("Callback for edit_lines() must be a code reference")
unless defined($cb) && ref($cb) eq 'CODE';
my $binmode = $args->{binmode};
# get default binmode from caller's lexical scope (see "perldoc open")
$binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
# writing needs to follow the link and create the tempfile in the same
# dir for later atomic rename
my $resolved_path = $self->_resolve_symlinks;
my $temp = $resolved_path->_replacment_path;
my $temp_fh = $temp->filehandle( { exclusive => 1, locked => 1 }, ">", $binmode );
my $in_fh = $self->filehandle( { locked => 1 }, '<', $binmode );
local $_;
while (! eof($in_fh) ) {
defined( $_ = readline($in_fh) ) or $self->_throw('readline');
$cb->();
$temp_fh->print($_) or self->_throw('print', $temp);
}
close $temp_fh or $self->_throw( 'close', $temp );
close $in_fh or $self->_throw('close');
return $temp->move($resolved_path);
}
sub edit_lines_raw { $_[2] = { binmode => ":raw" }; goto &edit_lines }
sub edit_lines_utf8 {
if ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
$_[2] = { binmode => ":raw:utf8_strict" };
}
else {
$_[2] = { binmode => ":raw:encoding(UTF-8)" };
}
goto &edit_lines;
}
#pod =method exists, is_file, is_dir
#pod
#pod if ( path("/tmp")->exists ) { ... } # -e
#pod if ( path("/tmp")->is_dir ) { ... } # -d
#pod if ( path("/tmp")->is_file ) { ... } # -e && ! -d
#pod
#pod Implements file test operations, this means the file or directory actually has
#pod to exist on the filesystem. Until then, it's just a path.
#pod
#pod B<Note>: C<is_file> is not C<-f> because C<-f> is not the opposite of C<-d>.
#pod C<-f> means "plain file", excluding symlinks, devices, etc. that often can be
#pod read just like files.
#pod
#pod Use C<-f> instead if you really mean to check for a plain file.
#pod
#pod Current API available since 0.053.
#pod
#pod =cut
sub exists { -e $_[0]->[PATH] }
sub is_file { -e $_[0]->[PATH] && !-d _ }
sub is_dir { -d $_[0]->[PATH] }
#pod =method filehandle
#pod
#pod $fh = path("/tmp/foo.txt")->filehandle($mode, $binmode);
#pod $fh = path("/tmp/foo.txt")->filehandle({ locked => 1 }, $mode, $binmode);
#pod $fh = path("/tmp/foo.txt")->filehandle({ exclusive => 1 }, $mode, $binmode);
#pod
#pod Returns an open file handle. The C<$mode> argument must be a Perl-style
#pod read/write mode string ("<" ,">", ">>", etc.). If a C<$binmode>
#pod is given, it is set during the C<open> call.
#pod
#pod An optional hash reference may be used to pass options.
#pod
#pod The C<locked> option governs file locking; if true, handles opened for writing,
#pod appending or read-write are locked with C<LOCK_EX>; otherwise, they are
#pod locked with C<LOCK_SH>. When using C<locked>, ">" or "+>" modes will delay
#pod truncation until after the lock is acquired.
#pod
#pod The C<exclusive> option causes the open() call to fail if the file already
#pod exists. This corresponds to the O_EXCL flag to sysopen / open(2).
#pod C<exclusive> implies C<locked> and will set it for you if you forget it.
#pod
#pod See C<openr>, C<openw>, C<openrw>, and C<opena> for sugar.
#pod
#pod Current API available since 0.066.
#pod
#pod =cut
# Note: must put binmode on open line, not subsequent binmode() call, so things
# like ":unix" actually stop perlio/crlf from being added
sub filehandle {
my ( $self, @args ) = @_;
my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
$args = _get_args( $args, qw/locked exclusive/ );
$args->{locked} = 1 if $args->{exclusive};
my ( $opentype, $binmode ) = @args;
$opentype = "<" unless defined $opentype;
Carp::croak("Invalid file mode '$opentype'")
unless grep { $opentype eq $_ } qw/< +< > +> >> +>>/;
$binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $opentype, -1, 1 ) }
unless defined $binmode;
$binmode = "" unless defined $binmode;
my ( $fh, $lock, $trunc );
if ( $HAS_FLOCK && $args->{locked} && !$ENV{PERL_PATH_TINY_NO_FLOCK} ) {
require Fcntl;
# truncating file modes shouldn't truncate until lock acquired
if ( grep { $opentype eq $_ } qw( > +> ) ) {
# sysopen in write mode without truncation
my $flags = $opentype eq ">" ? Fcntl::O_WRONLY() : Fcntl::O_RDWR();
$flags |= Fcntl::O_CREAT();
$flags |= Fcntl::O_EXCL() if $args->{exclusive};
sysopen( $fh, $self->[PATH], $flags ) or $self->_throw("sysopen");
# fix up the binmode since sysopen() can't specify layers like
# open() and binmode() can't start with just :unix like open()
if ( $binmode =~ s/^:unix// ) {
# eliminate pseudo-layers
binmode( $fh, ":raw" ) or $self->_throw("binmode (:raw)");
# strip off real layers until only :unix is left
while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
binmode( $fh, ":pop" ) or $self->_throw("binmode (:pop)");
}
}
# apply any remaining binmode layers
if ( length $binmode ) {
binmode( $fh, $binmode ) or $self->_throw("binmode ($binmode)");
}
# ask for lock and truncation
$lock = Fcntl::LOCK_EX();
$trunc = 1;
}
elsif ( $^O eq 'aix' && $opentype eq "<" ) {
# AIX can only lock write handles, so upgrade to RW and LOCK_EX if
# the file is writable; otherwise give up on locking. N.B.
# checking -w before open to determine the open mode is an
# unavoidable race condition
if ( -w $self->[PATH] ) {
$opentype = "+<";
$lock = Fcntl::LOCK_EX();
}
}
else {
$lock = $opentype eq "<" ? Fcntl::LOCK_SH() : Fcntl::LOCK_EX();
}
}
unless ($fh) {
my $mode = $opentype . $binmode;
open $fh, $mode, $self->[PATH] or $self->_throw("open ($mode)");
}
do { flock( $fh, $lock ) or $self->_throw("flock ($lock)") } if $lock;
do { truncate( $fh, 0 ) or $self->_throw("truncate") } if $trunc;
return $fh;
}
#pod =method has_same_bytes
#pod
#pod if ( path("foo.txt")->has_same_bytes("bar.txt") ) {
#pod # ...
#pod }
#pod
#pod This method returns true if both the invocant and the argument can be opened as
#pod file handles and the handles contain the same bytes. It returns false if their
#pod contents differ. If either can't be opened as a file (e.g. a directory or
#pod non-existent file), the method throws an exception. If both can be opened and
#pod both have the same C<realpath>, the method returns true without scanning any
#pod data.
#pod
#pod Current API available since 0.125.
#pod
#pod =cut
sub has_same_bytes {
my ($self, $other_path) = @_;
my $other = _path($other_path);
my $fh1 = $self->openr_raw({ locked => 1 });
my $fh2 = $other->openr_raw({ locked => 1 });
# check for directories
if (-d $fh1) {
$self->_throw('has_same_bytes', $self->[PATH], "directory not allowed");
}
if (-d $fh2) {
$self->_throw('has_same_bytes', $other->[PATH], "directory not allowed");
}
# Now that handles are open, we know the inputs are readable files that
# exist, so it's safe to compare via realpath
if ($self->realpath eq $other->realpath) {
return 1
}
# result is 0 for equal, 1 for unequal, -1 for error
require File::Compare;
my $res = File::Compare::compare($fh1, $fh2, 65536);
if ($res < 0) {
$self->_throw('has_same_bytes')
}
return $res == 0;
}
#pod =method is_absolute, is_relative
#pod
#pod if ( path("/tmp")->is_absolute ) { ... }
#pod if ( path("/tmp")->is_relative ) { ... }
#pod
#pod Booleans for whether the path appears absolute or relative.
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
sub is_absolute { substr( $_[0]->dirname, 0, 1 ) eq '/' }
sub is_relative { substr( $_[0]->dirname, 0, 1 ) ne '/' }
#pod =method is_rootdir
#pod
#pod while ( ! $path->is_rootdir ) {
#pod $path = $path->parent;
#pod ...
#pod }
#pod
#pod Boolean for whether the path is the root directory of the volume. I.e. the
#pod C<dirname> is C<q[/]> and the C<basename> is C<q[]>.
#pod
#pod This works even on C<MSWin32> with drives and UNC volumes:
#pod
#pod path("C:/")->is_rootdir; # true
#pod path("//server/share/")->is_rootdir; #true
#pod
#pod Current API available since 0.038.
#pod
#pod =cut
sub is_rootdir {
my ($self) = @_;
$self->_splitpath unless defined $self->[DIR];
return $self->[DIR] eq '/' && $self->[FILE] eq '';
}
#pod =method iterator
#pod
#pod $iter = path("/tmp")->iterator( \%options );
#pod
#pod Returns a code reference that walks a directory lazily. Each invocation
#pod returns a C<Path::Tiny> object or undef when the iterator is exhausted.
#pod
#pod $iter = path("/tmp")->iterator;
#pod while ( $path = $iter->() ) {
#pod ...
#pod }
#pod
#pod The current and parent directory entries ("." and "..") will not
#pod be included.
#pod
#pod If the C<recurse> option is true, the iterator will walk the directory
#pod recursively, breadth-first. If the C<follow_symlinks> option is also true,
#pod directory links will be followed recursively. There is no protection against
#pod loops when following links. If a directory is not readable, it will not be
#pod followed.
#pod
#pod The default is the same as:
#pod
#pod $iter = path("/tmp")->iterator( {
#pod recurse => 0,
#pod follow_symlinks => 0,
#pod } );
#pod
#pod For a more powerful, recursive iterator with built-in loop avoidance, see
#pod L<Path::Iterator::Rule>.
#pod
#pod See also L</visit>.
#pod
#pod Current API available since 0.016.
#pod
#pod =cut
sub iterator {
my $self = shift;
my $args = _get_args( shift, qw/recurse follow_symlinks/ );
my @dirs = $self;
my $current;
return sub {
my $next;
while (@dirs) {
if ( ref $dirs[0] eq 'Path::Tiny' ) {
if ( !-r $dirs[0] ) {
# Directory is missing or not readable, so skip it. There
# is still a race condition possible between the check and
# the opendir, but we can't easily differentiate between
# error cases that are OK to skip and those that we want
# to be exceptions, so we live with the race and let opendir
# be fatal.
shift @dirs and next;
}
$current = $dirs[0];
my $dh;
opendir( $dh, $current->[PATH] )
or $self->_throw( 'opendir', $current->[PATH] );
$dirs[0] = $dh;
if ( -l $current->[PATH] && !$args->{follow_symlinks} ) {
# Symlink attack! It was a real dir, but is now a symlink!
# N.B. we check *after* opendir so the attacker has to win
# two races: replace dir with symlink before opendir and
# replace symlink with dir before -l check above
shift @dirs and next;
}
}
while ( defined( $next = readdir $dirs[0] ) ) {
next if $next eq '.' || $next eq '..';
my $path = $current->child($next);
push @dirs, $path
if $args->{recurse} && -d $path && !( !$args->{follow_symlinks} && -l $path );
return $path;
}
shift @dirs;
}
return;
};
}
#pod =method lines, lines_raw, lines_utf8
#pod
#pod @contents = path("/tmp/foo.txt")->lines;
#pod @contents = path("/tmp/foo.txt")->lines(\%options);
#pod @contents = path("/tmp/foo.txt")->lines_raw;
#pod @contents = path("/tmp/foo.txt")->lines_utf8;
#pod
#pod @contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } );
#pod
#pod Returns a list of lines from a file. Optionally takes a hash-reference of
#pod options. Valid options are C<binmode>, C<count> and C<chomp>.
#pod
#pod If C<binmode> is provided, it will be set on the handle prior to reading.
#pod
#pod If a positive C<count> is provided, that many lines will be returned from the
#pod start of the file. If a negative C<count> is provided, the entire file will be
#pod read, but only C<abs(count)> will be kept and returned. If C<abs(count)>
#pod exceeds the number of lines in the file, all lines will be returned.
#pod
#pod If C<chomp> is set, any end-of-line character sequences (C<CR>, C<CRLF>, or
#pod C<LF>) will be removed from the lines returned.
#pod
#pod Because the return is a list, C<lines> in scalar context will return the number
#pod of lines (and throw away the data).
#pod
#pod $number_of_lines = path("/tmp/foo.txt")->lines;
#pod
#pod C<lines_raw> is like C<lines> with a C<binmode> of C<:raw>. We use C<:raw>
#pod instead of C<:unix> so PerlIO buffering can manage reading by line.
#pod
#pod C<lines_utf8> is like C<lines> with a C<binmode> of C<:raw:encoding(UTF-8)>
#pod (or C<:raw:utf8_strict> with L<PerlIO::utf8_strict>). If L<Unicode::UTF8>
#pod 0.58+ is installed, a raw, unbuffered UTF-8 slurp will be done and then the
#pod lines will be split. This is actually faster than relying on
#pod IO layers, though a bit memory intensive. If memory use is a
#pod concern, consider C<openr_utf8> and iterating directly on the handle.
#pod
#pod Current API available since 0.065.
#pod
#pod =cut
sub lines {
my $self = shift;
my $args = _get_args( shift, qw/binmode chomp count/ );
my $binmode = $args->{binmode};
$binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
my $chomp = $args->{chomp};
# XXX more efficient to read @lines then chomp(@lines) vs map?
if ( $args->{count} ) {
my ( $counter, $mod, @result ) = ( 0, abs( $args->{count} ) );
my $line;
while ( !eof($fh) ) {
defined( $line = readline($fh) ) or $self->_throw('readline');
$line =~ s/(?:\x{0d}?\x{0a}|\x{0d})\z// if $chomp;
$result[ $counter++ ] = $line;
# for positive count, terminate after right number of lines
last if $counter == $args->{count};
# for negative count, eventually wrap around in the result array
$counter %= $mod;
}
# reorder results if full and wrapped somewhere in the middle
splice( @result, 0, 0, splice( @result, $counter ) )
if @result == $mod && $counter % $mod;
return @result;
}
elsif ($chomp) {
local $!;
my @lines = map { s/(?:\x{0d}?\x{0a}|\x{0d})\z//; $_ } <$fh>; ## no critic
$self->_throw('readline') if $!;
return @lines;
}
else {
if ( wantarray ) {
local $!;
my @lines = <$fh>;
$self->_throw('readline') if $!;
return @lines;
} else {
local $!;
my $count =()= <$fh>;
$self->_throw('readline') if $!;
return $count;
}
}
}
sub lines_raw {
my $self = shift;
my $args = _get_args( shift, qw/binmode chomp count/ );
if ( $args->{chomp} && !$args->{count} ) {
return split /\n/, slurp_raw($self); ## no critic
}
else {
$args->{binmode} = ":raw";
return lines( $self, $args );
}
}
my $CRLF = qr/(?:\x{0d}?\x{0a}|\x{0d})/;
sub lines_utf8 {
my $self = shift;
my $args = _get_args( shift, qw/binmode chomp count/ );
if ( ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) )
&& $args->{chomp}
&& !$args->{count} )
{
my $slurp = slurp_utf8($self);
$slurp =~ s/$CRLF\z//; # like chomp, but full CR?LF|CR
return split $CRLF, $slurp, -1; ## no critic
}
elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
$args->{binmode} = ":raw:utf8_strict";
return lines( $self, $args );
}
else {
$args->{binmode} = ":raw:encoding(UTF-8)";
return lines( $self, $args );
}
}
#pod =method mkdir
#pod
#pod path("foo/bar/baz")->mkdir;
#pod path("foo/bar/baz")->mkdir( \%options );
#pod
#pod Like calling C<make_path> from L<File::Path>. An optional hash reference
#pod is passed through to C<make_path>. Errors will be trapped and an exception
#pod thrown. Returns the the path object to facilitate chaining.
#pod
#pod B<NOTE>: unlike Perl's builtin C<mkdir>, this will create intermediate paths
#pod similar to the Unix C<mkdir -p> command. It will not error if applied to an
#pod existing directory.
#pod
#pod Current API available since 0.125.
#pod
#pod =cut
sub mkdir {
my ( $self, $args ) = @_;
$args = {} unless ref $args eq 'HASH';
my $err;
$args->{error} = \$err unless defined $args->{error};
require File::Path;
my @dirs;
my $ok = eval {
File::Path::make_path( $self->[PATH], $args );
1;
};
if (!$ok) {
$self->_throw('mkdir', $self->[PATH], "error creating path: $@");
}
if ( $err && @$err ) {
my ( $file, $message ) = %{ $err->[0] };
$self->_throw('mkdir', $file, $message);
}
return $self;
}
#pod =method mkpath (deprecated)
#pod
#pod Like calling C<mkdir>, but returns the list of directories created or an empty list if
#pod the directories already exist, just like C<make_path>.
#pod
#pod Deprecated in 0.125.
#pod
#pod =cut
sub mkpath {
my ( $self, $args ) = @_;
$args = {} unless ref $args eq 'HASH';
my $err;
$args->{error} = \$err unless defined $args->{error};
require File::Path;
my @dirs = File::Path::make_path( $self->[PATH], $args );
if ( $err && @$err ) {
my ( $file, $message ) = %{ $err->[0] };
Carp::croak("mkpath failed for $file: $message");
}
return @dirs;
}
#pod =method move
#pod
#pod path("foo.txt")->move("bar.txt");
#pod
#pod Moves the current path to the given destination using L<File::Copy>'s
#pod C<move> function. Upon success, returns the C<Path::Tiny> object for the
#pod newly moved file.
#pod
#pod If the destination already exists and is a directory, and the source is not a
#pod directory, then the source file will be renamed into the directory
#pod specified by the destination.
#pod
#pod If possible, move() will simply rename the file. Otherwise, it
#pod copies the file to the new location and deletes the original. If an
#pod error occurs during this copy-and-delete process, you may be left
#pod with a (possibly partial) copy of the file under the destination
#pod name.
#pod
#pod Current API available since 0.124. Prior versions used Perl's
#pod -built-in (and less robust) L<rename|perlfunc/rename> function
#pod and did not return an object.
#pod
#pod =cut
sub move {
my ( $self, $dest ) = @_;
require File::Copy;
File::Copy::move( $self->[PATH], $dest )
or $self->_throw( 'move', $self->[PATH] . "' -> '$dest" );
return -d $dest ? _path( $dest, $self->basename ) : _path($dest);
}
#pod =method openr, openw, openrw, opena
#pod
#pod $fh = path("foo.txt")->openr($binmode); # read
#pod $fh = path("foo.txt")->openr_raw;
#pod $fh = path("foo.txt")->openr_utf8;
#pod
#pod $fh = path("foo.txt")->openw($binmode); # write
#pod $fh = path("foo.txt")->openw_raw;
#pod $fh = path("foo.txt")->openw_utf8;
#pod
#pod $fh = path("foo.txt")->opena($binmode); # append
#pod $fh = path("foo.txt")->opena_raw;
#pod $fh = path("foo.txt")->opena_utf8;
#pod
#pod $fh = path("foo.txt")->openrw($binmode); # read/write
#pod $fh = path("foo.txt")->openrw_raw;
#pod $fh = path("foo.txt")->openrw_utf8;
#pod
#pod Returns a file handle opened in the specified mode. The C<openr> style methods
#pod take a single C<binmode> argument. All of the C<open*> methods have
#pod C<open*_raw> and C<open*_utf8> equivalents that use buffered I/O layers C<:raw>
#pod and C<:raw:encoding(UTF-8)> (or C<:raw:utf8_strict> with
#pod L<PerlIO::utf8_strict>).
#pod
#pod An optional hash reference may be used to pass options. The only option is
#pod C<locked>. If true, handles opened for writing, appending or read-write are
#pod locked with C<LOCK_EX>; otherwise, they are locked for C<LOCK_SH>.
#pod
#pod $fh = path("foo.txt")->openrw_utf8( { locked => 1 } );
#pod
#pod See L</filehandle> for more on locking.
#pod
#pod Current API available since 0.011.
#pod
#pod =cut
# map method names to corresponding open mode
my %opens = (
opena => ">>",
openr => "<",
openw => ">",
openrw => "+<"
);
while ( my ( $k, $v ) = each %opens ) {
no strict 'refs';
# must check for lexical IO mode hint
*{$k} = sub {
my ( $self, @args ) = @_;
my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
$args = _get_args( $args, qw/locked/ );
my ($binmode) = @args;
$binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $v, -1, 1 ) }
unless defined $binmode;
$self->filehandle( $args, $v, $binmode );
};
*{ $k . "_raw" } = sub {
my ( $self, @args ) = @_;
my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
$args = _get_args( $args, qw/locked/ );
$self->filehandle( $args, $v, ":raw" );
};
*{ $k . "_utf8" } = sub {
my ( $self, @args ) = @_;
my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
$args = _get_args( $args, qw/locked/ );
my $layer;
if ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
$layer = ":raw:utf8_strict";
}
else {
$layer = ":raw:encoding(UTF-8)";
}
$self->filehandle( $args, $v, $layer );
};
}
#pod =method parent
#pod
#pod $parent = path("foo/bar/baz")->parent; # foo/bar
#pod $parent = path("foo/wibble.txt")->parent; # foo
#pod
#pod $parent = path("foo/bar/baz")->parent(2); # foo
#pod
#pod Returns a C<Path::Tiny> object corresponding to the parent directory of the
#pod original directory or file. An optional positive integer argument is the number
#pod of parent directories upwards to return. C<parent> by itself is equivalent to
#pod C<parent(1)>.
#pod
#pod Current API available since 0.014.
#pod
#pod =cut
# XXX this is ugly and coverage is incomplete. I think it's there for windows
# so need to check coverage there and compare
sub parent {
my ( $self, $level ) = @_;
$level = 1 unless defined $level && $level > 0;
$self->_splitpath unless defined $self->[FILE];
my $parent;
if ( length $self->[FILE] ) {
if ( $self->[FILE] eq '.' || $self->[FILE] eq ".." ) {
$parent = _path( $self->[PATH] . "/.." );
}
else {
$parent = _path( _non_empty( $self->[VOL] . $self->[DIR] ) );
}
}
elsif ( length $self->[DIR] ) {
# because of symlinks, any internal updir requires us to
# just add more updirs at the end
if ( $self->[DIR] =~ m{(?:^\.\./|/\.\./|/\.\.\z)} ) {
$parent = _path( $self->[VOL] . $self->[DIR] . "/.." );
}
else {
( my $dir = $self->[DIR] ) =~ s{/[^\/]+/\z}{/};
$parent = _path( $self->[VOL] . $dir );
}
}
else {
$parent = _path( _non_empty( $self->[VOL] ) );
}
return $level == 1 ? $parent : $parent->parent( $level - 1 );
}
sub _non_empty {
my ($string) = shift;
return ( ( defined($string) && length($string) ) ? $string : "." );
}
#pod =method realpath
#pod
#pod $real = path("/baz/foo/../bar")->realpath;
#pod $real = path("foo/../bar")->realpath;
#pod
#pod Returns a new C<Path::Tiny> object with all symbolic links and upward directory
#pod parts resolved using L<Cwd>'s C<realpath>. Compared to C<absolute>, this is
#pod more expensive as it must actually consult the filesystem.
#pod
#pod If the parent path can't be resolved (e.g. if it includes directories that
#pod don't exist), an exception will be thrown:
#pod
#pod $real = path("doesnt_exist/foo")->realpath; # dies
#pod
#pod However, if the parent path exists and only the last component (e.g. filename)
#pod doesn't exist, the realpath will be the realpath of the parent plus the
#pod non-existent last component:
#pod
#pod $real = path("./aasdlfasdlf")->realpath; # works
#pod
#pod The underlying L<Cwd> module usually worked this way on Unix, but died on
#pod Windows (and some Unixes) if the full path didn't exist. As of version 0.064,
#pod it's safe to use anywhere.
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
# Win32 and some Unixes need parent path resolved separately so realpath
# doesn't throw an error resolving non-existent basename
sub realpath {
my $self = shift;
$self = $self->_resolve_symlinks;
require Cwd;
$self->_splitpath if !defined $self->[FILE];
my $check_parent =
length $self->[FILE] && $self->[FILE] ne '.' && $self->[FILE] ne '..';
my $realpath = eval {
# pure-perl Cwd can carp
local $SIG{__WARN__} = sub { };
Cwd::realpath( $check_parent ? $self->parent->[PATH] : $self->[PATH] );
};
# parent realpath must exist; not all Cwd::realpath will error if it doesn't
$self->_throw("resolving realpath")
unless defined $realpath && length $realpath && -e $realpath;
return ( $check_parent ? _path( $realpath, $self->[FILE] ) : _path($realpath) );
}
#pod =method relative
#pod
#pod $rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar
#pod
#pod Returns a C<Path::Tiny> object with a path relative to a new base path
#pod given as an argument. If no argument is given, the current directory will
#pod be used as the new base path.
#pod
#pod If either path is already relative, it will be made absolute based on the
#pod current directly before determining the new relative path.
#pod
#pod The algorithm is roughly as follows:
#pod
#pod =for :list
#pod * If the original and new base path are on different volumes, an exception
#pod will be thrown.
#pod * If the original and new base are identical, the relative path is C<".">.
#pod * If the new base subsumes the original, the relative path is the original
#pod path with the new base chopped off the front
#pod * If the new base does not subsume the original, a common prefix path is
#pod determined (possibly the root directory) and the relative path will
#pod consist of updirs (C<"..">) to reach the common prefix, followed by the
#pod original path less the common prefix.
#pod
#pod Unlike C<File::Spec::abs2rel>, in the last case above, the calculation based
#pod on a common prefix takes into account symlinks that could affect the updir
#pod process. Given an original path "/A/B" and a new base "/A/C",
#pod (where "A", "B" and "C" could each have multiple path components):
#pod
#pod =for :list
#pod * Symlinks in "A" don't change the result unless the last component of A is
#pod a symlink and the first component of "C" is an updir.
#pod * Symlinks in "B" don't change the result and will exist in the result as
#pod given.
#pod * Symlinks and updirs in "C" must be resolved to actual paths, taking into
#pod account the possibility that not all path components might exist on the
#pod filesystem.
#pod
#pod Current API available since 0.001. New algorithm (that accounts for
#pod symlinks) available since 0.079.
#pod
#pod =cut
sub relative {
my ( $self, $base ) = @_;
$base = _path( defined $base && length $base ? $base : '.' );
# relative paths must be converted to absolute first
$self = $self->absolute if $self->is_relative;
$base = $base->absolute if $base->is_relative;
# normalize volumes if they exist
$self = $self->absolute if !length $self->volume && length $base->volume;
$base = $base->absolute if length $self->volume && !length $base->volume;
# can't make paths relative across volumes
if ( !_same( $self->volume, $base->volume ) ) {
Carp::croak("relative() can't cross volumes: '$self' vs '$base'");
}
# if same absolute path, relative is current directory
return _path(".") if _same( $self->[PATH], $base->[PATH] );
# if base is a prefix of self, chop prefix off self
if ( $base->subsumes($self) ) {
$base = "" if $base->is_rootdir;
my $relative = "$self";
$relative =~ s{\A\Q$base/}{};
return _path(".", $relative);
}
# base is not a prefix, so must find a common prefix (even if root)
my ( @common, @self_parts, @base_parts );
@base_parts = split /\//, $base->_just_filepath;
# if self is rootdir, then common directory is root (shown as empty
# string for later joins); otherwise, must be computed from path parts.
if ( $self->is_rootdir ) {
@common = ("");
shift @base_parts;
}
else {
@self_parts = split /\//, $self->_just_filepath;
while ( @self_parts && @base_parts && _same( $self_parts[0], $base_parts[0] ) ) {
push @common, shift @base_parts;
shift @self_parts;
}
}
# if there are any symlinks from common to base, we have a problem, as
# you can't guarantee that updir from base reaches the common prefix;
# we must resolve symlinks and try again; likewise, any updirs are
# a problem as it throws off calculation of updirs needed to get from
# self's path to the common prefix.
if ( my $new_base = $self->_resolve_between( \@common, \@base_parts ) ) {
return $self->relative($new_base);
}
# otherwise, symlinks in common or from common to A don't matter as
# those don't involve updirs
my @new_path = ( ("..") x ( 0+ @base_parts ), @self_parts );
return _path(@new_path);
}
sub _just_filepath {
my $self = shift;
my $self_vol = $self->volume;
return "$self" if !length $self_vol;
( my $self_path = "$self" ) =~ s{\A\Q$self_vol}{};
return $self_path;
}
sub _resolve_between {
my ( $self, $common, $base ) = @_;
my $path = $self->volume . join( "/", @$common );
my $changed = 0;
for my $p (@$base) {
$path .= "/$p";
if ( $p eq '..' ) {
$changed = 1;
if ( -e $path ) {
$path = _path($path)->realpath->[PATH];
}
else {
$path =~ s{/[^/]+/..\z}{/};
}
}
if ( -l $path ) {
$changed = 1;
$path = _path($path)->realpath->[PATH];
}
}
return $changed ? _path($path) : undef;
}
#pod =method remove
#pod
#pod path("foo.txt")->remove;
#pod
#pod This is just like C<unlink>, except for its error handling: if the path does
#pod not exist, it returns false; if deleting the file fails, it throws an
#pod exception.
#pod
#pod Current API available since 0.012.
#pod
#pod =cut
sub remove {
my $self = shift;
return 0 if !-e $self->[PATH] && !-l $self->[PATH];
return unlink( $self->[PATH] ) || $self->_throw('unlink');
}
#pod =method remove_tree
#pod
#pod # directory
#pod path("foo/bar/baz")->remove_tree;
#pod path("foo/bar/baz")->remove_tree( \%options );
#pod path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove
#pod
#pod Like calling C<remove_tree> from L<File::Path>, but defaults to C<safe> mode.
#pod An optional hash reference is passed through to C<remove_tree>. Errors will be
#pod trapped and an exception thrown. Returns the number of directories deleted,
#pod just like C<remove_tree>.
#pod
#pod If you want to remove a directory only if it is empty, use the built-in
#pod C<rmdir> function instead.
#pod
#pod rmdir path("foo/bar/baz/");
#pod
#pod Current API available since 0.013.
#pod
#pod =cut
sub remove_tree {
my ( $self, $args ) = @_;
return 0 if !-e $self->[PATH] && !-l $self->[PATH];
$args = {} unless ref $args eq 'HASH';
my $err;
$args->{error} = \$err unless defined $args->{error};
$args->{safe} = 1 unless defined $args->{safe};
require File::Path;
my $count = File::Path::remove_tree( $self->[PATH], $args );
if ( $err && @$err ) {
my ( $file, $message ) = %{ $err->[0] };
Carp::croak("remove_tree failed for $file: $message");
}
return $count;
}
#pod =method sibling
#pod
#pod $foo = path("/tmp/foo.txt");
#pod $sib = $foo->sibling("bar.txt"); # /tmp/bar.txt
#pod $sib = $foo->sibling("baz", "bam.txt"); # /tmp/baz/bam.txt
#pod
#pod Returns a new C<Path::Tiny> object relative to the parent of the original.
#pod This is slightly more efficient than C<< $path->parent->child(...) >>.
#pod
#pod Current API available since 0.058.
#pod
#pod =cut
sub sibling {
my $self = shift;
return _path( $self->parent->[PATH], @_ );
}
#pod =method size, size_human
#pod
#pod my $p = path("foo"); # with size 1025 bytes
#pod
#pod $p->size; # "1025"
#pod $p->size_human; # "1.1 K"
#pod $p->size_human( {format => "iec"} ); # "1.1 KiB"
#pod
#pod Returns the size of a file. The C<size> method is just a wrapper around C<-s>.
#pod
#pod The C<size_human> method provides a human-readable string similar to
#pod C<ls -lh>. Like C<ls>, it rounds upwards and provides one decimal place for
#pod single-digit sizes and no decimal places for larger sizes. The only available
#pod option is C<format>, which has three valid values:
#pod
#pod =for :list
#pod * 'ls' (the default): base-2 sizes, with C<ls> style single-letter suffixes (K, M, etc.)
#pod * 'iec': base-2 sizes, with IEC binary suffixes (KiB, MiB, etc.)
#pod * 'si': base-10 sizes, with SI decimal suffixes (kB, MB, etc.)
#pod
#pod If C<-s> would return C<undef>, C<size_human> returns the empty string.
#pod
#pod Current API available since 0.122.
#pod
#pod =cut
sub size { -s $_[0]->[PATH] }
my %formats = (
'ls' => [ 1024, log(1024), [ "", map { " $_" } qw/K M G T/ ] ],
'iec' => [ 1024, log(1024), [ "", map { " $_" } qw/KiB MiB GiB TiB/ ] ],
'si' => [ 1000, log(1000), [ "", map { " $_" } qw/kB MB GB TB/ ] ],
);
sub _formats { return $formats{$_[0]} }
sub size_human {
my $self = shift;
my $args = _get_args( shift, qw/format/ );
my $format = defined $args->{format} ? $args->{format} : "ls";
my $fmt_opts = $formats{$format}
or Carp::croak("Invalid format '$format' for size_human()");
my $size = -s $self->[PATH];
return defined $size ? _human_size( $size, @$fmt_opts ) : "";
}
sub _ceil {
return $_[0] == int($_[0]) ? $_[0] : int($_[0]+1);
}
sub _human_size {
my ( $size, $base, $log_base, $suffixes ) = @_;
return "0" if $size == 0;
my $mag = int( log($size) / $log_base );
$size /= $base**$mag;
$size =
$mag == 0 ? $size
: length( int($size) ) == 1 ? _ceil( $size * 10 ) / 10
: _ceil($size);
if ( $size >= $base ) {
$size /= $base;
$mag++;
}
my $fmt = ( $mag == 0 || length( int($size) ) > 1 ) ? "%.0f%s" : "%.1f%s";
return sprintf( $fmt, $size, $suffixes->[$mag] );
}
#pod =method slurp, slurp_raw, slurp_utf8
#pod
#pod $data = path("foo.txt")->slurp;
#pod $data = path("foo.txt")->slurp( {binmode => ":raw"} );
#pod $data = path("foo.txt")->slurp_raw;
#pod $data = path("foo.txt")->slurp_utf8;
#pod
#pod Reads file contents into a scalar. Takes an optional hash reference which may
#pod be used to pass options. The only available option is C<binmode>, which is
#pod passed to C<binmode()> on the handle used for reading.
#pod
#pod C<slurp_raw> is like C<slurp> with a C<binmode> of C<:unix> for
#pod a fast, unbuffered, raw read.
#pod
#pod C<slurp_utf8> is like C<slurp> with a C<binmode> of
#pod C<:unix:encoding(UTF-8)> (or C<:unix:utf8_strict> with
#pod L<PerlIO::utf8_strict>). If L<Unicode::UTF8> 0.58+ is installed, a
#pod unbuffered, raw slurp will be done instead and the result decoded with
#pod C<Unicode::UTF8>. This is just as strict and is roughly an order of
#pod magnitude faster than using C<:encoding(UTF-8)>.
#pod
#pod B<Note>: C<slurp> and friends lock the filehandle before slurping. If
#pod you plan to slurp from a file created with L<File::Temp>, be sure to
#pod close other handles or open without locking to avoid a deadlock:
#pod
#pod my $tempfile = File::Temp->new(EXLOCK => 0);
#pod my $guts = path($tempfile)->slurp;
#pod
#pod Current API available since 0.004.
#pod
#pod =cut
sub slurp {
my $self = shift;
my $args = _get_args( shift, qw/binmode/ );
my $binmode = $args->{binmode};
$binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
if ( ( defined($binmode) ? $binmode : "" ) eq ":unix"
and my $size = -s $fh )
{
my $buf;
my $rc = read $fh, $buf, $size; # File::Slurp in a nutshell
$self->_throw('read') unless defined $rc;
return $buf;
}
else {
local $/;
my $buf = scalar <$fh>;
$self->_throw('read') unless defined $buf;
return $buf;
}
}
sub slurp_raw { $_[1] = { binmode => ":unix" }; goto &slurp }
sub slurp_utf8 {
if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
return Unicode::UTF8::decode_utf8( slurp( $_[0], { binmode => ":unix" } ) );
}
elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
$_[1] = { binmode => ":unix:utf8_strict" };
goto &slurp;
}
else {
$_[1] = { binmode => ":unix:encoding(UTF-8)" };
goto &slurp;
}
}
#pod =method spew, spew_raw, spew_utf8
#pod
#pod path("foo.txt")->spew(@data);
#pod path("foo.txt")->spew(\@data);
#pod path("foo.txt")->spew({binmode => ":raw"}, @data);
#pod path("foo.txt")->spew_raw(@data);
#pod path("foo.txt")->spew_utf8(@data);
#pod
#pod Writes data to a file atomically. The file is written to a temporary file in
#pod the same directory, then renamed over the original. An optional hash reference
#pod may be used to pass options. The only option is C<binmode>, which is passed to
#pod C<binmode()> on the handle used for writing.
#pod
#pod C<spew_raw> is like C<spew> with a C<binmode> of C<:unix> for a fast,
#pod unbuffered, raw write.
#pod
#pod C<spew_utf8> is like C<spew> with a C<binmode> of C<:unix:encoding(UTF-8)>
#pod (or C<:unix:utf8_strict> with L<PerlIO::utf8_strict>). If L<Unicode::UTF8>
#pod 0.58+ is installed, a raw, unbuffered spew will be done instead on the data
#pod encoded with C<Unicode::UTF8>.
#pod
#pod B<NOTE>: because the file is written to a temporary file and then renamed, the
#pod new file will wind up with permissions based on your current umask. This is a
#pod feature to protect you from a race condition that would otherwise give
#pod different permissions than you might expect. If you really want to keep the
#pod original mode flags, use L</append> with the C<truncate> option.
#pod
#pod Current API available since 0.011.
#pod
#pod =cut
sub spew {
my ( $self, @data ) = @_;
my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
$args = _get_args( $args, qw/binmode/ );
my $binmode = $args->{binmode};
# get default binmode from caller's lexical scope (see "perldoc open")
$binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
# writing needs to follow the link and create the tempfile in the same
# dir for later atomic rename
my $resolved_path = $self->_resolve_symlinks;
my $temp = $resolved_path->_replacment_path;
my $fh;
my $ok = eval { $fh = $temp->filehandle( { exclusive => 1, locked => 1 }, ">", $binmode ); 1 };
if (!$ok) {
my $msg = ref($@) eq 'Path::Tiny::Error'
? "error opening temp file '$@->{file}' for atomic write: $@->{err}"
: "error opening temp file for atomic write: $@";
$self->_throw('spew', $self->[PATH], $msg);
}
print( {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data) or self->_throw('print', $temp->[PATH]);
close $fh or $self->_throw( 'close', $temp->[PATH] );
return $temp->move($resolved_path);
}
sub spew_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &spew }
sub spew_utf8 {
if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
my $self = shift;
spew(
$self,
{ binmode => ":unix" },
map { Unicode::UTF8::encode_utf8($_) } map { ref eq 'ARRAY' ? @$_ : $_ } @_
);
}
elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
splice @_, 1, 0, { binmode => ":unix:utf8_strict" };
goto &spew;
}
else {
splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" };
goto &spew;
}
}
#pod =method stat, lstat
#pod
#pod $stat = path("foo.txt")->stat;
#pod $stat = path("/some/symlink")->lstat;
#pod
#pod Like calling C<stat> or C<lstat> from L<File::stat>.
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
# XXX break out individual stat() components as subs?
sub stat {
my $self = shift;
require File::stat;
return File::stat::stat( $self->[PATH] ) || $self->_throw('stat');
}
sub lstat {
my $self = shift;
require File::stat;
return File::stat::lstat( $self->[PATH] ) || $self->_throw('lstat');
}
#pod =method stringify
#pod
#pod $path = path("foo.txt");
#pod say $path->stringify; # same as "$path"
#pod
#pod Returns a string representation of the path. Unlike C<canonpath>, this method
#pod returns the path standardized with Unix-style C</> directory separators.
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
sub stringify { $_[0]->[PATH] =~ /^~/ ? './' . $_[0]->[PATH] : $_[0]->[PATH] }
#pod =method subsumes
#pod
#pod path("foo/bar")->subsumes("foo/bar/baz"); # true
#pod path("/foo/bar")->subsumes("/foo/baz"); # false
#pod
#pod Returns true if the first path is a prefix of the second path at a directory
#pod boundary.
#pod
#pod This B<does not> resolve parent directory entries (C<..>) or symlinks:
#pod
#pod path("foo/bar")->subsumes("foo/bar/../baz"); # true
#pod
#pod If such things are important to you, ensure that both paths are resolved to
#pod the filesystem with C<realpath>:
#pod
#pod my $p1 = path("foo/bar")->realpath;
#pod my $p2 = path("foo/bar/../baz")->realpath;
#pod if ( $p1->subsumes($p2) ) { ... }
#pod
#pod Current API available since 0.048.
#pod
#pod =cut
sub subsumes {
my $self = shift;
Carp::croak("subsumes() requires a defined, positive-length argument")
unless defined $_[0];
my $other = _path(shift);
# normalize absolute vs relative
if ( $self->is_absolute && !$other->is_absolute ) {
$other = $other->absolute;
}
elsif ( $other->is_absolute && !$self->is_absolute ) {
$self = $self->absolute;
}
# normalize volume vs non-volume; do this after absolute path
# adjustments above since that might add volumes already
if ( length $self->volume && !length $other->volume ) {
$other = $other->absolute;
}
elsif ( length $other->volume && !length $self->volume ) {
$self = $self->absolute;
}
if ( $self->[PATH] eq '.' ) {
return !!1; # cwd subsumes everything relative
}
elsif ( $self->is_rootdir ) {
# a root directory ("/", "c:/") already ends with a separator
return $other->[PATH] =~ m{^\Q$self->[PATH]\E};
}
else {
# exact match or prefix breaking at a separator
return $other->[PATH] =~ m{^\Q$self->[PATH]\E(?:/|\z)};
}
}
#pod =method touch
#pod
#pod path("foo.txt")->touch;
#pod path("foo.txt")->touch($epoch_secs);
#pod
#pod Like the Unix C<touch> utility. Creates the file if it doesn't exist, or else
#pod changes the modification and access times to the current time. If the first
#pod argument is the epoch seconds then it will be used.
#pod
#pod Returns the path object so it can be easily chained with other methods:
#pod
#pod # won't die if foo.txt doesn't exist
#pod $content = path("foo.txt")->touch->slurp;
#pod
#pod Current API available since 0.015.
#pod
#pod =cut
sub touch {
my ( $self, $epoch ) = @_;
if ( !-e $self->[PATH] ) {
my $fh = $self->openw;
close $fh or $self->_throw('close');
}
if ( defined $epoch ) {
utime $epoch, $epoch, $self->[PATH]
or $self->_throw("utime ($epoch)");
}
else {
# literal undef prevents warnings :-(
utime undef, undef, $self->[PATH]
or $self->_throw("utime ()");
}
return $self;
}
#pod =method touchpath
#pod
#pod path("bar/baz/foo.txt")->touchpath;
#pod
#pod Combines C<mkdir> and C<touch>. Creates the parent directory if it doesn't exist,
#pod before touching the file. Returns the path object like C<touch> does.
#pod
#pod If you need to pass options, use C<mkdir> and C<touch> separately:
#pod
#pod path("bar/baz")->mkdir( \%options )->child("foo.txt")->touch($epoch_secs);
#pod
#pod Current API available since 0.022.
#pod
#pod =cut
sub touchpath {
my ($self) = @_;
my $parent = $self->parent;
$parent->mkdir unless $parent->exists;
$self->touch;
}
#pod =method visit
#pod
#pod path("/tmp")->visit( \&callback, \%options );
#pod
#pod Executes a callback for each child of a directory. It returns a hash
#pod reference with any state accumulated during iteration.
#pod
#pod The options are the same as for L</iterator> (which it uses internally):
#pod C<recurse> and C<follow_symlinks>. Both default to false.
#pod
#pod The callback function will receive a C<Path::Tiny> object as the first argument
#pod and a hash reference to accumulate state as the second argument. For example:
#pod
#pod # collect files sizes
#pod my $sizes = path("/tmp")->visit(
#pod sub {
#pod my ($path, $state) = @_;
#pod return if $path->is_dir;
#pod $state->{$path} = -s $path;
#pod },
#pod { recurse => 1 }
#pod );
#pod
#pod For convenience, the C<Path::Tiny> object will also be locally aliased as the
#pod C<$_> global variable:
#pod
#pod # print paths matching /foo/
#pod path("/tmp")->visit( sub { say if /foo/ }, { recurse => 1} );
#pod
#pod If the callback returns a B<reference> to a false scalar value, iteration will
#pod terminate. This is not the same as "pruning" a directory search; this just
#pod stops all iteration and returns the state hash reference.
#pod
#pod # find up to 10 files larger than 100K
#pod my $files = path("/tmp")->visit(
#pod sub {
#pod my ($path, $state) = @_;
#pod $state->{$path}++ if -s $path > 102400
#pod return \0 if keys %$state == 10;
#pod },
#pod { recurse => 1 }
#pod );
#pod
#pod If you want more flexible iteration, use a module like L<Path::Iterator::Rule>.
#pod
#pod Current API available since 0.062.
#pod
#pod =cut
sub visit {
my $self = shift;
my $cb = shift;
my $args = _get_args( shift, qw/recurse follow_symlinks/ );
Carp::croak("Callback for visit() must be a code reference")
unless defined($cb) && ref($cb) eq 'CODE';
my $next = $self->iterator($args);
my $state = {};
while ( my $file = $next->() ) {
local $_ = $file;
my $r = $cb->( $file, $state );
last if ref($r) eq 'SCALAR' && !$$r;
}
return $state;
}
#pod =method volume
#pod
#pod $vol = path("/tmp/foo.txt")->volume; # ""
#pod $vol = path("C:/tmp/foo.txt")->volume; # "C:"
#pod
#pod Returns the volume portion of the path. This is equivalent
#pod to what L<File::Spec> would give from C<splitpath> and thus
#pod usually is the empty string on Unix-like operating systems or the
#pod drive letter for an absolute path on C<MSWin32>.
#pod
#pod Current API available since 0.001.
#pod
#pod =cut
sub volume {
my ($self) = @_;
$self->_splitpath unless defined $self->[VOL];
return $self->[VOL];
}
package Path::Tiny::Error;
our @CARP_NOT = qw/Path::Tiny/;
use overload ( q{""} => sub { (shift)->{msg} }, fallback => 1 );
sub throw {
my ( $class, $op, $file, $err ) = @_;
chomp( my $trace = Carp::shortmess );
my $msg = "Error $op on '$file': $err$trace\n";
die bless { op => $op, file => $file, err => $err, msg => $msg }, $class;
}
1;
# vim: ts=4 sts=4 sw=4 et:
__END__
=pod
=encoding UTF-8
=head1 NAME
Path::Tiny - File path utility
=head1 VERSION
version 0.146
=head1 SYNOPSIS
use Path::Tiny;
# Creating Path::Tiny objects
my $dir = path("/tmp");
my $foo = path("foo.txt");
my $subdir = $dir->child("foo");
my $bar = $subdir->child("bar.txt");
# Stringifies as cleaned up path
my $file = path("./foo.txt");
print $file; # "foo.txt"
# Reading files
my $guts = $file->slurp;
$guts = $file->slurp_utf8;
my @lines = $file->lines;
@lines = $file->lines_utf8;
my ($head) = $file->lines( {count => 1} );
my ($tail) = $file->lines( {count => -1} );
# Writing files
$bar->spew( @data );
$bar->spew_utf8( @data );
# Reading directories
for ( $dir->children ) { ... }
my $iter = $dir->iterator;
while ( my $next = $iter->() ) { ... }
=head1 DESCRIPTION
This module provides a small, fast utility for working with file paths. It is
friendlier to use than L<File::Spec> and provides easy access to functions from
several other core file handling modules. It aims to be smaller and faster
than many alternatives on CPAN, while helping people do many common things in
consistent and less error-prone ways.
Path::Tiny does not try to work for anything except Unix-like and Win32
platforms. Even then, it might break if you try something particularly obscure
or tortuous. (Quick! What does this mean:
C<< ///../../..//./././a//b/.././c/././ >>? And how does it differ on Win32?)
All paths are forced to have Unix-style forward slashes. Stringifying
the object gives you back the path (after some clean up).
File input/output methods C<flock> handles before reading or writing,
as appropriate (if supported by the platform and/or filesystem).
The C<*_utf8> methods (C<slurp_utf8>, C<lines_utf8>, etc.) operate in raw
mode. On Windows, that means they will not have CRLF translation from the
C<:crlf> IO layer. Installing L<Unicode::UTF8> 0.58 or later will speed up
C<*_utf8> situations in many cases and is highly recommended.
Alternatively, installing L<PerlIO::utf8_strict> 0.003 or later will be
used in place of the default C<:encoding(UTF-8)>.
This module depends heavily on PerlIO layers for correct operation and thus
requires Perl 5.008001 or later.
=head1 CONSTRUCTORS
=head2 path
$path = path("foo/bar");
$path = path("/tmp", "file.txt"); # list
$path = path("."); # cwd
Constructs a C<Path::Tiny> object. It doesn't matter if you give a file or
directory path. It's still up to you to call directory-like methods only on
directories and file-like methods only on files. This function is exported
automatically by default.
The first argument must be defined and have non-zero length or an exception
will be thrown. This prevents subtle, dangerous errors with code like
C<< path( maybe_undef() )->remove_tree >>.
B<DEPRECATED>: If and only if the B<first> character of the B<first> argument
to C<path> is a tilde ('~'), then tilde replacement will be applied to the
first path segment. A single tilde will be replaced with C<glob('~')> and a
tilde followed by a username will be replaced with output of
C<glob('~username')>. B<No other method does tilde expansion on its arguments>.
See L</Tilde expansion (deprecated)> for more.
On Windows, if the path consists of a drive identifier without a path component
(C<C:> or C<D:>), it will be expanded to the absolute path of the current
directory on that volume using C<Cwd::getdcwd()>.
If called with a single C<Path::Tiny> argument, the original is returned unless
the original is holding a temporary file or directory reference in which case a
stringified copy is made.
$path = path("foo/bar");
$temp = Path::Tiny->tempfile;
$p2 = path($path); # like $p2 = $path
$t2 = path($temp); # like $t2 = path( "$temp" )
This optimizes copies without proliferating references unexpectedly if a copy is
made by code outside your control.
Current API available since 0.017.
=head2 new
$path = Path::Tiny->new("foo/bar");
This is just like C<path>, but with method call overhead. (Why would you
do that?)
Current API available since 0.001.
=head2 cwd
$path = Path::Tiny->cwd; # path( Cwd::getcwd )
$path = cwd; # optional export
Gives you the absolute path to the current directory as a C<Path::Tiny> object.
This is slightly faster than C<< path(".")->absolute >>.
C<cwd> may be exported on request and used as a function instead of as a
method.
Current API available since 0.018.
=head2 rootdir
$path = Path::Tiny->rootdir; # /
$path = rootdir; # optional export
Gives you C<< File::Spec->rootdir >> as a C<Path::Tiny> object if you're too
picky for C<path("/")>.
C<rootdir> may be exported on request and used as a function instead of as a
method.
Current API available since 0.018.
=head2 tempfile, tempdir
$temp = Path::Tiny->tempfile( @options );
$temp = Path::Tiny->tempdir( @options );
$temp = $dirpath->tempfile( @options );
$temp = $dirpath->tempdir( @options );
$temp = tempfile( @options ); # optional export
$temp = tempdir( @options ); # optional export
C<tempfile> passes the options to C<< File::Temp->new >> and returns a
C<Path::Tiny> object with the file name. The C<TMPDIR> option will be enabled
by default, but you can override that by passing C<< TMPDIR => 0 >> along with
the options. (If you use an absolute C<TEMPLATE> option, you will want to
disable C<TMPDIR>.)
The resulting C<File::Temp> object is cached. When the C<Path::Tiny> object is
destroyed, the C<File::Temp> object will be as well.
C<File::Temp> annoyingly requires you to specify a custom template in slightly
different ways depending on which function or method you call, but
C<Path::Tiny> lets you ignore that and can take either a leading template or a
C<TEMPLATE> option and does the right thing.
$temp = Path::Tiny->tempfile( "customXXXXXXXX" ); # ok
$temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok
The tempfile path object will be normalized to have an absolute path, even if
created in a relative directory using C<DIR>. If you want it to have
the C<realpath> instead, pass a leading options hash like this:
$real_temp = tempfile({realpath => 1}, @options);
C<tempdir> is just like C<tempfile>, except it calls
C<< File::Temp->newdir >> instead.
Both C<tempfile> and C<tempdir> may be exported on request and used as
functions instead of as methods.
The methods can be called on an instances representing a
directory. In this case, the directory is used as the base to create the
temporary file/directory, setting the C<DIR> option in File::Temp.
my $target_dir = path('/to/destination');
my $tempfile = $target_dir->tempfile('foobarXXXXXX');
$tempfile->spew('A lot of data...'); # not atomic
$tempfile->move($target_dir->child('foobar')); # hopefully atomic
In this case, any value set for option C<DIR> is ignored.
B<Note>: for tempfiles, the filehandles from File::Temp are closed and not
reused. This is not as secure as using File::Temp handles directly, but is
less prone to deadlocks or access problems on some platforms. Think of what
C<Path::Tiny> gives you to be just a temporary file B<name> that gets cleaned
up.
B<Note 2>: if you don't want these cleaned up automatically when the object
is destroyed, File::Temp requires different options for directories and
files. Use C<< CLEANUP => 0 >> for directories and C<< UNLINK => 0 >> for
files.
B<Note 3>: Don't lose the temporary object by chaining a method call instead
of storing it:
my $lost = tempdir()->child("foo"); # tempdir cleaned up right away
B<Note 4>: The cached object may be accessed with the L</cached_temp> method.
Keeping a reference to, or modifying the cached object may break the
behavior documented above and is not supported. Use at your own risk.
Current API available since 0.119.
=head1 METHODS
=head2 absolute
$abs = path("foo/bar")->absolute;
$abs = path("foo/bar")->absolute("/tmp");
Returns a new C<Path::Tiny> object with an absolute path (or itself if already
absolute). If no argument is given, the current directory is used as the
absolute base path. If an argument is given, it will be converted to an
absolute path (if it is not already) and used as the absolute base path.
This will not resolve upward directories ("foo/../bar") unless C<canonpath>
in L<File::Spec> would normally do so on your platform. If you need them
resolved, you must call the more expensive C<realpath> method instead.
On Windows, an absolute path without a volume component will have it added
based on the current drive.
Current API available since 0.101.
=head2 append, append_raw, append_utf8
path("foo.txt")->append(@data);
path("foo.txt")->append(\@data);
path("foo.txt")->append({binmode => ":raw"}, @data);
path("foo.txt")->append_raw(@data);
path("foo.txt")->append_utf8(@data);
Appends data to a file. The file is locked with C<flock> prior to writing
and closed afterwards. An optional hash reference may be used to pass
options. Valid options are:
=over 4
=item *
C<binmode>: passed to C<binmode()> on the handle used for writing.
=item *
C<truncate>: truncates the file after locking and before appending
=back
The C<truncate> option is a way to replace the contents of a file
B<in place>, unlike L</spew> which writes to a temporary file and then
replaces the original (if it exists).
C<append_raw> is like C<append> with a C<binmode> of C<:unix> for a fast,
unbuffered, raw write.
C<append_utf8> is like C<append> with an unbuffered C<binmode>
C<:unix:encoding(UTF-8)> (or C<:unix:utf8_strict> with
L<PerlIO::utf8_strict>). If L<Unicode::UTF8> 0.58+ is installed, an
unbuffered, raw append will be done instead on the data encoded with
C<Unicode::UTF8>.
Current API available since 0.060.
=head2 assert
$path = path("foo.txt")->assert( sub { $_->exists } );
Returns the invocant after asserting that a code reference argument returns
true. When the assertion code reference runs, it will have the invocant
object in the C<$_> variable. If it returns false, an exception will be
thrown. The assertion code reference may also throw its own exception.
If no assertion is provided, the invocant is returned without error.
Current API available since 0.062.
=head2 basename
$name = path("foo/bar.txt")->basename; # bar.txt
$name = path("foo.txt")->basename('.txt'); # foo
$name = path("foo.txt")->basename(qr/.txt/); # foo
$name = path("foo.txt")->basename(@suffixes);
Returns the file portion or last directory portion of a path.
Given a list of suffixes as strings or regular expressions, any that match at
the end of the file portion or last directory portion will be removed before
the result is returned.
Current API available since 0.054.
=head2 canonpath
$canonical = path("foo/bar")->canonpath; # foo\bar on Windows
Returns a string with the canonical format of the path name for
the platform. In particular, this means directory separators
will be C<\> on Windows.
Current API available since 0.001.
=head2 cached_temp
Returns the cached C<File::Temp> or C<File::Temp::Dir> object if the
C<Path::Tiny> object was created with C</tempfile> or C</tempdir>.
If there is no such object, this method throws.
B<WARNING>: Keeping a reference to, or modifying the cached object may
break the behavior documented for temporary files and directories created
with C<Path::Tiny> and is not supported. Use at your own risk.
Current API available since 0.101.
=head2 child
$file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt"
$file = path("/tmp")->child(@parts);
Returns a new C<Path::Tiny> object relative to the original. Works
like C<catfile> or C<catdir> from File::Spec, but without caring about
file or directories.
B<WARNING>: because the argument could contain C<..> or refer to symlinks,
there is no guarantee that the new path refers to an actual descendent of
the original. If this is important to you, transform parent and child with
L</realpath> and check them with L</subsumes>.
Current API available since 0.001.
=head2 children
@paths = path("/tmp")->children;
@paths = path("/tmp")->children( qr/\.txt\z/ );
Returns a list of C<Path::Tiny> objects for all files and directories
within a directory. Excludes "." and ".." automatically.
If an optional C<qr//> argument is provided, it only returns objects for child
names that match the given regular expression. Only the base name is used
for matching:
@paths = path("/tmp")->children( qr/^foo/ );
# matches children like the glob foo*
Current API available since 0.028.
=head2 chmod
path("foo.txt")->chmod(0777);
path("foo.txt")->chmod("0755");
path("foo.txt")->chmod("go-w");
path("foo.txt")->chmod("a=r,u+wx");
Sets file or directory permissions. The argument can be a numeric mode, a
octal string beginning with a "0" or a limited subset of the symbolic mode use
by F</bin/chmod>.
The symbolic mode must be a comma-delimited list of mode clauses. Clauses must
match C<< qr/\A([augo]+)([=+-])([rwx]+)\z/ >>, which defines "who", "op" and
"perms" parameters for each clause. Unlike F</bin/chmod>, all three parameters
are required for each clause, multiple ops are not allowed and permissions
C<stugoX> are not supported. (See L<File::chmod> for more complex needs.)
Current API available since 0.053.
=head2 copy
path("/tmp/foo.txt")->copy("/tmp/bar.txt");
Copies the current path to the given destination using L<File::Copy>'s
C<copy> function. Upon success, returns the C<Path::Tiny> object for the
newly copied file.
Current API available since 0.070.
=head2 digest
$obj = path("/tmp/foo.txt")->digest; # SHA-256
$obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected
$obj = path("/tmp/foo.txt")->digest( { chunk_size => 1e6 }, "MD5" );
Returns a hexadecimal digest for a file. An optional hash reference of options may
be given. The only option is C<chunk_size>. If C<chunk_size> is given, that many
bytes will be read at a time. If not provided, the entire file will be slurped
into memory to compute the digest.
Any subsequent arguments are passed to the constructor for L<Digest> to select
an algorithm. If no arguments are given, the default is SHA-256.
Current API available since 0.056.
=head2 dirname (deprecated)
$name = path("/tmp/foo.txt")->dirname; # "/tmp/"
Returns the directory portion you would get from calling
C<< File::Spec->splitpath( $path->stringify ) >> or C<"."> for a path without a
parent directory portion. Because L<File::Spec> is inconsistent, the result
might or might not have a trailing slash. Because of this, this method is
B<deprecated>.
A better, more consistently approach is likely C<< $path->parent->stringify >>,
which will not have a trailing slash except for a root directory.
Deprecated in 0.056.
=head2 edit, edit_raw, edit_utf8
path("foo.txt")->edit( \&callback, $options );
path("foo.txt")->edit_utf8( \&callback );
path("foo.txt")->edit_raw( \&callback );
These are convenience methods that allow "editing" a file using a single
callback argument. They slurp the file using C<slurp>, place the contents
inside a localized C<$_> variable, call the callback function (without
arguments), and then write C<$_> (presumably mutated) back to the
file with C<spew>.
An optional hash reference may be used to pass options. The only option is
C<binmode>, which is passed to C<slurp> and C<spew>.
C<edit_utf8> and C<edit_raw> act like their respective C<slurp_*> and
C<spew_*> methods.
Current API available since 0.077.
=head2 edit_lines, edit_lines_utf8, edit_lines_raw
path("foo.txt")->edit_lines( \&callback, $options );
path("foo.txt")->edit_lines_utf8( \&callback );
path("foo.txt")->edit_lines_raw( \&callback );
These are convenience methods that allow "editing" a file's lines using a
single callback argument. They iterate over the file: for each line, the
line is put into a localized C<$_> variable, the callback function is
executed (without arguments) and then C<$_> is written to a temporary file.
When iteration is finished, the temporary file is atomically renamed over
the original.
An optional hash reference may be used to pass options. The only option is
C<binmode>, which is passed to the method that open handles for reading and
writing.
C<edit_lines_raw> is like C<edit_lines> with a buffered C<binmode> of
C<:raw>.
C<edit_lines_utf8> is like C<edit_lines> with a buffered C<binmode>
C<:raw:encoding(UTF-8)> (or C<:raw:utf8_strict> with
L<PerlIO::utf8_strict>).
Current API available since 0.077.
=head2 exists, is_file, is_dir
if ( path("/tmp")->exists ) { ... } # -e
if ( path("/tmp")->is_dir ) { ... } # -d
if ( path("/tmp")->is_file ) { ... } # -e && ! -d
Implements file test operations, this means the file or directory actually has
to exist on the filesystem. Until then, it's just a path.
B<Note>: C<is_file> is not C<-f> because C<-f> is not the opposite of C<-d>.
C<-f> means "plain file", excluding symlinks, devices, etc. that often can be
read just like files.
Use C<-f> instead if you really mean to check for a plain file.
Current API available since 0.053.
=head2 filehandle
$fh = path("/tmp/foo.txt")->filehandle($mode, $binmode);
$fh = path("/tmp/foo.txt")->filehandle({ locked => 1 }, $mode, $binmode);
$fh = path("/tmp/foo.txt")->filehandle({ exclusive => 1 }, $mode, $binmode);
Returns an open file handle. The C<$mode> argument must be a Perl-style
read/write mode string ("<" ,">", ">>", etc.). If a C<$binmode>
is given, it is set during the C<open> call.
An optional hash reference may be used to pass options.
The C<locked> option governs file locking; if true, handles opened for writing,
appending or read-write are locked with C<LOCK_EX>; otherwise, they are
locked with C<LOCK_SH>. When using C<locked>, ">" or "+>" modes will delay
truncation until after the lock is acquired.
The C<exclusive> option causes the open() call to fail if the file already
exists. This corresponds to the O_EXCL flag to sysopen / open(2).
C<exclusive> implies C<locked> and will set it for you if you forget it.
See C<openr>, C<openw>, C<openrw>, and C<opena> for sugar.
Current API available since 0.066.
=head2 has_same_bytes
if ( path("foo.txt")->has_same_bytes("bar.txt") ) {
# ...
}
This method returns true if both the invocant and the argument can be opened as
file handles and the handles contain the same bytes. It returns false if their
contents differ. If either can't be opened as a file (e.g. a directory or
non-existent file), the method throws an exception. If both can be opened and
both have the same C<realpath>, the method returns true without scanning any
data.
Current API available since 0.125.
=head2 is_absolute, is_relative
if ( path("/tmp")->is_absolute ) { ... }
if ( path("/tmp")->is_relative ) { ... }
Booleans for whether the path appears absolute or relative.
Current API available since 0.001.
=head2 is_rootdir
while ( ! $path->is_rootdir ) {
$path = $path->parent;
...
}
Boolean for whether the path is the root directory of the volume. I.e. the
C<dirname> is C<q[/]> and the C<basename> is C<q[]>.
This works even on C<MSWin32> with drives and UNC volumes:
path("C:/")->is_rootdir; # true
path("//server/share/")->is_rootdir; #true
Current API available since 0.038.
=head2 iterator
$iter = path("/tmp")->iterator( \%options );
Returns a code reference that walks a directory lazily. Each invocation
returns a C<Path::Tiny> object or undef when the iterator is exhausted.
$iter = path("/tmp")->iterator;
while ( $path = $iter->() ) {
...
}
The current and parent directory entries ("." and "..") will not
be included.
If the C<recurse> option is true, the iterator will walk the directory
recursively, breadth-first. If the C<follow_symlinks> option is also true,
directory links will be followed recursively. There is no protection against
loops when following links. If a directory is not readable, it will not be
followed.
The default is the same as:
$iter = path("/tmp")->iterator( {
recurse => 0,
follow_symlinks => 0,
} );
For a more powerful, recursive iterator with built-in loop avoidance, see
L<Path::Iterator::Rule>.
See also L</visit>.
Current API available since 0.016.
=head2 lines, lines_raw, lines_utf8
@contents = path("/tmp/foo.txt")->lines;
@contents = path("/tmp/foo.txt")->lines(\%options);
@contents = path("/tmp/foo.txt")->lines_raw;
@contents = path("/tmp/foo.txt")->lines_utf8;
@contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } );
Returns a list of lines from a file. Optionally takes a hash-reference of
options. Valid options are C<binmode>, C<count> and C<chomp>.
If C<binmode> is provided, it will be set on the handle prior to reading.
If a positive C<count> is provided, that many lines will be returned from the
start of the file. If a negative C<count> is provided, the entire file will be
read, but only C<abs(count)> will be kept and returned. If C<abs(count)>
exceeds the number of lines in the file, all lines will be returned.
If C<chomp> is set, any end-of-line character sequences (C<CR>, C<CRLF>, or
C<LF>) will be removed from the lines returned.
Because the return is a list, C<lines> in scalar context will return the number
of lines (and throw away the data).
$number_of_lines = path("/tmp/foo.txt")->lines;
C<lines_raw> is like C<lines> with a C<binmode> of C<:raw>. We use C<:raw>
instead of C<:unix> so PerlIO buffering can manage reading by line.
C<lines_utf8> is like C<lines> with a C<binmode> of C<:raw:encoding(UTF-8)>
(or C<:raw:utf8_strict> with L<PerlIO::utf8_strict>). If L<Unicode::UTF8>
0.58+ is installed, a raw, unbuffered UTF-8 slurp will be done and then the
lines will be split. This is actually faster than relying on
IO layers, though a bit memory intensive. If memory use is a
concern, consider C<openr_utf8> and iterating directly on the handle.
Current API available since 0.065.
=head2 mkdir
path("foo/bar/baz")->mkdir;
path("foo/bar/baz")->mkdir( \%options );
Like calling C<make_path> from L<File::Path>. An optional hash reference
is passed through to C<make_path>. Errors will be trapped and an exception
thrown. Returns the the path object to facilitate chaining.
B<NOTE>: unlike Perl's builtin C<mkdir>, this will create intermediate paths
similar to the Unix C<mkdir -p> command. It will not error if applied to an
existing directory.
Current API available since 0.125.
=head2 mkpath (deprecated)
Like calling C<mkdir>, but returns the list of directories created or an empty list if
the directories already exist, just like C<make_path>.
Deprecated in 0.125.
=head2 move
path("foo.txt")->move("bar.txt");
Moves the current path to the given destination using L<File::Copy>'s
C<move> function. Upon success, returns the C<Path::Tiny> object for the
newly moved file.
If the destination already exists and is a directory, and the source is not a
directory, then the source file will be renamed into the directory
specified by the destination.
If possible, move() will simply rename the file. Otherwise, it
copies the file to the new location and deletes the original. If an
error occurs during this copy-and-delete process, you may be left
with a (possibly partial) copy of the file under the destination
name.
Current API available since 0.124. Prior versions used Perl's
-built-in (and less robust) L<rename|perlfunc/rename> function
and did not return an object.
=head2 openr, openw, openrw, opena
$fh = path("foo.txt")->openr($binmode); # read
$fh = path("foo.txt")->openr_raw;
$fh = path("foo.txt")->openr_utf8;
$fh = path("foo.txt")->openw($binmode); # write
$fh = path("foo.txt")->openw_raw;
$fh = path("foo.txt")->openw_utf8;
$fh = path("foo.txt")->opena($binmode); # append
$fh = path("foo.txt")->opena_raw;
$fh = path("foo.txt")->opena_utf8;
$fh = path("foo.txt")->openrw($binmode); # read/write
$fh = path("foo.txt")->openrw_raw;
$fh = path("foo.txt")->openrw_utf8;
Returns a file handle opened in the specified mode. The C<openr> style methods
take a single C<binmode> argument. All of the C<open*> methods have
C<open*_raw> and C<open*_utf8> equivalents that use buffered I/O layers C<:raw>
and C<:raw:encoding(UTF-8)> (or C<:raw:utf8_strict> with
L<PerlIO::utf8_strict>).
An optional hash reference may be used to pass options. The only option is
C<locked>. If true, handles opened for writing, appending or read-write are
locked with C<LOCK_EX>; otherwise, they are locked for C<LOCK_SH>.
$fh = path("foo.txt")->openrw_utf8( { locked => 1 } );
See L</filehandle> for more on locking.
Current API available since 0.011.
=head2 parent
$parent = path("foo/bar/baz")->parent; # foo/bar
$parent = path("foo/wibble.txt")->parent; # foo
$parent = path("foo/bar/baz")->parent(2); # foo
Returns a C<Path::Tiny> object corresponding to the parent directory of the
original directory or file. An optional positive integer argument is the number
of parent directories upwards to return. C<parent> by itself is equivalent to
C<parent(1)>.
Current API available since 0.014.
=head2 realpath
$real = path("/baz/foo/../bar")->realpath;
$real = path("foo/../bar")->realpath;
Returns a new C<Path::Tiny> object with all symbolic links and upward directory
parts resolved using L<Cwd>'s C<realpath>. Compared to C<absolute>, this is
more expensive as it must actually consult the filesystem.
If the parent path can't be resolved (e.g. if it includes directories that
don't exist), an exception will be thrown:
$real = path("doesnt_exist/foo")->realpath; # dies
However, if the parent path exists and only the last component (e.g. filename)
doesn't exist, the realpath will be the realpath of the parent plus the
non-existent last component:
$real = path("./aasdlfasdlf")->realpath; # works
The underlying L<Cwd> module usually worked this way on Unix, but died on
Windows (and some Unixes) if the full path didn't exist. As of version 0.064,
it's safe to use anywhere.
Current API available since 0.001.
=head2 relative
$rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar
Returns a C<Path::Tiny> object with a path relative to a new base path
given as an argument. If no argument is given, the current directory will
be used as the new base path.
If either path is already relative, it will be made absolute based on the
current directly before determining the new relative path.
The algorithm is roughly as follows:
=over 4
=item *
If the original and new base path are on different volumes, an exception will be thrown.
=item *
If the original and new base are identical, the relative path is C<".">.
=item *
If the new base subsumes the original, the relative path is the original path with the new base chopped off the front
=item *
If the new base does not subsume the original, a common prefix path is determined (possibly the root directory) and the relative path will consist of updirs (C<"..">) to reach the common prefix, followed by the original path less the common prefix.
=back
Unlike C<File::Spec::abs2rel>, in the last case above, the calculation based
on a common prefix takes into account symlinks that could affect the updir
process. Given an original path "/A/B" and a new base "/A/C",
(where "A", "B" and "C" could each have multiple path components):
=over 4
=item *
Symlinks in "A" don't change the result unless the last component of A is a symlink and the first component of "C" is an updir.
=item *
Symlinks in "B" don't change the result and will exist in the result as given.
=item *
Symlinks and updirs in "C" must be resolved to actual paths, taking into account the possibility that not all path components might exist on the filesystem.
=back
Current API available since 0.001. New algorithm (that accounts for
symlinks) available since 0.079.
=head2 remove
path("foo.txt")->remove;
This is just like C<unlink>, except for its error handling: if the path does
not exist, it returns false; if deleting the file fails, it throws an
exception.
Current API available since 0.012.
=head2 remove_tree
# directory
path("foo/bar/baz")->remove_tree;
path("foo/bar/baz")->remove_tree( \%options );
path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove
Like calling C<remove_tree> from L<File::Path>, but defaults to C<safe> mode.
An optional hash reference is passed through to C<remove_tree>. Errors will be
trapped and an exception thrown. Returns the number of directories deleted,
just like C<remove_tree>.
If you want to remove a directory only if it is empty, use the built-in
C<rmdir> function instead.
rmdir path("foo/bar/baz/");
Current API available since 0.013.
=head2 sibling
$foo = path("/tmp/foo.txt");
$sib = $foo->sibling("bar.txt"); # /tmp/bar.txt
$sib = $foo->sibling("baz", "bam.txt"); # /tmp/baz/bam.txt
Returns a new C<Path::Tiny> object relative to the parent of the original.
This is slightly more efficient than C<< $path->parent->child(...) >>.
Current API available since 0.058.
=head2 size, size_human
my $p = path("foo"); # with size 1025 bytes
$p->size; # "1025"
$p->size_human; # "1.1 K"
$p->size_human( {format => "iec"} ); # "1.1 KiB"
Returns the size of a file. The C<size> method is just a wrapper around C<-s>.
The C<size_human> method provides a human-readable string similar to
C<ls -lh>. Like C<ls>, it rounds upwards and provides one decimal place for
single-digit sizes and no decimal places for larger sizes. The only available
option is C<format>, which has three valid values:
=over 4
=item *
'ls' (the default): base-2 sizes, with C<ls> style single-letter suffixes (K, M, etc.)
=item *
'iec': base-2 sizes, with IEC binary suffixes (KiB, MiB, etc.)
=item *
'si': base-10 sizes, with SI decimal suffixes (kB, MB, etc.)
=back
If C<-s> would return C<undef>, C<size_human> returns the empty string.
Current API available since 0.122.
=head2 slurp, slurp_raw, slurp_utf8
$data = path("foo.txt")->slurp;
$data = path("foo.txt")->slurp( {binmode => ":raw"} );
$data = path("foo.txt")->slurp_raw;
$data = path("foo.txt")->slurp_utf8;
Reads file contents into a scalar. Takes an optional hash reference which may
be used to pass options. The only available option is C<binmode>, which is
passed to C<binmode()> on the handle used for reading.
C<slurp_raw> is like C<slurp> with a C<binmode> of C<:unix> for
a fast, unbuffered, raw read.
C<slurp_utf8> is like C<slurp> with a C<binmode> of
C<:unix:encoding(UTF-8)> (or C<:unix:utf8_strict> with
L<PerlIO::utf8_strict>). If L<Unicode::UTF8> 0.58+ is installed, a
unbuffered, raw slurp will be done instead and the result decoded with
C<Unicode::UTF8>. This is just as strict and is roughly an order of
magnitude faster than using C<:encoding(UTF-8)>.
B<Note>: C<slurp> and friends lock the filehandle before slurping. If
you plan to slurp from a file created with L<File::Temp>, be sure to
close other handles or open without locking to avoid a deadlock:
my $tempfile = File::Temp->new(EXLOCK => 0);
my $guts = path($tempfile)->slurp;
Current API available since 0.004.
=head2 spew, spew_raw, spew_utf8
path("foo.txt")->spew(@data);
path("foo.txt")->spew(\@data);
path("foo.txt")->spew({binmode => ":raw"}, @data);
path("foo.txt")->spew_raw(@data);
path("foo.txt")->spew_utf8(@data);
Writes data to a file atomically. The file is written to a temporary file in
the same directory, then renamed over the original. An optional hash reference
may be used to pass options. The only option is C<binmode>, which is passed to
C<binmode()> on the handle used for writing.
C<spew_raw> is like C<spew> with a C<binmode> of C<:unix> for a fast,
unbuffered, raw write.
C<spew_utf8> is like C<spew> with a C<binmode> of C<:unix:encoding(UTF-8)>
(or C<:unix:utf8_strict> with L<PerlIO::utf8_strict>). If L<Unicode::UTF8>
0.58+ is installed, a raw, unbuffered spew will be done instead on the data
encoded with C<Unicode::UTF8>.
B<NOTE>: because the file is written to a temporary file and then renamed, the
new file will wind up with permissions based on your current umask. This is a
feature to protect you from a race condition that would otherwise give
different permissions than you might expect. If you really want to keep the
original mode flags, use L</append> with the C<truncate> option.
Current API available since 0.011.
=head2 stat, lstat
$stat = path("foo.txt")->stat;
$stat = path("/some/symlink")->lstat;
Like calling C<stat> or C<lstat> from L<File::stat>.
Current API available since 0.001.
=head2 stringify
$path = path("foo.txt");
say $path->stringify; # same as "$path"
Returns a string representation of the path. Unlike C<canonpath>, this method
returns the path standardized with Unix-style C</> directory separators.
Current API available since 0.001.
=head2 subsumes
path("foo/bar")->subsumes("foo/bar/baz"); # true
path("/foo/bar")->subsumes("/foo/baz"); # false
Returns true if the first path is a prefix of the second path at a directory
boundary.
This B<does not> resolve parent directory entries (C<..>) or symlinks:
path("foo/bar")->subsumes("foo/bar/../baz"); # true
If such things are important to you, ensure that both paths are resolved to
the filesystem with C<realpath>:
my $p1 = path("foo/bar")->realpath;
my $p2 = path("foo/bar/../baz")->realpath;
if ( $p1->subsumes($p2) ) { ... }
Current API available since 0.048.
=head2 touch
path("foo.txt")->touch;
path("foo.txt")->touch($epoch_secs);
Like the Unix C<touch> utility. Creates the file if it doesn't exist, or else
changes the modification and access times to the current time. If the first
argument is the epoch seconds then it will be used.
Returns the path object so it can be easily chained with other methods:
# won't die if foo.txt doesn't exist
$content = path("foo.txt")->touch->slurp;
Current API available since 0.015.
=head2 touchpath
path("bar/baz/foo.txt")->touchpath;
Combines C<mkdir> and C<touch>. Creates the parent directory if it doesn't exist,
before touching the file. Returns the path object like C<touch> does.
If you need to pass options, use C<mkdir> and C<touch> separately:
path("bar/baz")->mkdir( \%options )->child("foo.txt")->touch($epoch_secs);
Current API available since 0.022.
=head2 visit
path("/tmp")->visit( \&callback, \%options );
Executes a callback for each child of a directory. It returns a hash
reference with any state accumulated during iteration.
The options are the same as for L</iterator> (which it uses internally):
C<recurse> and C<follow_symlinks>. Both default to false.
The callback function will receive a C<Path::Tiny> object as the first argument
and a hash reference to accumulate state as the second argument. For example:
# collect files sizes
my $sizes = path("/tmp")->visit(
sub {
my ($path, $state) = @_;
return if $path->is_dir;
$state->{$path} = -s $path;
},
{ recurse => 1 }
);
For convenience, the C<Path::Tiny> object will also be locally aliased as the
C<$_> global variable:
# print paths matching /foo/
path("/tmp")->visit( sub { say if /foo/ }, { recurse => 1} );
If the callback returns a B<reference> to a false scalar value, iteration will
terminate. This is not the same as "pruning" a directory search; this just
stops all iteration and returns the state hash reference.
# find up to 10 files larger than 100K
my $files = path("/tmp")->visit(
sub {
my ($path, $state) = @_;
$state->{$path}++ if -s $path > 102400
return \0 if keys %$state == 10;
},
{ recurse => 1 }
);
If you want more flexible iteration, use a module like L<Path::Iterator::Rule>.
Current API available since 0.062.
=head2 volume
$vol = path("/tmp/foo.txt")->volume; # ""
$vol = path("C:/tmp/foo.txt")->volume; # "C:"
Returns the volume portion of the path. This is equivalent
to what L<File::Spec> would give from C<splitpath> and thus
usually is the empty string on Unix-like operating systems or the
drive letter for an absolute path on C<MSWin32>.
Current API available since 0.001.
=for Pod::Coverage openr_utf8 opena_utf8 openw_utf8 openrw_utf8
openr_raw opena_raw openw_raw openrw_raw
IS_WIN32 FREEZE THAW TO_JSON abs2rel
=head1 EXCEPTION HANDLING
Simple usage errors will generally croak. Failures of underlying Perl
functions will be thrown as exceptions in the class
C<Path::Tiny::Error>.
A C<Path::Tiny::Error> object will be a hash reference with the following fields:
=over 4
=item *
C<op> — a description of the operation, usually function call and any extra info
=item *
C<file> — the file or directory relating to the error
=item *
C<err> — hold C<$!> at the time the error was thrown
=item *
C<msg> — a string combining the above data and a Carp-like short stack trace
=back
Exception objects will stringify as the C<msg> field.
=head1 ENVIRONMENT
=head2 PERL_PATH_TINY_NO_FLOCK
If the environment variable C<PERL_PATH_TINY_NO_FLOCK> is set to a true
value then flock will NOT be used when accessing files (this is not
recommended).
=head1 CAVEATS
=head2 Subclassing not supported
For speed, this class is implemented as an array based object and uses many
direct function calls internally. You must not subclass it and expect
things to work properly.
=head2 Tilde expansion (deprecated)
Tilde expansion was a nice idea, but it can't easily be applied consistently
across the entire API. This was a source of bugs and confusion for users.
Therefore, it is B<deprecated> and its use is discouraged. Limitations to the
existing, legacy behavior follow.
Tilde expansion will only occur if the B<first> argument to C<path> begins with
a tilde. B<No other method does tilde expansion on its arguments>. If you want
tilde expansion on arguments, you must explicitly wrap them in a call to
C<path>.
path( "~/foo.txt" )->copy( path( "~/bar.txt" ) );
If you need a literal leading tilde, use C<path("./~whatever")> so that the
argument to C<path> doesn't start with a tilde, but the path still resolves to
the current directory.
Behaviour of tilde expansion with a username for non-existent users depends on
the output of C<glob> on the system.
=head2 File locking
If flock is not supported on a platform, it will not be used, even if
locking is requested.
In situations where a platform normally would support locking, but the
flock fails due to a filesystem limitation, Path::Tiny has some heuristics
to detect this and will warn once and continue in an unsafe mode. If you
want this failure to be fatal, you can fatalize the 'flock' warnings
category:
use warnings FATAL => 'flock';
See additional caveats below.
=head3 NFS and BSD
On BSD, Perl's flock implementation may not work to lock files on an
NFS filesystem. If detected, this situation will warn once, as described
above.
=head3 Lustre
The Lustre filesystem does not support flock. If detected, this situation
will warn once, as described above.
=head3 AIX and locking
AIX requires a write handle for locking. Therefore, calls that normally
open a read handle and take a shared lock instead will open a read-write
handle and take an exclusive lock. If the user does not have write
permission, no lock will be used.
=head2 utf8 vs UTF-8
All the C<*_utf8> methods by default use C<:encoding(UTF-8)> -- either as
C<:unix:encoding(UTF-8)> (unbuffered, for whole file operations) or
C<:raw:encoding(UTF-8)> (buffered, for line-by-line operations). These are
strict against the Unicode spec and disallows illegal Unicode codepoints or
UTF-8 sequences.
Unfortunately, C<:encoding(UTF-8)> is very, very slow. If you install
L<Unicode::UTF8> 0.58 or later, that module will be used by some C<*_utf8>
methods to encode or decode data after a raw, binary input/output operation,
which is much faster. Alternatively, if you install L<PerlIO::utf8_strict>,
that will be used instead of C<:encoding(UTF-8)> and is also very fast.
If you need the performance and can accept the security risk,
C<< slurp({binmode => ":unix:utf8"}) >> will be faster than C<:unix:encoding(UTF-8)>
(but not as fast as C<Unicode::UTF8>).
Note that the C<*_utf8> methods read in B<raw> mode. There is no CRLF
translation on Windows. If you must have CRLF translation, use the regular
input/output methods with an appropriate binmode:
$path->spew_utf8($data); # raw
$path->spew({binmode => ":encoding(UTF-8)"}, $data; # LF -> CRLF
=head2 Default IO layers and the open pragma
If you have Perl 5.10 or later, file input/output methods (C<slurp>, C<spew>,
etc.) and high-level handle opening methods ( C<filehandle>, C<openr>,
C<openw>, etc. ) respect default encodings set by the C<-C> switch or lexical
L<open> settings of the caller. For UTF-8, this is almost certainly slower
than using the dedicated C<_utf8> methods if you have L<Unicode::UTF8> or
L<PerlIP::utf8_strict>.
=head1 TYPE CONSTRAINTS AND COERCION
A standard L<MooseX::Types> library is available at
L<MooseX::Types::Path::Tiny>. A L<Type::Tiny> equivalent is available as
L<Types::Path::Tiny>.
=head1 SEE ALSO
These are other file/path utilities, which may offer a different feature
set than C<Path::Tiny>.
=over 4
=item *
L<File::chmod>
=item *
L<File::Fu>
=item *
L<IO::All>
=item *
L<Path::Class>
=back
These iterators may be slightly faster than the recursive iterator in
C<Path::Tiny>:
=over 4
=item *
L<Path::Iterator::Rule>
=item *
L<File::Next>
=back
There are probably comparable, non-Tiny tools. Let me know if you want me to
add a module to the list.
This module was featured in the L<2013 Perl Advent Calendar|http://www.perladvent.org/2013/2013-12-18.html>.
=for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/dagolden/Path-Tiny/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
L<https://github.com/dagolden/Path-Tiny>
git clone https://github.com/dagolden/Path-Tiny.git
=head1 AUTHOR
David Golden <dagolden@cpan.org>
=head1 CONTRIBUTORS
=for stopwords Alex Efros Aristotle Pagaltzis Chris Williams Dan Book Dave Rolsky David Steinbrunner Doug Bell Elvin Aslanov Flavio Poletti Gabor Szabo Gabriel Andrade George Hartzell Geraud Continsouzas Goro Fuji Graham Knop Ollis Ian Sillitoe James Hunt John Karr Karen Etheridge Mark Ellis Martin H. Sluka Kjeldsen Mary Ehlers Michael G. Schwern Nicolas R Rochelemagne Nigel Gregoire Philippe Bruhat (BooK) regina-verbae Roy Ivy III Shlomi Fish Smylers Tatsuhiko Miyagawa Toby Inkster Yanick Champoux 김도형 - Keedi Kim
=over 4
=item *
Alex Efros <powerman@powerman.name>
=item *
Aristotle Pagaltzis <pagaltzis@gmx.de>
=item *
Chris Williams <bingos@cpan.org>
=item *
Dan Book <grinnz@grinnz.com>
=item *
Dave Rolsky <autarch@urth.org>
=item *
David Steinbrunner <dsteinbrunner@pobox.com>
=item *
Doug Bell <madcityzen@gmail.com>
=item *
Elvin Aslanov <rwp.primary@gmail.com>
=item *
Flavio Poletti <flavio@polettix.it>
=item *
Gabor Szabo <szabgab@cpan.org>
=item *
Gabriel Andrade <gabiruh@gmail.com>
=item *
George Hartzell <hartzell@cpan.org>
=item *
Geraud Continsouzas <geraud@scsi.nc>
=item *
Goro Fuji <gfuji@cpan.org>
=item *
Graham Knop <haarg@haarg.org>
=item *
Graham Ollis <plicease@cpan.org>
=item *
Ian Sillitoe <ian@sillit.com>
=item *
James Hunt <james@niftylogic.com>
=item *
John Karr <brainbuz@brainbuz.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Mark Ellis <mark.ellis@cartridgesave.co.uk>
=item *
Martin H. Sluka <fany@cpan.org>
=item *
Martin Kjeldsen <mk@bluepipe.dk>
=item *
Mary Ehlers <regina.verb.ae@gmail.com>
=item *
Michael G. Schwern <mschwern@cpan.org>
=item *
Nicolas R <nicolas@atoomic.org>
=item *
Nicolas Rochelemagne <rochelemagne@cpanel.net>
=item *
Nigel Gregoire <nigelgregoire@gmail.com>
=item *
Philippe Bruhat (BooK) <book@cpan.org>
=item *
regina-verbae <regina-verbae@users.noreply.github.com>
=item *
Roy Ivy III <rivy@cpan.org>
=item *
Shlomi Fish <shlomif@shlomifish.org>
=item *
Smylers <Smylers@stripey.com>
=item *
Tatsuhiko Miyagawa <miyagawa@bulknews.net>
=item *
Toby Inkster <tobyink@cpan.org>
=item *
Yanick Champoux <yanick@babyl.dyndns.org>
=item *
김도형 - Keedi Kim <keedi@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2014 by David Golden.
This is free software, licensed under:
The Apache License, Version 2.0, January 2004
=cut
perl5/5.32/AppConfig/Args.pm 0000444 00000016761 15157556134 0011307 0 ustar 00 #============================================================================
#
# AppConfig::Args.pm
#
# Perl5 module to read command line argument and update the variable
# values in an AppConfig::State object accordingly.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#============================================================================
package AppConfig::Args;
use 5.006;
use strict;
use warnings;
use AppConfig::State;
our $VERSION = '1.71';
#------------------------------------------------------------------------
# new($state, \@args)
#
# Module constructor. The first, mandatory parameter should be a
# reference to an AppConfig::State object to which all actions should
# be applied. The second parameter may be a reference to a list of
# command line arguments. This list reference is passed to args() for
# processing.
#
# Returns a reference to a newly created AppConfig::Args object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $state = shift;
my $self = {
STATE => $state, # AppConfig::State ref
DEBUG => $state->_debug(), # store local copy of debug
PEDANTIC => $state->_pedantic, # and pedantic flags
};
bless $self, $class;
# call parse() to parse any arg list passed
$self->parse(shift)
if @_;
return $self;
}
#------------------------------------------------------------------------
# parse(\@args)
#
# Examines the argument list and updates the contents of the
# AppConfig::State referenced by $self->{ STATE } accordingly. If
# no argument list is provided then the method defaults to examining
# @ARGV. The method reports any warning conditions (such as undefined
# variables) by calling $self->{ STATE }->_error() and then continues to
# examine the rest of the list. If the PEDANTIC option is set in the
# AppConfig::State object, this behaviour is overridden and the method
# returns 0 immediately on any parsing error.
#
# Returns 1 on success or 0 if one or more warnings were raised.
#------------------------------------------------------------------------
sub parse {
my $self = shift;
my $argv = shift || \@ARGV;
my $warnings = 0;
my ($arg, $nargs, $variable, $value);
# take a local copy of the state to avoid much hash dereferencing
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
# loop around arguments
ARG: while (@$argv && $argv->[0] =~ /^-/) {
$arg = shift(@$argv);
# '--' indicates the end of the options
last if $arg eq '--';
# strip leading '-';
($variable = $arg) =~ s/^-(-)?//;
# test for '--' prefix and push back any '=value' item
if (defined $1) {
($variable, $value) = split(/=/, $variable);
unshift(@$argv, $value) if defined $value;
}
# check the variable exists
if ($state->_exists($variable)) {
# see if it expects any mandatory arguments
$nargs = $state->_argcount($variable);
if ($nargs) {
# check there's another arg and it's not another '-opt'
if(defined($argv->[0])) {
$value = shift(@$argv);
}
else {
$state->_error("$arg expects an argument");
$warnings++;
last ARG if $pedantic;
next;
}
}
else {
# set a value of 1 if option doesn't expect an argument
$value = 1;
}
# set the variable with the new value
$state->set($variable, $value);
}
else {
$state->_error("$arg: invalid option");
$warnings++;
last ARG if $pedantic;
}
}
# return status
return $warnings ? 0 : 1;
}
1;
__END__
=head1 NAME
AppConfig::Args - Perl5 module for reading command line arguments.
=head1 SYNOPSIS
use AppConfig::Args;
my $state = AppConfig::State->new(\%cfg);
my $cfgargs = AppConfig::Args->new($state);
$cfgargs->parse(\@args); # read args
=head1 OVERVIEW
AppConfig::Args is a Perl5 module which reads command line arguments and
uses the options therein to update variable values in an AppConfig::State
object.
AppConfig::File is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::Args MODULE
To import and use the AppConfig::Args module the following line should appear
in your Perl script:
use AppConfig::Args;
AppConfig::Args is used automatically if you use the AppConfig module
and create an AppConfig::Args object through the parse() method.
AppConfig::File is implemented using object-oriented methods. A new
AppConfig::Args object is created and initialised using the new() method.
This returns a reference to a new AppConfig::File object. A reference to
an AppConfig::State object should be passed in as the first parameter:
my $state = AppConfig::State->new();
my $cfgargs = AppConfig::Args->new($state);
This will create and return a reference to a new AppConfig::Args object.
=head2 PARSING COMMAND LINE ARGUMENTS
The C<parse()> method is used to read a list of command line arguments and
update the STATE accordingly. A reference to the list of arguments should
be passed in.
$cfgargs->parse(\@ARGV);
If the method is called without a reference to an argument list then it
will examine and manipulate @ARGV.
If the PEDANTIC option is turned off in the AppConfig::State object, any
parsing errors (invalid variables, unvalidated values, etc) will generate
warnings, but not cause the method to return. Having processed all
arguments, the method will return 1 if processed without warning or 0 if
one or more warnings were raised. When the PEDANTIC option is turned on,
the method generates a warning and immediately returns a value of 0 as soon
as it encounters any parsing error.
The method continues parsing arguments until it detects the first one that
does not start with a leading dash, '-'. Arguments that constitute values
for other options are not examined in this way.
=head1 FUTURE DEVELOPMENT
This module was developed to provide backwards compatibility (to some
degree) with the preceeding App::Config module. The argument parsing
it provides is basic but offers a quick and efficient solution for those
times when simple option handling is all that is required.
If you require more flexibility in parsing command line arguments, then
you should consider using the AppConfig::Getopt module. This is loaded
and used automatically by calling the AppConfig getopt() method.
The AppConfig::Getopt module provides considerably extended functionality
over the AppConfig::Args module by delegating out the task of argument
parsing to Johan Vromans' Getopt::Long module. For advanced command-line
parsing, this module (either Getopt::Long by itself, or in conjunction with
AppConfig::Getopt) is highly recommended.
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
AppConfig, AppConfig::State, AppConfig::Getopt, Getopt::Long
=cut
perl5/5.32/AppConfig/CGI.pm 0000444 00000015416 15157556142 0011010 0 ustar 00 #============================================================================
#
# AppConfig::CGI.pm
#
# Perl5 module to provide a CGI interface to AppConfig. Internal variables
# may be set through the CGI "arguments" appended to a URL.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
#============================================================================
package AppConfig::CGI;
use 5.006;
use strict;
use warnings;
use AppConfig::State;
our $VERSION = '1.71';
#------------------------------------------------------------------------
# new($state, $query)
#
# Module constructor. The first, mandatory parameter should be a
# reference to an AppConfig::State object to which all actions should
# be applied. The second parameter may be a string containing a CGI
# QUERY_STRING which is then passed to parse() to process. If no second
# parameter is specifiied then the parse() process is skipped.
#
# Returns a reference to a newly created AppConfig::CGI object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $state = shift;
my $self = {
STATE => $state, # AppConfig::State ref
DEBUG => $state->_debug(), # store local copy of debug
PEDANTIC => $state->_pedantic, # and pedantic flags
};
bless $self, $class;
# call parse(@_) to parse any arg list passed
$self->parse(@_)
if @_;
return $self;
}
#------------------------------------------------------------------------
# parse($query)
#
# Method used to parse a CGI QUERY_STRING and set internal variable
# values accordingly. If a query is not passed as the first parameter,
# then _get_cgi_query() is called to try to determine the query by
# examing the environment as per CGI protocol.
#
# Returns 0 if one or more errors or warnings were raised or 1 if the
# string parsed successfully.
#------------------------------------------------------------------------
sub parse {
my $self = shift;
my $query = shift;
my $warnings = 0;
my ($variable, $value, $nargs);
# take a local copy of the state to avoid much hash dereferencing
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
# get the cgi query if not defined
$query = $ENV{ QUERY_STRING }
unless defined $query;
# no query to process
return 1 unless defined $query;
# we want to install a custom error handler into the AppConfig::State
# which appends filename and line info to error messages and then
# calls the previous handler; we start by taking a copy of the
# current handler..
my $errhandler = $state->_ehandler();
# install a closure as a new error handler
$state->_ehandler(
sub {
# modify the error message
my $format = shift;
$format =~ s/</</g;
$format =~ s/>/>/g;
$format = "<p>\n<b>[ AppConfig::CGI error: </b>$format<b> ] </b>\n<p>\n";
# send error to stdout for delivery to web client
printf($format, @_);
}
);
PARAM: foreach (split('&', $query)) {
# extract parameter and value from query token
($variable, $value) = map { _unescape($_) } split('=');
# check an argument was provided if one was expected
if ($nargs = $state->_argcount($variable)) {
unless (defined $value) {
$state->_error("$variable expects an argument");
$warnings++;
last PARAM if $pedantic;
next;
}
}
# default an undefined value to 1 if ARGCOUNT_NONE
else {
$value = 1 unless defined $value;
}
# set the variable, noting any error
unless ($state->set($variable, $value)) {
$warnings++;
last PARAM if $pedantic;
}
}
# restore original error handler
$state->_ehandler($errhandler);
# return $warnings => 0, $success => 1
return $warnings ? 0 : 1;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The following sub-routine was lifted from Lincoln Stein's CGI.pm
# module, version 2.36. Name has been prefixed by a '_'.
# unescape URL-encoded data
sub _unescape {
my($todecode) = @_;
$todecode =~ tr/+/ /; # pluses become spaces
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
return $todecode;
}
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1;
__END__
=head1 NAME
AppConfig::CGI - Perl5 module for processing CGI script parameters.
=head1 SYNOPSIS
use AppConfig::CGI;
my $state = AppConfig::State->new(\%cfg);
my $cgi = AppConfig::CGI->new($state);
$cgi->parse($cgi_query);
$cgi->parse(); # looks for CGI query in environment
=head1 OVERVIEW
AppConfig::CGI is a Perl5 module which implements a CGI interface to
AppConfig. It examines the QUERY_STRING environment variable, or a string
passed explicitly by parameter, which represents the additional parameters
passed to a CGI query. This is then used to update variable values in an
AppConfig::State object accordingly.
AppConfig::CGI is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::CGI MODULE
To import and use the AppConfig::CGI module the following line should appear
in your Perl script:
use AppConfig::CGI;
AppConfig::CGI is used automatically if you use the AppConfig module
and create an AppConfig::CGI object through the cgi() method.
AppConfig::CGI is implemented using object-oriented methods. A new
AppConfig::CGI object is created and initialised using the new()
method. This returns a reference to a new AppConfig::CGI object. A
reference to an AppConfig::State object should be passed in as the
first parameter:
my $state = AppConfig::State->new();
my $cgi = AppConfig::CGI->new($state);
This will create and return a reference to a new AppConfig::CGI object.
=head2 PARSING CGI QUERIES
The C<parse()> method is used to parse a CGI query which can be specified
explicitly, or is automatically extracted from the "QUERY_STRING" CGI
environment variable. This currently limits the module to only supporting
the GET method.
See AppConfig for information about using the AppConfig::CGI
module via the cgi() method.
=head1 AUTHOR
Andy Wardley, C<E<lt>abw@wardley.org<gt>>
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
AppConfig, AppConfig::State
=cut
perl5/5.32/AppConfig/Sys.pm 0000444 00000017451 15157556147 0011172 0 ustar 00 #============================================================================
#
# AppConfig::Sys.pm
#
# Perl5 module providing platform-specific information and operations as
# required by other AppConfig::* modules.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2003 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
# $Id: Sys.pm,v 1.61 2004/02/04 10:11:23 abw Exp $
#
#============================================================================
package AppConfig::Sys;
use 5.006;
use strict;
use warnings;
use POSIX qw( getpwnam getpwuid );
our $VERSION = '1.71';
our ($AUTOLOAD, $OS, %CAN, %METHOD);
BEGIN {
# define the methods that may be available
if($^O =~ m/win32/i) {
$METHOD{ getpwuid } = sub {
return wantarray()
? ( (undef) x 7, getlogin() )
: getlogin();
};
$METHOD{ getpwnam } = sub {
die("Can't getpwnam on win32");
};
}
else
{
$METHOD{ getpwuid } = sub {
getpwuid( defined $_[0] ? shift : $< );
};
$METHOD{ getpwnam } = sub {
getpwnam( defined $_[0] ? shift : '' );
};
}
# try out each METHOD to see if it's supported on this platform;
# it's important we do this before defining AUTOLOAD which would
# otherwise catch the unresolved call
foreach my $method (keys %METHOD) {
eval { &{ $METHOD{ $method } }() };
$CAN{ $method } = ! $@;
}
}
#------------------------------------------------------------------------
# new($os)
#
# Module constructor. An optional operating system string may be passed
# to explicitly define the platform type.
#
# Returns a reference to a newly created AppConfig::Sys object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $self = {
METHOD => \%METHOD,
CAN => \%CAN,
};
bless $self, $class;
$self->_configure(@_);
return $self;
}
#------------------------------------------------------------------------
# AUTOLOAD
#
# Autoload function called whenever an unresolved object method is
# called. If the method name relates to a METHODS entry, then it is
# called iff the corresponding CAN_$method is set true. If the
# method name relates to a CAN_$method value then that is returned.
#------------------------------------------------------------------------
sub AUTOLOAD {
my $self = shift;
my $method;
# splat the leading package name
($method = $AUTOLOAD) =~ s/.*:://;
# ignore destructor
$method eq 'DESTROY' && return;
# can_method()
if ($method =~ s/^can_//i && exists $self->{ CAN }->{ $method }) {
return $self->{ CAN }->{ $method };
}
# method()
elsif (exists $self->{ METHOD }->{ $method }) {
if ($self->{ CAN }->{ $method }) {
return &{ $self->{ METHOD }->{ $method } }(@_);
}
else {
return undef;
}
}
# variable
elsif (exists $self->{ uc $method }) {
return $self->{ uc $method };
}
else {
warn("AppConfig::Sys->", $method, "(): no such method or variable\n");
}
return undef;
}
#------------------------------------------------------------------------
# _configure($os)
#
# Uses the first parameter, $os, the package variable $AppConfig::Sys::OS,
# the value of $^O, or as a last resort, the value of
# $Config::Config('osname') to determine the current operating
# system/platform. Sets internal variables accordingly.
#------------------------------------------------------------------------
sub _configure {
my $self = shift;
# operating system may be defined as a parameter or in $OS
my $os = shift || $OS;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The following was lifted (and adapated slightly) from Lincoln Stein's
# CGI.pm module, version 2.36...
#
# FIGURE OUT THE OS WE'RE RUNNING UNDER
# Some systems support the $^O variable. If not
# available then require() the Config library
unless ($os) {
unless ($os = $^O) {
require Config;
$os = $Config::Config{'osname'};
}
}
if ($os =~ /win32/i) {
$os = 'WINDOWS';
} elsif ($os =~ /vms/i) {
$os = 'VMS';
} elsif ($os =~ /mac/i) {
$os = 'MACINTOSH';
} elsif ($os =~ /os2/i) {
$os = 'OS2';
} else {
$os = 'UNIX';
}
# The path separator is a slash, backslash or semicolon, depending
# on the platform.
my $ps = {
UNIX => '/',
OS2 => '\\',
WINDOWS => '\\',
MACINTOSH => ':',
VMS => '\\'
}->{ $os };
#
# Thanks Lincoln!
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$self->{ OS } = $os;
$self->{ PATHSEP } = $ps;
}
#------------------------------------------------------------------------
# _dump()
#
# Dump internals for debugging.
#------------------------------------------------------------------------
sub _dump {
my $self = shift;
print "=" x 71, "\n";
print "Status of AppConfig::Sys (Version $VERSION) object: $self\n";
print " Operating System : ", $self->{ OS }, "\n";
print " Path Separator : ", $self->{ PATHSEP }, "\n";
print " Available methods :\n";
foreach my $can (keys %{ $self->{ CAN } }) {
printf "%20s : ", $can;
print $self->{ CAN }->{ $can } ? "yes" : "no", "\n";
}
print "=" x 71, "\n";
}
1;
__END__
=pod
=head1 NAME
AppConfig::Sys - Perl5 module defining platform-specific information and methods for other AppConfig::* modules.
=head1 SYNOPSIS
use AppConfig::Sys;
my $sys = AppConfig::Sys->new();
@fields = $sys->getpwuid($userid);
@fields = $sys->getpwnam($username);
=head1 OVERVIEW
AppConfig::Sys is a Perl5 module provides platform-specific information and
operations as required by other AppConfig::* modules.
AppConfig::Sys is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::Sys MODULE
To import and use the AppConfig::Sys module the following line should
appear in your Perl script:
use AppConfig::Sys;
AppConfig::Sys is implemented using object-oriented methods. A new
AppConfig::Sys object is created and initialised using the
AppConfig::Sys->new() method. This returns a reference to a new
AppConfig::Sys object.
my $sys = AppConfig::Sys->new();
This will attempt to detect your operating system and create a reference to
a new AppConfig::Sys object that is applicable to your platform. You may
explicitly specify an operating system name to override this automatic
detection:
$unix_sys = AppConfig::Sys->new("Unix");
Alternatively, the package variable $AppConfig::Sys::OS can be set to an
operating system name. The valid operating system names are: Win32, VMS,
Mac, OS2 and Unix. They are not case-specific.
=head2 AppConfig::Sys METHODS
AppConfig::Sys defines the following methods:
=over 4
=item getpwnam()
Calls the system function getpwnam() if available and returns the result.
Returns undef if not available. The can_getpwnam() method can be called to
determine if this function is available.
=item getpwuid()
Calls the system function getpwuid() if available and returns the result.
Returns undef if not available. The can_getpwuid() method can be called to
determine if this function is available.
=back
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or modify it under
the term of the Perl Artistic License.
=head1 SEE ALSO
AppConfig, AppConfig::File
=cut
perl5/5.32/AppConfig/State.pm 0000444 00000134414 15157556154 0011471 0 ustar 00 #============================================================================
#
# AppConfig::State.pm
#
# Perl5 module in which configuration information for an application can
# be stored and manipulated. AppConfig::State objects maintain knowledge
# about variables; their identities, options, aliases, targets, callbacks
# and so on. This module is used by a number of other AppConfig::* modules.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
#----------------------------------------------------------------------------
#
# TODO
#
# * Change varlist() to varhash() and provide another varlist() method
# which returns a list. Multiple parameters passed implies a hash
# slice/list grep, a single parameter should indicate a regex.
#
# * Perhaps allow a callback to be installed which is called *instead* of
# the get() and set() methods (or rather, is called by them).
#
# * Maybe CMDARG should be in there to specify extra command-line only
# options that get added to the AppConfig::GetOpt alias construction,
# but not applied in config files, general usage, etc. The GLOBAL
# CMDARG might be specified as a format, e.g. "-%c" where %s = name,
# %c = first character, %u - first unique sequence(?). Will
# GetOpt::Long handle --long to -l application automagically?
#
# * ..and an added thought is that CASE sensitivity may be required for the
# command line (-v vs -V, -r vs -R, for example), but not for parsing
# config files where you may wish to treat "Name", "NAME" and "name" alike.
#
#============================================================================
package AppConfig::State;
use 5.006;
use strict;
use warnings;
our $VERSION = '1.71';
our $DEBUG = 0;
our $AUTOLOAD;
# need access to AppConfig::ARGCOUNT_*
use AppConfig ':argcount';
# internal per-variable hashes that AUTOLOAD should provide access to
my %METHVARS;
@METHVARS{ qw( EXPAND ARGS ARGCOUNT ) } = ();
# internal values that AUTOLOAD should provide access to
my %METHFLAGS;
@METHFLAGS{ qw( PEDANTIC ) } = ();
# variable attributes that may be specified in GLOBAL;
my @GLOBAL_OK = qw( DEFAULT EXPAND VALIDATE ACTION ARGS ARGCOUNT );
#------------------------------------------------------------------------
# new(\%config, @vars)
#
# Module constructor. A reference to a hash array containing
# configuration options may be passed as the first parameter. This is
# passed off to _configure() for processing. See _configure() for
# information about configurarion options. The remaining parameters
# may be variable definitions and are passed en masse to define() for
# processing.
#
# Returns a reference to a newly created AppConfig::State object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $self = {
# internal hash arrays to store variable specification information
VARIABLE => { }, # variable values
DEFAULT => { }, # default values
ALIAS => { }, # known aliases ALIAS => VARIABLE
ALIASES => { }, # reverse alias lookup VARIABLE => ALIASES
ARGCOUNT => { }, # arguments expected
ARGS => { }, # specific argument pattern (AppConfig::Getopt)
EXPAND => { }, # variable expansion (AppConfig::File)
VALIDATE => { }, # validation regexen or functions
ACTION => { }, # callback functions for when variable is set
GLOBAL => { }, # default global settings for new variables
# other internal data
CREATE => 0, # auto-create variables when set
CASE => 0, # case sensitivity flag (1 = sensitive)
PEDANTIC => 0, # return immediately on parse warnings
EHANDLER => undef, # error handler (let's hope we don't need it!)
ERROR => '', # error message
};
bless $self, $class;
# configure if first param is a config hash ref
$self->_configure(shift)
if ref($_[0]) eq 'HASH';
# call define(@_) to handle any variables definitions
$self->define(@_)
if @_;
return $self;
}
#------------------------------------------------------------------------
# define($variable, \%cfg, [$variable, \%cfg, ...])
#
# Defines one or more variables. The first parameter specifies the
# variable name. The following parameter may reference a hash of
# configuration options for the variable. Further variables and
# configuration hashes may follow and are processed in turn. If the
# parameter immediately following a variable name isn't a hash reference
# then it is ignored and the variable is defined without a specific
# configuration, although any default parameters as specified in the
# GLOBAL option will apply.
#
# The $variable value may contain an alias/args definition in compact
# format, such as "Foo|Bar=1".
#
# A warning is issued (via _error()) if an invalid option is specified.
#------------------------------------------------------------------------
sub define {
my $self = shift;
my ($var, $args, $count, $opt, $val, $cfg, @names);
while (@_) {
$var = shift;
$cfg = ref($_[0]) eq 'HASH' ? shift : { };
# variable may be specified in compact format, 'foo|bar=i@'
if ($var =~ s/(.+?)([!+=:].*)/$1/) {
# anything coming after the name|alias list is the ARGS
$cfg->{ ARGS } = $2
if length $2;
}
# examine any ARGS option
if (defined ($args = $cfg->{ ARGS })) {
ARGGCOUNT: {
$count = ARGCOUNT_NONE, last if $args =~ /^!/;
$count = ARGCOUNT_LIST, last if $args =~ /@/;
$count = ARGCOUNT_HASH, last if $args =~ /%/;
$count = ARGCOUNT_ONE;
}
$cfg->{ ARGCOUNT } = $count;
}
# split aliases out
@names = split(/\|/, $var);
$var = shift @names;
$cfg->{ ALIAS } = [ @names ] if @names;
# variable name gets folded to lower unless CASE sensitive
$var = lc $var unless $self->{ CASE };
# activate $variable (so it does 'exist()')
$self->{ VARIABLE }->{ $var } = undef;
# merge GLOBAL and variable-specific configurations
$cfg = { %{ $self->{ GLOBAL } }, %$cfg };
# examine each variable configuration parameter
while (($opt, $val) = each %$cfg) {
$opt = uc $opt;
# DEFAULT, VALIDATE, EXPAND, ARGS and ARGCOUNT are stored as
# they are;
$opt =~ /^DEFAULT|VALIDATE|EXPAND|ARGS|ARGCOUNT$/ && do {
$self->{ $opt }->{ $var } = $val;
next;
};
# CMDARG has been deprecated
$opt eq 'CMDARG' && do {
$self->_error("CMDARG has been deprecated. "
. "Please use an ALIAS if required.");
next;
};
# ACTION should be a code ref
$opt eq 'ACTION' && do {
unless (ref($val) eq 'CODE') {
$self->_error("'$opt' value is not a code reference");
next;
};
# store code ref, forcing keyword to upper case
$self->{ ACTION }->{ $var } = $val;
next;
};
# ALIAS creates alias links to the variable name
$opt eq 'ALIAS' && do {
# coerce $val to an array if not already so
$val = [ split(/\|/, $val) ]
unless ref($val) eq 'ARRAY';
# fold to lower case unless CASE sensitivity set
unless ($self->{ CASE }) {
@$val = map { lc } @$val;
}
# store list of aliases...
$self->{ ALIASES }->{ $var } = $val;
# ...and create ALIAS => VARIABLE lookup hash entries
foreach my $a (@$val) {
$self->{ ALIAS }->{ $a } = $var;
}
next;
};
# default
$self->_error("$opt is not a valid configuration item");
}
# set variable to default value
$self->_default($var);
# DEBUG: dump new variable definition
if ($DEBUG) {
print STDERR "Variable defined:\n";
$self->_dump_var($var);
}
}
}
#------------------------------------------------------------------------
# get($variable)
#
# Returns the value of the variable specified, $variable. Returns undef
# if the variable does not exists or is undefined and send a warning
# message to the _error() function.
#------------------------------------------------------------------------
sub get {
my $self = shift;
my $variable = shift;
my $negate = 0;
my $value;
# _varname returns variable name after aliasing and case conversion
# $negate indicates if the name got converted from "no<var>" to "<var>"
$variable = $self->_varname($variable, \$negate);
# check the variable has been defined
unless (exists($self->{ VARIABLE }->{ $variable })) {
$self->_error("$variable: no such variable");
return undef;
}
# DEBUG
print STDERR "$self->get($variable) => ",
defined $self->{ VARIABLE }->{ $variable }
? $self->{ VARIABLE }->{ $variable }
: "<undef>",
"\n"
if $DEBUG;
# return variable value, possibly negated if the name was "no<var>"
$value = $self->{ VARIABLE }->{ $variable };
return $negate ? !$value : $value;
}
#------------------------------------------------------------------------
# set($variable, $value)
#
# Assigns the value, $value, to the variable specified.
#
# Returns 1 if the variable is successfully updated or 0 if the variable
# does not exist. If an ACTION sub-routine exists for the variable, it
# will be executed and its return value passed back.
#------------------------------------------------------------------------
sub set {
my $self = shift;
my $variable = shift;
my $value = shift;
my $negate = 0;
my $create;
# _varname returns variable name after aliasing and case conversion
# $negate indicates if the name got converted from "no<var>" to "<var>"
$variable = $self->_varname($variable, \$negate);
# check the variable exists
if (exists($self->{ VARIABLE }->{ $variable })) {
# variable found, so apply any value negation
$value = $value ? 0 : 1 if $negate;
}
else {
# auto-create variable if CREATE is 1 or a pattern matching
# the variable name (real name, not an alias)
$create = $self->{ CREATE };
if (defined $create
&& ($create eq '1' || $variable =~ /$create/)) {
$self->define($variable);
print STDERR "Auto-created $variable\n" if $DEBUG;
}
else {
$self->_error("$variable: no such variable");
return 0;
}
}
# call the validate($variable, $value) method to perform any validation
unless ($self->_validate($variable, $value)) {
$self->_error("$variable: invalid value: $value");
return 0;
}
# DEBUG
print STDERR "$self->set($variable, ",
defined $value
? $value
: "<undef>",
")\n"
if $DEBUG;
# set the variable value depending on its ARGCOUNT
my $argcount = $self->{ ARGCOUNT }->{ $variable };
$argcount = AppConfig::ARGCOUNT_ONE unless defined $argcount;
if ($argcount eq AppConfig::ARGCOUNT_LIST) {
# push value onto the end of the list
push(@{ $self->{ VARIABLE }->{ $variable } }, $value);
}
elsif ($argcount eq AppConfig::ARGCOUNT_HASH) {
# insert "<key>=<value>" data into hash
my ($k, $v) = split(/\s*=\s*/, $value, 2);
# strip quoting
$v =~ s/^(['"])(.*)\1$/$2/ if defined $v;
$self->{ VARIABLE }->{ $variable }->{ $k } = $v;
}
else {
# set simple variable
$self->{ VARIABLE }->{ $variable } = $value;
}
# call any ACTION function bound to this variable
return &{ $self->{ ACTION }->{ $variable } }($self, $variable, $value)
if (exists($self->{ ACTION }->{ $variable }));
# ...or just return 1 (ok)
return 1;
}
#------------------------------------------------------------------------
# varlist($criteria, $filter)
#
# Returns a hash array of all variables and values whose real names
# match the $criteria regex pattern passed as the first parameter.
# If $filter is set to any true value, the keys of the hash array
# (variable names) will have the $criteria part removed. This allows
# the caller to specify the variables from one particular [block] and
# have the "block_" prefix removed, for example.
#
# TODO: This should be changed to varhash(). varlist() should return a
# list. Also need to consider specification by list rather than regex.
#
#------------------------------------------------------------------------
sub varlist {
my $self = shift;
my $criteria = shift;
my $strip = shift;
$criteria = "" unless defined $criteria;
# extract relevant keys and slice out corresponding values
my @keys = grep(/$criteria/, keys %{ $self->{ VARIABLE } });
my @vals = @{ $self->{ VARIABLE } }{ @keys };
my %set;
# clean off the $criteria part if $strip is set
@keys = map { s/$criteria//; $_ } @keys if $strip;
# slice values into the target hash
@set{ @keys } = @vals;
return %set;
}
#------------------------------------------------------------------------
# AUTOLOAD
#
# Autoload function called whenever an unresolved object method is
# called. If the method name relates to a defined VARIABLE, we patch
# in $self->get() and $self->set() to magically update the varaiable
# (if a parameter is supplied) and return the previous value.
#
# Thus the function can be used in the folowing ways:
# $state->variable(123); # set a new value
# $foo = $state->variable(); # get the current value
#
# Returns the current value of the variable, taken before any new value
# is set. Prints a warning if the variable isn't defined (i.e. doesn't
# exist rather than exists with an undef value) and returns undef.
#------------------------------------------------------------------------
sub AUTOLOAD {
my $self = shift;
my ($variable, $attrib);
# splat the leading package name
($variable = $AUTOLOAD) =~ s/.*:://;
# ignore destructor
$variable eq 'DESTROY' && return;
# per-variable attributes and internal flags listed as keys in
# %METHFLAGS and %METHVARS respectively can be accessed by a
# method matching the attribute or flag name in lower case with
# a leading underscore_
if (($attrib = $variable) =~ s/_//g) {
$attrib = uc $attrib;
if (exists $METHFLAGS{ $attrib }) {
return $self->{ $attrib };
}
if (exists $METHVARS{ $attrib }) {
# next parameter should be variable name
$variable = shift;
$variable = $self->_varname($variable);
# check we've got a valid variable
# $self->_error("$variable: no such variable or method"),
# return undef
# unless exists($self->{ VARIABLE }->{ $variable });
# return attribute
return $self->{ $attrib }->{ $variable };
}
}
# set a new value if a parameter was supplied or return the old one
return defined($_[0])
? $self->set($variable, shift)
: $self->get($variable);
}
#========================================================================
# ----- PRIVATE METHODS -----
#========================================================================
#------------------------------------------------------------------------
# _configure(\%cfg)
#
# Sets the various configuration options using the values passed in the
# hash array referenced by $cfg.
#------------------------------------------------------------------------
sub _configure {
my $self = shift;
my $cfg = shift || return;
# construct a regex to match values which are ok to be found in GLOBAL
my $global_ok = join('|', @GLOBAL_OK);
foreach my $opt (keys %$cfg) {
# GLOBAL must be a hash ref
$opt =~ /^GLOBALS?$/i && do {
unless (ref($cfg->{ $opt }) eq 'HASH') {
$self->_error("\U$opt\E parameter is not a hash ref");
next;
}
# we check each option is ok to be in GLOBAL, but we don't do
# any error checking on the values they contain (but should?).
foreach my $global ( keys %{ $cfg->{ $opt } } ) {
# continue if the attribute is ok to be GLOBAL
next if ($global =~ /(^$global_ok$)/io);
$self->_error( "\U$global\E parameter cannot be GLOBAL");
}
$self->{ GLOBAL } = $cfg->{ $opt };
next;
};
# CASE, CREATE and PEDANTIC are stored as they are
$opt =~ /^CASE|CREATE|PEDANTIC$/i && do {
$self->{ uc $opt } = $cfg->{ $opt };
next;
};
# ERROR triggers $self->_ehandler()
$opt =~ /^ERROR$/i && do {
$self->_ehandler($cfg->{ $opt });
next;
};
# DEBUG triggers $self->_debug()
$opt =~ /^DEBUG$/i && do {
$self->_debug($cfg->{ $opt });
next;
};
# warn about invalid options
$self->_error("\U$opt\E is not a valid configuration option");
}
}
#------------------------------------------------------------------------
# _varname($variable, \$negated)
#
# Variable names are treated case-sensitively or insensitively, depending
# on the value of $self->{ CASE }. When case-insensitive ($self->{ CASE }
# != 0), all variable names are converted to lower case. Variable values
# are not converted. This function simply converts the parameter
# (variable) to lower case if $self->{ CASE } isn't set. _varname() also
# expands a variable alias to the name of the target variable.
#
# Variables with an ARGCOUNT of ARGCOUNT_ZERO may be specified as
# "no<var>" in which case, the intended value should be negated. The
# leading "no" part is stripped from the variable name. A reference to
# a scalar value can be passed as the second parameter and if the
# _varname() method identified such a variable, it will negate the value.
# This allows the intended value or a simple negate flag to be passed by
# reference and be updated to indicate any negation activity taking place.
#
# The (possibly modified) variable name is returned.
#------------------------------------------------------------------------
sub _varname {
my $self = shift;
my $variable = shift;
my $negated = shift;
# convert to lower case if case insensitive
$variable = $self->{ CASE } ? $variable : lc $variable;
# get the actual name if this is an alias
$variable = $self->{ ALIAS }->{ $variable }
if (exists($self->{ ALIAS }->{ $variable }));
# if the variable doesn't exist, we can try to chop off a leading
# "no" and see if the remainder matches an ARGCOUNT_ZERO variable
unless (exists($self->{ VARIABLE }->{ $variable })) {
# see if the variable is specified as "no<var>"
if ($variable =~ /^no(.*)/) {
# see if the real variable (minus "no") exists and it
# has an ARGOUNT of ARGCOUNT_NONE (or no ARGCOUNT at all)
my $novar = $self->_varname($1);
if (exists($self->{ VARIABLE }->{ $novar })
&& ! $self->{ ARGCOUNT }->{ $novar }) {
# set variable name and negate value
$variable = $novar;
$$negated = ! $$negated if defined $negated;
}
}
}
# return the variable name
$variable;
}
#------------------------------------------------------------------------
# _default($variable)
#
# Sets the variable specified to the default value or undef if it doesn't
# have a default. The default value is returned.
#------------------------------------------------------------------------
sub _default {
my $self = shift;
my $variable = shift;
# _varname returns variable name after aliasing and case conversion
$variable = $self->_varname($variable);
# check the variable exists
if (exists($self->{ VARIABLE }->{ $variable })) {
# set variable value to the default scalar, an empty list or empty
# hash array, depending on its ARGCOUNT value
my $argcount = $self->{ ARGCOUNT }->{ $variable };
$argcount = AppConfig::ARGCOUNT_ONE unless defined $argcount;
if ($argcount == AppConfig::ARGCOUNT_NONE) {
return $self->{ VARIABLE }->{ $variable }
= $self->{ DEFAULT }->{ $variable } || 0;
}
elsif ($argcount == AppConfig::ARGCOUNT_LIST) {
my $deflist = $self->{ DEFAULT }->{ $variable };
return $self->{ VARIABLE }->{ $variable } =
[ ref $deflist eq 'ARRAY' ? @$deflist : ( ) ];
}
elsif ($argcount == AppConfig::ARGCOUNT_HASH) {
my $defhash = $self->{ DEFAULT }->{ $variable };
return $self->{ VARIABLE }->{ $variable } =
{ ref $defhash eq 'HASH' ? %$defhash : () };
}
else {
return $self->{ VARIABLE }->{ $variable }
= $self->{ DEFAULT }->{ $variable };
}
}
else {
$self->_error("$variable: no such variable");
return 0;
}
}
#------------------------------------------------------------------------
# _exists($variable)
#
# Returns 1 if the variable specified exists or 0 if not.
#------------------------------------------------------------------------
sub _exists {
my $self = shift;
my $variable = shift;
# _varname returns variable name after aliasing and case conversion
$variable = $self->_varname($variable);
# check the variable has been defined
return exists($self->{ VARIABLE }->{ $variable });
}
#------------------------------------------------------------------------
# _validate($variable, $value)
#
# Uses any validation rules or code defined for the variable to test if
# the specified value is acceptable.
#
# Returns 1 if the value passed validation checks, 0 if not.
#------------------------------------------------------------------------
sub _validate {
my $self = shift;
my $variable = shift;
my $value = shift;
my $validator;
# _varname returns variable name after aliasing and case conversion
$variable = $self->_varname($variable);
# return OK unless there is a validation function
return 1 unless defined($validator = $self->{ VALIDATE }->{ $variable });
#
# the validation performed is based on the validator type;
#
# CODE ref: code executed, returning 1 (ok) or 0 (failed)
# SCALAR : a regex which should match the value
#
# CODE ref
ref($validator) eq 'CODE' && do {
# run the validation function and return the result
return &$validator($variable, $value);
};
# non-ref (i.e. scalar)
ref($validator) || do {
# not a ref - assume it's a regex
return $value =~ /$validator/;
};
# validation failed
return 0;
}
#------------------------------------------------------------------------
# _error($format, @params)
#
# Checks for the existence of a user defined error handling routine and
# if defined, passes all variable straight through to that. The routine
# is expected to handle a string format and optional parameters as per
# printf(3C). If no error handler is defined, the message is formatted
# and passed to warn() which prints it to STDERR.
#------------------------------------------------------------------------
sub _error {
my $self = shift;
my $format = shift;
# user defined error handler?
if (ref($self->{ EHANDLER }) eq 'CODE') {
&{ $self->{ EHANDLER } }($format, @_);
}
else {
warn(sprintf("$format\n", @_));
}
}
#------------------------------------------------------------------------
# _ehandler($handler)
#
# Allows a new error handler to be installed. The current value of
# the error handler is returned.
#
# This is something of a kludge to allow other AppConfig::* modules to
# install their own error handlers to format error messages appropriately.
# For example, AppConfig::File appends a message of the form
# "at $file line $line" to each error message generated while parsing
# configuration files. The previous handler is returned (and presumably
# stored by the caller) to allow new error handlers to chain control back
# to any user-defined handler, and also restore the original handler when
# done.
#------------------------------------------------------------------------
sub _ehandler {
my $self = shift;
my $handler = shift;
# save previous value
my $previous = $self->{ EHANDLER };
# update internal reference if a new handler vas provide
if (defined $handler) {
# check this is a code reference
if (ref($handler) eq 'CODE') {
$self->{ EHANDLER } = $handler;
# DEBUG
print STDERR "installed new ERROR handler: $handler\n" if $DEBUG;
}
else {
$self->_error("ERROR handler parameter is not a code ref");
}
}
return $previous;
}
#------------------------------------------------------------------------
# _debug($debug)
#
# Sets the package debugging variable, $AppConfig::State::DEBUG depending
# on the value of the $debug parameter. 1 turns debugging on, 0 turns
# debugging off.
#
# May be called as an object method, $state->_debug(1), or as a package
# function, AppConfig::State::_debug(1). Returns the previous value of
# $DEBUG, before any new value was applied.
#------------------------------------------------------------------------
sub _debug {
# object reference may not be present if called as a package function
my $self = shift if ref($_[0]);
my $newval = shift;
# save previous value
my $oldval = $DEBUG;
# update $DEBUG if a new value was provided
$DEBUG = $newval if defined $newval;
# return previous value
$oldval;
}
#------------------------------------------------------------------------
# _dump_var($var)
#
# Displays the content of the specified variable, $var.
#------------------------------------------------------------------------
sub _dump_var {
my $self = shift;
my $var = shift;
return unless defined $var;
# $var may be an alias, so we resolve the real variable name
my $real = $self->_varname($var);
if ($var eq $real) {
print STDERR "$var\n";
}
else {
print STDERR "$real ('$var' is an alias)\n";
$var = $real;
}
# for some bizarre reason, the variable VALUE is stored in VARIABLE
# (it made sense at some point in time)
printf STDERR " VALUE => %s\n",
defined($self->{ VARIABLE }->{ $var })
? $self->{ VARIABLE }->{ $var }
: "<undef>";
# the rest of the values can be read straight out of their hashes
foreach my $param (qw( DEFAULT ARGCOUNT VALIDATE ACTION EXPAND )) {
printf STDERR " %-12s => %s\n", $param,
defined($self->{ $param }->{ $var })
? $self->{ $param }->{ $var }
: "<undef>";
}
# summarise all known aliases for this variable
print STDERR " ALIASES => ",
join(", ", @{ $self->{ ALIASES }->{ $var } }), "\n"
if defined $self->{ ALIASES }->{ $var };
}
#------------------------------------------------------------------------
# _dump()
#
# Dumps the contents of the Config object and all stored variables.
#------------------------------------------------------------------------
sub _dump {
my $self = shift;
my $var;
print STDERR "=" x 71, "\n";
print STDERR
"Status of AppConfig::State (version $VERSION) object:\n\t$self\n";
print STDERR "- " x 36, "\nINTERNAL STATE:\n";
foreach (qw( CREATE CASE PEDANTIC EHANDLER ERROR )) {
printf STDERR " %-12s => %s\n", $_,
defined($self->{ $_ }) ? $self->{ $_ } : "<undef>";
}
print STDERR "- " x 36, "\nVARIABLES:\n";
foreach $var (keys %{ $self->{ VARIABLE } }) {
$self->_dump_var($var);
}
print STDERR "- " x 36, "\n", "ALIASES:\n";
foreach $var (keys %{ $self->{ ALIAS } }) {
printf(" %-12s => %s\n", $var, $self->{ ALIAS }->{ $var });
}
print STDERR "=" x 72, "\n";
}
1;
__END__
=head1 NAME
AppConfig::State - application configuration state
=head1 SYNOPSIS
use AppConfig::State;
my $state = AppConfig::State->new(\%cfg);
$state->define("foo"); # very simple variable definition
$state->define("bar", \%varcfg); # variable specific configuration
$state->define("foo|bar=i@"); # compact format
$state->set("foo", 123); # trivial set/get examples
$state->get("foo");
$state->foo(); # shortcut variable access
$state->foo(456); # shortcut variable update
=head1 OVERVIEW
AppConfig::State is a Perl5 module to handle global configuration variables
for perl programs. It maintains the state of any number of variables,
handling default values, aliasing, validation, update callbacks and
option arguments for use by other AppConfig::* modules.
AppConfig::State is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::State MODULE
To import and use the AppConfig::State module the following line should
appear in your Perl script:
use AppConfig::State;
The AppConfig::State module is loaded automatically by the new()
constructor of the AppConfig module.
AppConfig::State is implemented using object-oriented methods. A
new AppConfig::State object is created and initialised using the
new() method. This returns a reference to a new AppConfig::State
object.
my $state = AppConfig::State->new();
This will create a reference to a new AppConfig::State with all
configuration options set to their default values. You can initialise
the object by passing a reference to a hash array containing
configuration options:
$state = AppConfig::State->new( {
CASE => 1,
ERROR => \&my_error,
} );
The new() constructor of the AppConfig module automatically passes all
parameters to the AppConfig::State new() constructor. Thus, any global
configuration values and variable definitions for AppConfig::State are
also applicable to AppConfig.
The following configuration options may be specified.
=over 4
=item CASE
Determines if the variable names are treated case sensitively. Any non-zero
value makes case significant when naming variables. By default, CASE is set
to 0 and thus "Variable", "VARIABLE" and "VaRiAbLe" are all treated as
"variable".
=item CREATE
By default, CREATE is turned off meaning that all variables accessed via
set() (which includes access via shortcut such as
C<$state-E<gt>variable($value)> which delegates to set()) must previously
have been defined via define(). When CREATE is set to 1, calling
set($variable, $value) on a variable that doesn't exist will cause it
to be created automatically.
When CREATE is set to any other non-zero value, it is assumed to be a
regular expression pattern. If the variable name matches the regex, the
variable is created. This can be used to specify configuration file
blocks in which variables should be created, for example:
$state = AppConfig::State->new( {
CREATE => '^define_',
} );
In a config file:
[define]
name = fred # define_name gets created automatically
[other]
name = john # other_name doesn't - warning raised
Note that a regex pattern specified in CREATE is applied to the real
variable name rather than any alias by which the variables may be
accessed.
=item PEDANTIC
The PEDANTIC option determines what action the configuration file
(AppConfig::File) or argument parser (AppConfig::Args) should take
on encountering a warning condition (typically caused when trying to set an
undeclared variable). If PEDANTIC is set to any true value, the parsing
methods will immediately return a value of 0 on encountering such a
condition. If PEDANTIC is not set, the method will continue to parse the
remainder of the current file(s) or arguments, returning 0 when complete.
If no warnings or errors are encountered, the method returns 1.
In the case of a system error (e.g. unable to open a file), the method
returns undef immediately, regardless of the PEDANTIC option.
=item ERROR
Specifies a user-defined error handling routine. When the handler is
called, a format string is passed as the first parameter, followed by
any additional values, as per printf(3C).
=item DEBUG
Turns debugging on or off when set to 1 or 0 accordingly. Debugging may
also be activated by calling _debug() as an object method
(C<$state-E<gt>_debug(1)>) or as a package function
(C<AppConfig::State::_debug(1)>), passing in a true/false value to
set the debugging state accordingly. The package variable
$AppConfig::State::DEBUG can also be set directly.
The _debug() method returns the current debug value. If a new value
is passed in, the internal value is updated, but the previous value is
returned.
Note that any AppConfig::File or App::Config::Args objects that are
instantiated with a reference to an App::State will inherit the
DEBUG (and also PEDANTIC) values of the state at that time. Subsequent
changes to the AppConfig::State debug value will not affect them.
=item GLOBAL
The GLOBAL option allows default values to be set for the DEFAULT, ARGCOUNT,
EXPAND, VALIDATE and ACTION options for any subsequently defined variables.
$state = AppConfig::State->new({
GLOBAL => {
DEFAULT => '<undef>', # default value for new vars
ARGCOUNT => 1, # vars expect an argument
ACTION => \&my_set_var, # callback when vars get set
}
});
Any attributes specified explicitly when a variable is defined will
override any GLOBAL values.
See L<DEFINING VARIABLES> below which describes these options in detail.
=back
=head2 DEFINING VARIABLES
The C<define()> function is used to pre-declare a variable and specify
its configuration.
$state->define("foo");
In the simple example above, a new variable called "foo" is defined. A
reference to a hash array may also be passed to specify configuration
information for the variable:
$state->define("foo", {
DEFAULT => 99,
ALIAS => 'metavar1',
});
Any variable-wide GLOBAL values passed to the new() constructor in the
configuration hash will also be applied. Values explicitly specified
in a variable's define() configuration will override the respective GLOBAL
values.
The following configuration options may be specified
=over 4
=item DEFAULT
The DEFAULT value is used to initialise the variable.
$state->define("drink", {
DEFAULT => 'coffee',
});
print $state->drink(); # prints "coffee"
=item ALIAS
The ALIAS option allows a number of alternative names to be specified for
this variable. A single alias should be specified as a string. Multiple
aliases can be specified as a reference to an array of alternatives or as
a string of names separated by vertical bars, '|'. e.g.:
# either
$state->define("name", {
ALIAS => 'person',
});
# or
$state->define("name", {
ALIAS => [ 'person', 'user', 'uid' ],
});
# or
$state->define("name", {
ALIAS => 'person|user|uid',
});
$state->user('abw'); # equivalent to $state->name('abw');
=item ARGCOUNT
The ARGCOUNT option specifies the number of arguments that should be
supplied for this variable. By default, no additional arguments are
expected for variables (ARGCOUNT_NONE).
The ARGCOUNT_* constants can be imported from the AppConfig module:
use AppConfig ':argcount';
$state->define('foo', { ARGCOUNT => ARGCOUNT_ONE });
or can be accessed directly from the AppConfig package:
use AppConfig;
$state->define('foo', { ARGCOUNT => AppConfig::ARGCOUNT_ONE });
The following values for ARGCOUNT may be specified.
=over 4
=item ARGCOUNT_NONE (0)
Indicates that no additional arguments are expected. If the variable is
identified in a confirguration file or in the command line arguments, it
is set to a value of 1 regardless of whatever arguments follow it.
=item ARGCOUNT_ONE (1)
Indicates that the variable expects a single argument to be provided.
The variable value will be overwritten with a new value each time it
is encountered.
=item ARGCOUNT_LIST (2)
Indicates that the variable expects multiple arguments. The variable
value will be appended to the list of previous values each time it is
encountered.
=item ARGCOUNT_HASH (3)
Indicates that the variable expects multiple arguments and that each
argument is of the form "key=value". The argument will be split into
a key/value pair and inserted into the hash of values each time it
is encountered.
=back
=item ARGS
The ARGS option can also be used to specify advanced command line options
for use with AppConfig::Getopt, which itself delegates to Getopt::Long.
See those two modules for more information on the format and meaning of
these options.
$state->define("name", {
ARGS => "=i@",
});
=item EXPAND
The EXPAND option specifies how the AppConfig::File processor should
expand embedded variables in the configuration file values it reads.
By default, EXPAND is turned off (EXPAND_NONE) and no expansion is made.
The EXPAND_* constants can be imported from the AppConfig module:
use AppConfig ':expand';
$state->define('foo', { EXPAND => EXPAND_VAR });
or can be accessed directly from the AppConfig package:
use AppConfig;
$state->define('foo', { EXPAND => AppConfig::EXPAND_VAR });
The following values for EXPAND may be specified. Multiple values should
be combined with vertical bars , '|', e.g. C<EXPAND_UID | EXPAND_VAR>).
=over 4
=item EXPAND_NONE
Indicates that no variable expansion should be attempted.
=item EXPAND_VAR
Indicates that variables embedded as $var or $(var) should be expanded
to the values of the relevant AppConfig::State variables.
=item EXPAND_UID
Indicates that '~' or '~uid' patterns in the string should be
expanded to the current users ($<), or specified user's home directory.
In the first case, C<~> is expanded to the value of the C<HOME>
environment variable. In the second case, the C<getpwnam()> method
is used if it is available on your system (which it isn't on Win32).
=item EXPAND_ENV
Inidicates that variables embedded as ${var} should be expanded to the
value of the relevant environment variable.
=item EXPAND_ALL
Equivalent to C<EXPAND_VARS | EXPAND_UIDS | EXPAND_ENVS>).
=item EXPAND_WARN
Indicates that embedded variables that are not defined should raise a
warning. If PEDANTIC is set, this will cause the read() method to return 0
immediately.
=back
=item VALIDATE
Each variable may have a sub-routine or regular expression defined which
is used to validate the intended value for a variable before it is set.
If VALIDATE is defined as a regular expression, it is applied to the
value and deemed valid if the pattern matches. In this case, the
variable is then set to the new value. A warning message is generated
if the pattern match fails.
VALIDATE may also be defined as a reference to a sub-routine which takes
as its arguments the name of the variable and its intended value. The
sub-routine should return 1 or 0 to indicate that the value is valid
or invalid, respectively. An invalid value will cause a warning error
message to be generated.
If the GLOBAL VALIDATE variable is set (see GLOBAL in L<DESCRIPTION>
above) then this value will be used as the default VALIDATE for each
variable unless otherwise specified.
$state->define("age", {
VALIDATE => '\d+',
});
$state->define("pin", {
VALIDATE => \&check_pin,
});
=item ACTION
The ACTION option allows a sub-routine to be bound to a variable as a
callback that is executed whenever the variable is set. The ACTION is
passed a reference to the AppConfig::State object, the name of the
variable and the value of the variable.
The ACTION routine may be used, for example, to post-process variable
data, update the value of some other dependant variable, generate a
warning message, etc.
Example:
$state->define("foo", { ACTION => \&my_notify });
sub my_notify {
my $state = shift;
my $var = shift;
my $val = shift;
print "$variable set to $value";
}
$state->foo(42); # prints "foo set to 42"
Be aware that calling C<$state-E<gt>set()> to update the same variable
from within the ACTION function will cause a recursive loop as the
ACTION function is repeatedly called.
=back
=head2 DEFINING VARIABLES USING THE COMPACT FORMAT
Variables may be defined in a compact format which allows any ALIAS and
ARGS values to be specified as part of the variable name. This is designed
to mimic the behaviour of Johan Vromans' Getopt::Long module.
Aliases for a variable should be specified after the variable name,
separated by vertical bars, '|'. Any ARGS parameter should be appended
after the variable name(s) and/or aliases.
The following examples are equivalent:
$state->define("foo", {
ALIAS => [ 'bar', 'baz' ],
ARGS => '=i',
});
$state->define("foo|bar|baz=i");
=head2 READING AND MODIFYING VARIABLE VALUES
AppConfig::State defines two methods to manipulate variable values:
set($variable, $value);
get($variable);
Both functions take the variable name as the first parameter and
C<set()> takes an additional parameter which is the new value for the
variable. C<set()> returns 1 or 0 to indicate successful or
unsuccessful update of the variable value. If there is an ACTION
routine associated with the named variable, the value returned will be
passed back from C<set()>. The C<get()> function returns the current
value of the variable.
Once defined, variables may be accessed directly as object methods where
the method name is the same as the variable name. i.e.
$state->set("verbose", 1);
is equivalent to
$state->verbose(1);
Without parameters, the current value of the variable is returned. If
a parameter is specified, the variable is set to that value and the
result of the set() operation is returned.
$state->age(29); # sets 'age' to 29, returns 1 (ok)
=head2 VARLIST
The varlist() method can be used to extract a number of variables into
a hash array. The first parameter should be a regular expression
used for matching against the variable names.
my %vars = $state->varlist("^file"); # all "file*" variables
A second parameter may be specified (any true value) to indicate that
the part of the variable name matching the regex should be removed
when copied to the target hash.
$state->file_name("/tmp/file");
$state->file_path("/foo:/bar:/baz");
my %vars = $state->varlist("^file_", 1);
# %vars:
# name => /tmp/file
# path => "/foo:/bar:/baz"
=head2 INTERNAL METHODS
The interal (private) methods of the AppConfig::State class are listed
below.
They aren't intended for regular use and potential users should consider
the fact that nothing about the internal implementation is guaranteed to
remain the same. Having said that, the AppConfig::State class is
intended to co-exist and work with a number of other modules and these
are considered "friend" classes. These methods are provided, in part,
as services to them. With this acknowledged co-operation in mind, it is
safe to assume some stability in this core interface.
The _varname() method can be used to determine the real name of a variable
from an alias:
$varname->_varname($alias);
Note that all methods that take a variable name, including those listed
below, can accept an alias and automatically resolve it to the correct
variable name. There is no need to call _varname() explicitly to do
alias expansion. The _varname() method will fold all variables names
to lower case unless CASE sensititvity is set.
The _exists() method can be used to check if a variable has been
defined:
$state->_exists($varname);
The _default() method can be used to reset a variable to its default value:
$state->_default($varname);
The _expand() method can be used to determine the EXPAND value for a
variable:
print "$varname EXPAND: ", $state->_expand($varname), "\n";
The _argcount() method returns the value of the ARGCOUNT attribute for a
variable:
print "$varname ARGCOUNT: ", $state->_argcount($varname), "\n";
The _validate() method can be used to determine if a new value for a variable
meets any validation criteria specified for it. The variable name and
intended value should be passed in. The methods returns a true/false value
depending on whether or not the validation succeeded:
print "OK\n" if $state->_validate($varname, $value);
The _pedantic() method can be called to determine the current value of the
PEDANTIC option.
print "pedantic mode is ", $state->_pedantic() ? "on" ; "off", "\n";
The _debug() method can be used to turn debugging on or off (pass 1 or 0
as a parameter). It can also be used to check the debug state,
returning the current internal value of $AppConfig::State::DEBUG. If a
new debug value is provided, the debug state is updated and the previous
state is returned.
$state->_debug(1); # debug on, returns previous value
The _dump_var($varname) and _dump() methods may also be called for
debugging purposes.
$state->_dump_var($varname); # show variable state
$state->_dump(); # show internal state and all vars
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
AppConfig, AppConfig::File, AppConfig::Args, AppConfig::Getopt
=cut
perl5/5.32/AppConfig/Getopt.pm 0000444 00000020063 15157556161 0011643 0 ustar 00 #============================================================================
#
# AppConfig::Getopt.pm
#
# Perl5 module to interface AppConfig::* to Johan Vromans' Getopt::Long
# module. Getopt::Long implements the POSIX standard for command line
# options, with GNU extensions, and also traditional one-letter options.
# AppConfig::Getopt constructs the necessary Getopt:::Long configuration
# from the internal AppConfig::State and delegates the parsing of command
# line arguments to it. Internal variable values are updated by callback
# from GetOptions().
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
#============================================================================
package AppConfig::Getopt;
use 5.006;
use strict;
use warnings;
use AppConfig::State;
use Getopt::Long 2.17;
our $VERSION = '1.71';
#------------------------------------------------------------------------
# new($state, \@args)
#
# Module constructor. The first, mandatory parameter should be a
# reference to an AppConfig::State object to which all actions should
# be applied. The second parameter may be a reference to a list of
# command line arguments. This list reference is passed to parse() for
# processing.
#
# Returns a reference to a newly created AppConfig::Getopt object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $state = shift;
my $self = {
STATE => $state,
};
bless $self, $class;
# call parse() to parse any arg list passed
$self->parse(@_)
if @_;
return $self;
}
#------------------------------------------------------------------------
# parse(@$config, \@args)
#
# Constructs the appropriate configuration information and then delegates
# the task of processing command line options to Getopt::Long.
#
# Returns 1 on success or 0 if one or more warnings were raised.
#------------------------------------------------------------------------
sub parse {
my $self = shift;
my $state = $self->{ STATE };
my (@config, $args, $getopt);
local $" = ', ';
# we trap $SIG{__WARN__} errors and patch them into AppConfig::State
local $SIG{__WARN__} = sub {
my $msg = shift;
# AppConfig::State doesn't expect CR terminated error messages
# and it uses printf, so we protect any embedded '%' chars
chomp($msg);
$state->_error("%s", $msg);
};
# slurp all config items into @config
push(@config, shift) while defined $_[0] && ! ref($_[0]);
# add debug status if appropriate (hmm...can't decide about this)
# push(@config, 'debug') if $state->_debug();
# next parameter may be a reference to a list of args
$args = shift;
# copy any args explicitly specified into @ARGV
@ARGV = @$args if defined $args;
# we enclose in an eval block because constructor may die()
eval {
# configure Getopt::Long
Getopt::Long::Configure(@config);
# construct options list from AppConfig::State variables
my @opts = $self->{ STATE }->_getopt_state();
# DEBUG
if ($state->_debug()) {
print STDERR "Calling GetOptions(@opts)\n";
print STDERR "\@ARGV = (@ARGV)\n";
};
# call GetOptions() with specifications constructed from the state
$getopt = GetOptions(@opts);
};
if ($@) {
chomp($@);
$state->_error("%s", $@);
return 0;
}
# udpdate any args reference passed to include only that which is left
# in @ARGV
@$args = @ARGV if defined $args;
return $getopt;
}
#========================================================================
# AppConfig::State
#========================================================================
package AppConfig::State;
#------------------------------------------------------------------------
# _getopt_state()
#
# Constructs option specs in the Getopt::Long format for each variable
# definition.
#
# Returns a list of specification strings.
#------------------------------------------------------------------------
sub _getopt_state {
my $self = shift;
my ($var, $spec, $args, $argcount, @specs);
my $linkage = sub { $self->set(@_) };
foreach $var (keys %{ $self->{ VARIABLE } }) {
$spec = join('|', $var, @{ $self->{ ALIASES }->{ $var } || [ ] });
# an ARGS value is used, if specified
unless (defined ($args = $self->{ ARGS }->{ $var })) {
# otherwise, construct a basic one from ARGCOUNT
ARGCOUNT: {
last ARGCOUNT unless
defined ($argcount = $self->{ ARGCOUNT }->{ $var });
$args = "=s", last ARGCOUNT if $argcount eq ARGCOUNT_ONE;
$args = "=s@", last ARGCOUNT if $argcount eq ARGCOUNT_LIST;
$args = "=s%", last ARGCOUNT if $argcount eq ARGCOUNT_HASH;
$args = "!";
}
}
$spec .= $args if defined $args;
push(@specs, $spec, $linkage);
}
return @specs;
}
1;
__END__
=head1 NAME
AppConfig::Getopt - Perl5 module for processing command line arguments via delegation to Getopt::Long.
=head1 SYNOPSIS
use AppConfig::Getopt;
my $state = AppConfig::State->new(\%cfg);
my $getopt = AppConfig::Getopt->new($state);
$getopt->parse(\@args); # read args
=head1 OVERVIEW
AppConfig::Getopt is a Perl5 module which delegates to Johan Vroman's
Getopt::Long module to parse command line arguments and update values
in an AppConfig::State object accordingly.
AppConfig::Getopt is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::Getopt MODULE
To import and use the AppConfig::Getopt module the following line should appear
in your Perl script:
use AppConfig::Getopt;
AppConfig::Getopt is used automatically if you use the AppConfig module
and create an AppConfig::Getopt object through the getopt() method.
AppConfig::Getopt is implemented using object-oriented methods. A new
AppConfig::Getopt object is created and initialised using the new() method.
This returns a reference to a new AppConfig::Getopt object. A reference to
an AppConfig::State object should be passed in as the first parameter:
my $state = AppConfig::State->new();
my $getopt = AppConfig::Getopt->new($state);
This will create and return a reference to a new AppConfig::Getopt object.
=head2 PARSING COMMAND LINE ARGUMENTS
The C<parse()> method is used to read a list of command line arguments and
update the state accordingly.
The first (non-list reference) parameters may contain a number of
configuration strings to pass to Getopt::Long::Configure. A reference
to a list of arguments may additionally be passed or @ARGV is used by
default.
$getopt->parse(); # uses @ARGV
$getopt->parse(\@myargs);
$getopt->parse(qw(auto_abbrev debug)); # uses @ARGV
$getopt->parse(qw(debug), \@myargs);
See Getopt::Long for details of the configuartion options available.
A Getopt::Long specification string is constructed for each variable
defined in the AppConfig::State. This consists of the name, any aliases
and the ARGS value for the variable.
These specification string are then passed to Getopt::Long, the arguments
are parsed and the values in the AppConfig::State updated.
See AppConfig for information about using the AppConfig::Getopt
module via the getopt() method.
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 ACKNOWLEDGMENTS
Many thanks are due to Johan Vromans for the Getopt::Long module. He was
kind enough to offer assistance and access to early releases of his code to
enable this module to be written.
=head1 SEE ALSO
AppConfig, AppConfig::State, AppConfig::Args, Getopt::Long
=cut
perl5/5.32/AppConfig/File.pm 0000444 00000057016 15157556166 0011275 0 ustar 00 #============================================================================
#
# AppConfig::File.pm
#
# Perl5 module to read configuration files and use the contents therein
# to update variable values in an AppConfig::State object.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
#============================================================================
package AppConfig::File;
use 5.006;
use strict;
use warnings;
use AppConfig;
use AppConfig::State;
our $VERSION = '1.71';
#------------------------------------------------------------------------
# new($state, $file, [$file, ...])
#
# Module constructor. The first, mandatory parameter should be a
# reference to an AppConfig::State object to which all actions should
# be applied. The remaining parameters are assumed to be file names or
# file handles for reading and are passed to parse().
#
# Returns a reference to a newly created AppConfig::File object.
#------------------------------------------------------------------------
sub new {
my $class = shift;
my $state = shift;
my $self = {
STATE => $state, # AppConfig::State ref
DEBUG => $state->_debug(), # store local copy of debug
PEDANTIC => $state->_pedantic, # and pedantic flags
};
bless $self, $class;
# call parse(@_) to parse any files specified as further params
$self->parse(@_) if @_;
return $self;
}
#------------------------------------------------------------------------
# parse($file, [file, ...])
#
# Reads and parses a config file, updating the contents of the
# AppConfig::State referenced by $self->{ STATE } according to the
# contents of the file. Multiple files may be specified and are
# examined in turn. The method reports any error condition via
# $self->{ STATE }->_error() and immediately returns undef if it
# encounters a system error (i.e. cannot open one of the files.
# Parsing errors such as unknown variables or unvalidated values will
# also cause warnings to be raised vi the same _error(), but parsing
# continues to the end of the current file and through any subsequent
# files. If the PEDANTIC option is set in the $self->{ STATE } object,
# the behaviour is overridden and the method returns 0 immediately on
# any system or parsing error.
#
# The EXPAND option for each variable determines how the variable
# value should be expanded.
#
# Returns undef on system error, 0 if all files were parsed but generated
# one or more warnings, 1 if all files parsed without warnings.
#------------------------------------------------------------------------
sub parse {
my $self = shift;
my $warnings = 0;
my $prefix; # [block] defines $prefix
my $file;
my $flag;
# take a local copy of the state to avoid much hash dereferencing
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
# we want to install a custom error handler into the AppConfig::State
# which appends filename and line info to error messages and then
# calls the previous handler; we start by taking a copy of the
# current handler..
my $errhandler = $state->_ehandler();
# ...and if it doesn't exist, we craft a default handler
$errhandler = sub { warn(sprintf(shift, @_), "\n") }
unless defined $errhandler;
# install a closure as a new error handler
$state->_ehandler(
sub {
# modify the error message
my $format = shift;
$format .= ref $file
? " at line $."
: " at $file line $.";
# chain call to prevous handler
&$errhandler($format, @_);
}
);
# trawl through all files passed as params
FILE: while ($file = shift) {
# local/lexical vars ensure opened files get closed
my $handle;
local *FH;
# if the file is a reference, we assume it's a file handle, if
# not, we assume it's a filename and attempt to open it
$handle = $file;
if (ref($file)) {
$handle = $file;
# DEBUG
print STDERR "reading from file handle: $file\n" if $debug;
}
else {
# open and read config file
open(FH, $file) or do {
# restore original error handler and report error
$state->_ehandler($errhandler);
$state->_error("$file: $!");
return undef;
};
$handle = \*FH;
# DEBUG
print STDERR "reading file: $file\n" if $debug;
}
# initialise $prefix to nothing (no [block])
$prefix = '';
local $_;
while (<$handle>) {
chomp;
# Throw away everything from an unescaped # to EOL
s/(^|\s+)#.*/$1/;
# add next line if there is one and this is a continuation
if (s/\\$// && !eof($handle)) {
$_ .= <$handle>;
redo;
}
# Convert \# -> #
s/\\#/#/g;
# ignore blank lines
next if /^\s*$/;
# strip leading and trailing whitespace
s/^\s+//;
s/\s+$//;
# look for a [block] to set $prefix
if (/^\[([^\]]+)\]$/) {
$prefix = $1;
print STDERR "Entering [$prefix] block\n" if $debug;
next;
}
# split line up by whitespace (\s+) or "equals" (\s*=\s*)
if (/^([^\s=]+)(?:(?:(?:\s*=\s*)|\s+)(.*))?/) {
my ($variable, $value) = ($1, $2);
if (defined $value) {
# here document
if ($value =~ /^([^\s=]+\s*=)?\s*<<(['"]?)(\S+)\2$/) { # '<<XX' or 'hashkey =<<XX'
my $boundary = "$3\n";
$value = defined($1) ? $1 : '';
while (<$handle>) {
last if $_ eq $boundary;
$value .= $_;
};
$value =~ s/[\r\n]$//;
} else {
# strip any quoting from the variable value
$value =~ s/^(['"])(.*)\1$/$2/;
};
};
# strip any leading '+/-' from the variable
$variable =~ s/^([\-+]?)//;
$flag = $1;
# $variable gets any $prefix
$variable = $prefix . '_' . $variable
if length $prefix;
# if the variable doesn't exist, we call set() to give
# AppConfig::State a chance to auto-create it
unless ($state->_exists($variable)
|| $state->set($variable, 1)) {
$warnings++;
last FILE if $pedantic;
next;
}
my $nargs = $state->_argcount($variable);
# variables prefixed '-' are reset to their default values
if ($flag eq '-') {
$state->_default($variable);
next;
}
# those prefixed '+' get set to 1
elsif ($flag eq '+') {
$value = 1 unless defined $value;
}
# determine if any extra arguments were expected
if ($nargs) {
if (defined $value && length $value) {
# expand any embedded variables, ~uids or
# environment variables, testing the return value
# for errors; we pass in any variable-specific
# EXPAND value
unless ($self->_expand(\$value,
$state->_expand($variable), $prefix)) {
print STDERR "expansion of [$value] failed\n"
if $debug;
$warnings++;
last FILE if $pedantic;
}
}
else {
$state->_error("$variable expects an argument");
$warnings++;
last FILE if $pedantic;
next;
}
}
# $nargs = 0
else {
# default value to 1 unless it is explicitly defined
# as '0' or "off"
if (defined $value) {
# "off" => 0
$value = 0 if $value =~ /off/i;
# any value => 1
$value = 1 if $value;
}
else {
# assume 1 unless explicitly defined off/0
$value = 1;
}
print STDERR "$variable => $value (no expansion)\n"
if $debug;
}
# set the variable, noting any failure from set()
unless ($state->set($variable, $value)) {
$warnings++;
last FILE if $pedantic;
}
}
else {
$state->_error("parse error");
$warnings++;
}
}
}
# restore original error handler
$state->_ehandler($errhandler);
# return $warnings => 0, $success => 1
return $warnings ? 0 : 1;
}
#========================================================================
# ----- PRIVATE METHODS -----
#========================================================================
#------------------------------------------------------------------------
# _expand(\$value, $expand, $prefix)
#
# The variable value string, referenced by $value, is examined and any
# embedded variables, environment variables or tilde globs (home
# directories) are replaced with their respective values, depending on
# the value of the second parameter, $expand. The third paramter may
# specify the name of the current [block] in which the parser is
# parsing. This prefix is prepended to any embedded variable name that
# can't otherwise be resolved. This allows the following to work:
#
# [define]
# home = /home/abw
# html = $define_home/public_html
# html = $home/public_html # same as above, 'define' is prefix
#
# Modifications are made directly into the variable referenced by $value.
# The method returns 1 on success or 0 if any warnings (undefined
# variables) were encountered.
#------------------------------------------------------------------------
sub _expand {
my ($self, $value, $expand, $prefix) = @_;
my $warnings = 0;
my ($sys, $var, $val);
# ensure prefix contains something (nothing!) valid for length()
$prefix = "" unless defined $prefix;
# take a local copy of the state to avoid much hash dereferencing
my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };
# bail out if there's nothing to do
return 1 unless $expand && defined($$value);
# create an AppConfig::Sys instance, or re-use a previous one,
# to handle platform dependant functions: getpwnam(), getpwuid()
unless ($sys = $self->{ SYS }) {
require AppConfig::Sys;
$sys = $self->{ SYS } = AppConfig::Sys->new();
}
print STDERR "Expansion of [$$value] " if $debug;
EXPAND: {
#
# EXPAND_VAR
# expand $(var) and $var as AppConfig::State variables
#
if ($expand & AppConfig::EXPAND_VAR) {
$$value =~ s{
(?<!\\)\$ (?: \((\w+)\) | (\w+) ) # $2 => $(var) | $3 => $var
} {
# embedded variable name will be one of $2 or $3
$var = defined $1 ? $1 : $2;
# expand the variable if defined
if ($state->_exists($var)) {
$val = $state->get($var);
}
elsif (length $prefix
&& $state->_exists($prefix . '_' . $var)) {
print STDERR "(\$$var => \$${prefix}_$var) "
if $debug;
$var = $prefix . '_' . $var;
$val = $state->get($var);
}
else {
# raise a warning if EXPAND_WARN set
if ($expand & AppConfig::EXPAND_WARN) {
$state->_error("$var: no such variable");
$warnings++;
}
# replace variable with nothing
$val = '';
}
# $val gets substituted back into the $value string
$val;
}gex;
$$value =~ s/\\\$/\$/g;
# bail out now if we need to
last EXPAND if $warnings && $pedantic;
}
#
# EXPAND_UID
# expand ~uid as home directory (for $< if uid not specified)
#
if ($expand & AppConfig::EXPAND_UID) {
$$value =~ s{
~(\w+)? # $1 => username (optional)
} {
$val = undef;
# embedded user name may be in $1
if (defined ($var = $1)) {
# try and get user's home directory
if ($sys->can_getpwnam()) {
$val = ($sys->getpwnam($var))[7];
}
} else {
# determine home directory
$val = $ENV{ HOME };
}
# catch-all for undefined $dir
unless (defined $val) {
# raise a warning if EXPAND_WARN set
if ($expand & AppConfig::EXPAND_WARN) {
$state->_error("cannot determine home directory%s",
defined $var ? " for $var" : "");
$warnings++;
}
# replace variable with nothing
$val = '';
}
# $val gets substituted back into the $value string
$val;
}gex;
# bail out now if we need to
last EXPAND if $warnings && $pedantic;
}
#
# EXPAND_ENV
# expand ${VAR} as environment variables
#
if ($expand & AppConfig::EXPAND_ENV) {
$$value =~ s{
( \$ \{ (\w+) \} )
} {
$var = $2;
# expand the variable if defined
if (exists $ENV{ $var }) {
$val = $ENV{ $var };
} elsif ( $var eq 'HOME' ) {
# In the special case of HOME, if not set
# use the internal version
$val = $self->{ HOME };
} else {
# raise a warning if EXPAND_WARN set
if ($expand & AppConfig::EXPAND_WARN) {
$state->_error("$var: no such environment variable");
$warnings++;
}
# replace variable with nothing
$val = '';
}
# $val gets substituted back into the $value string
$val;
}gex;
# bail out now if we need to
last EXPAND if $warnings && $pedantic;
}
}
print STDERR "=> [$$value] (EXPAND = $expand)\n" if $debug;
# return status
return $warnings ? 0 : 1;
}
#------------------------------------------------------------------------
# _dump()
#
# Dumps the contents of the Config object.
#------------------------------------------------------------------------
sub _dump {
my $self = shift;
foreach my $key (keys %$self) {
printf("%-10s => %s\n", $key,
defined($self->{ $key }) ? $self->{ $key } : "<undef>");
}
}
1;
__END__
=head1 NAME
AppConfig::File - Perl5 module for reading configuration files.
=head1 SYNOPSIS
use AppConfig::File;
my $state = AppConfig::State->new(\%cfg1);
my $cfgfile = AppConfig::File->new($state, $file);
$cfgfile->parse($file); # read config file
=head1 OVERVIEW
AppConfig::File is a Perl5 module which reads configuration files and use
the contents therein to update variable values in an AppConfig::State
object.
AppConfig::File is distributed as part of the AppConfig bundle.
=head1 DESCRIPTION
=head2 USING THE AppConfig::File MODULE
To import and use the AppConfig::File module the following line should appear
in your Perl script:
use AppConfig::File;
AppConfig::File is used automatically if you use the AppConfig module
and create an AppConfig::File object through the file() method.
AppConfig::File is implemented using object-oriented methods. A new
AppConfig::File object is created and initialised using the
AppConfig::File->new() method. This returns a reference to a new
AppConfig::File object. A reference to an AppConfig::State object
should be passed in as the first parameter:
my $state = AppConfig::State->new();
my $cfgfile = AppConfig::File->new($state);
This will create and return a reference to a new AppConfig::File object.
=head2 READING CONFIGURATION FILES
The C<parse()> method is used to read a configuration file and have the
contents update the STATE accordingly.
$cfgfile->parse($file);
Multiple files maye be specified and will be read in turn.
$cfgfile->parse($file1, $file2, $file3);
The method will return an undef value if it encounters any errors opening
the files. It will return immediately without processing any further files.
By default, the PEDANTIC option in the AppConfig::State object,
$self->{ STATE }, is turned off and any parsing errors (invalid variables,
unvalidated values, etc) will generated warnings, but not cause the method
to return. Having processed all files, the method will return 1 if all
files were processed without warning or 0 if one or more warnings were
raised. When the PEDANTIC option is turned on, the method generates a
warning and immediately returns a value of 0 as soon as it encounters any
parsing error.
Variables values in the configuration files may be expanded depending on
the value of their EXPAND option, as determined from the App::State object.
See L<AppConfig::State> for more information on variable expansion.
=head2 CONFIGURATION FILE FORMAT
A configuration file may contain blank lines and comments which are
ignored. Comments begin with a '#' as the first character on a line
or following one or more whitespace tokens, and continue to the end of
the line.
# this is a comment
foo = bar # so is this
url = index.html#hello # this too, but not the '#welcome'
Notice how the '#welcome' part of the URL is not treated as a comment
because a whitespace character doesn't precede it.
Long lines can be continued onto the next line by ending the first
line with a '\'.
callsign = alpha bravo camel delta echo foxtrot golf hipowls \
india juliet kilo llama mike november oscar papa \
quebec romeo sierra tango umbrella victor whiskey \
x-ray yankee zebra
Variables that are simple flags and do not expect an argument (ARGCOUNT =
ARGCOUNT_NONE) can be specified without any value. They will be set with
the value 1, with any value explicitly specified (except "0" and "off")
being ignored. The variable may also be specified with a "no" prefix to
implicitly set the variable to 0.
verbose # on (1)
verbose = 1 # on (1)
verbose = 0 # off (0)
verbose off # off (0)
verbose on # on (1)
verbose mumble # on (1)
noverbose # off (0)
Variables that expect an argument (ARGCOUNT = ARGCOUNT_ONE) will be set to
whatever follows the variable name, up to the end of the current line. An
equals sign may be inserted between the variable and value for clarity.
room = /home/kitchen
room /home/bedroom
Each subsequent re-definition of the variable value overwrites the previous
value.
print $config->room(); # prints "/home/bedroom"
Variables may be defined to accept multiple values (ARGCOUNT = ARGCOUNT_LIST).
Each subsequent definition of the variable adds the value to the list of
previously set values for the variable.
drink = coffee
drink = tea
A reference to a list of values is returned when the variable is requested.
my $beverages = $config->drinks();
print join(", ", @$beverages); # prints "coffee, tea"
Variables may also be defined as hash lists (ARGCOUNT = ARGCOUNT_HASH).
Each subsequent definition creates a new key and value in the hash array.
alias l="ls -CF"
alias h="history"
A reference to the hash is returned when the variable is requested.
my $aliases = $config->alias();
foreach my $k (keys %$aliases) {
print "$k => $aliases->{ $k }\n";
}
A large chunk of text can be defined using Perl's "heredoc" quoting
style.
scalar = <<BOUNDARY_STRING
line 1
line 2: Space/linebreaks within a HERE document are kept.
line 3: The last linebreak (\n) is stripped.
BOUNDARY_STRING
hash key1 = <<'FOO'
* Quotes (['"]) around the boundary string are simply ignored.
* Whether the variables in HERE document are expanded depends on
the EXPAND option of the variable or global setting.
FOO
hash = key2 = <<"_bar_"
Text within HERE document are kept as is.
# comments are treated as a normal text.
The same applies to line continuation. \
_bar_
Note that you cannot use HERE document as a key in a hash or a name
of a variable.
The '-' prefix can be used to reset a variable to its default value and
the '+' prefix can be used to set it to 1
-verbose
+debug
Variable, environment variable and tilde (home directory) expansions
Variable values may contain references to other AppConfig variables,
environment variables and/or users' home directories. These will be
expanded depending on the EXPAND value for each variable or the GLOBAL
EXPAND value.
Three different expansion types may be applied:
bin = ~/bin # expand '~' to home dir if EXPAND_UID
tmp = ~abw/tmp # as above, but home dir for user 'abw'
perl = $bin/perl # expand value of 'bin' variable if EXPAND_VAR
ripl = $(bin)/ripl # as above with explicit parens
home = ${HOME} # expand HOME environment var if EXPAND_ENV
See L<AppConfig::State> for more information on expanding variable values.
The configuration files may have variables arranged in blocks. A block
header, consisting of the block name in square brackets, introduces a
configuration block. The block name and an underscore are then prefixed
to the names of all variables subsequently referenced in that block. The
block continues until the next block definition or to the end of the current
file.
[block1]
foo = 10 # block1_foo = 10
[block2]
foo = 20 # block2_foo = 20
=head1 AUTHOR
Andy Wardley, E<lt>abw@wardley.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
AppConfig, AppConfig::State
=cut
perl5/5.32/FFI/CheckLib.pm 0000444 00000051122 15157556200 0010575 0 ustar 00 package FFI::CheckLib;
use strict;
use warnings;
use File::Spec;
use List::Util 1.33 qw( any );
use Carp qw( croak carp );
use Env qw( @FFI_CHECKLIB_PATH );
use base qw( Exporter );
our @EXPORT = qw(
find_lib
assert_lib
check_lib
check_lib_or_exit
find_lib_or_exit
find_lib_or_die
);
our @EXPORT_OK = qw(
which
where
has_symbols
);
# ABSTRACT: Check that a library is available for FFI
our $VERSION = '0.31'; # VERSION
our $system_path = [];
our $os ||= $^O;
my $try_ld_on_text = 0;
sub _homebrew_lib_path {
require File::Which;
return undef unless File::Which::which('brew');
chomp(my $brew_path = (qx`brew --prefix`)[0]);
return "$brew_path/lib";
}
sub _macports_lib_path {
require File::Which;
my $port_path = File::Which::which('port');
return undef unless $port_path;
$port_path =~ s|bin/port|lib|;
return $port_path;
}
sub _darwin_extra_paths {
my $pkg_managers = lc( $ENV{FFI_CHECKLIB_PACKAGE} || 'homebrew,macports' );
return () if $pkg_managers eq 'none';
my $supported_managers = {
homebrew => \&_homebrew_lib_path,
macports => \&_macports_lib_path
};
my @extra_paths = ();
foreach my $pkg_manager (split( /,/, $pkg_managers )) {
if (my $lib_path = $supported_managers->{$pkg_manager}()) {
push @extra_paths, $lib_path;
}
}
return @extra_paths;
}
my @extra_paths = ();
if($os eq 'MSWin32' || $os eq 'msys')
{
$system_path = eval {
require Env;
Env->import('@PATH');
\our @PATH;
};
die $@ if $@;
}
else
{
$system_path = eval {
require DynaLoader;
no warnings 'once';
\@DynaLoader::dl_library_path;
};
die $@ if $@;
@extra_paths = _darwin_extra_paths() if $os eq 'darwin';
}
our $pattern = [ qr{^lib(.*?)\.so(?:\.([0-9]+(?:\.[0-9]+)*))?$} ];
our $version_split = qr/\./;
if($os eq 'cygwin')
{
push @$pattern, qr{^cyg(.*?)(?:-([0-9])+)?\.dll$};
}
elsif($os eq 'msys')
{
# doesn't seem as though msys uses psudo libfoo.so files
# in the way that cygwin sometimes does. we can revisit
# this if we find otherwise.
$pattern = [ qr{^msys-(.*?)(?:-([0-9])+)?\.dll$} ];
}
elsif($os eq 'MSWin32')
{
# handle cases like libgeos-3-7-0___.dll, libproj_9_1.dll and libgtk-2.0-0.dll
$pattern = [ qr{^(?:lib)?(\w+?)(?:[_-]([0-9\-\._]+))?_*\.dll$}i ];
$version_split = qr/[_\-]/;
}
elsif($os eq 'darwin')
{
push @$pattern, qr{^lib(.*?)(?:\.([0-9]+(?:\.[0-9]+)*))?\.(?:dylib|bundle)$};
}
elsif($os eq 'linux')
{
if(-e '/etc/redhat-release' && -x '/usr/bin/ld')
{
$try_ld_on_text = 1;
}
}
sub _matches
{
my($filename, $path) = @_;
foreach my $regex (@$pattern)
{
return [
$1, # 0 capture group 1 library name
File::Spec->catfile($path, $filename), # 1 full path to library
defined $2 ? (split $version_split, $2) : (), # 2... capture group 2 library version
] if $filename =~ $regex;
}
return ();
}
sub _cmp
{
my($A,$B) = @_;
return $A->[0] cmp $B->[0] if $A->[0] ne $B->[0];
my $i=2;
while(1)
{
return 0 if !defined($A->[$i]) && !defined($B->[$i]);
return -1 if !defined $A->[$i];
return 1 if !defined $B->[$i];
return $B->[$i] <=> $A->[$i] if $A->[$i] != $B->[$i];
$i++;
}
}
my $diagnostic;
sub _is_binary
{
-B $_[0]
}
sub find_lib
{
my(%args) = @_;
undef $diagnostic;
croak "find_lib requires lib argument" unless defined $args{lib};
my $recursive = $args{_r} || $args{recursive} || 0;
# make arguments be lists.
foreach my $arg (qw( lib libpath symbol verify alien ))
{
next if ref $args{$arg} eq 'ARRAY';
if(defined $args{$arg})
{
$args{$arg} = [ $args{$arg} ];
}
else
{
$args{$arg} = [];
}
}
if(defined $args{systempath} && !ref($args{systempath}))
{
$args{systempath} = [ $args{systempath} ];
}
my @path = @{ $args{libpath} };
@path = map { _recurse($_) } @path if $recursive;
if(defined $args{systempath})
{
push @path, grep { defined } @{ $args{systempath} }
}
else
{
# This is a little convaluted, but:
# 1. These are modifications of what we consider the "system" path
# if systempath isn't explicitly passed in as systempath
# 2. FFI_CHECKLIB_PATH is considered an authortative modification
# so it goes first and overrides FFI_CHECKLIB_PACKAGE
# 3. otherwise FFI_CHECKLIB_PACKAGE does its thing and goes on
# the end because homebrew does a good job of not replacing
# anything in the system by default.
# 4. We finally add what we consider the "system" path to the end of
# the search path so that libpath will be searched first.
my @system_path = @$system_path;
if($ENV{FFI_CHECKLIB_PATH})
{
@system_path = (@FFI_CHECKLIB_PATH, @system_path);
}
else
{
foreach my $extra_path (@extra_paths)
{
push @path, $extra_path unless any { $_ eq $extra_path } @path;
}
}
push @path, @system_path;
}
my $any = any { $_ eq '*' } @{ $args{lib} };
my %missing = map { $_ => 1 } @{ $args{lib} };
my %symbols = map { $_ => 1 } @{ $args{symbol} };
my @found;
delete $missing{'*'};
alien: foreach my $alien (reverse @{ $args{alien} })
{
unless($alien =~ /^([A-Za-z_][A-Za-z_0-9]*)(::[A-Za-z_][A-Za-z_0-9]*)*$/)
{
croak "Doesn't appear to be a valid Alien name $alien";
}
unless(eval { $alien->can('dynamic_libs') })
{
{
my $pm = "$alien.pm";
$pm =~ s/::/\//g;
local $@ = '';
eval { require $pm };
next alien if $@;
}
unless(eval { $alien->can('dynamic_libs') })
{
croak "Alien $alien doesn't provide a dynamic_libs method";
}
}
unshift @path, [$alien->dynamic_libs];
}
foreach my $path (@path)
{
next if ref $path ne 'ARRAY' && ! -d $path;
my @maybe =
# make determinist based on names and versions
sort { _cmp($a,$b) }
# Filter out the items that do not match the name that we are looking for
# Filter out any broken symbolic links
grep { ($any || $missing{$_->[0]} ) && (-e $_->[1]) }
ref $path eq 'ARRAY'
? do {
map {
my($v, $d, $f) = File::Spec->splitpath($_);
_matches($f, File::Spec->catpath($v,$d,''));
} @$path;
}
: do {
my $dh;
opendir $dh, $path;
# get [ name, full_path ] mapping,
# each entry is a 2 element list ref
map { _matches($_,$path) } readdir $dh;
};
if($try_ld_on_text && $args{try_linker_script})
{
# This is tested in t/ci.t only
@maybe = map {
-B $_->[1] ? $_ : do {
my($name, $so) = @$_;
my $output = `/usr/bin/ld -t $so -o /dev/null -shared`;
$output =~ /\((.*?lib.*\.so.*?)\)/
? [$name, $1]
: die "unable to parse ld output";
}
} @maybe;
}
midloop:
foreach my $lib (@maybe)
{
next unless $any || $missing{$lib->[0]};
foreach my $verify (@{ $args{verify} })
{
next midloop unless $verify->(@$lib);
}
delete $missing{$lib->[0]};
if(%symbols)
{
require DynaLoader;
my $dll = DynaLoader::dl_load_file($lib->[1],0);
foreach my $symbol (keys %symbols)
{
if(DynaLoader::dl_find_symbol($dll, $symbol) ? 1 : 0)
{
delete $symbols{$symbol}
}
}
DynaLoader::dl_unload_file($dll);
}
my $found = $lib->[1];
unless($any)
{
while(-l $found)
{
require File::Basename;
my $dir = File::Basename::dirname($found);
$found = File::Spec->rel2abs( readlink($found), $dir );
}
}
push @found, $found;
}
}
if(%missing)
{
my @missing = sort keys %missing;
if(@missing > 1)
{ $diagnostic = "libraries not found: @missing" }
else
{ $diagnostic = "library not found: @missing" }
}
elsif(%symbols)
{
my @missing = sort keys %symbols;
if(@missing > 1)
{ $diagnostic = "symbols not found: @missing" }
else
{ $diagnostic = "symbol not found: @missing" }
}
return if %symbols;
return $found[0] unless wantarray;
return @found;
}
sub _recurse
{
my($dir) = @_;
return unless -d $dir;
my $dh;
opendir $dh, $dir;
my @list = grep { -d $_ } map { File::Spec->catdir($dir, $_) } grep !/^\.\.?$/, readdir $dh;
closedir $dh;
($dir, map { _recurse($_) } @list);
}
sub assert_lib
{
croak $diagnostic || 'library not found' unless check_lib(@_);
}
sub check_lib_or_exit
{
unless(check_lib(@_))
{
carp $diagnostic || 'library not found';
exit;
}
}
sub find_lib_or_exit
{
my(@libs) = find_lib(@_);
unless(@libs)
{
carp $diagnostic || 'library not found';
exit;
}
return unless @libs;
wantarray ? @libs : $libs[0];
}
sub find_lib_or_die
{
my(@libs) = find_lib(@_);
unless(@libs)
{
croak $diagnostic || 'library not found';
}
return unless @libs;
wantarray ? @libs : $libs[0];
}
sub check_lib
{
find_lib(@_) ? 1 : 0;
}
sub which
{
my($name) = @_;
croak("cannot which *") if $name eq '*';
scalar find_lib( lib => $name );
}
sub where
{
my($name) = @_;
$name eq '*'
? find_lib(lib => '*')
: find_lib(lib => '*', verify => sub { $_[0] eq $name });
}
sub has_symbols
{
my($path, @symbols) = @_;
require DynaLoader;
my $dll = DynaLoader::dl_load_file($path, 0);
my $ok = 1;
foreach my $symbol (@symbols)
{
unless(DynaLoader::dl_find_symbol($dll, $symbol))
{
$ok = 0;
last;
}
}
DynaLoader::dl_unload_file($dll);
$ok;
}
sub system_path
{
$system_path;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::CheckLib - Check that a library is available for FFI
=head1 VERSION
version 0.31
=head1 SYNOPSIS
use FFI::CheckLib;
check_lib_or_exit( lib => 'jpeg', symbol => 'jinit_memory_mgr' );
check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] );
# or prompt for path to library and then:
print "where to find jpeg library: ";
my $path = <STDIN>;
check_lib_or_exit( lib => 'jpeg', libpath => $path );
=head1 DESCRIPTION
This module checks whether a particular dynamic library is available for
FFI to use. It is modeled heavily on L<Devel::CheckLib>, but will find
dynamic libraries even when development packages are not installed. It
also provides a L<find_lib|FFI::CheckLib#find_lib> function that will
return the full path to the found dynamic library, which can be feed
directly into L<FFI::Platypus> or another FFI system.
Although intended mainly for FFI modules via L<FFI::Platypus> and
similar, this module does not actually use any FFI to do its detection
and probing. This module does not have any non-core runtime dependencies.
The test suite does depend on L<Test2::Suite>.
=head1 FUNCTIONS
All of these take the same named parameters and are exported by default.
=head2 find_lib
my(@libs) = find_lib(%args);
This will return a list of dynamic libraries, or empty list if none were
found.
[version 0.05]
If called in scalar context it will return the first library found.
Arguments are key value pairs with these keys:
=over 4
=item lib
Must be either a string with the name of a single library or a reference
to an array of strings of library names. Depending on your platform,
C<CheckLib> will prepend C<lib> or append C<.dll> or C<.so> when
searching.
[version 0.11]
As a special case, if C<*> is specified then any libs found will match.
=item libpath
A string or array of additional paths to search for libraries.
=item systempath
[version 0.11]
A string or array of system paths to search for instead of letting
L<FFI::CheckLib> determine the system path. You can set this to C<[]>
in order to not search I<any> system paths.
=item symbol
A string or a list of symbol names that must be found.
=item verify
A code reference used to verify a library really is the one that you
want. It should take two arguments, which is the name of the library
and the full path to the library pathname. It should return true if it
is acceptable, and false otherwise. You can use this in conjunction
with L<FFI::Platypus> to determine if it is going to meet your needs.
Example:
use FFI::CheckLib;
use FFI::Platypus;
my($lib) = find_lib(
lib => 'foo',
verify => sub {
my($name, $libpath) = @_;
my $ffi = FFI::Platypus->new;
$ffi->lib($libpath);
my $f = $ffi->function('foo_version', [] => 'int');
return $f->call() >= 500; # we accept version 500 or better
},
);
=item recursive
[version 0.11]
Recursively search for libraries in any non-system paths (those provided
via C<libpath> above).
=item try_linker_script
[version 0.24]
Some vendors provide C<.so> files that are linker scripts that point to
the real binary shared library. These linker scripts can be used by gcc
or clang, but are not directly usable by L<FFI::Platypus> and friends.
On select platforms, this options will use the linker command (C<ld>)
to attempt to resolve the real C<.so> for non-binary files. Since there
is extra overhead this is off by default.
An example is libyaml on Red Hat based Linux distributions. On Debian
these are handled with symlinks and no trickery is required.
=item alien
[version 0.25]
If no libraries can be found, try the given aliens instead. The Alien
classes specified must provide the L<Alien::Base> interface for dynamic
libraries, which is to say they should provide a method called
C<dynamic_libs> that returns a list of dynamic libraries.
[version 0.28]
In 0.28 and later, if the L<Alien> is not installed then it will be
ignored and this module will search in system or specified directories
only. This module I<will> still throw an exception, if the L<Alien>
doesn't look like a module name or if it does not provide a C<dynamic_libs>
method (which is implemented by all L<Alien::Base> subclasses).
[version 0.30]
[breaking change]
Starting with version 0.30, libraries provided by L<Alien>s is preferred
over the system libraries. The original thinking was that you want to
prefer the system libraries because they are more likely to get patched
with regular system updates. Unfortunately, the reason a module needs to
install an Alien is likely because the system library is not new enough,
so we now prefer the L<Alien>s instead.
=back
=head2 assert_lib
assert_lib(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that instead of returning empty list of failure it throws an
exception.
=head2 check_lib_or_exit
check_lib_or_exit(%args);
This behaves exactly the same as L<assert_lib|FFI::CheckLib#assert_lib>,
except that instead of dying, it warns (with exactly the same error
message) and exists. This is intended for use in C<Makefile.PL> or
C<Build.PL>
=head2 find_lib_or_exit
[version 0.05]
my(@libs) = find_lib_or_exit(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that if the library is not found, it will call exit with an
appropriate diagnostic.
=head2 find_lib_or_die
[version 0.06]
my(@libs) = find_lib_or_die(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that if the library is not found, it will die with an appropriate
diagnostic.
=head2 check_lib
my $bool = check_lib(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that it returns true (1) on finding the appropriate libraries or
false (0) otherwise.
=head2 which
[version 0.17]
my $path = which($name);
Return the path to the first library that matches the given name.
Not exported by default.
=head2 where
[version 0.17]
my @paths = where($name);
Return the paths to all the libraries that match the given name.
Not exported by default.
=head2 has_symbols
[version 0.17]
my $bool = has_symbols($path, @symbol_names);
Returns true if I<all> of the symbols can be found in the dynamic library located
at the given path. Can be useful in conjunction with C<verify> with C<find_lib>
above.
Not exported by default.
=head2 system_path
[version 0.20]
my $path = FFI::CheckLib::system_path;
Returns the system path as a list reference. On some systems, this is C<PATH>
on others it might be C<LD_LIBRARY_PATH> on still others it could be something
completely different. So although you I<may> add items to this list, you should
probably do some careful consideration before you do so.
This function is not exportable, even on request.
=head1 ENVIRONMENT
L<FFI::CheckLib> responds to these environment variables:
=over 4
=item FFI_CHECKLIB_PACKAGE
On macOS platforms with L<Homebrew|http://brew.sh> and/or L<MacPorts|https://www.macports.org>
installed, their corresponding lib paths will be automatically appended to C<$system_path>.
In case of having both managers installed, Homebrew will appear before.
This behaviour can be overridden using the environment variable C<FFI_CHECKLIB_PACKAGE>.
Allowed values are:
- C<none>: Won't use either Homebrew's path nor MacPorts
- C<homebrew>: Will append C<$(brew --prefix)/lib> to the system paths
- C<macports>: Will append C<port>'s default lib path
A comma separated list is also valid:
export FFI_CHECKLIB_PACKAGE=macports,homebrew
Order matters. So in this example, MacPorts' lib path appears before Homebrew's path.
=item FFI_CHECKLIB_PATH
List of directories that will be considered by L<FFI::CheckLib> as additional "system
directories". They will be searched before other system directories but after C<libpath>.
The variable is colon separated on Unix and semicolon separated on Windows. If you
use this variable, C<FFI_CHECKLIB_PACKAGE> will be ignored.
=item PATH
On Windows the C<PATH> environment variable will be used as a search path for
libraries.
=back
On some operating systems C<LD_LIBRARY_PATH>, C<DYLD_LIBRARY_PATH>,
C<DYLD_FALLBACK_LIBRARY_PATH> or others I<may> be used as part of the search
for dynamic libraries and I<may> be used (indirectly) by L<FFI::CheckLib>
as well.
=head1 FAQ
=over 4
=item Why not just use C<dlopen>?
Calling C<dlopen> on a library name and then C<dlclose> immediately can tell
you if you have the exact name of a library available on a system. It does
have a number of drawbacks as well.
=over 4
=item No absolute or relative path
It only tells you that the library is I<somewhere> on the system, not having
the absolute or relative path makes it harder to generate useful diagnostics.
=item POSIX only
This doesn't work on non-POSIX systems like Microsoft Windows. If you are
using a POSIX emulation layer on Windows that provides C<dlopen>, like
Cygwin, there are a number of gotchas there as well. Having a layer written
in Perl handles this means that developers on Unix can develop FFI that will
more likely work on these platforms without special casing them.
=item inconsistent implementations
Even on POSIX systems you have inconsistent implementations. OpenBSD for
example don't usually include symlinks for C<.so> files meaning you need
to know the exact C<.so> version.
=item non-system directories
By default C<dlopen> only works for libraries in the system paths. Most
platforms have a way of configuring the search for different non-system
paths, but none of them are portable, and are usually discouraged anyway.
L<Alien> and friends need to do searches for dynamic libraries in
non-system directories for C<share> installs.
=back
=item My 64-bit Perl is misconfigured and has 32-bit libraries in its search path. Is that a bug in L<FFI::CheckLib>?
Nope.
=item The way L<FFI::CheckLib> is implemented it won't work on AIX, HP-UX, OpenVMS or Plan 9.
I know for a fact that it doesn't work on AIX I<as currently implemented>
because I used to develop on AIX in the early 2000s, and I am aware of some
of the technical challenges. There are probably other systems that it won't
work on. I would love to add support for these platforms. Realistically
these platforms have a tiny market share, and absent patches from users or
the companies that own these operating systems (patches welcome), or hardware
/ CPU time donations, these platforms are unsupportable anyway.
=back
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Call library functions dynamically without a compiler.
=item L<Dist::Zilla::Plugin::FFI::CheckLib>
L<Dist::Zilla> plugin for this module.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dan Book (grinnz, DBOOK)
Ilya Pavlov (Ilya, ILUX)
Shawn Laffan (SLAFFAN)
Petr Písař (ppisar)
Michael R. Davis (MRDVT)
Shawn Laffan (SLAFFAN)
Carlos D. Álvaro (cdalvaro)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014-2022 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
perl5/5.32/IO/Lines.pm 0000444 00000010112 15157556212 0010103 0 ustar 00 package IO::Lines;
use strict;
use Carp;
use IO::ScalarArray;
# The package version, both in 1.23 style *and* usable by MakeMaker:
our $VERSION = '2.113';
# Inheritance:
our @ISA = qw(IO::ScalarArray); ### also gets us new_tie :-)
=head1 NAME
IO::Lines - IO:: interface for reading/writing an array of lines
=head1 SYNOPSIS
use IO::Lines;
### See IO::ScalarArray for details
=head1 DESCRIPTION
This class implements objects which behave just like FileHandle
(or IO::Handle) objects, except that you may use them to write to
(or read from) an array of lines. C<tiehandle> capable as well.
This is a subclass of L<IO::ScalarArray|IO::ScalarArray>
in which the underlying
array has its data stored in a line-oriented-format: that is,
every element ends in a C<"\n">, with the possible exception of the
final element. This makes C<getline()> I<much> more efficient;
if you plan to do line-oriented reading/printing, you want this class.
The C<print()> method will enforce this rule, so you can print
arbitrary data to the line-array: it will break the data at
newlines appropriately.
See L<IO::ScalarArray> for full usage and warnings.
=cut
#------------------------------
#
# getline
#
# Instance method, override.
# Return the next line, or undef on end of data.
# Can safely be called in an array context.
# Currently, lines are delimited by "\n".
#
sub getline {
my $self = shift;
if (!defined $/) {
return join( '', $self->_getlines_for_newlines );
}
elsif ($/ eq "\n") {
if (!*$self->{Pos}) { ### full line...
return *$self->{AR}[*$self->{Str}++];
}
else { ### partial line...
my $partial = substr(*$self->{AR}[*$self->{Str}++], *$self->{Pos});
*$self->{Pos} = 0;
return $partial;
}
}
else {
croak 'unsupported $/: must be "\n" or undef';
}
}
#------------------------------
#
# getlines
#
# Instance method, override.
# Return an array comprised of the remaining lines, or () on end of data.
# Must be called in an array context.
# Currently, lines are delimited by "\n".
#
sub getlines {
my $self = shift;
wantarray or croak("can't call getlines in scalar context!");
if ((defined $/) and ($/ eq "\n")) {
return $self->_getlines_for_newlines(@_);
}
else { ### slow but steady
return $self->SUPER::getlines(@_);
}
}
#------------------------------
#
# _getlines_for_newlines
#
# Instance method, private.
# If $/ is newline, do fast getlines.
# This CAN NOT invoke getline!
#
sub _getlines_for_newlines {
my $self = shift;
my ($rArray, $Str, $Pos) = @{*$self}{ qw( AR Str Pos ) };
my @partial = ();
if ($Pos) { ### partial line...
@partial = (substr( $rArray->[ $Str++ ], $Pos ));
*$self->{Pos} = 0;
}
*$self->{Str} = scalar @$rArray; ### about to exhaust @$rArray
return (@partial,
@$rArray[ $Str .. $#$rArray ]); ### remaining full lines...
}
#------------------------------
#
# print ARGS...
#
# Instance method, override.
# Print ARGS to the underlying line array.
#
sub print {
if (defined $\ && $\ ne "\n") {
croak 'unsupported $\: must be "\n" or undef';
}
my $self = shift;
### print STDERR "\n[[ARRAY WAS...\n", @{*$self->{AR}}, "<<EOF>>\n";
my @lines = split /^/, join('', @_); @lines or return 1;
### Did the previous print not end with a newline?
### If so, append first line:
if (@{*$self->{AR}} and (*$self->{AR}[-1] !~ /\n\Z/)) {
*$self->{AR}[-1] .= shift @lines;
}
push @{*$self->{AR}}, @lines; ### add the remainder
### print STDERR "\n[[ARRAY IS NOW...\n", @{*$self->{AR}}, "<<EOF>>\n";
1;
}
#------------------------------
1;
__END__
=head1 VERSION
$Id: Lines.pm,v 1.3 2005/02/10 21:21:53 dfs Exp $
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/IO/InnerFile.pm 0000444 00000015601 15157556220 0010713 0 ustar 00 package IO::InnerFile;
use strict;
use warnings;
use Symbol;
our $VERSION = '2.113';
sub new {
my ($class, $fh, $start, $lg) = @_;
$start = 0 if (!$start or ($start < 0));
$lg = 0 if (!$lg or ($lg < 0));
### Create the underlying "object":
my $a = {
FH => $fh,
CRPOS => 0,
START => $start,
LG => $lg,
};
### Create a new filehandle tied to this object:
$fh = gensym;
tie(*$fh, $class, $a);
return bless($fh, $class);
}
sub TIEHANDLE {
my ($class, $data) = @_;
return bless($data, $class);
}
sub DESTROY {
my ($self) = @_;
$self->close() if (ref($self) eq 'SCALAR');
}
sub set_length { tied(${$_[0]})->{LG} = $_[1]; }
sub get_length { tied(${$_[0]})->{LG}; }
sub add_length { tied(${$_[0]})->{LG} += $_[1]; }
sub set_start { tied(${$_[0]})->{START} = $_[1]; }
sub get_start { tied(${$_[0]})->{START}; }
sub set_end { tied(${$_[0]})->{LG} = $_[1] - tied(${$_[0]})->{START}; }
sub get_end { tied(${$_[0]})->{LG} + tied(${$_[0]})->{START}; }
sub write { shift->WRITE(@_) }
sub print { shift->PRINT(@_) }
sub printf { shift->PRINTF(@_) }
sub flush { "0 but true"; }
sub fileno { }
sub binmode { 1; }
sub getc { return GETC(tied(${$_[0]}) ); }
sub read { return READ( tied(${$_[0]}), @_[1,2,3] ); }
sub readline { return READLINE( tied(${$_[0]}) ); }
sub getline { return READLINE( tied(${$_[0]}) ); }
sub close { return CLOSE(tied(${$_[0]}) ); }
sub seek {
my ($self, $ofs, $whence) = @_;
$self = tied( $$self );
$self->{CRPOS} = $ofs if ($whence == 0);
$self->{CRPOS}+= $ofs if ($whence == 1);
$self->{CRPOS} = $self->{LG} + $ofs if ($whence == 2);
$self->{CRPOS} = 0 if ($self->{CRPOS} < 0);
$self->{CRPOS} = $self->{LG} if ($self->{CRPOS} > $self->{LG});
return 1;
}
sub tell {
return tied(${$_[0]})->{CRPOS};
}
sub WRITE {
die "inner files can only open for reading\n";
}
sub PRINT {
die "inner files can only open for reading\n";
}
sub PRINTF {
die "inner files can only open for reading\n";
}
sub GETC {
my ($self) = @_;
return 0 if ($self->{CRPOS} >= $self->{LG});
my $data;
### Save and seek...
my $old_pos = $self->{FH}->tell;
$self->{FH}->seek($self->{CRPOS}+$self->{START}, 0);
### ...read...
my $lg = $self->{FH}->read($data, 1);
$self->{CRPOS} += $lg;
### ...and restore:
$self->{FH}->seek($old_pos, 0);
$self->{LG} = $self->{CRPOS} unless ($lg);
return ($lg ? $data : undef);
}
sub READ {
my ($self, $undefined, $lg, $ofs) = @_;
$undefined = undef;
return 0 if ($self->{CRPOS} >= $self->{LG});
$lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG});
return 0 unless ($lg);
### Save and seek...
my $old_pos = $self->{FH}->tell;
$self->{FH}->seek($self->{CRPOS}+$self->{START}, 0);
### ...read...
$lg = $self->{FH}->read($_[1], $lg, $_[3] );
$self->{CRPOS} += $lg;
### ...and restore:
$self->{FH}->seek($old_pos, 0);
$self->{LG} = $self->{CRPOS} unless ($lg);
return $lg;
}
sub READLINE {
my ($self) = @_;
return $self->_readline_helper() unless wantarray;
my @arr;
while(defined(my $line = $self->_readline_helper())) {
push(@arr, $line);
}
return @arr;
}
sub _readline_helper {
my ($self) = @_;
return undef if ($self->{CRPOS} >= $self->{LG});
# Handle slurp mode (CPAN ticket #72710)
if (! defined($/)) {
my $text;
$self->READ($text, $self->{LG} - $self->{CRPOS});
return $text;
}
### Save and seek...
my $old_pos = $self->{FH}->tell;
$self->{FH}->seek($self->{CRPOS}+$self->{START}, 0);
### ...read...
my $text = $self->{FH}->getline;
### ...and restore:
$self->{FH}->seek($old_pos, 0);
#### If we detected a new EOF ...
unless (defined $text) {
$self->{LG} = $self->{CRPOS};
return undef;
}
my $lg=length($text);
$lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG});
$self->{CRPOS} += $lg;
return substr($text, 0,$lg);
}
sub CLOSE { %{$_[0]}=(); }
1;
__END__
__END__
=head1 NAME
IO::InnerFile - define a file inside another file
=head1 SYNOPSIS
use strict;
use warnings;
use IO::InnerFile;
# Read a subset of a file:
my $fh = _some_file_handle;
my $start = 10;
my $length = 50;
my $inner = IO::InnerFile->new($fh, $start, $length);
while (my $line = <$inner>) {
# ...
}
=head1 DESCRIPTION
If you have a file handle that can C<seek> and C<tell>, then you
can open an L<IO::InnerFile> on a range of the underlying file.
=head1 CONSTRUCTORS
L<IO::InnerFile> implements the following constructors.
=head2 new
my $inner = IO::InnerFile->new($fh);
$inner = IO::InnerFile->new($fh, 10);
$inner = IO::InnerFile->new($fh, 10, 50);
Create a new L<IO::InnerFile> opened on the given file handle.
The file handle supplied B<MUST> be able to both C<seek> and C<tell>.
The second and third parameters are start and length. Both are defaulted
to zero (C<0>). Negative values are silently coerced to zero.
=head1 METHODS
L<IO::InnerFile> implements the following methods.
=head2 add_length
$inner->add_length(30);
Add to the virtual length of the inner file by the number given in bytes.
=head2 add_start
$inner->add_start(30);
Add to the virtual position of the inner file by the number given in bytes.
=head2 binmode
$inner->binmode();
This is a NOOP method just to satisfy the normal L<IO::File> interface.
=head2 close
=head2 fileno
$inner->fileno();
This is a NOOP method just to satisfy the normal L<IO::File> interface.
=head2 flush
$inner->flush();
This is a NOOP method just to satisfy the normal L<IO::File> interface.
=head2 get_end
my $num_bytes = $inner->get_end();
Get the virtual end position of the inner file in bytes.
=head2 get_length
my $num_bytes = $inner->get_length();
Get the virtual length of the inner file in bytes.
=head2 get_start
my $num_bytes = $inner->get_start();
Get the virtual position of the inner file in bytes.
=head2 getc
=head2 getline
=head2 print LIST
=head2 printf
=head2 read
=head2 readline
=head2 seek
=head2 set_end
$inner->set_end(30);
Set the virtual end of the inner file in bytes (this basically just alters the length).
=head2 set_length
$inner->set_length(30);
Set the virtual length of the inner file in bytes.
=head2 set_start
$inner->set_start(30);
Set the virtual start position of the inner file in bytes.
=head2 tell
=head2 write
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/IO/ScalarArray.pm 0000444 00000040077 15157556225 0011256 0 ustar 00 package IO::ScalarArray;
use strict;
use Carp;
use IO::Handle;
# The package version, both in 1.23 style *and* usable by MakeMaker:
our $VERSION = '2.113';
# Inheritance:
our @ISA = qw(IO::Handle);
require IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] >= 5.004);
=head1 NAME
IO::ScalarArray - IO:: interface for reading/writing an array of scalars
=head1 SYNOPSIS
Perform I/O on strings, using the basic OO interface...
use IO::ScalarArray;
@data = ("My mes", "sage:\n");
### Open a handle on an array, and append to it:
$AH = new IO::ScalarArray \@data;
$AH->print("Hello");
$AH->print(", world!\nBye now!\n");
print "The array is now: ", @data, "\n";
### Open a handle on an array, read it line-by-line, then close it:
$AH = new IO::ScalarArray \@data;
while (defined($_ = $AH->getline)) {
print "Got line: $_";
}
$AH->close;
### Open a handle on an array, and slurp in all the lines:
$AH = new IO::ScalarArray \@data;
print "All lines:\n", $AH->getlines;
### Get the current position (either of two ways):
$pos = $AH->getpos;
$offset = $AH->tell;
### Set the current position (either of two ways):
$AH->setpos($pos);
$AH->seek($offset, 0);
### Open an anonymous temporary array:
$AH = new IO::ScalarArray;
$AH->print("Hi there!");
print "I printed: ", @{$AH->aref}, "\n"; ### get at value
Don't like OO for your I/O? No problem.
Thanks to the magic of an invisible tie(), the following now
works out of the box, just as it does with IO::Handle:
use IO::ScalarArray;
@data = ("My mes", "sage:\n");
### Open a handle on an array, and append to it:
$AH = new IO::ScalarArray \@data;
print $AH "Hello";
print $AH ", world!\nBye now!\n";
print "The array is now: ", @data, "\n";
### Open a handle on a string, read it line-by-line, then close it:
$AH = new IO::ScalarArray \@data;
while (<$AH>) {
print "Got line: $_";
}
close $AH;
### Open a handle on a string, and slurp in all the lines:
$AH = new IO::ScalarArray \@data;
print "All lines:\n", <$AH>;
### Get the current position (WARNING: requires 5.6):
$offset = tell $AH;
### Set the current position (WARNING: requires 5.6):
seek $AH, $offset, 0;
### Open an anonymous temporary scalar:
$AH = new IO::ScalarArray;
print $AH "Hi there!";
print "I printed: ", @{$AH->aref}, "\n"; ### get at value
And for you folks with 1.x code out there: the old tie() style still works,
though this is I<unnecessary and deprecated>:
use IO::ScalarArray;
### Writing to a scalar...
my @a;
tie *OUT, 'IO::ScalarArray', \@a;
print OUT "line 1\nline 2\n", "line 3\n";
print "Array is now: ", @a, "\n"
### Reading and writing an anonymous scalar...
tie *OUT, 'IO::ScalarArray';
print OUT "line 1\nline 2\n", "line 3\n";
tied(OUT)->seek(0,0);
while (<OUT>) {
print "Got line: ", $_;
}
=head1 DESCRIPTION
This class is part of the IO::Stringy distribution;
see L<IO::Stringy> for change log and general information.
The IO::ScalarArray class implements objects which behave just like
IO::Handle (or FileHandle) objects, except that you may use them
to write to (or read from) arrays of scalars. Logically, an
array of scalars defines an in-core "file" whose contents are
the concatenation of the scalars in the array. The handles created by
this class are automatically C<tiehandle>d (though please see L<"WARNINGS">
for information relevant to your Perl version).
For writing large amounts of data with individual print() statements,
this class is likely to be more efficient than IO::Scalar.
Basically, this:
my @a;
$AH = new IO::ScalarArray \@a;
$AH->print("Hel", "lo, "); ### OO style
$AH->print("world!\n"); ### ditto
Or this:
my @a;
$AH = new IO::ScalarArray \@a;
print $AH "Hel", "lo, "; ### non-OO style
print $AH "world!\n"; ### ditto
Causes @a to be set to the following array of 3 strings:
( "Hel" ,
"lo, " ,
"world!\n" )
See L<IO::Scalar> and compare with this class.
=head1 PUBLIC INTERFACE
=head2 Construction
=over 4
=cut
#------------------------------
=item new [ARGS...]
I<Class method.>
Return a new, unattached array handle.
If any arguments are given, they're sent to open().
=cut
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = bless \do { local *FH }, $class;
tie *$self, $class, $self;
$self->open(@_); ### open on anonymous by default
$self;
}
sub DESTROY {
shift->close;
}
#------------------------------
=item open [ARRAYREF]
I<Instance method.>
Open the array handle on a new array, pointed to by ARRAYREF.
If no ARRAYREF is given, a "private" array is created to hold
the file data.
Returns the self object on success, undefined on error.
=cut
sub open {
my ($self, $aref) = @_;
### Sanity:
defined($aref) or do {my @a; $aref = \@a};
(ref($aref) eq "ARRAY") or croak "open needs a ref to a array";
### Setup:
$self->setpos([0,0]);
*$self->{AR} = $aref;
$self;
}
#------------------------------
=item opened
I<Instance method.>
Is the array handle opened on something?
=cut
sub opened {
*{shift()}->{AR};
}
#------------------------------
=item close
I<Instance method.>
Disassociate the array handle from its underlying array.
Done automatically on destroy.
=cut
sub close {
my $self = shift;
%{*$self} = ();
1;
}
=back
=cut
#==============================
=head2 Input and output
=over 4
=cut
#------------------------------
=item flush
I<Instance method.>
No-op, provided for OO compatibility.
=cut
sub flush { "0 but true" }
#------------------------------
=item fileno
I<Instance method.>
No-op, returns undef
=cut
sub fileno { }
#------------------------------
=item getc
I<Instance method.>
Return the next character, or undef if none remain.
This does a read(1), which is somewhat costly.
=cut
sub getc {
my $buf = '';
($_[0]->read($buf, 1) ? $buf : undef);
}
#------------------------------
=item getline
I<Instance method.>
Return the next line, or undef on end of data.
Can safely be called in an array context.
Currently, lines are delimited by "\n".
=cut
sub getline {
my $self = shift;
my ($str, $line) = (undef, '');
### Minimal impact implementation!
### We do the fast thing (no regexps) if using the
### classic input record separator.
### Case 1: $/ is undef: slurp all...
if (!defined($/)) {
return undef if ($self->eof);
### Get the rest of the current string, followed by remaining strings:
my $ar = *$self->{AR};
my @slurp = (
substr($ar->[*$self->{Str}], *$self->{Pos}),
@$ar[(1 + *$self->{Str}) .. $#$ar ]
);
### Seek to end:
$self->_setpos_to_eof;
return join('', @slurp);
}
### Case 2: $/ is "\n":
elsif ($/ eq "\012") {
### Until we hit EOF (or exited because of a found line):
until ($self->eof) {
### If at end of current string, go fwd to next one (won't be EOF):
if ($self->_eos) {++*$self->{Str}, *$self->{Pos}=0};
### Get ref to current string in array, and set internal pos mark:
$str = \(*$self->{AR}[*$self->{Str}]); ### get current string
pos($$str) = *$self->{Pos}; ### start matching from here
### Get from here to either \n or end of string, and add to line:
$$str =~ m/\G(.*?)((\n)|\Z)/g; ### match to 1st \n or EOS
$line .= $1.$2; ### add it
*$self->{Pos} += length($1.$2); ### move fwd by len matched
return $line if $3; ### done, got line with "\n"
}
return ($line eq '') ? undef : $line; ### return undef if EOF
}
### Case 3: $/ is ref to int. Bail out.
elsif (ref($/)) {
croak '$/ given as a ref to int; currently unsupported';
}
### Case 4: $/ is either "" (paragraphs) or something weird...
### Bail for now.
else {
croak '$/ as given is currently unsupported';
}
}
#------------------------------
=item getlines
I<Instance method.>
Get all remaining lines.
It will croak() if accidentally called in a scalar context.
=cut
sub getlines {
my $self = shift;
wantarray or croak("can't call getlines in scalar context!");
my ($line, @lines);
push @lines, $line while (defined($line = $self->getline));
@lines;
}
#------------------------------
=item print ARGS...
I<Instance method.>
Print ARGS to the underlying array.
Currently, this always causes a "seek to the end of the array"
and generates a new array entry. This may change in the future.
=cut
sub print {
my $self = shift;
push @{*$self->{AR}}, join('', @_) . (defined($\) ? $\ : ""); ### add the data
$self->_setpos_to_eof;
1;
}
#------------------------------
=item read BUF, NBYTES, [OFFSET];
I<Instance method.>
Read some bytes from the array.
Returns the number of bytes actually read, 0 on end-of-file, undef on error.
=cut
sub read {
my $self = $_[0];
### we must use $_[1] as a ref
my $n = $_[2];
my $off = $_[3] || 0;
### print "getline\n";
my $justread;
my $len;
($off ? substr($_[1], $off) : $_[1]) = '';
### Stop when we have zero bytes to go, or when we hit EOF:
my @got;
until (!$n or $self->eof) {
### If at end of current string, go forward to next one (won't be EOF):
if ($self->_eos) {
++*$self->{Str};
*$self->{Pos} = 0;
}
### Get longest possible desired substring of current string:
$justread = substr(*$self->{AR}[*$self->{Str}], *$self->{Pos}, $n);
$len = length($justread);
push @got, $justread;
$n -= $len;
*$self->{Pos} += $len;
}
$_[1] .= join('', @got);
return length($_[1])-$off;
}
#------------------------------
=item write BUF, NBYTES, [OFFSET];
I<Instance method.>
Write some bytes into the array.
=cut
sub write {
my $self = $_[0];
my $n = $_[2];
my $off = $_[3] || 0;
my $data = substr($_[1], $n, $off);
$n = length($data);
$self->print($data);
return $n;
}
=back
=cut
#==============================
=head2 Seeking/telling and other attributes
=over 4
=cut
#------------------------------
=item autoflush
I<Instance method.>
No-op, provided for OO compatibility.
=cut
sub autoflush {}
#------------------------------
=item binmode
I<Instance method.>
No-op, provided for OO compatibility.
=cut
sub binmode {}
#------------------------------
=item clearerr
I<Instance method.> Clear the error and EOF flags. A no-op.
=cut
sub clearerr { 1 }
#------------------------------
=item eof
I<Instance method.> Are we at end of file?
=cut
sub eof {
### print "checking EOF [*$self->{Str}, *$self->{Pos}]\n";
### print "SR = ", $#{*$self->{AR}}, "\n";
return 0 if (*{$_[0]}->{Str} < $#{*{$_[0]}->{AR}}); ### before EOA
return 1 if (*{$_[0]}->{Str} > $#{*{$_[0]}->{AR}}); ### after EOA
### ### at EOA, past EOS:
((*{$_[0]}->{Str} == $#{*{$_[0]}->{AR}}) && ($_[0]->_eos));
}
#------------------------------
#
# _eos
#
# I<Instance method, private.> Are we at end of the CURRENT string?
#
sub _eos {
(*{$_[0]}->{Pos} >= length(*{$_[0]}->{AR}[*{$_[0]}->{Str}])); ### past last char
}
#------------------------------
=item seek POS,WHENCE
I<Instance method.>
Seek to a given position in the stream.
Only a WHENCE of 0 (SEEK_SET) is supported.
=cut
sub seek {
my ($self, $pos, $whence) = @_;
### Seek:
if ($whence == 0) { $self->_seek_set($pos); }
elsif ($whence == 1) { $self->_seek_cur($pos); }
elsif ($whence == 2) { $self->_seek_end($pos); }
else { croak "bad seek whence ($whence)" }
return 1;
}
#------------------------------
#
# _seek_set POS
#
# Instance method, private.
# Seek to $pos relative to start:
#
sub _seek_set {
my ($self, $pos) = @_;
### Advance through array until done:
my $istr = 0;
while (($pos >= 0) && ($istr < scalar(@{*$self->{AR}}))) {
if (length(*$self->{AR}[$istr]) > $pos) { ### it's in this string!
return $self->setpos([$istr, $pos]);
}
else { ### it's in next string
$pos -= length(*$self->{AR}[$istr++]); ### move forward one string
}
}
### If we reached this point, pos is at or past end; zoom to EOF:
return $self->_setpos_to_eof;
}
#------------------------------
#
# _seek_cur POS
#
# Instance method, private.
# Seek to $pos relative to current position.
#
sub _seek_cur {
my ($self, $pos) = @_;
$self->_seek_set($self->tell + $pos);
}
#------------------------------
#
# _seek_end POS
#
# Instance method, private.
# Seek to $pos relative to end.
# We actually seek relative to beginning, which is simple.
#
sub _seek_end {
my ($self, $pos) = @_;
$self->_seek_set($self->_tell_eof + $pos);
}
#------------------------------
=item tell
I<Instance method.>
Return the current position in the stream, as a numeric offset.
=cut
sub tell {
my $self = shift;
my $off = 0;
my ($s, $str_s);
for ($s = 0; $s < *$self->{Str}; $s++) { ### count all "whole" scalars
defined($str_s = *$self->{AR}[$s]) or $str_s = '';
###print STDERR "COUNTING STRING $s (". length($str_s) . ")\n";
$off += length($str_s);
}
###print STDERR "COUNTING POS ($self->{Pos})\n";
return ($off += *$self->{Pos}); ### plus the final, partial one
}
#------------------------------
#
# _tell_eof
#
# Instance method, private.
# Get position of EOF, as a numeric offset.
# This is identical to the size of the stream - 1.
#
sub _tell_eof {
my $self = shift;
my $len = 0;
foreach (@{*$self->{AR}}) { $len += length($_) }
$len;
}
#------------------------------
=item setpos POS
I<Instance method.>
Seek to a given position in the array, using the opaque getpos() value.
Don't expect this to be a number.
=cut
sub setpos {
my ($self, $pos) = @_;
(ref($pos) eq 'ARRAY') or
die "setpos: only use a value returned by getpos!\n";
(*$self->{Str}, *$self->{Pos}) = @$pos;
}
#------------------------------
#
# _setpos_to_eof
#
# Fast-forward to EOF.
#
sub _setpos_to_eof {
my $self = shift;
$self->setpos([scalar(@{*$self->{AR}}), 0]);
}
#------------------------------
=item getpos
I<Instance method.>
Return the current position in the array, as an opaque value.
Don't expect this to be a number.
=cut
sub getpos {
[*{$_[0]}->{Str}, *{$_[0]}->{Pos}];
}
#------------------------------
=item aref
I<Instance method.>
Return a reference to the underlying array.
=cut
sub aref {
*{shift()}->{AR};
}
=back
=cut
#------------------------------
# Tied handle methods...
#------------------------------
### Conventional tiehandle interface:
sub TIEHANDLE { (defined($_[1]) && UNIVERSAL::isa($_[1],"IO::ScalarArray"))
? $_[1]
: shift->new(@_) }
sub GETC { shift->getc(@_) }
sub PRINT { shift->print(@_) }
sub PRINTF { shift->print(sprintf(shift, @_)) }
sub READ { shift->read(@_) }
sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) }
sub WRITE { shift->write(@_); }
sub CLOSE { shift->close(@_); }
sub SEEK { shift->seek(@_); }
sub TELL { shift->tell(@_); }
sub EOF { shift->eof(@_); }
sub BINMODE { 1; }
#------------------------------------------------------------
1;
__END__
# SOME PRIVATE NOTES:
#
# * The "current position" is the position before the next
# character to be read/written.
#
# * Str gives the string index of the current position, 0-based
#
# * Pos gives the offset within AR[Str], 0-based.
#
# * Inital pos is [0,0]. After print("Hello"), it is [1,0].
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/IO/WrapTie.pm 0000444 00000034574 15157556232 0010430 0 ustar 00 package IO::WrapTie;
use strict;
use Exporter;
# Inheritance, exporting, and package version:
our @ISA = qw(Exporter);
our @EXPORT = qw(wraptie);
our $VERSION = '2.113';
# Function, exported.
sub wraptie {
IO::WrapTie::Master->new(@_);
}
# Class method; BACKWARDS-COMPATIBILITY ONLY!
sub new {
shift;
IO::WrapTie::Master->new(@_);
}
#------------------------------------------------------------
package # hide from pause
IO::WrapTie::Master;
#------------------------------------------------------------
use strict;
use vars qw($AUTOLOAD);
use IO::Handle;
# We inherit from IO::Handle to get methods which invoke i/o operators,
# like print(), on our tied handle:
our @ISA = qw(IO::Handle);
#------------------------------
# new SLAVE, TIEARGS...
#------------------------------
# Create a new subclass of IO::Handle which...
#
# (1) Handles i/o OPERATORS because it is tied to an instance of
# an i/o-like class, like IO::Scalar.
#
# (2) Handles i/o METHODS by delegating them to that same tied object!.
#
# Arguments are the slave class (e.g., IO::Scalar), followed by all
# the arguments normally sent into that class's C<TIEHANDLE> method.
# In other words, much like the arguments to tie(). :-)
#
# NOTE:
# The thing $x we return must be a BLESSED REF, for ($x->print()).
# The underlying symbol must be a FILEHANDLE, for (print $x "foo").
# It has to have a way of getting to the "real" back-end object...
#
sub new {
my $master = shift;
my $io = IO::Handle->new; ### create a new handle
my $slave = shift;
tie *$io, $slave, @_; ### tie: will invoke slave's TIEHANDLE
bless $io, $master; ### return a master
}
#------------------------------
# AUTOLOAD
#------------------------------
# Delegate method invocations on the master to the underlying slave.
#
sub AUTOLOAD {
my $method = $AUTOLOAD;
$method =~ s/.*:://;
my $self = shift; tied(*$self)->$method(\@_);
}
#------------------------------
# PRELOAD
#------------------------------
# Utility.
#
# Most methods like print(), getline(), etc. which work on the tied object
# via Perl's i/o operators (like 'print') are inherited from IO::Handle.
#
# Other methods, like seek() and sref(), we must delegate ourselves.
# AUTOLOAD takes care of these.
#
# However, it may be necessary to preload delegators into your
# own class. PRELOAD will do this.
#
sub PRELOAD {
my $class = shift;
foreach (@_) {
eval "sub ${class}::$_ { my \$s = shift; tied(*\$s)->$_(\@_) }";
}
}
# Preload delegators for some standard methods which we can't simply
# inherit from IO::Handle... for example, some IO::Handle methods
# assume that there is an underlying file descriptor.
#
PRELOAD IO::WrapTie::Master
qw(open opened close read clearerr eof seek tell setpos getpos);
#------------------------------------------------------------
package # hide from pause
IO::WrapTie::Slave;
#------------------------------------------------------------
# Teeny private class providing a new_tie constructor...
#
# HOW IT ALL WORKS:
#
# Slaves inherit from this class.
#
# When you send a new_tie() message to a tie-slave class (like IO::Scalar),
# it first determines what class should provide its master, via TIE_MASTER.
# In this case, IO::Scalar->TIE_MASTER would return IO::Scalar::Master.
# Then, we create a new master (an IO::Scalar::Master) with the same args
# sent to new_tie.
#
# In general, the new() method of the master is inherited directly
# from IO::WrapTie::Master.
#
sub new_tie {
my $self = shift;
$self->TIE_MASTER->new($self,@_); ### e.g., IO::Scalar::Master->new(@_)
}
# Default class method for new_tie().
# All your tie-slave class (like IO::Scalar) has to do is override this
# method with a method that returns the name of an appropriate "master"
# class for tying that slave.
#
sub TIE_MASTER { 'IO::WrapTie::Master' }
#------------------------------
1;
__END__
package IO::WrapTie; ### for doc generator
=head1 NAME
IO::WrapTie - wrap tieable objects in IO::Handle interface
I<This is currently Alpha code, released for comments.
Please give me your feedback!>
=head1 SYNOPSIS
First of all, you'll need tie(), so:
require 5.004;
I<Function interface (experimental).>
Use this with any existing class...
use IO::WrapTie;
use FooHandle; ### implements TIEHANDLE interface
### Suppose we want a "FooHandle->new(&FOO_RDWR, 2)".
### We can instead say...
$FH = wraptie('FooHandle', &FOO_RDWR, 2);
### Now we can use...
print $FH "Hello, "; ### traditional operator syntax...
$FH->print("world!\n"); ### ...and OO syntax as well!
I<OO interface (preferred).>
You can inherit from the L<IO::WrapTie/"Slave"> mixin to get a
nifty C<new_tie()> constructor...
#------------------------------
package FooHandle; ### a class which can TIEHANDLE
use IO::WrapTie;
@ISA = qw(IO::WrapTie::Slave); ### inherit new_tie()
...
#------------------------------
package main;
$FH = FooHandle->new_tie(&FOO_RDWR, 2); ### $FH is an IO::WrapTie::Master
print $FH "Hello, "; ### traditional operator syntax
$FH->print("world!\n"); ### OO syntax
See IO::Scalar as an example. It also shows you how to create classes
which work both with and without 5.004.
=head1 DESCRIPTION
Suppose you have a class C<FooHandle>, where...
=over 4
=item *
C<FooHandle> does not inherit from L<IO::Handle>. That is, it performs
file handle-like I/O, but to something other than an underlying
file descriptor. Good examples are L<IO::Scalar> (for printing to a
string) and L<IO::Lines> (for printing to an array of lines).
=item *
C<FooHandle> implements the C<TIEHANDLE> interface (see L<perltie>).
That is, it provides methods C<TIEHANDLE>, C<GETC>, C<PRINT>, C<PRINTF>,
C<READ>, and C<READLINE>.
=item *
C<FooHandle> implements the traditional OO interface of
L<FileHandle> and L<IO::Handle>. i.e., it contains methods like C<getline>,
C<read>, C<print>, C<seek>, C<tell>, C<eof>, etc.
=back
Normally, users of your class would have two options:
=over 4
=item *
B<Use only OO syntax,> and forsake named I/O operators like C<print>.
=item *
B<Use with tie,> and forsake treating it as a first-class object
(i.e., class-specific methods can only be invoked through the underlying
object via C<tied>... giving the object a "split personality").
=back
But now with L<IO::WrapTie>, you can say:
$WT = wraptie('FooHandle', &FOO_RDWR, 2);
$WT->print("Hello, world\n"); ### OO syntax
print $WT "Yes!\n"; ### Named operator syntax too!
$WT->weird_stuff; ### Other methods!
And if you're authoring a class like C<FooHandle>, just have it inherit
from C<IO::WrapTie::Slave> and that first line becomes even prettier:
$WT = FooHandle->new_tie(&FOO_RDWR, 2);
B<The bottom line:> now, almost any class can look and work exactly like
an L<IO::Handle> and be used both with OO and non-OO file handle syntax.
=head1 HOW IT ALL WORKS
=head2 The data structures
Consider this example code, using classes in this distribution:
use IO::Scalar;
use IO::WrapTie;
$WT = wraptie('IO::Scalar',\$s);
print $WT "Hello, ";
$WT->print("world!\n");
In it, the C<wraptie> function creates a data structure as follows:
* $WT is a blessed reference to a tied filehandle
$WT glob; that glob is tied to the "Slave" object.
| * You would do all your i/o with $WT directly.
|
|
| ,---isa--> IO::WrapTie::Master >--isa--> IO::Handle
V /
.-------------.
| |
| | * Perl i/o operators work on the tied object,
| "Master" | invoking the C<TIEHANDLE> methods.
| | * Method invocations are delegated to the tied
| | slave.
`-------------'
|
tied(*$WT) | .---isa--> IO::WrapTie::Slave
V /
.-------------.
| |
| "Slave" | * Instance of FileHandle-like class which doesn't
| | actually use file descriptors, like IO::Scalar.
| IO::Scalar | * The slave can be any kind of object.
| | * Must implement the C<TIEHANDLE> interface.
`-------------'
I<NOTE:> just as an L<IO::Handle> is really just a blessed reference to a
I<traditional> file handle glob. So also, an C<IO::WrapTie::Master>
is really just a blessed reference to a file handle
glob I<which has been tied to some "slave" class.>
=head2 How C<wraptie> works
=over 4
=item 1.
The call to function C<wraptie(SLAVECLASS, TIEARGS...)> is
passed onto C<IO::WrapTie::Master::new()>.
Note that class C<IO::WrapTie::Master> is a subclass of L<IO::Handle>.
=item 2.
The C<< IO::WrapTie::Master->new >> method creates a new L<IO::Handle> object,
re-blessed into class C<IO::WrapTie::Master>. This object is the I<master>,
which will be returned from the constructor. At the same time...
=item 3.
The C<new> method also creates the I<slave>: this is an instance
of C<SLAVECLASS> which is created by tying the master's L<IO::Handle>
to C<SLAVECLASS> via C<tie>.
This call to C<tie> creates the slave in the following manner:
=item 4.
Class C<SLAVECLASS> is sent the message C<TIEHANDLE>; it
will usually delegate this to C<< SLAVECLASS->new(TIEARGS) >>, resulting
in a new instance of C<SLAVECLASS> being created and returned.
=item 5.
Once both master and slave have been created, the master is returned
to the caller.
=back
=head2 How I/O operators work (on the master)
Consider using an i/o operator on the master:
print $WT "Hello, world!\n";
Since the master C<$WT> is really a C<blessed> reference to a glob,
the normal Perl I/O operators like C<print> may be used on it.
They will just operate on the symbol part of the glob.
Since the glob is tied to the slave, the slave's C<PRINT> method
(part of the C<TIEHANDLE> interface) will be automatically invoked.
If the slave is an L<IO::Scalar>, that means L<IO::Scalar/"PRINT"> will be
invoked, and that method happens to delegate to the C<print> method
of the same class. So the I<real> work is ultimately done by
L<IO::Scalar/"print">.
=head2 How methods work (on the master)
Consider using a method on the master:
$WT->print("Hello, world!\n");
Since the master C<$WT> is blessed into the class C<IO::WrapTie::Master>,
Perl first attempts to find a C<print> method there. Failing that,
Perl next attempts to find a C<print> method in the super class,
L<IO::Handle>. It just so happens that there I<is> such a method;
that method merely invokes the C<print> I/O operator on the self object...
and for that, see above!
But let's suppose we're dealing with a method which I<isn't> part
of L<IO::Handle>... for example:
my $sref = $WT->sref;
In this case, the intuitive behavior is to have the master delegate the
method invocation to the slave (now do you see where the designations
come from?). This is indeed what happens: C<IO::WrapTie::Master> contains
an C<AUTOLOAD> method which performs the delegation.
So: when C<sref> can't be found in L<IO::Handle>, the C<AUTOLOAD> method
of C<IO::WrapTie::Master> is invoked, and the standard behavior of
delegating the method to the underlying slave (here, an L<IO::Scalar>)
is done.
Sometimes, to get this to work properly, you may need to create
a subclass of C<IO::WrapTie::Master> which is an effective master for
I<your> class, and do the delegation there.
=head1 NOTES
B<Why not simply use the object's OO interface?>
Because that means forsaking the use of named operators
like C<print>, and you may need to pass the object to a subroutine
which will attempt to use those operators:
$O = FooHandle->new(&FOO_RDWR, 2);
$O->print("Hello, world\n"); ### OO syntax is okay, BUT....
sub nope { print $_[0] "Nope!\n" }
X nope($O); ### ERROR!!! (not a glob ref)
B<Why not simply use tie()?>
Because (1) you have to use C<tied> to invoke methods in the
object's public interface (yuck), and (2) you may need to pass
the tied symbol to another subroutine which will attempt to treat
it in an OO-way... and that will break it:
tie *T, 'FooHandle', &FOO_RDWR, 2;
print T "Hello, world\n"; ### Operator is okay, BUT...
tied(*T)->other_stuff; ### yuck! AND...
sub nope { shift->print("Nope!\n") }
X nope(\*T); ### ERROR!!! (method "print" on unblessed ref)
B<Why a master and slave?>
Why not simply write C<FooHandle> to inherit from L<IO::Handle?>
I tried this, with an implementation similar to that of L<IO::Socket>.
The problem is that I<the whole point is to use this with objects
that don't have an underlying file/socket descriptor.>.
Subclassing L<IO::Handle> will work fine for the OO stuff, and fine with
named operators I<if> you C<tie>... but if you just attempt to say:
$IO = FooHandle->new(&FOO_RDWR, 2);
print $IO "Hello!\n";
you get a warning from Perl like:
Filehandle GEN001 never opened
because it's trying to do system-level I/O on an (unopened) file
descriptor. To avoid this, you apparently have to C<tie> the handle...
which brings us right back to where we started! At least the
L<IO::WrapTie> mixin lets us say:
$IO = FooHandle->new_tie(&FOO_RDWR, 2);
print $IO "Hello!\n";
and so is not I<too> bad. C<:-)>
=head1 WARNINGS
Remember: this stuff is for doing L<FileHandle>-like I/O on things
I<without underlying file descriptors>. If you have an underlying
file descriptor, you're better off just inheriting from L<IO::Handle>.
B<Be aware that new_tie() always returns an instance of a
kind of IO::WrapTie::Master...> it does B<not> return an instance
of the I/O class you're tying to!
Invoking some methods on the master object causes C<AUTOLOAD> to delegate
them to the slave object... so it I<looks> like you're manipulating a
C<FooHandle> object directly, but you're not.
I have not explored all the ramifications of this use of C<tie>.
I<Here there be dragons>.
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/IO/AtomicFile.pm 0000444 00000012372 15157556237 0011066 0 ustar 00 package IO::AtomicFile;
use strict;
use warnings;
use parent 'IO::File';
our $VERSION = '2.113';
#------------------------------
# new ARGS...
#------------------------------
# Class method, constructor.
# Any arguments are sent to open().
#
sub new {
my $class = shift;
my $self = $class->SUPER::new();
${*$self}{'io_atomicfile_suffix'} = '';
$self->open(@_) if @_;
$self;
}
#------------------------------
# DESTROY
#------------------------------
# Destructor.
#
sub DESTROY {
shift->close(1); ### like close, but raises fatal exception on failure
}
#------------------------------
# open PATH, MODE
#------------------------------
# Class/instance method.
#
sub open {
my ($self, $path, $mode) = @_;
ref($self) or $self = $self->new; ### now we have an instance!
### Create tmp path, and remember this info:
my $temp = "${path}..TMP" . ${*$self}{'io_atomicfile_suffix'};
${*$self}{'io_atomicfile_temp'} = $temp;
${*$self}{'io_atomicfile_path'} = $path;
### Open the file! Returns filehandle on success, for use as a constructor:
$self->SUPER::open($temp, $mode) ? $self : undef;
}
#------------------------------
# _closed [YESNO]
#------------------------------
# Instance method, private.
# Are we already closed? Argument sets new value, returns previous one.
#
sub _closed {
my $self = shift;
my $oldval = ${*$self}{'io_atomicfile_closed'};
${*$self}{'io_atomicfile_closed'} = shift if @_;
$oldval;
}
#------------------------------
# close
#------------------------------
# Instance method.
# Close the handle, and rename the temp file to its final name.
#
sub close {
my ($self, $die) = @_;
unless ($self->_closed(1)) { ### sentinel...
if ($self->SUPER::close()) {
rename(${*$self}{'io_atomicfile_temp'},
${*$self}{'io_atomicfile_path'})
or ($die ? die "close (rename) atomic file: $!\n" : return undef);
} else {
($die ? die "close atomic file: $!\n" : return undef);
}
}
1;
}
#------------------------------
# delete
#------------------------------
# Instance method.
# Close the handle, and delete the temp file.
#
sub delete {
my $self = shift;
unless ($self->_closed(1)) { ### sentinel...
$self->SUPER::close();
return unlink(${*$self}{'io_atomicfile_temp'});
}
1;
}
#------------------------------
# detach
#------------------------------
# Instance method.
# Close the handle, but DO NOT delete the temp file.
#
sub detach {
my $self = shift;
$self->SUPER::close() unless ($self->_closed(1));
1;
}
#------------------------------
1;
__END__
=head1 NAME
IO::AtomicFile - write a file which is updated atomically
=head1 SYNOPSIS
use strict;
use warnings;
use feature 'say';
use IO::AtomicFile;
# Write a temp file, and have it install itself when closed:
my $fh = IO::AtomicFile->open("bar.dat", "w");
$fh->say("Hello!");
$fh->close || die "couldn't install atomic file: $!";
# Write a temp file, but delete it before it gets installed:
my $fh = IO::AtomicFile->open("bar.dat", "w");
$fh->say("Hello!");
$fh->delete;
# Write a temp file, but neither install it nor delete it:
my $fh = IO::AtomicFile->open("bar.dat", "w");
$fh->say("Hello!");
$fh->detach;
=head1 DESCRIPTION
This module is intended for people who need to update files
reliably in the face of unexpected program termination.
For example, you generally don't want to be halfway in the middle of
writing I</etc/passwd> and have your program terminate! Even
the act of writing a single scalar to a filehandle is I<not> atomic.
But this module gives you true atomic updates, via C<rename>.
When you open a file I</foo/bar.dat> via this module, you are I<actually>
opening a temporary file I</foo/bar.dat..TMP>, and writing your
output there. The act of closing this file (either explicitly
via C<close>, or implicitly via the destruction of the object)
will cause C<rename> to be called... therefore, from the point
of view of the outside world, the file's contents are updated
in a single time quantum.
To ensure that problems do not go undetected, the C<close> method
done by the destructor will raise a fatal exception if the C<rename>
fails. The explicit C<close> just returns C<undef>.
You can also decide at any point to trash the file you've been
building.
=head1 METHODS
L<IO::AtomicFile> inherits all methods from L<IO::File> and
implements the following new ones.
=head2 close
$fh->close();
This method calls its parent L<IO::File/"close"> and then renames its temporary file
as the original file name.
=head2 delete
$fh->delete();
This method calls its parent L<IO::File/"close"> and then deletes the temporary file.
=head2 detach
$fh->detach();
This method calls its parent L<IO::File/"close">. Unlike L<IO::AtomicFile/"delete"> it
does not then delete the temporary file.
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/IO/Stringy.pm 0000444 00000003435 15157556244 0010507 0 ustar 00 package IO::Stringy;
use strict;
use Exporter;
our $VERSION = '2.113';
1;
__END__
=head1 NAME
IO-stringy - I/O on in-core objects like strings and arrays
=head1 SYNOPSIS
use strict;
use warnings;
use IO::AtomicFile; # Write a file which is updated atomically
use IO::InnerFile; # define a file inside another file
use IO::Lines; # I/O handle to read/write to array of lines
use IO::Scalar; # I/O handle to read/write to a string
use IO::ScalarArray; # I/O handle to read/write to array of scalars
use IO::Wrap; # Wrap old-style FHs in standard OO interface
use IO::WrapTie; # Tie your handles & retain full OO interface
# ...
=head1 DESCRIPTION
This toolkit primarily provides modules for performing both traditional
and object-oriented i/o) on things I<other> than normal filehandles;
in particular, L<IO::Scalar|IO::Scalar>, L<IO::ScalarArray|IO::ScalarArray>,
and L<IO::Lines|IO::Lines>.
In the more-traditional IO::Handle front, we
have L<IO::AtomicFile|IO::AtomicFile>
which may be used to painlessly create files which are updated
atomically.
And in the "this-may-prove-useful" corner, we have L<IO::Wrap|IO::Wrap>,
whose exported wraphandle() function will clothe anything that's not
a blessed object in an IO::Handle-like wrapper... so you can just
use OO syntax and stop worrying about whether your function's caller
handed you a string, a globref, or a FileHandle.
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/IO/Scalar.pm 0000444 00000035264 15157556251 0010260 0 ustar 00 package IO::Scalar;
use strict;
use Carp;
use IO::Handle;
### Stringification, courtesy of B. K. Oxley (binkley): :-)
use overload '""' => sub { ${*{$_[0]}->{SR}} };
use overload 'bool' => sub { 1 }; ### have to do this, so object is true!
### The package version, both in 1.23 style *and* usable by MakeMaker:
our $VERSION = '2.113';
### Inheritance:
our @ISA = qw(IO::Handle);
### This stuff should be got rid of ASAP.
require IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] >= 5.004);
#==============================
=head1 NAME
IO::Scalar - IO:: interface for reading/writing a scalar
=head1 SYNOPSIS
Perform I/O on strings, using the basic OO interface...
use 5.005;
use IO::Scalar;
$data = "My message:\n";
### Open a handle on a string, and append to it:
$SH = new IO::Scalar \$data;
$SH->print("Hello");
$SH->print(", world!\nBye now!\n");
print "The string is now: ", $data, "\n";
### Open a handle on a string, read it line-by-line, then close it:
$SH = new IO::Scalar \$data;
while (defined($_ = $SH->getline)) {
print "Got line: $_";
}
$SH->close;
### Open a handle on a string, and slurp in all the lines:
$SH = new IO::Scalar \$data;
print "All lines:\n", $SH->getlines;
### Get the current position (either of two ways):
$pos = $SH->getpos;
$offset = $SH->tell;
### Set the current position (either of two ways):
$SH->setpos($pos);
$SH->seek($offset, 0);
### Open an anonymous temporary scalar:
$SH = new IO::Scalar;
$SH->print("Hi there!");
print "I printed: ", ${$SH->sref}, "\n"; ### get at value
Don't like OO for your I/O? No problem.
Thanks to the magic of an invisible tie(), the following now
works out of the box, just as it does with IO::Handle:
use 5.005;
use IO::Scalar;
$data = "My message:\n";
### Open a handle on a string, and append to it:
$SH = new IO::Scalar \$data;
print $SH "Hello";
print $SH ", world!\nBye now!\n";
print "The string is now: ", $data, "\n";
### Open a handle on a string, read it line-by-line, then close it:
$SH = new IO::Scalar \$data;
while (<$SH>) {
print "Got line: $_";
}
close $SH;
### Open a handle on a string, and slurp in all the lines:
$SH = new IO::Scalar \$data;
print "All lines:\n", <$SH>;
### Get the current position (WARNING: requires 5.6):
$offset = tell $SH;
### Set the current position (WARNING: requires 5.6):
seek $SH, $offset, 0;
### Open an anonymous temporary scalar:
$SH = new IO::Scalar;
print $SH "Hi there!";
print "I printed: ", ${$SH->sref}, "\n"; ### get at value
And for you folks with 1.x code out there: the old tie() style still works,
though this is I<unnecessary and deprecated>:
use IO::Scalar;
### Writing to a scalar...
my $s;
tie *OUT, 'IO::Scalar', \$s;
print OUT "line 1\nline 2\n", "line 3\n";
print "String is now: $s\n"
### Reading and writing an anonymous scalar...
tie *OUT, 'IO::Scalar';
print OUT "line 1\nline 2\n", "line 3\n";
tied(OUT)->seek(0,0);
while (<OUT>) {
print "Got line: ", $_;
}
Stringification works, too!
my $SH = new IO::Scalar \$data;
print $SH "Hello, ";
print $SH "world!";
print "I printed: $SH\n";
=head1 DESCRIPTION
This class is part of the IO::Stringy distribution;
see L<IO::Stringy> for change log and general information.
The IO::Scalar class implements objects which behave just like
IO::Handle (or FileHandle) objects, except that you may use them
to write to (or read from) scalars. These handles are
automatically C<tiehandle>d (though please see L<"WARNINGS">
for information relevant to your Perl version).
Basically, this:
my $s;
$SH = new IO::Scalar \$s;
$SH->print("Hel", "lo, "); ### OO style
$SH->print("world!\n"); ### ditto
Or this:
my $s;
$SH = tie *OUT, 'IO::Scalar', \$s;
print OUT "Hel", "lo, "; ### non-OO style
print OUT "world!\n"; ### ditto
Causes $s to be set to:
"Hello, world!\n"
=head1 PUBLIC INTERFACE
=head2 Construction
=over 4
=cut
#------------------------------
=item new [ARGS...]
I<Class method.>
Return a new, unattached scalar handle.
If any arguments are given, they're sent to open().
=cut
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = bless \do { local *FH }, $class;
tie *$self, $class, $self;
$self->open(@_); ### open on anonymous by default
$self;
}
sub DESTROY {
shift->close;
}
#------------------------------
=item open [SCALARREF]
I<Instance method.>
Open the scalar handle on a new scalar, pointed to by SCALARREF.
If no SCALARREF is given, a "private" scalar is created to hold
the file data.
Returns the self object on success, undefined on error.
=cut
sub open {
my ($self, $sref) = @_;
### Sanity:
defined($sref) or do {my $s = ''; $sref = \$s};
(ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar";
### Setup:
*$self->{Pos} = 0; ### seek position
*$self->{SR} = $sref; ### scalar reference
$self;
}
#------------------------------
=item opened
I<Instance method.>
Is the scalar handle opened on something?
=cut
sub opened {
*{shift()}->{SR};
}
#------------------------------
=item close
I<Instance method.>
Disassociate the scalar handle from its underlying scalar.
Done automatically on destroy.
=cut
sub close {
my $self = shift;
%{*$self} = ();
1;
}
=back
=cut
#==============================
=head2 Input and output
=over 4
=cut
#------------------------------
=item flush
I<Instance method.>
No-op, provided for OO compatibility.
=cut
sub flush { "0 but true" }
#------------------------------
=item fileno
I<Instance method.>
No-op, returns undef
=cut
sub fileno { }
#------------------------------
=item getc
I<Instance method.>
Return the next character, or undef if none remain.
=cut
sub getc {
my $self = shift;
### Return undef right away if at EOF; else, move pos forward:
return undef if $self->eof;
substr(${*$self->{SR}}, *$self->{Pos}++, 1);
}
#------------------------------
=item getline
I<Instance method.>
Return the next line, or undef on end of string.
Can safely be called in an array context.
Currently, lines are delimited by "\n".
=cut
sub getline {
my $self = shift;
### Return undef right away if at EOF:
return undef if $self->eof;
### Get next line:
my $sr = *$self->{SR};
my $i = *$self->{Pos}; ### Start matching at this point.
### Minimal impact implementation!
### We do the fast thing (no regexps) if using the
### classic input record separator.
### Case 1: $/ is undef: slurp all...
if (!defined($/)) {
*$self->{Pos} = length $$sr;
return substr($$sr, $i);
}
### Case 2: $/ is "\n": zoom zoom zoom...
elsif ($/ eq "\012") {
### Seek ahead for "\n"... yes, this really is faster than regexps.
my $len = length($$sr);
for (; $i < $len; ++$i) {
last if ord (substr ($$sr, $i, 1)) == 10;
}
### Extract the line:
my $line;
if ($i < $len) { ### We found a "\n":
$line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1);
*$self->{Pos} = $i+1; ### Remember where we finished up.
}
else { ### No "\n"; slurp the remainder:
$line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos});
*$self->{Pos} = $len;
}
return $line;
}
### Case 3: $/ is ref to int. Do fixed-size records.
### (Thanks to Dominique Quatravaux.)
elsif (ref($/)) {
my $len = length($$sr);
my $i = ${$/} + 0;
my $line = substr ($$sr, *$self->{Pos}, $i);
*$self->{Pos} += $i;
*$self->{Pos} = $len if (*$self->{Pos} > $len);
return $line;
}
### Case 4: $/ is either "" (paragraphs) or something weird...
### This is Graham's general-purpose stuff, which might be
### a tad slower than Case 2 for typical data, because
### of the regexps.
else {
pos($$sr) = $i;
### If in paragraph mode, skip leading lines (and update i!):
length($/) or
(($$sr =~ m/\G\n*/g) and ($i = pos($$sr)));
### If we see the separator in the buffer ahead...
if (length($/)
? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp!
: $$sr =~ m,\n\n,g ### (a paragraph)
) {
*$self->{Pos} = pos $$sr;
return substr($$sr, $i, *$self->{Pos}-$i);
}
### Else if no separator remains, just slurp the rest:
else {
*$self->{Pos} = length $$sr;
return substr($$sr, $i);
}
}
}
#------------------------------
=item getlines
I<Instance method.>
Get all remaining lines.
It will croak() if accidentally called in a scalar context.
=cut
sub getlines {
my $self = shift;
wantarray or croak("can't call getlines in scalar context!");
my ($line, @lines);
push @lines, $line while (defined($line = $self->getline));
@lines;
}
#------------------------------
=item print ARGS...
I<Instance method.>
Print ARGS to the underlying scalar.
B<Warning:> this continues to always cause a seek to the end
of the string, but if you perform seek()s and tell()s, it is
still safer to explicitly seek-to-end before subsequent print()s.
=cut
sub print {
my $self = shift;
*$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : ""));
1;
}
sub _unsafe_print {
my $self = shift;
my $append = join('', @_) . $\;
${*$self->{SR}} .= $append;
*$self->{Pos} += length($append);
1;
}
sub _old_print {
my $self = shift;
${*$self->{SR}} .= join('', @_) . $\;
*$self->{Pos} = length(${*$self->{SR}});
1;
}
#------------------------------
=item read BUF, NBYTES, [OFFSET]
I<Instance method.>
Read some bytes from the scalar.
Returns the number of bytes actually read, 0 on end-of-file, undef on error.
=cut
sub read {
my $self = $_[0];
my $n = $_[2];
my $off = $_[3] || 0;
my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n);
$n = length($read);
*$self->{Pos} += $n;
($off ? substr($_[1], $off) : $_[1]) = $read;
return $n;
}
#------------------------------
=item write BUF, NBYTES, [OFFSET]
I<Instance method.>
Write some bytes to the scalar.
=cut
sub write {
my $self = $_[0];
my $n = $_[2];
my $off = $_[3] || 0;
my $data = substr($_[1], $off, $n);
$n = length($data);
$self->print($data);
return $n;
}
#------------------------------
=item sysread BUF, LEN, [OFFSET]
I<Instance method.>
Read some bytes from the scalar.
Returns the number of bytes actually read, 0 on end-of-file, undef on error.
=cut
sub sysread {
my $self = shift;
$self->read(@_);
}
#------------------------------
=item syswrite BUF, NBYTES, [OFFSET]
I<Instance method.>
Write some bytes to the scalar.
=cut
sub syswrite {
my $self = shift;
$self->write(@_);
}
=back
=cut
#==============================
=head2 Seeking/telling and other attributes
=over 4
=cut
#------------------------------
=item autoflush
I<Instance method.>
No-op, provided for OO compatibility.
=cut
sub autoflush {}
#------------------------------
=item binmode
I<Instance method.>
No-op, provided for OO compatibility.
=cut
sub binmode {}
#------------------------------
=item clearerr
I<Instance method.> Clear the error and EOF flags. A no-op.
=cut
sub clearerr { 1 }
#------------------------------
=item eof
I<Instance method.> Are we at end of file?
=cut
sub eof {
my $self = shift;
(*$self->{Pos} >= length(${*$self->{SR}}));
}
#------------------------------
=item seek OFFSET, WHENCE
I<Instance method.> Seek to a given position in the stream.
=cut
sub seek {
my ($self, $pos, $whence) = @_;
my $eofpos = length(${*$self->{SR}});
### Seek:
if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET
elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR
elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END
else { croak "bad seek whence ($whence)" }
### Fixup:
if (*$self->{Pos} < 0) { *$self->{Pos} = 0 }
if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos }
return 1;
}
#------------------------------
=item sysseek OFFSET, WHENCE
I<Instance method.> Identical to C<seek OFFSET, WHENCE>, I<q.v.>
=cut
sub sysseek {
my $self = shift;
$self->seek (@_);
}
#------------------------------
=item tell
I<Instance method.>
Return the current position in the stream, as a numeric offset.
=cut
sub tell { *{shift()}->{Pos} }
#------------------------------
#
# use_RS [YESNO]
#
# I<Instance method.>
# Obey the current setting of $/, like IO::Handle does?
# Default is false in 1.x, but cold-welded true in 2.x and later.
#
sub use_RS {
my ($self, $yesno) = @_;
carp "use_RS is deprecated and ignored; \$/ is always consulted\n";
}
#------------------------------
=item setpos POS
I<Instance method.>
Set the current position, using the opaque value returned by C<getpos()>.
=cut
sub setpos { shift->seek($_[0],0) }
#------------------------------
=item getpos
I<Instance method.>
Return the current position in the string, as an opaque object.
=cut
*getpos = \&tell;
#------------------------------
=item sref
I<Instance method.>
Return a reference to the underlying scalar.
=cut
sub sref { *{shift()}->{SR} }
#------------------------------
# Tied handle methods...
#------------------------------
# Conventional tiehandle interface:
sub TIEHANDLE {
((defined($_[1]) && UNIVERSAL::isa($_[1], "IO::Scalar"))
? $_[1]
: shift->new(@_));
}
sub GETC { shift->getc(@_) }
sub PRINT { shift->print(@_) }
sub PRINTF { shift->print(sprintf(shift, @_)) }
sub READ { shift->read(@_) }
sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) }
sub WRITE { shift->write(@_); }
sub CLOSE { shift->close(@_); }
sub SEEK { shift->seek(@_); }
sub TELL { shift->tell(@_); }
sub EOF { shift->eof(@_); }
sub BINMODE { 1; }
#------------------------------------------------------------
1;
__END__
=back
=cut
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/IO/Wrap.pm 0000444 00000021125 15157556256 0007760 0 ustar 00 package IO::Wrap;
use strict;
use Exporter;
use FileHandle;
use Carp;
our $VERSION = '2.113';
our @ISA = qw(Exporter);
our @EXPORT = qw(wraphandle);
#------------------------------
# wraphandle RAW
#------------------------------
sub wraphandle {
my $raw = shift;
new IO::Wrap $raw;
}
#------------------------------
# new STREAM
#------------------------------
sub new {
my ($class, $stream) = @_;
no strict 'refs';
### Convert raw scalar to globref:
ref($stream) or $stream = \*$stream;
### Wrap globref and incomplete objects:
if ((ref($stream) eq 'GLOB') or ### globref
(ref($stream) eq 'FileHandle') && !defined(&FileHandle::read)) {
return bless \$stream, $class;
}
$stream; ### already okay!
}
#------------------------------
# I/O methods...
#------------------------------
sub close {
my $self = shift;
return close($$self);
}
sub fileno {
my $self = shift;
my $fh = $$self;
return fileno($fh);
}
sub getline {
my $self = shift;
my $fh = $$self;
return scalar(<$fh>);
}
sub getlines {
my $self = shift;
wantarray or croak("Can't call getlines in scalar context!");
my $fh = $$self;
<$fh>;
}
sub print {
my $self = shift;
print { $$self } @_;
}
sub read {
my $self = shift;
return read($$self, $_[0], $_[1]);
}
sub seek {
my $self = shift;
return seek($$self, $_[0], $_[1]);
}
sub tell {
my $self = shift;
return tell($$self);
}
1;
__END__
=head1 NAME
IO::Wrap - Wrap raw filehandles in the IO::Handle interface
=head1 SYNOPSIS
use strict;
use warnings;
use IO::Wrap;
# this is a fairly senseless use case as IO::Handle already does this.
my $wrap_fh = IO::Wrap->new(\*STDIN);
my $line = $wrap_fh->getline();
# Do stuff with any kind of filehandle (including a bare globref), or
# any kind of blessed object that responds to a print() message.
# already have a globref? a FileHandle? a scalar filehandle name?
$wrap_fh = IO::Wrap->new($some_unknown_thing);
# At this point, we know we have an IO::Handle-like object! YAY
$wrap_fh->print("Hey there!");
You can also do this using a convenience wrapper function
use strict;
use warnings;
use IO::Wrap qw(wraphandle);
# this is a fairly senseless use case as IO::Handle already does this.
my $wrap_fh = wraphandle(\*STDIN);
my $line = $wrap_fh->getline();
# Do stuff with any kind of filehandle (including a bare globref), or
# any kind of blessed object that responds to a print() message.
# already have a globref? a FileHandle? a scalar filehandle name?
$wrap_fh = wraphandle($some_unknown_thing);
# At this point, we know we have an IO::Handle-like object! YAY
$wrap_fh->print("Hey there!");
=head1 DESCRIPTION
Let's say you want to write some code which does I/O, but you don't
want to force the caller to provide you with a L<FileHandle> or L<IO::Handle>
object. You want them to be able to say:
do_stuff(\*STDOUT);
do_stuff('STDERR');
do_stuff($some_FileHandle_object);
do_stuff($some_IO_Handle_object);
And even:
do_stuff($any_object_with_a_print_method);
Sure, one way to do it is to force the caller to use C<tiehandle()>.
But that puts the burden on them. Another way to do it is to
use B<IO::Wrap>.
Clearly, when wrapping a raw external filehandle (like C<\*STDOUT>),
I didn't want to close the file descriptor when the wrapper object is
destroyed; the user might not appreciate that! Hence, there's no
C<DESTROY> method in this class.
When wrapping a L<FileHandle> object, however, I believe that Perl will
invoke the C<FileHandle::DESTROY> when the last reference goes away,
so in that case, the filehandle is closed if the wrapped L<FileHandle>
really was the last reference to it.
=head1 FUNCTIONS
L<IO::Wrap> makes the following functions available.
=head2 wraphandle
# wrap a filehandle glob
my $fh = wraphandle(\*STDIN);
# wrap a raw filehandle glob by name
$fh = wraphandle('STDIN');
# wrap a handle in an object
$fh = wraphandle('Class::HANDLE');
# wrap a blessed FileHandle object
use FileHandle;
my $fho = FileHandle->new("/tmp/foo.txt", "r");
$fh = wraphandle($fho);
# wrap any other blessed object that shares IO::Handle's interface
$fh = wraphandle($some_object);
This function is simply a wrapper to the L<IO::Wrap/"new"> constructor method.
=head1 METHODS
L<IO::Wrap> implements the following methods.
=head2 close
$fh->close();
The C<close> method will attempt to close the system file descriptor. For a
more complete description, read L<perlfunc/close>.
=head2 fileno
my $int = $fh->fileno();
The C<fileno> method returns the file descriptor for the wrapped filehandle.
See L<perlfunc/fileno> for more information.
=head2 getline
my $data = $fh->getline();
The C<getline> method mimics the function by the same name in L<IO::Handle>.
It's like calling C<< my $data = <$fh>; >> but only in scalar context.
=head2 getlines
my @data = $fh->getlines();
The C<getlines> method mimics the function by the same name in L<IO::Handle>.
It's like calling C<< my @data = <$fh>; >> but only in list context. Calling
this method in scalar context will result in a croak.
=head2 new
# wrap a filehandle glob
my $fh = IO::Wrap->new(\*STDIN);
# wrap a raw filehandle glob by name
$fh = IO::Wrap->new('STDIN');
# wrap a handle in an object
$fh = IO::Wrap->new('Class::HANDLE');
# wrap a blessed FileHandle object
use FileHandle;
my $fho = FileHandle->new("/tmp/foo.txt", "r");
$fh = IO::Wrap->new($fho);
# wrap any other blessed object that shares IO::Handle's interface
$fh = IO::Wrap->new($some_object);
The C<new> constructor method takes in a single argument and decides to wrap
it or not it based on what it seems to be.
A raw scalar file handle name, like C<"STDOUT"> or C<"Class::HANDLE"> can be
wrapped, returning an L<IO::Wrap> object instance.
A raw filehandle glob, like C<\*STDOUT> can also be wrapped, returning an
L<IO::Wrawp> object instance.
A blessed L<FileHandle> object can also be wrapped. This is a special case
where an L<IO::Wrap> object instance will only be returned in the case that
your L<FileHandle> object doesn't support the C<read> method.
Also, any other kind of blessed object that conforms to the
L<IO::Handle> interface can be passed in. In this case, you just get back
that object.
In other words, we only wrap it into an L<IO::Wrap> object when what you've
supplied doesn't already conform to the L<IO::Handle> interface.
If you get back an L<IO::Wrap> object, it will obey a basic subset of
the C<IO::> interface. It will do so with object B<methods>, not B<operators>.
=head3 CAVEATS
This module does not allow you to wrap filehandle names which are given
as strings that lack the package they were opened in. That is, if a user
opens FOO in package Foo, they must pass it to you either as C<\*FOO>
or as C<"Foo::FOO">. However, C<"STDIN"> and friends will work just fine.
=head2 print
$fh->print("Some string");
$fh->print("more", " than one", " string");
The C<print> method will attempt to print a string or list of strings to the
filehandle. For a more complete description, read
L<perlfunc/print>.
=head2 read
my $buffer;
# try to read 30 chars into the buffer starting at the
# current cursor position.
my $num_chars_read = $fh->read($buffer, 30);
The L<read> method attempts to read a number of characters, starting at the
filehandle's current cursor position. It returns the number of characters
actually read. See L<perlfunc/read> for more information.
=head2 seek
use Fcntl qw(:seek); # import the SEEK_CUR, SEEK_SET, SEEK_END constants
# seek to the position in bytes
$fh->seek(0, SEEK_SET);
# seek to the position in bytes from the current position
$fh->seek(22, SEEK_CUR);
# seek to the EOF plus bytes
$fh->seek(0, SEEK_END);
The C<seek> method will attempt to set the cursor to a given position in bytes
for the wrapped file handle. See L<perlfunc/seek> for more information.
=head2 tell
my $bytes = $fh->tell();
The C<tell> method will attempt to return the current position of the cursor
in bytes for the wrapped file handle. See L<perlfunc/tell> for more
information.
=head1 AUTHOR
Eryq (F<eryq@zeegee.com>).
President, ZeeGee Software Inc (F<http://www.zeegee.com>).
=head1 CONTRIBUTORS
Dianne Skoll (F<dfs@roaringpenguin.com>).
=head1 COPYRIGHT & LICENSE
Copyright (c) 1997 Erik (Eryq) Dorfman, ZeeGee Software, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
perl5/5.32/cPanelUserConfig.pm 0000644 00000001061 15157556263 0011724 0 ustar 00 # cpanel - cPanelUserConfig.pm Copyright(c) 2021 cPanel, L.L.C.
# All Rights Reserved.
# copyright@cpanel.net http://cpanel.net
# This code is subject to the cPanel license. Unauthorized copying is prohibited
BEGIN {
if ( $> != 0 ) {
my $b__dir = ( getpwuid($>) )[7] . '/perl';
unshift @INC, $b__dir . '5/lib/perl5', $b__dir . '5/lib/perl5/x86_64-linux-thread-multi', map { $b__dir . $_ } grep { $_ ne '.' } @INC;
}
}
1;
doc/alt-php-libc-client11/bugs.txt 0000644 00000027265 15157607663 0012740 0 ustar 00 /* ========================================================================
* Copyright 1988-2007 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
KNOWN BUGS/MISFEATURES/DEFICIENCIES IN THE IMAP TOOLKIT
Last Updated: 15 November 2007
The following are known problems/deficiencies in the imap-2007 toolkit:
. Possible problems for some installations:
. In some versions of Redhat Linux, SVR4-style timezone name lookup
doesn't work properly due to a bug in glibc. The workaround is to
edit os_lnx.c to include tz_bsd.c instead of tz_sv4.c. Note that
other versions of Linux don't support BSD-style timezone name
lookup, so don't make this change unless it's needed on your system.
. In some systems, the OpenSSL distribution is installed other than at
the standard /usr/local/ssl location. If this is the case on your
system and you want to build with SSL support, you will need to set
the SSLDIR variable, either by including a setting of EXTRASPECIALS
in the make command line, e.g.
build lnp SPECIALAUTHENTICATORS=ssl EXTRASPECIALS="SSLDIR=/usr/ssl"
or by editing .../src/osdep/unix/Makefile
. /tmp, /usr/tmp or /var/tmp (if present), and the mail spool directory
must be protected 1777 (world write with sticky bit); otherwise
mailbox locking and updates won't work. An alternative to 1777 on
the mail spool directory is to install the mlock program that is
bundled with the IMAP toolkit.
. Multiple access protection locking does not work if the mailbox or
/tmp are NFS mounted.
. Shared access mailbox formats (mbx, mtx, mx, and tenex) do not work
well with NFS and such usage is not supported. mmdf and unix formats
are supported for use over NFS; however there won't be any multiple
access locking protection.
. Server startup delays may occur if a reverse DNS (IP address to name)
lookup on the client's IP address does not complete in an expeditious
fashion. This is actually a DNS problem and should be fixed in the
DNS and/or the server's host table. A workaround exists (see the
top-level Makefile for details) but is not recommended and can not
be used at all with Kerberos.
. At the insistance of the security gurus, SSL certification validation
is now on by default. This means that you must now use the new
/novalidate-cert switch if establishing an SSL connection to a server
with a self-signed certificate; i.e. if "imap.example.com" has a
self-signed certificate, you must use a mailbox name such as
{imap.example.com/ssl/novalidate-cert}INBOX
to get an SSL session instead of just
{imap.example.com/ssl}INBOX
. GCC 8.x and above on SGI systems does not correctly pass/return
structures which are smaller than 16 bytes and are not 8 bytes. The
problem is that structures are padded at the wrong end; e.g. a 4 byte
structure is loaded into the lower 4 bytes of the register when it
should be loaded into the upper 4 bytes of the register. This affects
IRIX 6 the most because it is a 64-bit system and 4 byte structures are
common. This compiler bug impacts the use of inet_ntoa() in c-client
and causes syslog messages to show IP addresses as 255.255.255.255
instead of the correct values. The fix is either to use SGI's C compiler
instead of GCC or link with an implementation of inet_ntoa() that was
built with GCC instead of the standard SGI C library version.
. By default, the UNIX SSL build assumes that RSAREF is not needed, because
RSA Security Inc. released the RSA public key encryption algorithm into
the public domain on September 6, 2000. There is no longer any need to
use RSAREF, and since RSAREF is slower than OpenSSL's RSA routines
there's good reason not to. If for some reason you still want to use
RSAREF, you will need to edit .../src/osdep/unix/Makefile to
change SSLRSA to load libRSAglue and librsaref.
. By default, the UNIX SSL build assumes that no name conflict exists
between OpenSSL and Kerberos 5. If you are using an older version
of Kerberos, you may need to edit .../src/osdep/unix/Makefile
to change SSLCRYPTO so that it loads the OpenSSL libcrypto library
explicitly as libcrypto.a.
. By default, host names are canonicalized via gethostbyname() and
gethostbyaddr() for everything except for SSL certificate validation.
This can represent a security bug due to DNS spoofing, but is more
likely to deliver results that users expect and also may be necessary
to get Kerberos to work. Set variable "trustdns" in mail.c to NIL if
you want to disable this.
. Bugs:
. It doesn't work to have a "}" character as a user name in /user= in a
mailbox name, even if the user name is quoted. In other words,
{example.com/user="foo}bar"}zap
won't work; foo will be interpreted as an unterminated quoted string
and the remote mailbox name will be
bar"}zap.
. The experimental mx driver has performance problems and shouldn't be used
. docs/internal.txt is out of date (again)
. UIDPLUS bugs/limitations:
. Not supported in all local file formats (see below).
. There are two known issues with UIDPLUS in the mmdf and unix formats:
(a) If the destination mailbox is currently selected (whether in this
or another session), no COPYUID or APPENDUID is returned. The other
choice was to assign a UID based upon the uid_last value and hope
that the session selecting the mailbox would pick it up and update
uid_last. The problem was a timing race if another message was
copied/appended to that mailbox before the selecting session updated
the mailbox. If the timing race is lost, then all UID in the mailbox
would be reassigned by the selecting session, thus making the
returned APPENDUID/COPYUID data useless and causing a performance
problem.
Earlier versions did the "hope for the best" method. This was
revoked in favor of not returning COPYUID/APPENDUID.
Although this violates RFC 4315, there is a loophole which, although
for other purposes, permits this behavior.
(b) There is a known failure if the destination mailbox is currently
selected by legacy software (e.g. older versions of the IMAP
server, Pine, etc.). In this case, all UIDs end up being
reassigned by the legacy software.
. Annoyances:
. Friendly host names (e.g. "server" instead of "server.foo.com") can't be
used in a mailbox name with SSL certificate validation; you have to enter
the fully-qualified domain name. This is a requirement established by
the security gurus.
. IMAP client limitations:
. No SASL protection mechanisms (SASL authentication mechanisms are
supported)
. NNTP client limitations:
. Non-standard IMAP SCAN extension not supported
. POP client limitations:
. No SASL protection mechanisms (SASL authentication mechanisms are
supported)
. No POP3 UID support
. Non-standard IMAP SCAN extension not supported
. SMTP client limitations:
. No SASL protection mechanisms (SASL authentication mechanisms are
supported)
. No support for use of TURN, ETRN, and pipelining.
. No support for enhanced status codes
. UNIX limitations:
. IPv6 is supported but is not the default on most platforms; you have to
use IP=6 in the make command
. Supported local file formats: mbx, mh, mmdf, mix, mtx, mx, news, phile,
tenex, unix
. Supported SASL mechanisms: CRAM-MD5, PLAIN, LOGIN, ANONYMOUS, GSSAPI
. Sticky UIDs are not supported in the mh, mtx, and tenex drivers
. Creation of keywords is not supported in the mh, mtx, and tenex drivers
. Copy and append of keywords only works in the mbx driver.
. Flat file formats (mbx, mmdf, mtx, phile, tenex, unix) do not permit
mailboxes to have inferior names
. SSL temporary key should be seeded better than it is.
. UIDPLUS support is limited to the unix, mmdf, mbx, mx, and mix formats.
. Non-standard IMAP SCAN extension not support for mh and news formats.
. Amiga limitations:
. Supported local file formats: mbx, mh, mmdf, mix, mtx, mx, news, phile,
tenex, unix
. Supported SASL mechanisms: CRAM-MD5, PLAIN, LOGIN, ANONYMOUS
. Sticky UIDs are not supported in the mh, mtx, and tenex drivers
. Creation of keywords is not supported in the mh, mtx, and tenex drivers
. Copy and append of keywords only works in the mbx driver.
. Flat file formats (mbx, mmdf, mtx, phile, tenex, unix) do not permit
mailboxes to have inferior names
. UIDPLUS support is limited to the unix, mmdf, mbx, mx, and mix formats.
. Non-standard IMAP SCAN extension not supported for mh and news formats.
. Win32 (Win9x/NT/Windows 2000) limitations:
. IPv6 is supported in W2K builds but is not the default; you have to use
IP=6 in the nmake command
. Supported local file formats: mbx, mtx, tenex, unix
. Supported SASL mechanisms: CRAM-MD5, PLAIN, LOGIN, ANONYMOUS, GSSAPI
. No server SSL or TLS support.
. No server authentication for GSSAPI
. No server authentication for CRAM-MD5 on NT-based Windows (NT/2K/XP);
it does work on DOS-based Windows (9x/Me).
. Sticky UIDs are not supported in the mtxnt and tenexnt drivers
. Creation of keywords is not supported in the mtxnt and tenexnt drivers
. Copy and append of keywords only works in the mbxnt driver.
. No support for TCP open timeouts
. Flat file formats (mbx, mtx, tenex, unix) do not permit mailboxes to have
inferior names
. UIDPLUS support is limited to the unix and mbx formats.
. Win16 (Win3.1)/DOS limitations:
. IPv6 not supported
. Supported local file formats: bezerk, mtx
. Supported SASL mechanisms: CRAM-MD5, LOGIN, ANONYMOUS
. Supported TCPs: B&W, Novell, PC-NFs, PC/TCP, Waterloo, Winsock
. Sticky UIDs are not supported on local files
. Creation of keywords are not supported on local files
. Bezerk driver is read-only and does not handle LF-only newlines well
. No support for any TCP timeouts on Waterloo DOS
. No support for TCP open timeouts on Winsock and generic DOS
. Flat file formats (bezerk, mtx) do not permit mailboxes to have inferior
names
. Does not work well unless a mailgets routine is armed when fetching
texts.
. Mac limitations:
. IPv6 not supported
. No local file drivers
. Supported SASL mechanisms: CRAM-MD5, LOGIN, ANONYMOUS
. Does not output human-friendly time zone string
. TOPS-20 limitations:
. IPv6 not supported
. No local file drivers
. Supported SASL mechanisms: CRAM-MD5, LOGIN, ANONYMOUS
. No support for any TCP timeouts
. VMS limitations:
. IPv6 not supported
. No local file drivers
. Supported SASL mechanisms: CRAM-MD5, LOGIN, ANONYMOUS
. Supported TCPs: Multinet, Netlib
. No support for any TCP timeouts on VMS Netlib
. No support for TCP open timeouts on VMS Multinet
. Time zone must be configured at build time
. Does not output human-friendly time zone string
. Windows CE limitations:
. IPv6 not yet supported
. No local file drivers
. Supported SASL mechanisms: CRAM-MD5, LOGIN, ANONYMOUS
. No support for TCP open timeouts
. Not finished, only builds c-client library
. OS/2 limitations:
. IPv6 not supported
. Not finished, does not build
doc/alt-php-libc-client11/locking.txt 0000644 00000045615 15157607671 0013424 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
UNIX Advisory File Locking Implications on c-client
Mark Crispin, 28 November 1995
THIS DOCUMENT HAS BEEN UPDATED TO REFLECT THE FACT THAT
LINUX SUPPORTS BOTH flock() AND fcntl() AND THAT OSF/1
HAS BEEN BROKEN SO THAT IT ONLY SUPPORTS fcntl().
-- JUNE 15, 2004
THIS DOCUMENT HAS BEEN UPDATED TO REFLECT THE CODE IN THE
IMAP-4 TOOLKIT AS OF NOVEMBER 28, 1995. SOME STATEMENTS
IN THIS DOCUMENT DO NOT APPLY TO EARLIER VERSIONS OF THE
IMAP TOOLKIT.
INTRODUCTION
Advisory locking is a mechanism by which cooperating processes
can signal to each other their usage of a resource and whether or not
that usage is critical. It is not a mechanism to protect against
processes which do not cooperate in the locking.
The most basic form of locking involves a counter. This counter
is -1 when the resource is available. If a process wants the lock, it
executes an atomic increment-and-test-if-zero. If the value is zero,
the process has the lock and can execute the critical code that needs
exclusive usage of a resource. When it is finished, it sets the lock
back to -1. In C terms:
while (++lock) /* try to get lock */
invoke_other_threads (); /* failed, try again */
.
. /* critical code here */
.
lock = -1; /* release lock */
This particular form of locking appears most commonly in
multi-threaded applications such as operating system kernels. It
makes several presumptions:
(1) it is alright to keep testing the lock (no overflow)
(2) the critical resource is single-access only
(3) there is shared writeable memory between the two threads
(4) the threads can be trusted to release the lock when finished
In applications programming on multi-user systems, most commonly
the other threads are in an entirely different process, which may even
be logged in as a different user. Few operating systems offer shared
writeable memory between such processes.
A means of communicating this is by use of a file with a mutually
agreed upon name. A binary semaphore can be passed by means of the
existance or non-existance of that file, provided that there is an
atomic means to create a file if and only if that file does not exist.
In C terms:
/* try to get lock */
while ((fd = open ("lockfile",O_WRONLY|O_CREAT|O_EXCL,0666)) < 0)
sleep (1); /* failed, try again */
close (fd); /* got the lock */
.
. /* critical code here */
.
unlink ("lockfile"); /* release lock */
This form of locking makes fewer presumptions, but it still is
guilty of presumptions (2) and (4) above. Presumption (2) limits the
ability to have processes sharing a resource in a non-conflicting
fashion (e.g. reading from a file). Presumption (4) leads to
deadlocks should the process crash while it has a resource locked.
Most modern operating systems provide a resource locking system
call that has none of these presumptions. In particular, a mechanism
is provided for identifying shared locks as opposed to exclusive
locks. A shared lock permits other processes to obtain a shared lock,
but denies exclusive locks. In other words:
current state want shared want exclusive
------------- ----------- --------------
unlocked YES YES
locked shared YES NO
locked exclusive NO NO
Furthermore, the operating system automatically relinquishes all
locks held by that process when it terminates.
A useful operation is the ability to upgrade a shared lock to
exclusive (provided there are no other shared users of the lock) and
to downgrade an exclusive lock to shared. It is important that at no
time is the lock ever removed; a process upgrading to exclusive must
not relenquish its shared lock.
Most commonly, the resources being locked are files. Shared
locks are particularly important with files; multiple simultaneous
processes can read from a file, but only one can safely write at a
time. Some writes may be safer than others; an append to the end of
the file is safer than changing existing file data. In turn, changing
a file record in place is safer than rewriting the file with an
entirely different structure.
FILE LOCKING ON UNIX
In the oldest versions of UNIX, the use of a semaphore lockfile
was the only available form of locking. Advisory locking system calls
were not added to UNIX until after the BSD vs. System V split. Both
of these system calls deal with file resources only.
Most systems only have one or the other form of locking. AIX
and newer versions of OSF/1 emulate the BSD form of locking as a jacket
into the System V form. Ultrix and Linux implement both forms.
BSD
BSD added the flock() system call. It offers capabilities to
acquire shared lock, acquire exclusive lock, and unlock. Optionally,
the process can request an immediate error return instead of blocking
when the lock is unavailable.
FLOCK() BUGS
flock() advertises that it permits upgrading of shared locks to
exclusive and downgrading of exclusive locks to shared, but it does so
by releasing the former lock and then trying to acquire the new lock.
This creates a window of vulnerability in which another process can
grab the exclusive lock. Therefore, this capability is not useful,
although many programmers have been deluded by incautious reading of
the flock() man page to believe otherwise. This problem can be
programmed around, once the programmer is aware of it.
flock() always returns as if it succeeded on NFS files, when in
fact it is a no-op. There is no way around this.
Leaving aside these two problems, flock() works remarkably well,
and has shown itself to be robust and trustworthy.
SYSTEM V/POSIX
System V added new functions to the fnctl() system call, and a
simple interface through the lockf() subroutine. This was
subsequently included in POSIX. Both offer the facility to apply the
lock to a particular region of the file instead of to the entire file.
lockf() only supports exclusive locks, and calls fcntl() internally;
hence it won't be discussed further.
Functionally, fcntl() locking is a superset of flock(); it is
possible to implement a flock() emulator using fcntl(), with one minor
exception: it is not possible to acquire an exclusive lock if the file
is not open for write.
The fcntl() locking functions are: query lock station of a file
region, lock/unlock a region, and lock/unlock a region and block until
have the lock. The locks may be shared or exclusive. By means of the
statd and lockd daemons, fcntl() locking is available on NFS files.
When statd is started at system boot, it reads its /etc/state
file (which contains the number of times it has been invoked) and
/etc/sm directory (which contains a list of all remote sites which are
client or server locking with this site), and notifies the statd on
each of these systems that it has been restarted. Each statd then
notifies the local lockd of the restart of that system.
lockd receives fcntl() requests for NFS files. It communicates
with the lockd at the server and requests it to apply the lock, and
with the statd to request it for notification when the server goes
down. It blocks until all these requests are completed.
There is quite a mythos about fcntl() locking.
One religion holds that fcntl() locking is the best thing since
sliced bread, and that programs which use flock() should be converted
to fcntl() so that NFS locking will work. However, as noted above,
very few systems support both calls, so such an exercise is pointless
except on Ultrix and Linux.
Another religion, which I adhere to, has the opposite viewpoint.
FCNTL() BUGS
For all of the hairy code to do individual section locking of a
file, it's clear that the designers of fcntl() locking never
considered some very basic locking operations. It's as if all they
knew about locking they got out of some CS textbook with not
investigation of real-world needs.
It is not possible to acquire an exclusive lock unless the file
is open for write. You could have append with shared read, and thus
you could have a case in which a read-only access may need to go
exclusive. This problem can be programmed around once the programmer
is aware of it.
If the file is opened on another file designator in the same
process, the file is unlocked even if no attempt is made to do any
form of locking on the second designator. This is a very bad bug. It
means that an application must keep track of all the files that it has
opened and locked.
If there is no statd/lockd on the NFS server, fcntl() will hang
forever waiting for them to appear. This is a bad bug. It means that
any attempt to lock on a server that doesn't run these daemons will
hang. There is no way for an application to request flock() style
``try to lock, but no-op if the mechanism ain't there''.
There is a rumor to the effect that fcntl() will hang forever on
local files too if there is no local statd/lockd. These daemons are
running on mailer.u, although they appear not to have much CPU time.
A useful experiment would be to kill them and see if imapd is affected
in any way, but I decline to do so without an OK from UCS! ;-) If
killing statd/lockd can be done without breaking fcntl() on local
files, this would become one of the primary means of dealing with this
problem.
The statd and lockd daemons have quite a reputation for extreme
fragility. There have been numerous reports about the locking
mechanism being wedged on a systemwide or even clusterwide basis,
requiring a reboot to clear. It is rumored that this wedge, once it
happens, also blocks local locking. Presumably killing and restarting
statd would suffice to clear the wedge, but I haven't verified this.
There appears to be a limit to how many locks may be in use at a
time on the system, although the documentation only mentions it in
passing. On some of their systems, UCS has increased lockd's ``size
of the socket buffer'', whatever that means.
C-CLIENT USAGE
c-client uses flock(). On System V systems, flock() is simulated
by an emulator that calls fcntl().
BEZERK AND MMDF
Locking in the traditional UNIX formats was largely dictated by
the status quo in other applications; however, additional protection
is added against inadvertantly running multiple instances of a
c-client application on the same mail file.
(1) c-client attempts to create a .lock file (mail file name with
``.lock'' appended) whenever it reads from, or writes to, the mail
file. This is an exclusive lock, and is held only for short periods
of time while c-client is actually doing the I/O. There is a 5-minute
timeout for this lock, after which it is broken on the presumption
that it is a stale lock. If it can not create the .lock file due to
an EACCES (protection failure) error, it once silently proceeded
without this lock; this was for systems which protect /usr/spool/mail
from unprivileged processes creating files. Today, c-client reports
an error unless it is built otherwise. The purpose of this lock is to
prevent against unfavorable interactions with mail delivery.
(2) c-client applies a shared flock() to the mail file whenever
it reads from the mail file, and an exclusive flock() whenever it
writes to the mail file. This lock is freed as soon as it finishes
reading. The purpose of this lock is to prevent against unfavorable
interactions with mail delivery.
(3) c-client applies an exclusive flock() to a file on /tmp
(whose name represents the device and inode number of the file) when
it opens the mail file. This lock is maintained throughout the
session, although c-client has a feature (called ``kiss of death'')
which permits c-client to forcibly and irreversibly seize the lock
from a cooperating c-client application that surrenders the lock on
demand. The purpose of this lock is to prevent against unfavorable
interactions with other instances of c-client (rewriting the mail
file).
Mail delivery daemons use lock (1), (2), or both. Lock (1) works
over NFS; lock (2) is the only one that works on sites that protect
/usr/spool/mail against unprivileged file creation. Prudent mail
delivery daemons use both forms of locking, and of course so does
c-client.
If only lock (2) is used, then multiple processes can read from
the mail file simultaneously, although in real life this doesn't
really change things. The normal state of locks (1) and (2) is
unlocked except for very brief periods.
TENEX AND MTX
The design of the locking mechanism of these formats was
motivated by a design to enable multiple simultaneous read/write
access. It is almost the reverse of how locking works with
bezerk/mmdf.
(1) c-client applies a shared flock() to the mail file when it
opens the mail file. It upgrades this lock to exclusive whenever it
tries to expunge the mail file. Because of the flock() bug that
upgrading a lock actually releases it, it will not do so until it has
acquired an exclusive lock (2) first. The purpose of this lock is to
prevent against expunge taking place while some other c-client has the
mail file open (and thus knows where all the messages are).
(2) c-client applies a shared flock() to a file on /tmp (whose
name represents the device and inode number of the file) when it
parses the mail file. It applies an exclusive flock() to this file
when it appends new mail to the mail file, as well as before it
attempts to upgrade lock (1) to exclusive. The purpose of this lock
is to prevent against data being appended while some other c-client is
parsing mail in the file (to prevent reading of incomplete messages).
It also protects against the lock-releasing timing race on lock (1).
OBSERVATIONS
In a perfect world, locking works. You are protected against
unfavorable interactions with the mailer and against your own mistake
by running more than one instance of your mail reader. In tenex/mtx
formats, you have the additional benefit that multiple simultaneous
read/write access works, with the sole restriction being that you
can't expunge if there are any sharers of the mail file.
If the mail file is NFS-mounted, then flock() locking is a silent
no-op. This is the way BSD implements flock(), and c-client's
emulation of flock() through fcntl() tests for NFS files and
duplicates this functionality. There is no locking protection for
tenex/mtx mail files at all, and only protection against the mailer
for bezerk/mmdf mail files. This has been the accepted state of
affairs on UNIX for many sad years.
If you can not create .lock files, it should not affect locking,
since the flock() locks suffice for all protection. This is, however,
not true if the mailer does not check for flock() locking, or if the
the mail file is NFS-mounted.
What this means is that there is *no* locking protection at all
in the case of a client using an NFS-mounted /usr/spool/mail that does
not permit file creation by unprivileged programs. It is impossible,
under these circumstances, for an unprivileged program to do anything
about it. Worse, if EACCES errors on .lock file creation are no-op'ed
, the user won't even know about it. This is arguably a site
configuration error.
The problem with not being able to create .lock files exists on
System V as well, but the failure modes for flock() -- which is
implemented via fcntl() -- are different.
On System V, if the mail file is NFS-mounted and either the
client or the server lacks a functioning statd/lockd pair, then the
lock attempt would have hung forever if it weren't for the fact that
c-client tests for NFS and no-ops the flock() emulator in this case.
Systemwide or clusterwide failures of statd/lockd have been known to
occur which cause all locks in all processes to hang (including
local?). Without the special NFS test made by c-client, there would
be no way to request BSD-style no-op behavior, nor is there any way to
determine that this is happening other than the system being hung.
The additional locking introduced by c-client was shown to cause
much more stress on the System V locking mechanism than has
traditionally been placed upon it. If it was stressed too far, all
hell broke loose. Fortunately, this is now past history.
TRADEOFFS
c-client based applications have a reasonable chance of winning
as long as you don't use NFS for remote access to mail files. That's
what IMAP is for, after all. It is, however, very important to
realize that you can *not* use the lock-upgrade feature by itself
because it releases the lock as an interim step -- you need to have
lock-upgrading guarded by another lock.
If you have the misfortune of using System V, you are likely to
run into problems sooner or later having to do with statd/lockd. You
basically end up with one of three unsatisfactory choices:
1) Grit your teeth and live with it.
2) Try to make it work:
a) avoid NFS access so as not to stress statd/lockd.
b) try to understand the code in statd/lockd and hack it
to be more robust.
c) hunt out the system limit of locks, if there is one,
and increase it. Figure on at least two locks per
simultaneous imapd process and four locks per Pine
process. Better yet, make the limit be 10 times the
maximum number of processes.
d) increase the socket buffer (-S switch to lockd) if
it is offered. I don't know what this actually does,
but giving lockd more resources to do its work can't
hurt. Maybe.
3) Decide that it can't possibly work, and turn off the
fcntl() calls in your program.
4) If nuking statd/lockd can be done without breaking local
locking, then do so. This would make SVR4 have the same
limitations as BSD locking, with a couple of additional
bugs.
5) Check for NFS, and don't do the fcntl() in the NFS case.
This is what c-client does.
Note that if you are going to use NFS to access files on a server
which does not have statd/lockd running, your only choice is (3), (4),
or (5). Here again, IMAP can bail you out.
These problems aren't unique to c-client applications; they have
also been reported with Elm, Mediamail, and other email tools.
Of the other two SVR4 locking bugs:
Programmer awareness is necessary to deal with the bug that you
can not get an exclusive lock unless the file is open for write. I
believe that c-client has fixed all of these cases.
The problem about opening a second designator smashing any
current locks on the file has not been addressed satisfactorily yet.
This is not an easy problem to deal with, especially in c-client which
really doesn't know what other files/streams may be open by Pine.
Aren't you so happy that you bought an System V system?
doc/alt-php-libc-client11/SUPPORT 0000644 00000001475 15157607676 0012335 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
BUG REPORTING ADDRESS
Bug reports, comments, or questions regarding this software may
be reported to the imap-uw@u.washington.edu mailing list (this replaces
the old c-client@u.washington.edu mailing list). You can subscribe to
this list by sending a message to:
imap-uw-subscribe@mailman.u.washington.edu
An alternative is to use the comp.mail.imap newsgroup.
doc/alt-php-libc-client11/IPv6.txt 0000644 00000011320 15157607703 0012540 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
The following information about configuring inetd and xinetd for IPv6 was
contributed by a user. I have not checked it for accuracy or completeness,
but have included it as-is in the hope that it may be useful:
---------------------------------------------------------------------------
One thing you might consider adding to the docs are hints for setting up
inetd or xinetd to simultaneously listen on BOTH IPv4 and IPv6 for
different OS.
Some OS want to see separate IPv4-only and IPv6-only listening sockets
configured in inetd.conf or xinetd.conf. Others will accept IPv4
connections on lines configured for IPv6 and actually generate errors if
you have both configured when inetd or xinetd start up. It's not clear to
me whether this difference is due to how inetd or xinetd are built or
whether it's due to the kernel's IP stack implementation. I suspect it's
really the latter. Below are some examples:
Here's a fragment of /usr/local/etc/xinetd.conf for a FreeBSD 4.9 server:
service imap
{
socket_type = stream
protocol = tcp
wait = no
user = root
server = /usr/local/libexec/imapd
}
service imap
{
flags = IPv6
socket_type = stream
protocol = tcp
wait = no
user = root
server = /usr/local/libexec/imapd
}
service imaps
{
socket_type = stream
protocol = tcp
wait = no
user = root
server = /usr/local/libexec/imapd
}
service imaps
{
flags = IPv6
socket_type = stream
protocol = tcp
wait = no
user = root
server = /usr/local/libexec/imapd
}
Note that you have to specify a nearly identical paragraph for each
service which differs only by the 'flags = IPv6'. An equivalent
inetd.conf would look something like:
imap stream tcp nowait root /usr/local/libexec/imapd imapd
imap stream tcp6 nowait root /usr/local/libexec/imapd imapd
imaps stream tcp nowait root /usr/local/libexec/imapd imapd
imaps stream tcp6 nowait root /usr/local/libexec/imapd imapd
The man pages for inetd suggest that if you use a single entry with
'tcp46' replacing either 'tcp' or 'tcp6' the system will listen on both
types of addresses. At least for the case of FreeBSD this is actually
incorrect.
Now if you were to use the above xinetd.conf on Fedora Linux, it would
complain. What does work under Linux is to create a single service
paragraph for each service which will accept connections on both IPv4 and
IPv6:
In /etc/xinetd.d/imap:
service imap
{
flags = IPv6
disable = no
socket_type = stream
wait = no
user = root
server = /usr/local/sbin/imapd
}
In /etc/xinetd.d/imaps:
service imaps
{
flags = IPv6
disable = no
socket_type = stream
wait = no
user = root
server = /usr/local/sbin/imapd
}
The man page for xinetd says the IPv6 flag means xinetd will listen ONLY
on IPv6. However the actual behaviour (for Fedora Linux) is to listen on
both IPv4 and IPv6.
All of the above also applies to ipop3d. Anyway, this might save some
folks a little bit of head scratching time.
---------------------------------------------------------------------------
Addendum from the original submitter:
---------------------------------------------------------------------------
I've since learned that the discrepancy really is a function of the OS.
It seems those systems that force you to create separate IPv4 and IPv6
listeners in inetd (or xinetd) are the same systems that also disable
IPv4-mapped IPv6 addresses by default. This is a boot-time configuration
option. If you enable IPv4-mapped IPv6 addresses, then the 'tcp46' option
in inetd works and the simplified config would look like:
imap4 stream tcp46 nowait root /usr/local/libexec/imapd imapd
imaps stream tcp46 nowait root /usr/local/libexec/imapd imapd
In FreeBSD, enabling IPv4-mapped addresses is done by adding
ipv6_ipv4mapping="YES" to /etc/rc.conf (in addition to ipv6_enable="YES").
doc/alt-php-libc-client11/RELNOTES 0000644 00000103203 15157607710 0012371 0 ustar 00 /* ========================================================================
* Copyright 1988-2008 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
Updated: 22 July 2011
imap-2007f fixes a couple bugs.
Fix for RFC 4959 Initial Client Response auth failures noted first by
MacOSX Lion Mail users.
Adjust tcp_open.c:tcp_socket_open to make it a little more useful by adding
a write file descriptor test to the select in the case that the open
timeout is set.
In osdep/unix/env_unix.c:create_path there was a printf that should have
been an sprintf. Doesn't matter on modern systems.
Updated: 16 December 2008
imap-2007e is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users
plus a security fix for users of the RFC822BUFFER routines.
Updated: 29 October 2008
imap-2007d is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users
plus a security fix for users of tmail or dmail.
Updated: 25 March 2008
imap-2007b is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
Updated: 2 January 2008
imap-2007a is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
Updated: 20 December 2007
imap-2007 is a release corresponding with the release of Alpine 1.0.
The primary focus of the imap-2007 release is bugfixes and reliability
improvements. This includes:
. fixes to problems discovered between the Alpine 0.99999 pre-release
and Alpine 1.0
. fixes to the mix driver to timing race problems uncovered by Timo
Sirainen's imaptest suite. imap-2007 using the mix format is
believed to pass imaptest completely.
A new function, utf8_csvalidmap(), has been added for the benefit of
Alpine to use in examining UTF-8 text and determining efficiently
whether it can be downgraded to a legacy charset. If you develop an
MUA, this may be useful for you too, although you'll have to read the
source code to see how to use it. The purpose of the "not-CJK" bit is
to prevent messages being downgraded to a CJK charset if all they have
in that charset are some special punctuation.
Updated: 5 September 2007
imap-2006k is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
The primary focus of this maintenance release is to correct deadlock
issues. There were two major causes of the deadlocks:
. a change in imap-2006i attempted to resolve a glibc mutex-based
deadlock in imapd's signal handler, but ended up worsening the problem.
. a bug in the mbx driver, introduced as part of the UIDPLUS work in 2006,
applied an mbx-style lock briefly on a traditional UNIX format mailbox.
If the traditional UNIX format mailbox was already locked by some other
process, the result would be a deadlock of both processes.
imapd's signal handling logic is rewritten to avoid the mutex issue, and
the mbx driver is fixed so that mbx-style locks are only applied to mbx
format mailboxes.
imapd now supports the WITHIN extension.
Updated: 14 June 2007
imap-2006j is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
Updated: 5 June 2007
imap-2006i is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
imapd now supports the CHILDREN and ESEARCH extensions.
imapd's attempt to return COPYUID/APPENDUID information for a traditional
UNIX (and MMDF) format mailbox when the mailbox is open by another process
has been declared to be a failure and is now revoked. It was subject to a
timing race, loss of which involved an expensive reset of the mailbox's UID
regime. Any imapd COPY or APPEND to a traditional UNIX or MMDF format that
is open by some other process will now no longer return COPYUID/APPEND.
Although this is technically in violation of RFC 4315, there is a loophole
in that document and the timing race/performance problem is worse.
Updated: 4 April 2007
imap-2006h is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
Updated: 30 March 2007
imap-2006g is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
Updated: 30 January 2007
imap-2006f is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
For the benefit of multi-threaded applications, use of strtok() has been
abolished in the c-client library. imapd and ipop3d stuff use it though.
The TOPS-20 and VAX/VMS ports still use strtok() since they don't use UNIX
threads.
This version has been test-built on Linux, Mac OS X, NeXT, Windows XP,
TOPS-20, and VAX/VMS. This will probably be the last test-build on VAX/VMS
since the system I use for that purpose is being shut down. I have no way
to test-build on DOS, legacy Mac OS (OS 9 and earlier), OS/2, or Windows CE;
and the builds on those systems are probably broken.
Updated: 26 January 2007
imap-2006e is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
Updated: 6 December 2006
imap-2006d is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
The decomposition mapping, title-case mapping, and character widths tables
have been updated to comply with the Unicode 5.0 standard.
Prototypes for the utf8aux.c functions have been moved to a new utf8aux.h.
The general c-client modules now include c-client.h instead of the individual
files. Use of c-client.h instead of individual include files insulates
against future shuffling of include files.
Updated: 23 October 2006
imap-2006c is a maintenance release, consisting primarily of bugfixes to
problems discovered in the release that affected a small number of users.
By popular request, if a user has a mix (or other dual-use) format INBOX,
it will no longer be listed as \NoInferiors. It's a bad idea to depend
upon this due to the case ambiguity issue, but it's there.
Updated: 26 September 2006
imap-2006b is a maintenance release, consisting entirely of bugfixes to
problems discovered in the release that affected a small number of users.
Updated: 15 September 2006
imap-2006a is a maintenance release, consisting entirely of bugfixes to
problems discovered in the release that affected a small number of users.
If it is necessary to build IPv4-only on one of the ports that has IPv6
preconfigured (ldb, lfd, lmd, lrh, lsu, osx, oxp), this can be done by
using IP6=4. You can't do IP=4 in the build command directly since these
ports set IP themselves; however, now instead of setting IP=6 they now set
IP=$(IP6).
Updated: 30 August 2006
imap-2006 is a major release. Programs written for imap-2004g should
build with this version with minor or no modification. imap-2005 was not
released except as development snapshots.
imap-2006 contains major extensions to its Unicode support. Searching and
sorting are now done with strings canonicalized to titlecase and decomposed
form. Among other things, this means that Latin letters with diacriticals
will now sort with the basic Latin letter, and case-independent searching of
such letters (e.g., German umlauts) now works. Previously, sorting was done
strictly by Unicode codepoint, and case-independence only worked with ASCII.
imapd now supports the UIDPLUS extension for mailboxes in unix, mmdf, mbx, mx,
and mix formats. UID EXPUNGE is fully implemented. Note that UIDPLUS is not
supported in the little-used drivers (mh, mtx, tenex) in which meaningful
APPENDUID/COPYUID data can not be returned. Refer to bugs.txt for more
details.
The new mix format is a dual-use mailbox format designed for performance and
reliability with large mailboxes. mix is documented in file mixfmt.txt.
SSL/TLS certificate validation on UNIX now checks the alternative names in the
certificate if the CN does not match.
The new /tls-sslv23 flag in a mailbox name causes a TLS session to use the
(incorrect) SSLv23 client method instead of the TLSv1 client method. Some
broken servers use the SSLv23 server method, and this flag works around that
problem. WARNING: use of this flag will cause TLS negotiation to fail with
a server which uses the proper TLSv1 server method. Additionally, there are
known security risks in SSLv2; so users should be suspicious if this switch
suddenly becomes necesary.
The silly mailbox flag combination /ssl/tls is now rejected as an invalid
remote specification. Previous versions tried to negotiate TLS over an SSL
session; even if the server permitted such a thing it couldn't work.
The memory management of several drivers has been redesigned to consume less
memory and hopefully be faster.
The private.data member of the MESSAGECACHE (elt) has been replaced with
a union that contains private.spare.data and private.spare.ptr, the latter
being a pointer.
A new FT_RETURNSTRINGSTRUCT flag has been added for mail_fetch_body() and
mail_fetch_text() calls. If this flag is set, *and* if the function returns
NIL, then the requested string data is available on a stringstruct on
stream->private.string. This is a special hack for the IMAP and POP servers
and is subject to incompatible change. The result is a major performance
improvement in the servers with the mbx driver, particularly with large
messages.
Updated: 15 September 2005
imap-2004g is a maintenance release, and consists solely of a bugfix to
quoted string handling in the mailbox name parsing routine.
Updated: 15 August 2005
imap-2004f is a maintenance release, and consists solely of a bugfix to
the TCP code.
Also included is a new version of the UNIX SSL/TLS routines that allows the
SSL/TLS certificate validation client code to validate alternative names in
server certificates. This code has not been thoroughly regression-tested but
is believed to work. To use this new code instead of the old support:
cd imap-2004f/src/osdep/unix
mv ssl_unix.c ssl_unix.old
mv ssl_unix.new ssl_unix.c
Then rebuild.
Updated: 21 June 2005
imap-2004e is a maintenance release, consisting entirely of bugfixes.
There are no user-visible functional enhancements in this version.
Updated: 20 April 2005
imap-2004d is a maintenance release, released concurrently with Pine
4.63, and consists primarily of bugfixes
There is now a workaround for RedHat breaking flock(). However, since
RedHat has said that they don't support flock(), there is no guarantee
that they won't break it in the future. So you may want to consider some
other Linux distribution or BSD instead. See:
https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=123415
for the gruesome details.
There are no user-visible functional enhancements in this version.
Updated: 18 January 2005
imap-2004c is a maintenance release, released concurrently with Pine
4.62, including fixes to quoted-printable encoding and CRAM-MD5
authentication.
NNTP proxy in imapd now supports the LIST and LSUB commands.
There are no other user-visible functional enhancements in this version.
Updated: 29 November 2004
imap-2004b is a maintenance release, consisting primarily of bugfixes.
Programs written for imap-2004a will build with this version without
modifification.
There are new ports for Solaris with Blastwave Community Open Source
Software (gcs) and Mandrake Linux (lmd).
SET_SNARFINTERVAL now controls how frequently local drivers will move new
mail from the mail spool as well as from a maildrop. Maildrops are still
tied to a minimum interval of 1 minute, but there is now no minimum for the
spool file.
Character set conversions now map non-breaking space to space if the
destination character set doesn't have nbsp. JIS Roman yen sign is now
mapped to Unicode yen sign.
There are no user-visible functional enhancements in this version.
Updated: 8 July 2004
imap-2004a is a maintenance release, consisting primarily of critical
bugfixes. Programs written for imap-2004 will build with this version
without modification.
imapd now has a supported NNTP proxy capability. If the file /etc/imapd.nntp
exists, the contents of that file are used as the host name of an NNTP
server which will be used whenever a #news. name is used. For example, if
/etc/imapd.nntp contains nntp.example.com, and the IMAP client SELECTs or
EXAMINEs the name #news.comp.mail.imap, what will actually be opened in
imapd is {nntp.example.com/nntp}comp.mail.imap
The OSF/1 port (Digital UNIX, Tru64) now uses flocksim instead of flcksafe.
Some cretin decided to delete the winning flock() call and make flock() use
the losing fcntl() call instead.
The unix[nt] and mmdf drivers now prevent mail_append() from writing Status:,
X-Status:, X-UID, X-IMAP[base]:, and X-Keywords: header lines to a
traditional UNIX or MMDF format mailbox. If any such lines are in the
text supplied to mail_append(), they will be quoted by prefixing with
"X-Original-" (e.g. Status: will become X-Original-Status:).
There are no user-visible functional enhancements in this version.
Updated: 10 May 2004
imap-2004 is a major release. Programs written for imap-2002e should
build with this version with minor modification. imap-2003 was not
released except as development snapshots.
mailutil has three new commands: delete, rename, and prune.
IPv6 support now exists for UNIX and W2K. It is the default in W2K builds.
On UNIX, add "IP=6" to the make command line. Windows IPv6 support is
only for W2K builds.
The NNTP driver now supports NNTP SASL and TLS.
The ldb (Debian) and lrh (RedHat) ports now look for mlock on
/usr/sbin/mlock instead of /etc/mlock.
imapd now supports the LITERAL+ and SASL-IR initial-response extensions.
The IMAP driver has some additional checks to reduce the amount of network
traffic, including executing "silly searches" (searches of sequence numbers
only) locally.
The IMAP, POP, SMTP, and NNTP drivers now have diagnostic code to provide
better information about servers which violate SASL's empty challenge
requirements (e.g. with the PLAIN mechanism).
There is a new mail_fetch_overview_sequence() function which is like
mail_fetch_overview() but takes a sequence number string as an argument.
There should have been a flags argument and FT_UID bit as in all the other
mail_fetch_???() functions but compatibility with the past... :-(
The overview_t callback (from mail_fetch_overview()) now has a fourth
argument which contains the message sequence number (as opposed to the UID
which is in the second argument). It turned out that some applications were
calling mail_msgno() (which can be moderately expensive) to get the sequence
number, and c-client already knew it.
Many declarations which are completely internal to a driver have been removed
from the driver .h file, and in those cases where there are no external
declarations left the .h file has been eliminated entirely. As part of this,
the mbox driver routines are now incorporated with the unix driver routines
as opposed to being a separate file. The mbox driver still needs to be lunk
in order to get the mbox functionality.
Updated: 27 August 2003
imap-2002e is a minor release, released concurrently with Pine 4.58, and
contains primarily bugfixes. Programs written for imap-2002d will build
with this version without modification.
The NNTP client code now tries to perform better with legacy NNTP servers
which do not comply with the current NNTP protocol specification draft, most
notably Netscape Collabra.
Delivery notifications now work reliably with SMTP servers that support it.
The following changes are primarily of concern to developers and power users:
There is a "limited advertise" option in env_unix.c which, if set, will only
advertise the user's own namespace and the #shared/ namespace.
It is now possible to build the IMAP toolkit with a separate SSL KEY file
from the certificate file (SSLKEYS vs. SSLCERTS).
A new BODY structure element, sparep, is available for the main program to
use as a pointer for its own purposes; as well as a SET_FREEBODYSPAREP
function, similar to SET_FREEENVELOPESPAREP, SET_FREEELTSPAREP, etc.
Updated: 28 May 2003
imap-2002d is a minor release, released concurrently with Pine 4.56, and
contains primarily bugfixes. Programs written for imap-2002 should build
with this version without modification, with one exception. That exception
is the ngbogus envelope flag, which stopped being used in imap-2002c and is
now gone for good.
The NNTP newsgroup listing code now tries to use wildmats on the NNTP server,
which should result in better performance especially on slow lines. It is
also once again permitted to log in on NNTP servers when /loser is set.
imapd now supports the UNSELECT command.
A new envelope flag, imapenvonly, indicates that the envelope in a
MESSAGE/RFC822 BODY structure only has the IMAP envelope components and
not the additional components from c-client: Newsgroups, Followup-To,
and References.
Updated: 7 April 2003
imap-2002c is a minor release, released concurrently with Pine 4.55, and
contains primarily bugfixes. Programs written for imap-2002 will build
with this version without modification.
The POP3 driver will, with new servers that support CAPA, use the LIST
command to get the elt->rfc822_size and the TOP command to get the message
header, instead of fetching the entire message. Note that it is a bad idea
to do this with old servers, since they may misimplement LIST and TOP. The
result is a substantial performance improvement.
Subject extraction for comparisons in SORT and THREAD are now done in full
compliance with the rules laid out in the specification. This only makes
a difference if "re:" was part of a MIME quoted-word.
The new experimental #move namespace allows download-and-delete from a source
mailbox to a destination mailbox. Immediately following #move is a delimiter
character which must not appear in the source mailbox name, then the source
mailbox name, then the delimiter again, then the destination mailbox name.
For example:
#move+{pop3.foo.com/pop3}+INBOX
will download messages from "pop3.foo.com" into your local INBOX.
The NNTP driver now uses the LIST EXTENSIONS command as described in the
current NNTP protocol specification draft, and will prefer to use OVER over
XOVER, HDR over XHDR, etc.
The SET_NNTPRANGE function of mail_parameters() can be used to limit the
number of articles recognized by the NNTP driver, resulting in a substantial
performance improvement with NNTP servers that may have hundreds of thousands
of old articles in the spool. If set non-zero, then only the last n article
numbers will be considered. If you are on a slow link, you may want to set
this to 1000 or less.
Besides the normally tested UNIX and 32-bit Microsoft platforms, this release
has also been tested and will once build under TOPS-20 and VAX/VMS. I also
fixed a bug which would keep it from building on 16-bit DOS, but I don't know
if it will build on that platform or not since I no longer have a system with
the old DOS C compiler. It has not been tested on Macintosh (note however
that Mac OS X is a type of UNIX and should build), Amiga, or OS/2, and probably
no longer builds on those platforms.
Updated: 7 January 2003
imap-2002b is a maintenace release, released concurrently with Pine 4.52,
and contains only bugfixes. Programs written for imap-2002 will build with
this version without modification.
Drivers which do not announce new mail are now indicated by the DR_NONEWMAIL
driver flag. Driver which do not announce new mail when read-only are now
indicated by the DR_NONEWMAILRONLY flag.
There are no user-visible functional enhancements in this version.
Updated: 10 December 2002
imap-2002a is a maintenance release, consisting entirely of critical
bugfixes. Programs written for imap-2002 will build with this version
without modification.
There are no functional enhancements in this version.
Updated: 28 October 2002
imap-2002 is a major release. Programs written for imap-2001 will probably
build with this version without modification, with one exception. That
exception is if the program uses [GS]ET_DISABLEAUTOMATICSHAREDNAMESPACES,
which has been renamed to [GS]ET_DISABLEAUTOSHAREDNS in order to placate
some compilers which don't like very long names.
SSLTYPE=nopwd is now the default, in accordance with current IESG security
requirements. In order to build the IMAP toolkit without SSL/TLS you must
now use SSLTYPE=none. At initial build time, you will be told if the SSLTYPE
setting is in compliance with IESG security requirements, and if it is not
you will be asked to confirm to continue the build.
ORDEREDSUBJECT threading has been changed in accordance with draft 12 of the
IMAP threading specification. Previously, each non-root message in an
ORDEREDSUBJECT thread has been a child of the message immediately preceeding
it in the thread. Draft 12 changes this so that the second message in the
thread is the child of the first (root) message, and all subsequent messages
are siblings of the first message. This is significant in MUAs which display
the thread structure graphically; the new definition is much saner than the
old one since it does not nest endlessly due to parent/child relationships
that may not exist. This also impacts imapd, since imapd's THREAD command
will return a thread structure.
RFC 1730 server support, which was disabled in imap-2001, is now fully
removed from imapd. imapd still supports IMAP2bis, specifically the FIND
command, since there are still a few IMAP2 clients out there.
The IMAP client routines in the c-client library continue to support recognize
RFC 1730 servers, but do not implement the deprecated features of RFC 1730.
The Frequently Asked Questions file is now in HTML format, although a text
version (generated from the HTML version with Lynx) is also provided.
A new program, mailutil, is now bundled with the IMAP toolkit. mailutil
replaces the old chkmail, imapcopy, imapmove, imapxfer, mbxcopy, mbxcreat,
and mbxcvt programs that were distributed in the imap-utils. In addition,
the tmail, dmail, and mlock programs from the imap-utils are now also
bundled with the IMAP toolkit.
In addition to the usual bugfixes, the following c-client functionalities
are new in imap-2002:
The SET_DISABLE822TZTEXT parameter allows a client to suppress generation of
the "human friendly" time zone text in RFC822 dates. This placates netnews
and some broken SMTP servers which think that long timezone names from Windows
are an attempt at a buffer overflow attack.
The restrictBox option in env_unix.c sets "restricted box" functionality,
which disables access to the root (leading "/"), access to other user's
directories (leading "~"), and access to superior directories via "..".
Content-Location is now supported by the "location" member of the BODY
structure. Note that there is a bug in the IMAP client code in older
versions of the c-client library that causes it to handle BODYSTRUCTURE
extension data improperly if that data is a literal. The new functionality
for Content-Location may trigger this bug. The fix is either to upgrade
the IMAP client program to the imap-2002 version of c-client or to remove
the Content-Location support from imapd.
There are now 8 spare bits for application use in both the elts and the
mail streams.
mail_search() now returns a value (previously it was void). If mail_search()
returns NIL, then the supplied charset was invalid or the IMAP server
returned NO (probably because the supplied charset was invalid).
New utf8_charset() routine to look up a charset and return c-client's
database about that charset if found. Among other things, this will give
you the scripts supported by that charset and its Unicode conversion table.
New FT_NOLOOKAHEAD flag for mail_fetch_structure() disables fetching of
any envelopes other than the one specified. Otherwise, it will try to do
anticipatory fetching (up to IMAPLOOKAHEAD).
New GET_FETCHLOOKAHEAD allows better control of mail_fetch_structure()
lookahead. Instead of looking IMAPLOOKAHEAD messages forward from the
specified message, it will use a supplied SEARCHSET to generate message
sequences and ranges. It will stop at IMAPLOOKAHEAD messages or at the
completion of a range which exceeds IMAPLOOKAHEAD. The search set only
applies to the next mail_fetch_structure() on that stream, and is cleared
once it is used. Call with
SEARCHSET **set = (SEARCHSET **)
mail_parameters (stream,GET_FETCHLOOKAHEAD,(void *) stream);
*set = pointer to desired search set
New mail_shortdate() routine returns an date in the format expected by
SEARCHPGMs.
Updated: 2 November 2001
imap-2001a is a maintenance release, consisting primarily of bugfixes
including some critical bugfixes to crash and denial of service problems.
Programs written for imap-2001 will build with this version without
modification.
The following new facilities have also been added:
The new /norsh switch in mailbox names provides a more intuitive way of
disabling rsh-IMAP than the existing :143 or setting the rsh-timeout to 0.
Passwords are no longer returned in mm_dlog() callbacks unless the
application sets the SET_DEBUGSENSITIVE parameter.
The SET_NETFSSTATBUG parameter allows an application to force the
traditional UNIX mailbox driver to close and reopen the mailbox at ping
time. This is EXTREMELY inefficient, and should only be used to access
files stored on AFS and old NFS systems.
The ISO 8859 and Windows conversion tables have been updated to comply
with Unicode 3.1, and the KOI8-R table has been verified as compliant with
Unicode 3.1.
The SPECIALS mechanism for passing parameters to the lowest level Makefile
has been updated to be more general. See the next item for why you might
care.
New lrh port to build on Red Hat Linux 7.2, with pre-set definitions for
the places where Red Hat has placed Kerberos and SSL. It's actually just
the lnp port with SPECIALS defined accordingly. You may want to use it as
a model if your system needs such definitions. Note that SPECIALS is
primarily for IMAP toolkit (and Pine) purposes, and that user settings
should use EXTRASPECIALS instead.
Updated: 22 June 2001
imap-2001 is a major release. Programs written for imap-2000 will probably
build with this version without modification.
The FAQ document has been significantly expanded. Be sure to read it for
more information.
In addition to the usual bugfixes, the following features are new in
imap-2001:
SSL is now fully integrated into the IMAP toolkit; the old "alt" kludges to
be able to produce a "sanitized" version of the IMAP toolkit to comply with
late unlamented US export regulations are now completely gone.
Full client and server TLS support is also in this release.
The server certificate must be signed by a trusted certificate authority and
the name in the certificate match the user's entry for the server host name;
this means that the user must enter a fully-qualified host name.
To build with SSL/TLS on UNIX, you now use "SSLTYPE=unix" instead of the
former "SPECIALAUTHENTICATORS=ssl". To build with SSL/TLS on UNIX and disable
the use of plaintext passwords except when under SSL/TLS, use "SSLTYPE=nopwd"
instead of "SSLTYPE=unix".
RFC 1730 (IMAP4 as opposed to IMAP4rev1) support is turned off by default in
imapd. No clients should still be using RFC 1730 protocol. Look at the imapd
Makefile for how to re-enable RFC 1730 support. Note that this code may be
removed in the future, so if you think you need it you had better let me know.
There are some new options (turned off by default) which attempt to work around
problems in certain clients. See the FAQ file for more details.
Updated: 24 January 2001
imap-2000c is a maintenance release, consisting primarily of bugfixes.
Updated: 9 January 2001
imap-2000b is a maintenance release, consisting primarily of bugfixes.
Updated: 9 November 2000
imap-2000a is a maintenance release, consisting primarily of bugfixes.
Updated: 19 September 2000
imap-2000 is a major release. There are major internal and external changes
from earlier versions (imap-4.x and imap-3.x series). Programs written for
imap-4.x will probably build with this version without modification. It is
extremely unlikely that a program written for imap-3.x or earlier series will
build with this version without modifications. Drivers written for earlier
versions will definitely need to be rewritten.
In addition to the usual bugfixes, the following features are new in imap-2000:
SSL support is now available. For UNIX, it is necessary to install some
version of OpenSSL; see imap-2000/docs/SSLBUILD for more information. SSL
support is now automatic for the NT, NTK, and W2K ports. SSL use is indicated
by the /ssl switch in the mailbox name.
With SSL connections, the server certificate is validated by the client code
on UNIX, and Windows 2000 unless /novalidate-cert is specified. Server
certificates are currently is not validated on Windows 9x, Windows Millenium,
or Windows NT 4; this is an artifact of the operating system and not the port
(e.g. client code using the NT port will validate certificates if running on
Windows 2000). On UNIX, the server certificate must be signed by a trusted
certificate authority. On Windows 2000, the certificate must be signed by a
trusted certificate authority and match the user's entry for the server host
name; this means that the user must enter a fully-qualified host name.
Calendar reclama for the benefit of old broken non-Y2K compliant software.
Two digit years from 00 to 69 will be interpreted as 2000 through 2069. In
addition, three digit years from 100 to 105 will be interpreted as 2000
through 2005.
Support for REFERENCES threading (in addition to the previously-existing
ORDEREDSUBJECT threading).
Support for the IMAP MULTIAPPEND extension. This allows much faster uploading
of multiple messages to an IMAP server.
Support for the LOGINDISABLED IMAP capability. If the IMAP server sends
LOGINDISABLED as a capability, the client code will never attempt to send an
IMAP LOGIN command.
Support for SASL authentication identity vs. authorization identity. If the
authentication method does not support this concept (e.g. AUTH=CRAM-MD5,
AUTH=LOGIN, LOGIN command), the "*" character in the user name may be used to
indicate a separate authentication identity; for example, "fred*joe" indicates
authorization identity "fred", authentication identity "joe".
UNIX-specific Changes:
Support for SASL authentication identity vs. authorization identity in the
IMAP and POP3 servers. If the user indicated by the authentication identity
is in the "mailadm" group, he may specify any authorization identity and get
logged in as the authorization identity user.
If the IMAP and POP3 servers are build with PASSWDTYPE=nul, it will send
LOGINDISABLED as a capability and also disable the AUTH=LOGIN and AUTH=PLAIN
SASL authenticators.
New MAILSUBDIR build option to change the default mailbox directory from the
user's home directory to a subdirectory of the user's home directory. See
imap-2000/Makefile for more information.
New CHROOT_SERVER build option for closed server systems only. If defined, a
chroot() call to the user's home directory is done as part of the login
process. See imap-2000/Makefile for more information.
New ADVERTISE_THE_WORLD build option which will add an IMAP namespace that
points to the root. Not for the faint of heart.
UNIX format mailboxes no longer require the pseudo-message, nor will a
pseudo-message be added to a mailbox that does not have one. A new
X-IMAPbase: header will be written in the first message. This is rather less
efficient and robust than the pseudo-message (which remains the encouraged
mechanism; UNIX format mailboxes will always be created with it), but perhaps
will pacify some people who get upset by the pseudo-message.
When building with MIT Kerberos it will try to detect and use libk5crypto.a
instead of libcrypto.a.
The mbx driver is more aggressive about cleaning up expunged messages that
couldn't be purged because of shared access to the mailbox at the time of
expunge. Now, every checkpoint will try to purge such messages; and a
checkpoint is attempted at close time.
Windows-specific Changes:
New W2K port for Windows 2000. In addition to supporting SSL using the
official SSPI interface (the NT and NTK ports invoke SChannel.DLL directly),
the W2K port also supports Microsoft Kerberos. Note that the NT and NTK ports
will work on Windows 2000, but the W2K port will not work on NT4, Windows
9x, or Windows Millenium.
There is now a #user namespace, equivalent to the "~" namespace on UNIX.
Changes for Developers:
New c-client.h file which acts as a master include. c-client based
applications should now include c-client.h instead of the individual c-client
files (mail.h, misc.h, etc.). It is believed that c-client.h will work in C++
applications.
New GET_FREEENVELOPESPAREP/SET_FREEENVELOPESPAREP and
GET_FREEELTSPAREP/SET_FREEELTSPAREP function callbacks to free the "sparep"
member of the envelope and cache elements, respectively.
New OP_MULNEWSRC flag to mail_open() to use multiple newsrc files, and new
GET_NEWSRCQUERY/SET_NEWSRCQUERY function callbacks to get the name of the
newsrc file for news access.
New "secret" nntp_article() function to do the NNTP ARTICLE command; this is
generally useful only when chasing news URLs.
New GET_HIDEDOTFILES/SET_HIDEDOTFILES feature to suppress file names that
start with "." in mail_list() results.
doc/alt-php-libc-client11/LICENSE.txt 0000644 00000026137 15157607716 0013056 0 ustar 00 Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
1. Definitions.
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
END OF TERMS AND CONDITIONS
APPENDIX: How to apply the Apache License to your work.
To apply the Apache License to your work, attach the following
boilerplate notice, with the fields enclosed by brackets "[]"
replaced with your own identifying information. (Don't include
the brackets!) The text should be enclosed in the appropriate
comment syntax for the file format. We also recommend that a
file or class name and description of purpose be included on the
same "printed page" as the copyright notice for easier
identification within third-party archives.
Copyright [yyyy] [name of copyright owner]
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
doc/alt-php-libc-client11/md5.txt 0000644 00000007310 15157607723 0012447 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
MD5 Based Authentication
Mark Crispin
1 November 1999
The IMAP toolkit makes available two MD5 based authentication
mechanisms, CRAM-MD5 and APOP. CRAM-MD5 is described in RFC 2195, and
is a SASL (RFC 2222) authentication mechanism. APOP is described in
RFC 1939, the standard document for the POP3 protocol.
These mechanisms use the same general idea. The server issues a
challenge; the client responds with an MD5 checksum of the challenge
plus the password; the server in compares the client's response with
its own calculated value of the checksum. If the client's response
matches the server's calulated value, the client is authenticated.
Unlike plaintext passwords, this form of authentication is
believed to be secure against the session being monitored; "sniffing"
the session will not disclose the password nor will it provide usable
information to authenticate in another session without knowing the
password.
The key disadvantage with this form of authentication is that the
server must know a plaintext form of the password. In traditional
UNIX authentication, the server only knows an encrypted form of the
password. Consequently, the authentication database for this form of
authentication must be kept strictly confidential; a bad guy who
acquires access to this database can access any account in the
database.
CRAM-MD5 client support is implemented unconditionally; any
client application built with the IMAP toolkit will use CRAM-MD5 with
any server which advertises CRAM-MD5 SASL support.
CRAM-MD5 and APOP server support is implemented if, and only if,
the CRAM-MD5 authentication database exists. By default, the CRAM-MD5
authentication database is in a UNIX file called
/etc/cram-md5.pwd
It is recommended that this file be protected 0400.
NOTE: FAILURE TO PROTECT THIS FILE AGAINST UNAUTHORIZED
ACCESS WILL COMPROMSE CRAM-MD5 AND APOP AUTHENTICATION
FOR ALL USERS LISTED IN THIS DATABASE.
If the CRAM-MD5 authentication database exists, then plaintext
password authentication (e.g. the LOGIN command) will also use the
CRAM-MD5 passwords instead of UNIX passwords. Alternatively, it is
possible to build the IMAP toolkit so that plaintext password
authentication is disabled entirely, by using PASSWDTYPE=nul, e.g.
make aix PASSWDTYPE=nul
The CRAM-MD5 authentication database file consists of a series of
text lines, consisting of a UNIX user name, a single tab, and the
password. A line starting with a "#" character is ignored, as are any
lines which are not in valid format. For example:
------------------------------Sample------------------------------
# CRAM-MD5 authentication database
# Entries are in form <user><tab><password>
# Lines starting with "#" are comments
bill hubba-hubba
hillary nysenator
monica beret
tripp wired
kenstarr inquisitor
reno waco
jessie thebody
billgates ruleworld
------------------------------Sample------------------------------
Every entry in the CRAM-MD5 authentication database must have a
corresponding entry in the /etc/passwd file. It is STRONGLY
RECOMMENDED that the CRAM-MD5 password NOT be the same as the
/etc/passwd password. It is permitted for the /etc/passwd password to
be disabled; /etc/passwd is just used to get the UID, GID, and home
directory information.
doc/alt-php-libc-client11/commndmt.txt 0000644 00000011600 15157607730 0013573 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
[I wrote this tongue-in-cheek, but there's a lot here that people who
build IMAP clients should take careful note. Most existing clients
violate at least one, generally several, of these commandments.
These are based on known user-visible problems that occur with various
commonly used clients. Put another way, behind each commandment is a
plethora of user (and server administrator) complaints caused by a
violator.]
Ten Commandments of How to Write an IMAP client
Mark Crispin
1. Thou shalt not assume that it is alright to open multiple IMAP
sessions selected on the same mailbox simultaneously, lest thou face
the righteous wrath of mail stores that doth not permit such access.
Instead, thou shalt labor mightily, even unto having to use thy brain
to thinketh the matter through, such that thy client use existing
sessions that are already open.
2. Thou shalt not abuse the STATUS command by using it to check for
new mail on a mailbox that you already have selected in an IMAP
session; for that session hath already told thou about new mail
without thy having to ask.
3. Thou shalt remember the 30 minute inactivity timeout, and remember
to speak to the IMAP server before that timeout expires. If thou
useth the IDLE command, thou shalt send DONE from the IDLE before 29
minutes hath passed, and issue a new IDLE. If thou maketh no use of
IDLE, then thou shalt send NOOP every few minutes, and the server
shalt tell you about new mail, and there will be much rejoicing in the
land.
4. Thou shalt not assume that all names are both the name of a mailbox
and the name of a upper level of hierarchy that contains mailboxes;
lest thou face the righteous wrath of mail stores in which a mailbox
is a file and a level of hierarchy is a directory. Thou shalt pay
diligent attention to the \NoSelect and \NoInferiors flags, so that
your users may praise you with great praise.
5. Thou shalt learn and understand the unique features of IMAP, such
as the unsolicited data model, the strict ascending rule of UIDs, how
UIDs map to sequence numbers, the ENVELOPE and BODYSTRUCTURE
structures; so that thou may use the IMAP protocol effectively. For a
POP client hacked to babble IMAP protocol is still no more than a POP
client.
6. Thou shalt remember untagged data sent by the server, and when thou
needest data thou shalt consult your memory before asking the server.
For those who must analyze thy protocol transactions are weak of
stomach, and are likely to lose their recent meal should they see thou
repeatedly re-fetch static data.
7. Thou shalt labor with great effort to work within the IMAP
deleted/expunge model, even if thy own model is that of a trashcan;
for interoperability is paramount and a trashcan model can be done
entirely in the user interface.
8. Thou shalt not fear to open multiple IMAP sessions to the server;
but thou shalt use this technique with wisdom. For verily it is true;
if thou doth desire to monitor continuously five mailboxes for new
mail, it is better to have five IMAP sessions continuously open on the
mailboxes. It is generally not good to do a succession of five SELECT
or STATUS commands on a periodic basis; and it is truly wretched to
open and close five sessions to do a STATUS or SELECT on a periodic
basis. The cost of opening and closing a session is great, especially
if that session is SSL/TLS protected; and the cost of a STATUS or
SELECT can also be great. By comparison, the cost of an open session
doing an IDLE or getting a NOOP every few minutes is small. Great
praise shall be given to thy wisdom in doing what is less costly
instead of "common sense."
9. Thou shalt not abuse subscriptions, for verily the LIST command is
the proper way to discover mailboxes on the server. Thou shalt not
subscribe names to the user's subscription list without explicit
instructions from the user; nor shalt thou assume that only subscribed
names are valid. Rather, thou shalt treat subscribed names as akin to
a bookmarks, or perhaps akin to how Windows shows the "My Documents"
folder -- a set of names that are separate from the hierarchy, for
they are such.
10. Thou shalt use the LIST "*" wildcard only with great care. If
thou doth not fully comprehend the danger of "*", thou shalt use only
"%" and forget about the existance of "*".
Honor these commandments, and keep them holy in thy heart, so that thy
users shalt maximize their pleasure, and the server administrators
shalt sing thy praises and recommend thy work as a model for others to
emulate.
doc/alt-php-libc-client11/imaprc.txt 0000644 00000064757 15157607735 0013262 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
.imaprc secrets revealed!
Mark Crispin, June 17, 2002
The following information describes the format of the /etc/c-client.cf
and ~/.imaprc file. The Columbia MM ~/.mminit file is also read by
c-client; however, the only command that ~/.mminit has in common is
set keywords.
**********************************************************************
* DANGER! BEWARE! TAKE CARE! *
**********************************************************************
* *
* These files, and this documentation, are for internal UW usage *
* only. This capability is for UW experimental tinkering, and most *
* emphatically *not* for sorcerer's apprentices at other sites who *
* feel that if a config file capability exists, they must write a *
* config file whether or not there is any need for one. *
* *
* This information is subject to change without notice. Commands *
* may be added, removed, or altered. The behavior of comamnds may *
* change. Do not use any of this information without consulting me *
* first. c-client's defaults have been carefully chosen to be right *
* for general-purpose and most special-purpose configurations. If *
* you tinker with these defaults, all hell may break loose. *
* *
* This is not an idle threat. There have been several instances of *
* people who ignored these warnings and have gotten burned. *
* *
* Don't even trust this file to work. Many of the things which can *
* be changed by this file can also be changed by the application, *
* and it is totally unpredictable which will take precedence. It *
* all depends upon how the application is coded. Not only that, you *
* may cause the application to crash. *
* *
* In other words, keep your cotton-pickin' hands off my defaults. *
* If it crashes and erases your mail, I don't want to hear about it. *
* Consider 'em ``mandatory defaults''. Got a nice ring, eh? :-) If *
* you must tinker with defaults, play with the .pinerc and pine.conf *
* files in Pine. It's got options galore, all supported for you to *
* have fun. They're also documented; so well documented, it takes *
* two strong men to carry around all the documentation. ;-) ;-) *
* *
* Joking aside, you really shouldn't be fooling around with this *
* capability. It's dangerous, and you can shoot yourself in the *
* foot easily. If you need custom changes, you are better off with *
* local source code modifications. Seriously. *
* *
* One last warning: don't believe anything that you read in this *
* document. Every effort has been made to ensure that this document *
* is incomplete and inaccurate, and I take no responsibility for any *
* glimmers of correct information that may, by some fluke, be here. *
* *
**********************************************************************
The files are read in order: /etc/c-client.cf, ~/.mminit, ~/.imaprc,
and an entry in a later file overrides the setting of an earlier file
except as noted below. This ordering and overriding behavior may
change without notice.
Almost all of these facilities can also be set via the mail_parameters()
call in the program. Whether the file overrides mail_parameters(), or
mail_parameters() overrides the file, is indeterminate. It will vary
from program to program, and it may be one way in one version and the
other way in the next version. It's completely unpredictable, and so
anything you do with these files has to be in complete knowledge of what
the version of each program you're running is going to do. This is
because the files do something for testing, but the real capability for
configurability is put in the program instead. Are you getting the
feeling that you shouldn't be messing with these files yet?
The very first line of the file MUST start with the exact string "I
accept the risk". This ensures that you have checked the file for
correctness against this version of the IMAP toolkit. This enable
string may change without notice in future versions, and the new
string may or may not be accurately described in an updated version of
this file. So any time you install software that uses the IMAP
toolkit, you need to check the new version against these files (if you
have insisted upon creating them in spite of all warnings). If two
pieces of software use different versions of the IMAP toolkit with
incompatible requirements, one of them won't work. Re-read the
warning above about why you should not use these files.
Subsequent lines are read from the file one at a time. Case does not
matter. Unrecognized commands are ignored.
1) set new-folder-format
sets what format new mailboxes are created in. This also controls
default delivery via tmail and dmail.
a) set new-folder-format same-as-inbox
Folder is created using the same mailbox format as INBOX. If
INBOX is empty, it defaults to system standard.
b) set new-folder-format system-standard
This is the default. Folder is created using the wired-in system
standard format, which on most UNIX systems is ordinary UNIX
/bin/mail format. On SCO systems, this is MMDF.
c) set new-folder-format <driver name>
Folder is created using the given driver name, e.g. mbx, unix,
mmdf, etc.
There is no protection against setting this to a silly value (e.g.
news, nntp, dummy) and doing so is a great way to screw things up.
Setting this to mh does not do what you think it does. Setting this
to tenex or mtx isn't particularly useful.
2) set empty-folder-format
sets what format data is written into an empty mailbox file using
mail_copy() or mail_append(). This also controls default delivery
via tmail.
a) set empty-folder-format same-as-inbox
Data is written using the same mailbox format as INBOX. If
INBOX is empty, it defaults to system standard.
b) set empty-folder-format system-standard
This is the default. Data is written using the wired-in system
standard format, which on most UNIX systems is ordinary UNIX
/bin/mail format. On SCO systems, this is MMDF.
c) set-empty-folder-format <driver name>
Data is written using the given driver name, e.g. tenex, unix,
mmdf, etc.
There is no protection against setting this to a silly value (e.g.
news, nntp, dummy) and doing so is a great way to screw things up.
Setting this to mh, mbx, or mx does not work.
3) set keywords <word1>, <word2>, ... <wordn>
Sets the list of keyword flags (supported by tenex and mtx) to the
given list. Up to 30 flags may be given. Since these names
correspond to numeric bits, the order of the keywords can not be
changed, nor can keywords be removed or inserted (you can append
new keywords, up to the limit of 30).
Set keywords is a deprecated command. It may not appear in
future versions, or it may appear in a changed form. It exists
only for compatibility with MM, and should only appear in ~/.mminit
and not in the other files. It is likely to disappear entirely in
IMAP4.
There is no protection against setting these to silly values, and
doing so is a great way to cause a crash.
4) set from-widget header-only
Sets smart insertion of the > character in front of lines that
begin with ``From ''. Only such lines that are also in UNIX mbox
header file format will have a > character inserted. The default
is to insert the > character in front of all lines which begin with
``From '', for the benefit of legacy tools that get confused
otherwise.
5) set black-box-directory <directory name>
Sets the directory in which the user's data can be found. A user's
folders can be found in a subdirectory of the black box directory
named with the user's username. For example, if the blackbox
directory is /usr/spool/folders/, user jones' data can be found
in /usr/spool/folders/jones/. The user's black-box directory is
the location of folders, .mminit, .imaprc, .newsrc, and all other
files used by c-client; internally, it sets c-client's idea of the
user's ``home directory'', overriding /etc/passwd.
This command may not appear in ~/.mminit or ~/.imaprc
In black-box mode, it is not permitted to access any folders
outside of the user's personal blackbox directory. The breakouts
``/'', ``~'', and ``..'' are not permitted.
In order to make this work without crashing, you must set another
option which is not listed in this document.
There is no protection against setting this to a silly value, and
doing so is a great way to cause a crash.
6) set local-host <host name>
Sets c-client's idea of the local host name.
There is no protection against setting this to a silly value, and
doing so is a great way to cause a crash.
7) set news-active-file <file name>
Sets the location of the news active file, if it is not in the
standard place.
It is recommended to use a courtesy symbolic link instead.
There is no protection against setting this to a silly value, and
doing so is a great way to cause a crash.
8) set news-spool-directory <directory name>
Sets the location of the news spool, if it is not in the standard
place.
It is recommended to use a courtesy symbolic link instead.
There is no protection against setting this to a silly value, and
doing so is a great way to cause a crash.
9) set news-state-file <file name>
Sets the location of the news state file (normally $(USER)/.newsrc).
This is not very useful in /etc/c-client.cf because it is a file name.
Setting this in /etc/c-client.cf would set all users to the same file
as their newsrc, which is probably not what you want.
There is no protection against setting this to a silly value, and
doing so is a great way to cause a crash.
10) set system-inbox <file name>
Sets the location of the "system inbox", if it is not in the standard
place. This is the default location of INBOX, or the mail drop point
from which mail is snarfed (e.g. in tenex, mtx, mbox, mh formats).
This is not very useful in /etc/c-client.cf because it is a file name.
Setting this in /etc/c-client.cf would set all users to the same file
as their system inbox, which is probably not what you want.
There is no protection against setting this to a silly value, and
doing so is a great way to cause a crash.
11) set tcp-open-timeout <number>
Sets the number of seconds that the TCP routines will block on opening
a TCP connection before timing out. If a timeout occurs, the connection
attempt is aborted.
The default is zero, meaning use the operating system default (75
seconds on most UNIX systems).
There is no protection against setting this to an excessively small
value, such as 1, and doing so is a great way to cause users extreme
grief.
12) set tcp-read-timeout <number>
Sets the number of seconds that the TCP routines will block on reading
data before calling the timeout routine. If no timeout routine is set
by the program, the connection will be aborted on a timeout.
The default is zero, meaning infinite.
There is no protection against setting this to an excessively small
value, such as 1, and doing so is a great way to cause users extreme
grief.
13) set tcp-write-timeout <number>
Sets the number of seconds that the TCP routines will block on sending
data before calling the timeout routine. If no timeout routine is set
by the program, the connection will be aborted on a timeout.
The default is zero, meaning infinite.
There is no protection against setting this to an excessively small
value, such as 1, and doing so is a great way to cause users extreme
grief.
14) set rsh-timeout <number>
Sets the number of seconds that the rsh routines will block on opening
an rimapd connection before timing out. If a timeout occurs, the
rsh connection attempt is aborted. A zero timeout will disable rsh.
The default is 15 seconds.
There is no protection against setting this to an excessively small
value, such as 1, and doing so is a great way to cause users extreme
grief.
15) set maximum-login-trials <number>
Sets the number of iterations of asking the user, via mm_login(), for
a user name and password, before cancelling the attempt.
The default is 3.
There is no protection against setting this to zero, and doing so is
a great way to cause users extreme grief.
16) set lookahead <number>
Sets the number of envelopes that are looked ahead in IMAP, in
mail_fetchstructure(). This is based on the guess that in such
operations as drawing browser lines, if you get data for message n
you are likely to want it for message n+1, n+2,... in short order.
Lookahead preloads the c-client cache and saves unnecessary RTTs.
The default is 20, a good number for a browser on a 24x80 screen, and
small enough to usually have no significant real-time difference from
a single message fetch.
Setting it to 0 turns off lookahead.
There is no protection against setting this ridiculously high and
incurring performance penalties as a result.
17) set prefetch <number>
Sets the number of envelops which are automatically fetched for the
messages which match in a search. This is based on the guess that
in a browser that is "zoomed" on the results of a search, you are
likely to want the envelope data for each of those messages in
short order. Prefetching reloads the c-client cache, saves
unnecessary RTTs, and avoids loading undesired envelopes due to
lookahead (see above).
The default is 20.
Setting it to 0 turns off prefetch.
There is no protection against setting this ridiculously high and
incurring performance penalties as a result.
18) set close-on-error <number>
If non-zero, IMAP connections are closed if an EXAMINE or SELECT
command fails. Otherwise, they are left half-open, and can be used
again to select some other mailbox. The mailbox name in the stream
is set to {serverhost}<no_mailbox>
The default is zero (do not close on error).
19) set imap-port <number>
Set the TCP/IP contact port to use for IMAP. This overrides the
wired-in setting and the setting from /etc/services, and can in
turn be overridden by an explicit user specification in the mailbox
name, e.g. {serverhost:143}foo
The default is zero (use setting from /etc/services or the wired-in
setting (143).
There is no protection against setting this to a silly value, and
doing so is a great way to cause users extreme grief.
20) set pop3-port <number>
Set the TCP/IP contact port to use for POP3. This overrides the
wired-in setting and the setting from /etc/services, and can in
turn be overridden by an explicit user specification in the mailbox
name, e.g. {serverhost:110/pop3}
The default is zero (use setting from /etc/services or the wired-in
setting (110).
There is no protection against setting this to a silly value, and
doing so is a great way to cause users extreme grief.
21) set uid-lookahead <number>
Sets the number of UIDs that are looked ahead in IMAP in mail_uid().
Lookahead preloads the c-client cache and saves unnecessary RTTs.
The default is 1000, small enough to usually have no significant
real-time difference from a single message UID fetch.
Setting it to 0 turns off lookahead.
There is no protection against setting this ridiculously high and
incurring performance penalties as a result.
22) set mailbox-protection <number>
Set the default protection for newly-created mailbox files.
The default is 384.
There is no protection against setting this to a silly value, and
doing so is a great way to screw things up massively.
23) set directory-protection <number>
Set the default protection for newly-created directories.
The default is 448.
There is no protection against setting this to a silly value, and
doing so is a great way to screw things up massively.
24) set lock-protection <number>
Set the default protection for lock files
The default is 438, which is necessary if locks are to be respected
by processes running as other UIDs.
There is no protection against setting this to a silly value, and
contrary to what you may think just about any value other than 438
turns out to be a silly value.
25) set disable-fcntl-locking <number>
This only applies to SVR4 systems.
If non-zero, fnctl() locking is not attempted. In the past, this
was used to avoid locking NFS files. If NFS is involved, the evil
lockd/statd daemons get invoked. These daemons supposedly work over
NFS, but really don't.
You probably don't really want to do this, though, because now the
flock() emulator (which calls fcntl()) now checks to see if the file
is accessed via NFS and no-ops the lock. This is compatible with
BSD.
Disabling fcntl() locking loses a great deal of locking protection
on local files as well as NFS files (which now never have locking
protection).
The default is zero (fcntl() locking is enabled).
26) set lock-EACCES-error <number>
If non-zero, a warning message is given if an attempt to create a
lock file fails. Otherwise, EACCES is treated as a "silent failure",
and it proceeds without trying to use the lock file. This is for
the benefit of users on systems with paranoid /usr/spool/mail
protections which don't let users create /usr/spool/mail/$(USER).lock
files; these unfortunate users would be harassed with a flood of
error messages otherwise. The problem is that on SVR4, if EACCES
remains disabled and fcntl() locking is also disabled, then there is
no locking at all which is doubleplus-ungood.
If the site is paranoid on /usr/spool/mail protections AND if there
is no fcntl() locking (SVR4) or usable flock() locking (e.g. NFS),
then there is no way to win. Find a different system to use.
The default is non-zero (report EACCESS as an error).
27) set list-maximum-level <number>
Sets the maximum depth of recursion that a * wildcard list will go
down the directory tree. 0 means that no recursion is permitted,
and * becomes like %.
The default is 20.
There is no protection against setting this to a ridiculously high
value. Since LIST will follow symbolic links, it can effectively
recurse infinitely, until the name strings get large enough that
some name limit is exceeded.
28) set anonymous-home-directory <directory name>
Sets the location of the anonymous home directory, if it is not in
the standard place.
It is recommended to use a courtesy symbolic link instead.
There is no protection against setting this to a silly value, and
doing so is a great way to cause a crash.
29) set chroot-server <number>
This option is for closed server systems only. If defined, a chroot()
call to the user's home directory is done as part of the login
process. This has the effect of preventing access to any files
outside of the user's home directory (including shared mailboxes).
Shared mailboxes with other users can't possibly work with this
option, because there is no way to export lock information to other
users.
This should be done ONLY on systems which do not permit users to
have shell access
This option should NEVER(!!) be set if users are allowed shell access.
Doing so actually makes the system *less* secure, since the user could
create an etc subdirectory which would be treated as real /etc by such
programs as /bin/su.
The default is zero (don't do chroot).
This option is strongly *NOT* recommended.
30) set disable-automatic-shared-namespaces <number>
Never look up the "ftp", "imappublic", and "imapshared" users as
posssible home directories for the #ftp, #public, and #shared
namespaces. On some systems (reportedly including AIX 4.3.3)
getpwnam() of an unknown user name is horrendously slow.
Note that this does not remove the #ftp, #public, and #shared
namespaces, and they can still be set up by other means.
The default is zero (shared namespaces are automatic).
31) set advertise-the-world <number>
Include the UNIX root as a shared namespace. This is generally a bad
idea, since certain IMAP clients (names withheld to protect the guilty)
will take this as license to download the entire filesystem tree.
The default is zero (don't advertise the world).
32) set mail-subdirectory <subdirectory name>
Change the default connected directory from the user's home directory
to the named subdirectory of the user's home directory. For example,
setting MAILSUBDIR="mail" will cause the POP2 and IMAP servers to
connect to the user's ~/mail subdirectory. This is equivalent to
the env_unix.c edit described in Example 2 of the CONFIG file.
Note that if the subdirectory does not exist, the result is undefined.
It is probably an extremely bad idea to set this unless you can
guarantee that the subdirectory exists for all users. If you can not
guarantee this, then you should leave the default as the user's home
directory and allow them to configure a personal default in their IMAP
client.
The default is not to use any subdirectory.
33) set allow-user-config <number>
Allow users to use ~/.imaprc and ~/.mminit files.
The default is zero (don't allow user config files).
34) set allow-reverse-dns <number>
By default, the servers (ipop[23]d and imapd) will do gethostbyaddr()
on the local and remote sockets so that imapd can identify itself
properly (this is important when the same CPU hosts multiple virtual
hosts on different IP addresss) and also includes the client's name
when it writes to the syslog. There are also client gethostbyaddr()
calls, used primarily by authentication mechanisms.
Setting this option to zero disables all gethostbyaddr() calls. The
returned "host name" string for the socket is just the bracketed
[12.34.56.78] form, as if the reverse DNS lookup failed.
WARNING: Some authentication mechanisms, e.g. Kerberos V, depend upon
the host names being right, and if you set this option, it won't work.
You should only do this if you are encountering server performance
problems due to a misconfigured DNS, e.g. long startup delays or
client timeouts.
The default is non-zero (allow reverse DNS).
35) set disable-plaintext <number>
Disable plaintext password authentication (LOGIN command, AUTH=LOGIN,
and AUTH=PLAIN).
The default is zero (allow plaintext authentication).
36) set trust-dns <number>
By default, host names are canonicalized via gethostbyname() for
everything except for SSL certificate validation.
This can represent a security bug due to DNS spoofing, but is more
likely to deliver results that users expect. It also may be necessary
for SASL authentication to work right (e.g. generating a correct name
for a Kerberos service principal) if the name entered by the user is a
CNAME or not a fully-qualified domain name.
If trust-dns is set to zero, no host name canonicalization is done.
The user's actual entered name is used for SASL authentication and
will appear in the mailbox name of the open stream.
The default is non-zero (do DNS canonicalization).
37) set sasl-uses-ptr-name <number>
By default, if trust-dns is set, the host names used in authentication
(e.g. to generate a Kerberos service principal) are canonicalized via
gethostbyaddr() instead of by gethostbyname(). If gethostbyaddr()
fails the gethostbyname() canonicalization is used.
This represents an additional security bug due to DNS spoofing, over and
above trust-dns. It also adds an additional DNS query to starting a
session.
It is necessary for sites which implement a server cluster with multiple
A records for a cluster name (instead of a CNAME) but each cluster
member has a unique PTR record which it expects for a Kerberos service
principal.
If sasl-uses-ptr-name is set to zero and trust-dns is set non-zero, the
gethostbyname() canonicalized name is used for SASL authentication.
The setting of sasl-uses-ptr-name is irrelevant if trust-dns is set to
zero.
The default is non-zero (use name from PTR record for SASL).
38) set network-filesystem-stat-bug <number>
By default, traditional UNIX mailbox files are only closed and reopened
at checkpoint and expunge time. This ensures that, prior to rewriting
the file, that any cached stat() data from a network filesystem is
updated with current data.
Very old versions of NFS, and reputedly also AFS, can get into a state
in which the cached stat() data stays out-of-date, even across a
close and reopen of the file.
If network-filesystem-stat-bug is set non-zero, then the mailbox file
is closed and reopened at ping time as a workaround for this bug in
these network filesystems. This means that in imapd, the mailbox
file is closed and reopened for every IMAP command. This is obviously
something that should be avoided unless absolutely necessary.
NFS and AFS are terrible ways to distribute mail. You use use IMAP
servers with a local disk instead.
The default is zero (only close/reopen at checkpoint and expunge time).
Setting this option is a great way to ruin your system's performance.
39) set restrict-mailbox-access <option> <option> ... <option>
This option is for closed server systems only. It is less extreme
than chroot-server, and allows selective restriction of what mailbox
named users can use. The existing options are:
root access not permitted to names starting with "/"
otherusers access not permitted to other users' names; this should
normally be used in conjunction with "root", otherwise
another user's names can be accessed via a root name.
all all of the above
Setting any combination of options also disables access to superior
directories via "..".
This should be done ONLY on systems which do not permit users to
have shell access
The default is no restrictions.
doc/alt-php-libc-client11/naming.txt 0000644 00000011637 15157607742 0013243 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
Mailbox Name Conventions
Mark Crispin
5 October 2005
Please refer to the file drivers.txt for related information.
I. Special names
Special names appear by themselves.
I.a. INBOX
The name INBOX is special and refers to primary incoming message
mailbox on the local system.
I.b. #mhinbox (UNIX only)
The name #mhinbox is special and refers to the primary incoming mh
format mailbox on the local system. Don't worry about this if you
don't know what mh format is.
II. Special prefixes
All names which start with a "#" have a "special prefix" which
identifies an alternative namespace. Special prefixes appear in front
of some additional text which constitutes a suffix.
II.a. #mh/ (UNIX only)
The prefix #mh/ is special and refers to the mh format mailbox named
with the suffix. For example, #mh/foo refers to the mh format mailbox
named foo. Don't worry about this if you don't know what mh format is.
II.b. #news. (UNIX only)
The prefix #news. is special and refers to the newsgroup named with
the suffix. For example, #news.comp.mail.misc refers to the newsgroup
named comp.mail.misc.
II.c. #ftp/ (UNIX only)
The prefix #ftp/ is special and refers to the anonymous ftp filesystem
named with the suffix. For example, #ftp/foo/bar refers to the file
/foo/bar in the anonymous FTP filesystem. Anonymous FTP files are
available to anonymous IMAP logins.
II.d. #public/ (UNIX only)
The prefix #public/ is special and refers to the public files
filesystem named with the suffix. For example, #public/foo/bar refers
to the file /foo/bar in the public filesystem. Public files are
available to anonymous IMAP logins.
II.e. #shared/ (UNIX only)
The prefix #shared/ is special and refers to the shared files
filesystem named with the suffix. For example, #shared/foo/bar
frefers to the file /foo/bar in the shared filesystem.
III. Remote names
All names which start with "{" are remote names, and are in the form
"{" remote_system_name [":" port] [flags] "}" [mailbox_name]
where:
remote_system_name Internet domain name or bracketed IP address
of server.
port optional TCP port number, default is the
default port for that service
flags optional flags, one of the following:
"/service=" service mailbox access service, default is "imap"
"/user=" user remote user name for login on the server
"/authuser=" user remote authentication user; if specified this
is the user name whose password is used (e.g.
administrator)
"/anonymous" remote access as anonymous user
"/debug" record protocol telemetry in application's
debug log
"/secure" do not transmit a plaintext password over
the network
"/imap", "/imap2", "/imap2bis", "/imap4", "/imap4rev1"
equivalent to /service=imap
"/pop3" equivalent to /service=pop3
"/nntp" equivalent to /service=nntp
"/norsh" do not use rsh or ssh to establish a preauthenticated
IMAP session
"/ssl" use the Secure Socket Layer to encrypt the session
"/validate-cert" validate certificates from TLS/SSL server (this is the
default behavior)
"/novalidate-cert" do not validate certificates from TLS/SSL server,
needed if server uses self-signed certificates
"/tls" force use of start-TLS to encrypt the session, and
reject connection to servers that do not support it
"/tls-sslv23" use the depreciated SSLv23 client when negotiating
TLS to the server. This is necessary with some
broken servers which (incorrectly) think that TLS
is just another way of doing SSL.
"/notls" do not do start-TLS to encrypt the session, even
with servers that support it
"/readonly" request read-only mailbox open (IMAP only; ignored
on NNTP, and an error with SMTP and POP3)
"/loser" disable various protocol features and perform various
client-side workarounds; for example, it disables
the SEARCH command in IMAP and does client-side
searching instead. The precise measures taken by
/loser depend upon the protocol and are subject to
change over time. /loser is intended for use with
defective servers which do not implement the
protocol specification correctly. It should be used
only as a last resort since it will seriously
degrade performance.
mailbox_name remote mailbox name, default is INBOX
For example:
{imap.foo.com}INBOX
opens an IMAP connection to system imap.foo.com and selects INBOX.
IV. All other names
All other names are treated as local file names, relative to the
user's home directory. Read drivers.txt for more details.
doc/alt-php-libc-client11/formats.txt 0000644 00000021646 15157607747 0013453 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
Mailbox Format Characteristics
Mark Crispin
11 December 2006
When a mailbox storage technology uses local files and
directories directly, the file(s) and directories are layed out in a
mailbox format.
I. Flat-File Formats
In these formats, a mailbox and all the messages inside are a
single file on the filesystem. The mailbox name is the name of the
file in the filesystem, relative to the user's "mail home directory."
A flat-file format mailbox is always a file, never a directory.
This means that it is impossible to have a flat-file format mailbox
that has inferior mailbox names under it (so-called "dual-usage"
mailboxes). For some inexplicable reason, some people want this.
The mail home directory is usually the same as the user login
home directory if that concept is meaningful; otherwise, it is some
other default directory (e.g. "C:\My Documents" on Windows 98). This
can be redefined by modifying the c-client source code or in an
application via the SET_HOMEDIR mail_parameters() call.
For example, a mailbox named "project" is likely to be found in
the file "project" in the user's home directory. Similarly, a mailbox
named "test/trial1" (assuming a UNIX system) is likely to be found in
the file "trial1" in the subdirectory "test" in the user's home
directory.
Note that the name "INBOX" has special semantics and rules, as
described in the file naming.txt.
The following flat-file formats are supported by c-client as of
the time of this writing:
. unix This is the traditional UNIX mailbox format, in use for nearly
30 years. It uses a line starting with "From " to indicate
start of message, and stores the message status inside the
RFC822 message header.
unix is not particularly efficient; the entire mailbox file
must be read when the mailbox is open, and when reading message
texts it is necessary to convert the newline convention to
Internet standard CR LF form. unix preserves UIDs, and allows
the creation of keywords.
Only one process may have a unix-format mailbox open
read/write at a time.
. mmdf This is the format used by the MMDF mailer. It uses a line
consisting of 4 <CTRL/A> (0x01) characters to indicate start
and end of message. Optionally, there may also be a unix
format "From " line. It otherwise has the same
characteristics as unix format.
. mbx This is the current preferred mailbox format. It can be
handled quite efficiently by c-client, without the problems
that exist with unix and mmdf formats. Messages are stored
in Internet standard CR LF format.
mbx permits shared access, including shared expunge. It
preserves UIDs, and allows the creation of keywords.
. mtx This is supported for compatibility with the past. This is
the old Tenex/TOPS-20 mail.txt format. It can be handled
quite efficiently by c-client, and has most of the
characteristics of mbx format.
mtx is deficient in that it does not support shared expunge;
it has no means to store UIDs; and it has no way to define
keywords except through an external configuration file.
. tenex This is supported for compatibility with the past. This is
the old Columbia MM format. This is similar to mtx format,
only it uses UNIX-style bare-LF newlines instead of CR LF
newlines, thus incurring a performance penalty for newline
conversion.
. phile This is not strictly a format. Any file which is not in a
recognized format is in phile format, which treats the entire
contents of the file as a single message.
II. File/Message Formats
In these formats, a mailbox is a directory, and each the messages
inside are separate files inside the directory. The file names of
these files are generally the text form of a number, which also
matches the UID of the message.
In the case of mx, the mailbox name is the name of the directory
in the filesystem, relative to the user's "mail home directory." In
the case of news and mh, the mailbox name is in a separate namespace
as described in the file naming.txt.
A file/message format mailbox is always a directory. This means
that it is possible to have a file/message format mailbox that has
inferior mailbox names under it (so-called "dual-usage" mailboxes).
For some inexplicable reason, some people want this.
Note that the name "INBOX" has special semantics and rules, as
described in the file naming.txt.
The following file/message formats are supported by c-client as of
the time of this writing:
. mx This is an experimental format, and may be removed in a future
release. An mx format mailbox has a .mxindex file which holds
the message status and unique identifiers. Messages are
stored in Internet standard CF LF form, so the file size of
the message file equals the size of the message.
mx is somewhat inefficient; the entire directory must be read
and each file stat()'d. We found it intolerable for a
moderate sized mailbox (2000 messages) and have more or less
abandoned it.
. mh This is supported for compatibility with the past. This is
the format used by the old mh program.
mh is very inefficient; the entire directory must be read
and each file stat()'d, and in order to determine the size
of a message, the entire file must be read and newline
conversion performed.
mh is deficient in that it does not support any permanent
flags or keywords; and has no means to store UIDs (because
the mh "compress" command renames all the files, that's
why).
. news This is an export of the local filesystem's news spool, e.g.
/var/spool/news. Access to mailboxes in news format is read
only; however, message "deleted" status is preserved in a
.newsrc file in the user's home directory. There is no other
status or keywords.
news is very inefficient; the entire directory must be
read and each file stat()'d, and in order to determine the
size of a message, the entire file must be read and newline
conversion performed.
news is deficient in that it does not support permanent flags
other than deleted; does not support keywords; and has no
expunge.
Soapbox on File/Message Formats
If it sounds from the above descriptions that we're not putting
too much effort into file/message formats, you are correct.
There's a general reason why file/message formats are a bad idea.
Just about every filesystem in existance serializes file creation and
deletions because these manipulate the free space map. This turns out
to be an enormous problem when you start creating/deleting more than a
few messages per second; you spend all your time thrashing in the
filesystem.
It is also extremely slow to do a text search through a
file/message format mailbox. All of those open()s and close()s really
add up to major filesystem thrashing.
What about Cyrus and Maildir?
Both formats are vulnerable to the filesystem thrashing outlined
above.
The Cyrus format used by CMU's Cyrus server (and Esys' server)
has a special associated flat file in each directory that contains
extensive data (including pre-parsed ENVELOPEs and BODYSTRUCTUREs)
about the messages. Put another way, it's a (considerably) more
featureful form of mx. It also uses certain operating system
facilities (e.g. file/memory mapping) which are not available on older
systems, at a cost of much more limited portability than c-client.
These considerably ameliorate the fundamental problems with
file/message formats; in fact, Cyrus is halfway to being a database.
Rather than support Cyrus format in c-client, you should run Cyrus or
Esys if you want that format.
The Maildir format used by qmail has all of the performance
disadvantages of mh noted above, with the additional problem that the
files are renamed in order to change their status so you end up having
to rescan the directory frequently to locate the current names
(particularly in a shared mailbox scenario). It doesn't scale, and it
represents a support nightmare; it is therefore not supported in the
official distribution. Maildir support code for c-client is available
from third parties; but, if you use it, it is entirely at your own
risk (read: don't complain about how poorly it performs or bugs).
So what does this all mean?
A database (such as used by Exchange) is really a much better
approach if you want to move away from flat files. mx and especially
Cyrus take a tenative step in that direction; mx failed mostly because
it didn't go anywhere near far enough. Cyrus goes much further, and
scores remarkable benefits from doing so.
However, a well-designed pure database without the overhead of
separate files would do even better.
doc/alt-php-libc-client11/SSLBUILD 0000644 00000025722 15157607754 0012400 0 ustar 00 /* ========================================================================
* Copyright 1988-2007 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
SSL/TLS BUILD AND INSTALLATION NOTES FOR UNIX
Last Updated: 15 November 2007
PREREQUISITES BEFORE STARTING:
1) Review the information in imap-2007/docs/BUILD.
2) Obtain a copy of OpenSSL. OpenSSL is available from third parties. We
do not provide OpenSSL.
3) Make sure that you know how to build OpenSSL properly on the standard
/usr/local/ssl directory. In particular, /usr/local/ssl/include (and
/usr/local/ssl/include/openssl) and /usr/local/ssl/lib must be set up
from the OpenSSL build. If you have a non-standard installation, then
you must modify the imap-2007/src/osdep/unix/Makefile file to point
to the appropriate locations.
4) Make sure that you know how to obtain appropriate certificates on your
system.
NOTE: We can NOT provide you with support in building/installing OpenSSL, or
in obtaining certificates. If you need help in doing this, try the contacts
mentioned in the OpenSSL README.
SSL BUILD:
By default, the IMAP toolkit builds with SSL and disabling plaintext
passwords unless SSL/TLS encryption is in effect (SSLTYPE=nopwd). This
produces an IMAP server which is compliant with RFC 3501 security
requirements.
To build with SSL but allow plaintext passwords in insecure sessions,
add "SSLTYPE=unix" to the make command line. Note that doing so will
produce an IMAP server which is NON-COMPLIANT with RFC 3501.
To build without SSL, add "SSLTYPE=none" to the make command line.
Note that doing so will produce an IMAP server which is NON-COMPLIANT
with RFC 3501.
There are other make options relevant to SSL, described in
imap-2007/src/osdep/unix/Makefile
The most important of these are SSLDIR, SSLCRYPTO, and SSLRSA.
SSLDIR is set to /usr/local/ssl by default. This is the normal
installation directory for OpenSSL. If your system uses a different directory
you will need to change this.
SSLCRYPTO is set to -lcrypto by default. Older versions of MIT Kerberos
also have a libcrypto and will cause a library name conflict. If you are
using an older version of Kerberos, you may need to change SSLCRYPTO to
$(SSLLIB)/libcrypto.a
SSLRSA is set empty by default. It can be set to specify the RSAREF
libraries, which you once had to use with OpenSSL to use RSA algorithms
legally if you are in the USA, due to patent issues. Since RSA Security Inc.
released the RSA algorithm into the public domain on September 6, 2000, there
is no longer any reason to do this.
SSL INSTALLATION:
Binaries from the build are:
imap-2007/mtest/mtest c-client testbed program
imap-2007/ipopd/ipop2d POP2 daemon
imap-2007/ipopd/ipop3d POP3 daemon
imap-2007/imapd/imapd IMAP4rev1 daemon
mtest is normally not used except by c-client developers.
STEP 1: inetd setup
The ipop2d, ipop3d, and imapd daemons should be installed in a system
daemon directory and invoked by a listener such as xinetd or inetd. In the
following examples, /usr/local/etc is used).
STEP 1(A): xinetd-specific setup
If your system uses xinetd, the daemons are invoked by files in your
/etc/xinetd.d directory with names corresponding to the service names (that
is: imap, imaps, pop2, pop3, pop3s). You will need to consult your local
xinetd documentation to see what should go into these files. Here is a a
sample /etc/xinetd.d/imaps file:
service imaps
{
disable = no
socket_type = stream
wait = no
user = root
server = /usr/local/etc/imapd
groups = yes
flags = REUSE IPv6
}
STEP 1(B): inetd-specific setup
If your system still uses inetd, the daemons are invoked by your
/etc/inetd.conf file with lines such as:
pop stream tcp nowait root /usr/local/etc/ipop2d ipop2d
pop3 stream tcp nowait root /usr/local/etc/ipop3d ipop3d
imap stream tcp nowait root /usr/local/etc/imapd imapd
pop3s stream tcp nowait root /usr/local/etc/ipop3d ipop3d
imaps stream tcp nowait root /usr/local/etc/imapd imapd
Please refer to imap-2007/docs/BUILD for an important note about inetd's
limit on the number of new connections. If that note applies to you, and you
can configure the number of connection in /etc/inetd.conf as described in
imap-2007/docs/build, here is the sample /etc/inetd.conf entry with SSL:
pop3 stream tcp nowait.100 root /usr/local/etc/ipop3d ipop3d
pop3s stream tcp nowait.100 root /usr/local/etc/ipop3d ipop3d
imap stream tcp nowait.100 root /usr/local/etc/imapd imapd
imaps stream tcp nowait.100 root /usr/local/etc/imapd imapd
(or, if you use TCP wrappers)
pop3 stream tcp nowait.100 root /usr/local/etc/tcpd ipop3d
imap stream tcp nowait.100 root /usr/local/etc/tcpd imapd
pop3s stream tcp nowait.100 root /usr/local/etc/ipop3d ipop3d
imaps stream tcp nowait.100 root /usr/local/etc/imapd imapd
NOTE: do *NOT* use TCP wrappers (tcpd) for the imaps and pop3s services! I
don't know why, but it doesn't work with TCP wrappers.
STEP 2: services setup
You may also have to edit your /etc/services (or Yellow Pages,
NetInfo, etc. equivalent) to register these services, such as:
pop 109/tcp
pop3 110/tcp
imap 143/tcp
imaps 993/tcp
pop3s 995/tcp
NOTE: The SSL IMAP service *MUST* be called "imaps", and the SSL POP3 service
*MUST* be called "pop3s".
STEP 3: PAM setup
If your system has PAM (Pluggable Authentication Modules -- most
modern systems do) then you need to set up PAM authenticators for imap and
pop. The correct file names are
/etc/pam.d/imap
and
/etc/pam.d/pop
It probably works to copy your /etc/pam.d/ftpd file to the above two
names.
Many people get these file names wrong, and then spend a lot of time
trying to figure out why it doesn't work. Common mistakes are:
/etc/pam.d/imapd
/etc/pam.d/imap4
/etc/pam.d/imap4rev1
/etc/pam.d/imaps
/etc/pam.d/ipop3d
/etc/pam.d/pop3d
/etc/pam.d/popd
/etc/pam.d/pop3
/etc/pam.d/pop3s
STEP 4: certificates setup
NOTE: We can NOT provide you with support in obtaining certificates. If you
need help in doing this, try the contacts mentioned in the OpenSSL README.
WARNING: Do NOT install servers built with SSL support unless you also plan to
install proper certificates! It is NOT supported to run SSL-enabled servers
on a system without the proper certificates.
You must set up certificates on /usr/local/ssl/certs (this may be
different if you have a non-standard installation of OpenSSL; for example,
FreeBSD has modified OpenSSL to use /usr/local/certs). You should install
both the certificate authority certificates from the SSL distribution after
building OpenSSL, plus your own certificates. The latter should have been
purchased from a certificate authority, although self-signed certificates are
permissible. A sample certificate file is at the end of this document.
Install the resulting certificate file on /usr/local/ssl/certs, with a
file name consisting of the server name and a suffix of ".pem". For example,
install the imapd certificate on /usr/local/ssl/certs/imapd.pem and the ipop3d
certificate on /usr/local/ssl/certs/ipop3d.pem. These files should be
protected against random people accessing them. It is permissible for
imapd.pem and ipop3d.pem to be links to the same file.
The imapd.pem and ipop3d.pem must contain a private key and a
certificate. The private key must not be encrypted.
The following command to openssl can be used to create a self-signed
certificate with a 10-year expiration:
req -new -x509 -nodes -out imapd.pem -keyout imapd.pem -days 3650
*** IMPORTANT ***
We DO NOT recommend, encourage, or sanction the use of self-signed
certificates. Nor will we be responsible for any problems (including security
problems!) which result from your use of a self-signed certificate. Use of
self-signed certificates should be limited to testing only. Buy a real
certificate from a certificate authority!
*** IMPORTANT ***
If you have a multihomed system with multiple domain names (and hence
separate certificates for each domain name), you can append the IP address
to the service name. For example, the IMAP certificate for [12.34.56.78]
would be /usr/local/ssl/certs/imapd-12.34.56.78.pem and so on. You only need
to use this feature if you need to use multiple certificates (because different
DNS names are used).
SAMPLE CERTIFICATE FILE
Here is a sample certificate file. Do *NOT* use this on your own
machine; it is simply an example of what one would look like.
-----BEGIN RSA PRIVATE KEY-----
MIICXQIBAAKBgQDHkqs4YDbakYxRkYXIpY7xLXDQwULR5LW7xWVzuWmmZJOtzwlP
7mN87g+aaiQzwXUVndaCw3Zm6cOG4mytf20jPZq0tvWnjEB3763sorpfpOe/4Vsn
VBFjyQY6YdqYXNmjmzff5gTAecEXOcJ8CrPsaK+nkhw7bHUHX2X+97oMNQIDAQAB
AoGBAMd3YkZAc9LUsig8iDhYsJuAzUb4Qi7Cppj73EBjyqKR18BaM3Z+T1VoIpQ1
DeXkr39heCrN7aNCdTh1SiXGPG6+fkGj9HVw7LmjwXclp4UZwWp3fVbSAWfe3VRe
LM/6p65qogEYuBRMhbSmsn9rBgz3tYVU0lDMZvWxQmUWWg7BAkEA6EbMJeCVdAYu
nQsjwf4vhsHJTChKv/He6kT93Yr/rvq5ihIAPQK/hwcmWf05P9F6bdrA6JTOm3xu
TvJsT/rIvQJBANv0yczI5pUQszw4s+LTzH+kZSb6asWp316BAMDedX+7ID4HaeKk
e4JnBK//xHKVP7xmHuioKYtRlsnuHpWVtNkCQQDPru2+OE6pTRXEqT8xp3sLPJ4m
ECi18yfjxAhRXIU9CUV4ZJv98UUbEJOEBtx3aW/UZbHyw4rwj5N511xtLsjpAkA9
p1XRYxbO/clfvf0ePYP621fHHzZChaUo1jwh07lXvloBSQ6zCqvcF4hG1Qh5ncAp
zO4pBMnwVURRAb/s6fOxAkADv2Tilu1asafmqVzpnRsdfBZx2Xt4oPtquR9IN0Q1
ewRxOC13KZwoAWtkS7l0mY19WD27onF6iAaF7beuK/Va
-----END RSA PRIVATE KEY-----
-----BEGIN CERTIFICATE-----
MIIECTCCA3KgAwIBAgIBADANBgkqhkiG9w0BAQQFADCBujELMAkGA1UEBhMCVVMx
EzARBgNVBAgTCldhc2hpbmd0b24xEDAOBgNVBAcTB1NlYXR0bGUxHzAdBgNVBAoT
FkJsdXJkeWJsb29wIEluZHVzdHJpZXMxFjAUBgNVBAsTDUlTIERlcGFydG1lbnQx
ITAfBgNVBAMTGEJvbWJhc3RpYyBULiBCbHVyZHlibG9vcDEoMCYGCSqGSIb3DQEJ
ARYZYm9tYmFzdGljQGJsdXJkeWJsb29wLmNvbTAeFw0wMDA2MDYwMDUxMTRaFw0x
MDA2MDQwMDUxMTRaMIG6MQswCQYDVQQGEwJVUzETMBEGA1UECBMKV2FzaGluZ3Rv
bjEQMA4GA1UEBxMHU2VhdHRsZTEfMB0GA1UEChMWQmx1cmR5Ymxvb3AgSW5kdXN0
cmllczEWMBQGA1UECxMNSVMgRGVwYXJ0bWVudDEhMB8GA1UEAxMYQm9tYmFzdGlj
IFQuIEJsdXJkeWJsb29wMSgwJgYJKoZIhvcNAQkBFhlib21iYXN0aWNAYmx1cmR5
Ymxvb3AuY29tMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDHkqs4YDbakYxR
kYXIpY7xLXDQwULR5LW7xWVzuWmmZJOtzwlP7mN87g+aaiQzwXUVndaCw3Zm6cOG
4mytf20jPZq0tvWnjEB3763sorpfpOe/4VsnVBFjyQY6YdqYXNmjmzff5gTAecEX
OcJ8CrPsaK+nkhw7bHUHX2X+97oMNQIDAQABo4IBGzCCARcwHQYDVR0OBBYEFD+g
lcPrnpsSvIdkm/eol4sYYg09MIHnBgNVHSMEgd8wgdyAFD+glcPrnpsSvIdkm/eo
l4sYYg09oYHApIG9MIG6MQswCQYDVQQGEwJVUzETMBEGA1UECBMKV2FzaGluZ3Rv
bjEQMA4GA1UEBxMHU2VhdHRsZTEfMB0GA1UEChMWQmx1cmR5Ymxvb3AgSW5kdXN0
cmllczEWMBQGA1UECxMNSVMgRGVwYXJ0bWVudDEhMB8GA1UEAxMYQm9tYmFzdGlj
IFQuIEJsdXJkeWJsb29wMSgwJgYJKoZIhvcNAQkBFhlib21iYXN0aWNAYmx1cmR5
Ymxvb3AuY29tggEAMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEEBQADgYEAwEEk
JXpVXVaFTuG2VJGIzPOxQ+X3V1Cl86y4gM1bDbqlilOUdByUEG4YfSb8ILIn+eXk
WzMAw63Ww5t0/jkO5JRs6i1SUt0Oy80DryNRJYLBVBi499WEduro8GCVD8HuSkDC
yL1Rdq8qlNhWPsggcbhuhvpbEz4pAfzPkrWMBn4=
-----END CERTIFICATE-----
doc/alt-php-libc-client11/drivers.txt 0000644 00000017070 15157607761 0013446 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
c-client Driver Characteristics
Mark Crispin
11 December 2006
Drivers are code modules that support different mailbox storage
technologies. A mailbox storage technology may be implemented by
1) files and directories on the local system
2) a database
3) a network protocol.
In the case of files and directories on the local system, a
driver supports a particular mailbox format. Mailbox formats are
discussed in more detail in the file formats.txt.
As of the date this document was written, there was no bundled
support for any databases in c-client. However, it should not be
particularly difficult to write a driver that communicates with a
database.
Network protocols supported by c-client drivers are the Internet
Mail Access Protocol (all versions: IMAP4rev1, IMAP4, IMAP2bis, and
IMAP2); the Post Office Protocol (version 3); and the Network News
Transport Protocol (NNTP). In addition, c-client also supports NNTP
and the Simple Mail Transport Protocol (SMTP) for mailbox transport.
By default, all drivers are enabled. There is little benefit to
be gained by disabling a driver, with one exception. The mbox driver
implements the behavior of automatically moving new mail from the
spool directory to the "mbox" file on the user's home directory, if
and *only* if the "mbox" exists and is in mailbox format. The mbox
driver is listed under EXTRADRIVERS; if you wish to disable it just
remove it from that list and rebuild.
I. Special name "INBOX"
The following rules to select INBOX and its format apply in
the order given if "black box mode" is not in effect:
1) mbox format is selected if file ~/mbox exists, and is in unix
format or is zero-length.
2) mx format is selected if file ~/INBOX/.mxindex exists.
3) mbx format is selected if file ~/INBOX exists and is in mbx format.
4) tenex format is selected if:
a) file ~/mail.txt exists, and is in tenex format or is zero-length.
b) file ~/INBOX exists and is in tenex format.
5) mtx format is selected if:
a) file ~/INBOX.MTX exists, and is in mtx format or is zero-length.
b) file ~/INBOX exists and is in mtx format.
6) mmdf format is selected if the spool directory file exists and is
in mmdf format.
7) unix format is selected if the spool directory file exists and is
in unix format.
8) the dummy driver is selected if the spool directory file does not
exist, or exists and is empty.
If "black box mode" is not in effect, messages are automatically
transferred ("snarfed") from the spool directory to an INBOX in mbox,
mx, mbx, tenex, and mtx formats.
The following rules to select INBOX and its format apply in the order
given if "black box mode" is in effect:
1) mx format is selected if file ~/INBOX/.mxindex exists.
2) mbx format is selected if file ~/INBOX exists and is in mbx format.
3) tenex format is selected if file ~/INBOX exists and is in tenex format.
4) mtx format is selected if file ~/INBOX exists and is in mtx format.
5) mmdf format is selected if file ~/INBOX exists and is in mmdf format.
6) unix format is selected if file ~/INBOX exists and is in unix format.
7) the dummy driver is selected if ~/INBOX does not exist, or exists
and is empty.
II. Special Name #mhinbox
#mhinbox always refers to the directory "inbox" in the MH path, which
is declared in the ~/.mh_profile file. Messages are automatically
transferred from the spool directory to #mhinbox mailbox.
III. Special Prefix "#mh/"
Any name prefixed with "#mh/" always refers to a directory in the MH
path, which is declared in the ~/.mh_profile file. For example, the name
"#mh/foo" refers to directory "foo" in the MH path.
IV. Special prefix "#news."
Any name prefixed with "#news" always refers to a newsgroup. For
example, the name "#news.comp.mail.misc" refers to newsgroup
"comp.mail.misc".
V. All Other Names
The driver is selected by generating a file name from the mailbox
name, and then examining the data of the object with the resulting
name. The formats are checked in order: mx, mbx, tenex, mtx, mmdf,
unix, and phile. The dummy driver is selected if the file is empty.
The file name is generated according to certain rules, based upon the
prefix of the mailbox name. On UNIX, the following rules apply:
Prefix Interpretation of Suffix
------ ------------------------
/ [black box] preceeds a user name; "/foo/bar" means
"black box user foo's mailbox bar"
[not black box] preceeds an absolute path name.
~ [not black box] preceeds a user name; "~foo/bar" means
"UNIX user foo's mailbox bar"
#ftp/ preceeds UNIX user ftp's mailbox name
#public/ preceeds UNIX user imappublic's mailbox name
#shared/ preceeds UNIX user imapshared's mailbox name
All other names are interpreted in the context of the UNIX user's home
directory (not black box), the black box user's black box directory
(black box), or UNIX user ftp's home directory (anonymous).
The strings "..", "//", and /~ are forbidden in names in:
black box mode
#ftp, #public, or #shared names
anonymous users
Anonymous users may only access:
INBOX (belonging to UNIX user ftp)
files in or below UNIX user ftp's home directory
#ftp, #news, and #public namespace
VI. Driver Comparison
The following information about the local file drivers is an
elaboration of a table compiled by Osma Ahvenlampi.
Driver CA CE UID Kwd Sub NFS Performance Layout
------ -- -- --- --- --- --- ----------- ------
unix no no yes yes no limited fair file
;;; traditional UNIX format
mbox no no yes yes no limited fair file
;;; traditional UNIX format, INBOX only, using ~/mbox with automatic
;;; moving from the mail spool directory.
mmdf no no yes yes no limited fair file
;;; default on SCO systems
mbx yes yes yes yes no no very good prefile
;;; best performing local file driver; preferred format at UW
tenex yes no no limited no no good prefile
;;; compatible with UNIX MM
mtx yes no no limited no no very good prefile
;;; PC Pine standard format; compatible with TOPS-20; identical to tenex
;;; but instead CRLF newlines instead of LF
mx yes buggy yes yes yes no poor ixdir
;;; fullest function; *not* recommended due to performance problems and bugs;
;;; to be redesigned/rewritten
mh yes no no no yes yes very poor dir
;;; compatible with mh; #mhinbox for INBOX, #mh/ prefix for all other names
news yes no yes no yes yes very poor ixdir
;;; local news spool access; #news. prefix for all names
phile no no no no no yes good file
;;; reads arbitrary file as a single readonly message
IMPORTANT: the "performance" ratings are relative to other drivers,
and not necessarily to other software which implements those formats.
They relate to the driver's performance in typical operations such as
an IMAP "FETCH ALL".
Key to headings:
CA: concurrent read/write access
CE: expunge permitted in concurrent read/write access
UID: sticky UIDs
Kwd: keyword flags
Sub: subfolders
NFS: usable over network filesystems (NFS, AFS, etc.)
Layout: file - single file
prefile - file with preallocated space for state
dir - directory, messages are files
ixdir - directory, messages are files, with helper index
In addition, drivers imap, nntp, and pop3 support IMAP4rev1, NNTP, and
POP3 protocols respectively.
doc/alt-php-libc-client11/FAQ.txt 0000644 00000430660 15157607770 0012403 0 ustar 00 /* ========================================================================
* Copyright 1988-2007 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
IMAP Toolkit Frequently Asked Questions
Table of Contents
* 1. General/Software Feature Questions
+ 1.1 Can I set up a POP or IMAP server on UNIX/Linux/OSF/etc.?
+ 1.2 I am currently using qpopper as my POP3 server on UNIX.
Do I need to replace it with ipop3d in order to run imapd?
+ 1.3 Can I set up a POP or IMAP server on Windows XP, 2000,
NT, Me, 98, or 95?
+ 1.4 Can I set up a POP or IMAP server on Windows 3.1 or DOS?
+ 1.5 Can I set up a POP or IMAP server on Macintosh?
+ 1.6 Can I set up a POP or IMAP server on VAX/VMS?
+ 1.7 Can I set up a POP or IMAP server on TOPS-20?
+ 1.8 Are hierarchical mailboxes supported?
+ 1.9 Are "dual-use" mailboxes supported?
+ 1.10 Can I have a mailbox that has both messages and
sub-mailboxes?
+ 1.11 What is the difference between "mailbox" and "folder"?
+ 1.12 What is the status of internationalization?
+ 1.13 Can I use SSL?
+ 1.14 Can I use TLS and the STARTTLS facility?
+ 1.15 Can I use CRAM-MD5 authentication?
+ 1.16 Can I use APOP authentication?
+ 1.17 Can I use Kerberos V5?
+ 1.18 Can I use PAM for plaintext passwords?
+ 1.19 Can I use Kerberos 5 for plaintext passwords?
+ 1.20 Can I use AFS for plaintext passwords?
+ 1.21 Can I use DCE for plaintext passwords?
+ 1.22 Can I use the CRAM-MD5 database for plaintext passwords?
+ 1.23 Can I disable plaintext passwords?
+ 1.24 Can I disable plaintext passwords on unencrypted
sessions, but allow them on encrypted sessions?
+ 1.25 Can I use virtual hosts?
+ 1.26 Can I use RPOP authentication?
+ 1.27 Can I use Kerberos V4?
+ 1.28 Is there support for S/Key or OTP?
+ 1.29 Is there support for NTLM or SPA?
+ 1.30 Is there support for mh?
+ 1.31 Is there support for qmail and the maildir format?
+ 1.32 Is there support for the Cyrus mailbox format?
+ 1.33 Is this software Y2K compliant?
* 2. What Do I Need to Build This Software?
+ 2.1 What do I need to build this software with SSL on UNIX?
+ 2.2 What do I need to build this software with Kerberos V on
UNIX?
+ 2.3 What do I need to use a C++ compiler with this software
to build my own application?
+ 2.4 What do I need to build this software on Windows?
+ 2.5 What do I need to build this software on DOS?
+ 2.6 Can't I use Borland C to build this software on the PC?
+ 2.7 What do I need to build this software on the Mac?
+ 2.8 What do I need to build this software on VMS?
+ 2.9 What do I need to build this software on TOPS-20?
+ 2.10 What do I need to build this software on Amiga or OS/2?
+ 2.11 What do I need to build this software on Windows CE?
* 3. Build and Configuration Questions
+ 3.1 How do I configure the IMAP and POP servers on UNIX?
+ 3.2 I built and installed the servers according to the BUILD
instructions. It can't be that easy. Don't I need to write a
config file?
+ 3.3 How do I make the IMAP and POP servers look for INBOX at
some place other than the mail spool directory?
+ 3.4 How do I make the IMAP server look for secondary folders
at some place other than the user's home directory?
+ 3.5 How do I configure SSL?
+ 3.6 How do I configure TLS and the STARTTLS facility?
+ 3.7 How do I build/install OpenSSL and obtain/create
certificates for use with SSL?
+ 3.8 How do I configure CRAM-MD5 authentication?
+ 3.9 How do I configure APOP authentication?
+ 3.10 How do I configure Kerberos V5?
+ 3.11 How do I configure PAM for plaintext passwords?
+ 3.12 It looks like all I have to do to make the server use
Kerberos is to build with PAM on my Linux system, and set it
up in PAM for Kerberos passwords. Right?
+ 3.13 How do I configure Kerberos 5 for plaintext passwords?
+ 3.14 How do I configure AFS for plaintext passwords?
+ 3.15 How do I configure DCE for plaintext passwords?
+ 3.16 How do I configure the CRAM-MD5 database for plaintext
passwords?
+ 3.17 How do I disable plaintext passwords?
+ 3.18 How do I disable plaintext passwords on unencrypted
sessions, but allow them in SSL or TLS sessions?
+ 3.19 How do I configure virtual hosts?
+ 3.20 Why do I get compiler warning messages such as:
o passing arg 3 of `scandir' from incompatible pointer
type
o Pointers are not assignment-compatible.
o Argument #4 is not the correct type.
during the build?
+ 3.21 Why do I get compiler warning messages such as
o Operation between types "void(*)(int)" and "void*" is
not allowed.
o Function argument assignment between types "void*" and
"void(*)(int)" is not allowed.
o Pointers are not assignment-compatible.
o Argument #5 is not the correct type.
during the build?
+ 3.22 Why do I get linker warning messages such as:
o mtest.c:515: the `gets' function is dangerous and should
not be used.
during the build? Isn't this a security bug?
+ 3.23 Why do I get linker warning messages such as:
o auth_ssl.c:92: the `tmpnam' function is dangerous and
should not be used.
during the build? Isn't this a security bug?
+ 3.24 OK, suppose I see a warning message about a function
being "dangerous and should not be used" for something other
than this gets() or tmpnam() call?
* 4. Operational Questions
+ 4.1 How can I enable anonymous IMAP logins?
+ 4.2 How do I set up an alert message that each IMAP user will
see?
+ 4.3 How does the c-client library choose which of its several
mechanisms to use to establish an IMAP connection to the
server? I noticed that it can connect on port 143, port 993,
via rsh, and via ssh.
+ 4.4 I am using a TLS-capable IMAP server, so I don't need to
use /ssl to get encryption. However, I want to be certain
that my session is TLS encrypted before I send my password.
How to I do this?
+ 4.5 How do I use one of the alternative formats described in
the formats.txt document? In particular, I hear that mbx
format will give me better performance and allow shared
access.
+ 4.6 How do I set up shared mailboxes?
+ 4.7 How can I make the server syslogs go to someplace other
than the mail syslog?
* 5. Security Questions
+ 5.1 I see that the IMAP server allows access to arbitary
files on the system, including /etc/passwd! How do I disable
this?
+ 5.2 I've heard that IMAP servers are insecure. Is this true?
+ 5.3 How do I know that I have the most secure version of the
server?
+ 5.4 I see all these strcpy() and sprintf() calls, those are
unsafe, aren't they?
+ 5.5 Those /tmp lock files are protected 666, is that really
right?
* 6. Why Did You Do This Strange Thing? Questions
+ 6.1 Why don't you use GNU autoconfig / automake /
autoblurdybloop?
+ 6.2 Why do you insist upon a build with -g? Doesn't it waste
disk and memory space?
+ 6.3 Why don't you make c-client a shared library?
+ 6.4 Why don't you use iconv() for internationalization
support?
+ 6.5 Why is the IMAP server connected to the home directory by
default?
+ 6.6 I have a Windows system. Why isn't the server plug and
play for me?
+ 6.7 I looked at the UNIX SSL code and saw that you have the
SSL data payload size set to 8192 bytes. SSL allows 16K; why
aren't you using the full size?
+ 6.8 Why is an mh format INBOX called #mhinbox instead of just
INBOX?
+ 6.9 Why don't you support the maildir format?
+ 6.10 Why don't you support the Cyrus format?
+ 6.11 Why is it creating extra forks on my SVR4 system?
+ 6.12 Why are you so fussy about the date/time format in the
internal "From " line in traditional UNIX mailbox files? My
other mail program just considers every line that starts with
"From " to be the start of the message.
+ 6.13 Why is traditional UNIX format the default format?
+ 6.14 Why do you write this "DON'T DELETE THIS MESSAGE --
FOLDER INTERNAL DATA" message at the start of traditional
UNIX and MMDF format mailboxes?
+ 6.15 Why don't you stash the mailbox metadata in the first
real message of the mailbox instead of writing this fake
FOLDER INTERNAL DATA message?
+ 6.16 Why aren't "dual-use" mailboxes the default?
+ 6.17 Why do you use ucbcc to build on Solaris?
+ 6.18 Why should I care about some old system with BSD
libraries? cc is the right thing on my Solaris system!
+ 6.19 Why do you insist upon writing .lock files in the spool
directory?
+ 6.20 Why should I care about compatibility with the past?
* 7. Problems and Annoyances
+ 7.1 Help! My INBOX is empty! What happened to my messages?
+ 7.2 Help! All my messages in a non-INBOX mailbox have been
concatenated into one message which claims to be from me and
has a subject of the file name of the mailbox! What's going
on?
+ 7.3 Why do I get the message:
o CREATE failed: Can't create mailbox node xxxxxxxxx: File
exists
and how do I fix it?
+ 7.4 Why can't I log in to the server? The user name and
password are right!
+ 7.5 Help! My load average is soaring and I see hundreds of
POP and IMAP servers, many logged in as the same user!
+ 7.6 Why does mail disappear even though I set "keep mail on
server"?
+ 7.7 Why do I get the message
o Moved ##### bytes of new mail to /home/user/mbox from
/var/spool/mail/user
and why did this happen?
+ 7.8 Why isn't it showing the local host name as a
fully-qualified domain name?
+ 7.9 Why is the local host name in the From/Sender/Message-ID
headers of outgoing mail not coming out as a fully-qualified
domain name?
+ 7.10 What does the message:
o Mailbox vulnerable - directory /var/spool/mail must have
1777 protection
mean? How can I fix this?
+ 7.11 What does the message:
o Mailbox is open by another process, access is readonly
mean? How do I fix this?
+ 7.12 What does the message:
o Can't get write access to mailbox, access is readonly
mean?
+ 7.13 I set my POP3 client to "delete messages from server"
but they never get deleted. What is wrong?
+ 7.14 What do messages such as:
o Message ... UID ... already has UID ...
o Message ... UID ... less than ...
o Message ... UID ... greater than last ...
o Invalid UID ... in message ..., rebuilding UIDs
mean?
+ 7.15 What do the error messages:
o Unable to read internal header at ...
o Unable to find CRLF at ...
o Unable to parse internal header at ...
o Unable to parse message date at ...
o Unable to parse message flags at ...
o Unable to parse message UID at ...
o Unable to parse message size at ...
o Last message (at ... ) runs past end of file ...
mean? I am using mbx format.
+ 7.16 What do the syslog messages:
o imap/tcp server failing (looping)
o pop3/tcp server failing (looping)
mean? When it happens, the listed service shuts down. How can
I fix this?
+ 7.17 What does the syslog message:
o Mailbox lock file /tmp/.600.1df3 open failure:
Permission denied
mean?
+ 7.18 What do the syslog messages:
o Command stream end of file, while reading line user=...
host=...
o Command stream end of file, while reading char user=...
host=...
o Command stream end of file, while writing text user=...
host=...
mean?
+ 7.19 Why did my POP or IMAP session suddenly disconnect? The
syslog has the message:
o Killed (lost mailbox lock) user=... host=...
+ 7.20 Why does my IMAP client show all the files on the
system, recursively from the UNIX root directory?
+ 7.21 Why does my IMAP client show all of my files,
recursively from my UNIX home directory?
+ 7.22 Why does my IMAP client show that I have mailboxes named
"#mhinbox", "#mh", "#shared", "#ftp", "#news", and "#public"?
+ 7.23 Why does my IMAP client show all my files in my home
directory?
+ 7.24 Why is there a long delay before I get connected to the
IMAP or POP server, no matter what client I use?
+ 7.25 Why is there a long delay in Pine or any other c-client
based application call before I get connected to the IMAP
server? The hang seems to be in the c-client mail_open()
call. I don't have this problem with any other IMAP client.
There is no delay connecting to a POP3 or NNTP server with
mail_open().
+ 7.26 Why does a message sometimes get split into two or more
messages on my SUN system?
+ 7.27 Why did my POP or IMAP session suddenly disconnect? The
syslog has the message:
o Autologout user=<...my user name...> host=<...my imap
server...>
+ 7.28 What does the UNIX error message:
o TLS/SSL failure: myserver: SSL negotiation failed
mean?
+ 7.29 What does the PC error message:
o TLS/SSL failure: myserver: Unexpected TCP input
disconnect
mean?
+ 7.30 What does the error message:
o TLS/SSL failure: myserver: Server name does not match
certificate
mean?
+ 7.31 What does the UNIX error message:
o TLS/SSL failure: myserver: self-signed certificate
mean?
+ 7.32 What does the PC error message
o TLS/SSL failure: myserver: Self-signed certificate or
untrusted authority
mean?
+ 7.33 What does the UNIX error message:
o TLS/SSL failure: myserver: unable to get local issuer
certificate
mean?
+ 7.34 Why does reading certain messages hang when using
Netscape? It works fine with Pine!
+ 7.35 Why does Netscape say that there's a problem with the
IMAP server and that I should "Contact your mail server
administrator."?
+ 7.36 Why is one user creating huge numbers of IMAP or POP
server sessions?
+ 7.37 Why don't I get any new mail notifications from Outlook
Express or Outlook after a while?
+ 7.38 Why don't I get any new mail notifications from
Entourage?
+ 7.39 Why doesn't Entourage work at all?
+ 7.40 Why doesn't Netscape Notify (NSNOTIFY.EXE) work at all?
+ 7.41 Why can't I connect via SSL to Eudora? It says the
connection has been broken, and in the server syslogs I see
"Command stream end of file".
+ 7.42 Sheesh. Aren't there any good IMAP clients out there?
+ 7.43 But wait! PC Pine (or other PC program build with
c-client) crashes with the message
o incomplete SecBuffer exceeds maximum buffer size
when I use SSL connections. This is a bug in c-client, right?
+ 7.44 My qpopper users keep on getting the DON'T DELETE THIS
MESSAGE -- FOLDER INTERNAL DATA if they also use Pine or
IMAP. How can I fix this?
+ 7.45 Help! I installed the servers but I can't connect to
them from my client!
+ 7.46 Why do I get the message
o Can not authenticate to SMTP server: 421 SMTP connection
went away!
and why did this happen? There was also something about
o SECURITY PROBLEM: insecure server advertised AUTH=PLAIN
+ 7.47 Why do I get the message
o SMTP Authentication cancelled
and why did this happen? There was also something about
o SECURITY PROBLEM: insecure server advertised AUTH=PLAIN
+ 7.48 Why do I get the message
o Invalid base64 string
when I try to authenticate to a Cyrus server?
* 8. Where to Go For Additional Information
+ 8.1 Where can I go to ask questions?
+ 8.2 I have some ideas for enhancements to IMAP. Where should
I go?
+ 8.3 Where can I read more about IMAP and other email
protocols?
+ 8.4 Where can I find out more about setting up and
administering an IMAP server?
_________________________________________________________________
1. General/Software Feature Questions
_________________________________________________________________
1.1 Can I set up a POP or IMAP server on UNIX/Linux/OSF/etc.?
Yes. Refer to the UNIX specific notes in files CONFIG and
BUILD.
_________________________________________________________________
1.2 I am currently using qpopper as my POP3 server on UNIX. Do I need
to replace it with ipop3d in order to run imapd?
Not necessarily.
Although ipop3d interoperates with imapd better than qpopper,
imapd and qpopper will work together. The few qpopper/imapd
interoperability issues mostly affect users who use both IMAP
and POP3 clients; those users would probably be better served
if their POP3 server is ipop3d.
If you are happy with qpopper and just want to add imapd, you
should do that, and defer a decision on changing qpopper to
ipop3d. That way, you can get comfortable with imapd's
performance, without changing anything for your qpopper users.
Many sites have subsequently decided to change from qpopper to
ipop3d in order to get better POP3/IMAP interoperability. If
you need to do this, you'll know. There also seems to be a way
to make qpopper work better with imapd; see the answer to the
My qpopper users keep on getting the DON'T DELETE THIS MESSAGE
-- FOLDER INTERNAL DATA if they also use Pine or IMAP. How can
I fix this? question.
_________________________________________________________________
1.3 Can I set up a POP or IMAP server on Windows XP, 2000, NT, Me, 98,
or 95?
Yes. Refer to the NT specific notes in files CONFIG and BUILD.
Also, for DOS-based versions of Windows (Windows Me, 98, and
95) you *must* set up CRAM-MD5 authentication, as described in
md5.txt.
There is no file access control on Windows 9x or Me, so you
probably will have to do modifications to env_unix.c to prevent
people from hacking others' mail.
Note, however, that the server is not plug and play the way it
is for UNIX.
_________________________________________________________________
1.4 Can I set up a POP or IMAP server on Windows 3.1 or DOS?
1.5 Can I set up a POP or IMAP server on Macintosh?
1.6 Can I set up a POP or IMAP server on VAX/VMS?
Yes, it's just a small matter of programming.
_________________________________________________________________
1.7 Can I set up a POP or IMAP server on TOPS-20?
You have a TOPS-20 system? Cool.
If IMAP2 (RFC 1176) is good enough for you, you can use MAPSER
which is about the ultimate gonzo pure TOPS-20 extended
addressing assembly language program. Unfortunately, IMAP2 is
barely good enough for Pine these days, and most other IMAP
clients won't work with IMAP2 at all. Maybe someone will hack
MAPSER to do IMAP4rev1 some day.
We don't know if anyone wrote a POP3 server for TOPS-20. There
definitely was a POP2 server once upon a time.
Or you can port the POP and IMAP server from this IMAP toolkit
to it. All that you need for a first stab is to port the MTX
driver. That'll probably be just a couple of hours of hacking.
_________________________________________________________________
1.8 Are hierarchical mailboxes supported?
1.9 Are "dual-use" mailboxes supported?
1.10 Can I have a mailbox that has both messages and sub-mailboxes?
Yes. However, there is one important caveat.
Some mailbox formats, including the default which is the
traditional UNIX mailbox format, are stored as a single file
containing all the messages. UNIX does not permit a name in the
filesystem to be both a file and a directory; consequently you
can not have a sub-mailbox within a mailbox that is in one of
these formats.
This is not a limitation of the software; this is a limitation
of UNIX. For example, there are mailbox formats in which the
name is a directory and each message is a file within that
directory; these formats support sub-mailboxes within such
mailboxes. However, for technical reasons, the "flat file"
formats are generally preferred since they perform better. Read
imap-2007/docs/formats.txt for more information on this topic.
It is always permissible to create a directory that is not a
mailbox, and have sub-mailboxes under it. The easiest way to
create a directory is to create a new mailbox inside a
directory that doesn't already exist. For example, if you
create "Mail/testbox" on UNIX, the directory "Mail/" will
automatically be created and then the mailbox "testbox" will be
created as a sub-mailbox of "Mail/".
It is also possible to create the name "Mail/" directly. Check
the documentation for your client software to see how to do
this with that software.
Of course, on Windows systems you would use "\" instead of "/".
_________________________________________________________________
1.11 What is the difference between "mailbox" and "folder"?
The term "mailbox" is IMAP-speak for what a lot of software
calls a "folder" or a "mail folder". However, "folder" is often
used in other contexts to refer to a directory, for example, in
the graphic user interface on both Windows and Macintosh.
A "mailbox" is specifically defined as a named object that
contains messages. It is not required to be capable of
containing other types of objects including other mailboxes;
although some mailbox formats will permit this.
In IMAP-speak, a mailbox which can not contain other mailboxes
is called a "no-inferiors mailbox". Similarly, a directory
which can not contain messages is not a mailbox and is called a
"no-select name".
_________________________________________________________________
1.12 What is the status of internationalization?
The IMAP toolkit is partially internationalized and
multilingualized.
Searching is supported in the following charsets: US-ASCII,
UTF-8, ISO-8859-1, ISO-8859-2, ISO-8859-3, ISO-8859-4,
ISO-8859-5, ISO-8859-6, ISO-8859-7, ISO-8859-8, ISO-8859-9,
ISO-8859-10, ISO-8859-11, ISO-8859-13, ISO-8859-14,
ISO-8859-15, ISO-8859-16, KOI8-R, KOI8-U (alias KOI8-RU),
TIS-620, VISCII, ISO-2022-JP, ISO-2022-KR, ISO-2022-CN,
ISO-2022-JP-1, ISO-2022-JP-2, GB2312 (alias CN-GB),
CN-GB-12345, BIG5 (alias CN-BIG5), EUC-JP, EUC-KR, Shift_JIS,
Shift-JIS, KS_C_5601-1987, KS_C_5601-1992, WINDOWS_874,
WINDOWS-1250, WINDOWS-1251, WINDOWS-1252, WINDOWS-1253,
WINDOWS-1254, WINDOWS-1255, WINDOWS-1256, WINDOWS-1257,
WINDOWS-1258.
All ISO-2022-?? charsets are treated identically, and support
ASCII, JIS Roman, hankaku katakana, ISO-8859-[1 - 10], TIS, GB
2312, JIS X 0208, JIS X 0212, KSC 5601, and planes 1 and 2 of
CNS 11643.
EUC-JP includes support for JIS X 0212 and hankaku katakana.
c-client library support also exists to convert text in any of
the above charsets into Unicode, including headers with MIME
encoded-words.
There is no support for localization (e.g. non-English error
messages) at the present time, but such support is planned.
_________________________________________________________________
1.13 Can I use SSL?
Yes. See the answer to the How do I configure SSL? question.
_________________________________________________________________
1.14 Can I use TLS and the STARTTLS facility?
Yes. See the answer to the How do I configure TLS and the
STARTTLS facility? question.
_________________________________________________________________
1.15 Can I use CRAM-MD5 authentication?
Yes. See the answer to the How do I configure CRAM-MD5
authentication? question.
_________________________________________________________________
1.16 Can I use APOP authentication?
Yes. See the How do I configure APOP authentication? question.
Note that there is no client support for APOP authentication.
_________________________________________________________________
1.17 Can I use Kerberos V5?
Yes. See the answer to the How do I configure Kerberos V5?
question.
_________________________________________________________________
1.18 Can I use PAM for plaintext passwords?
Yes. See the answer to the How do I configure PAM for plaintext
passwords? question.
_________________________________________________________________
1.19 Can I use Kerberos 5 for plaintext passwords?
Yes. See the answer to the How do I configure Kerberos 5 for
plaintext passwords? question.
_________________________________________________________________
1.20 Can I use AFS for plaintext passwords?
Yes. See the answer to the How do I configure AFS for plaintext
passwords? question.
_________________________________________________________________
1.21 Can I use DCE for plaintext passwords?
Yes. See the answer to the How do I configure DCE for plaintext
passwords? question.
_________________________________________________________________
1.22 Can I use the CRAM-MD5 database for plaintext passwords?
Yes. See the answer to the How do I configure the CRAM-MD5
database for plaintext passwords? question.
_________________________________________________________________
1.23 Can I disable plaintext passwords?
Yes. See the answer to the How do I disable plaintext
passwords? question.
_________________________________________________________________
1.24 Can I disable plaintext passwords on unencrypted sessions, but
allow them on encrypted sessions?
Yes. See the answer to the How do I disable plaintext passwords
on unencrypted sessions, but allow them in SSL or TLS sessions?
question.
_________________________________________________________________
1.25 Can I use virtual hosts?
Yes. See the answer to the How do I configure virtual hosts?
question.
_________________________________________________________________
1.26 Can I use RPOP authentication?
There is no support for RPOP authentication.
_________________________________________________________________
1.27 Can I use Kerberos V4?
Kerberos V4 is not supported. Kerberos V4 client-only
contributed code is available in
ftp://ftp.cac.washington.edu/mail/kerberos4-patches.tar.Z
This is a patchkit which must be applied to the IMAP toolkit
according to the instructions in the patchkit's README. We can
not promise that this code works.
_________________________________________________________________
1.28 Is there support for S/Key or OTP?
There is currently no support for S/Key or OTP. There may be an
OTP SASL authenticator available from third parties.
_________________________________________________________________
1.29 Is there support for NTLM or SPA?
There is currently no support for NTLM or SPA, nor are there
any plans to add such support. In general, I avoid
vendor-specific mechanisms. I also believe that these
mechanisms are being deprecated by their vendor.
There may be an NTLM SASL authenticator available from third
parties.
_________________________________________________________________
1.30 Is there support for mh?
Yes, but only as a legacy format. Your mh format INBOX is
accessed by the name "#mhinbox", and all other mh format
mailboxes are accessed by prefixing "#mh/" to the name, e.g.
"#mh/foo". The mh support uses the "Path:" entry in your
.mh_profile file to identify the root directory of your mh
format mailboxes.
Non-legacy use of mh format is not encouraged. There is no
support for permanent flags or unique identifiers; furthermore
there are known severe performance problems with the mh format.
_________________________________________________________________
1.31 Is there support for qmail and the maildir format?
There is no support for qmail or the maildir format in our
distribution, nor are there any plans to add such support.
Maildir support may be available from third parties.
_________________________________________________________________
1.32 Is there support for the Cyrus mailbox format?
No.
_________________________________________________________________
1.33 Is this software Y2K compliant?
Please read the files Y2K and calendar.txt.
_________________________________________________________________
2. What Do I Need to Build This Software?
_________________________________________________________________
2.1 What do I need to build this software with SSL on UNIX?
You need to build and install OpenSSL first.
_________________________________________________________________
2.2 What do I need to build this software with Kerberos V on UNIX?
You need to build and install MIT Kerberos first.
_________________________________________________________________
2.3 What do I need to use a C++ compiler with this software to build
my own application?
If you are building an application using the c-client library,
use the new c-client.h file instead of including the other
include files. It seems that c-client.h should define away all
the troublesome names that conflict with C++.
If you use gcc, you may need to use -fno-operator-names as
well.
_________________________________________________________________
2.4 What do I need to build this software on Windows?
You need Microsoft Visual C++ 6.0, Visual C++ .NET, or Visual
C# .NET (which you can buy from any computer store), along with
the Microsoft Platform SDK (which you can download from
Microsoft's web site).
You do not need to install the entire Platform SDK; it suffices
to install just the Core SDK and the Internet Development SDK.
_________________________________________________________________
2.5 What do I need to build this software on DOS?
It's been several years since we last attempted to do this. At
the time, we used Microsoft C.
_________________________________________________________________
2.6 Can't I use Borland C to build this software on the PC?
Probably not. If you know otherwise, please let us know.
_________________________________________________________________
2.7 What do I need to build this software on the Mac?
It has been several years since we last attempted to do this.
At the time, we used Symantec THINK C; but today you'll need a
C compiler which allows segments to be more than 32K.
_________________________________________________________________
2.8 What do I need to build this software on VMS?
You need the VMS C compiler, and either the Multinet or Netlib
TCP.
_________________________________________________________________
2.9 What do I need to build this software on TOPS-20?
You need the TOPS-20 KCC compiler.
_________________________________________________________________
2.10 What do I need to build this software on Amiga or OS/2?
We don't know.
_________________________________________________________________
2.11 What do I need to build this software on Windows CE?
This port is incomplete. Someone needs to finish it.
_________________________________________________________________
3. Build and Configuration Questions
_________________________________________________________________
3.1 How do I configure the IMAP and POP servers on UNIX?
3.2 I built and installed the servers according to the BUILD
instructions. It can't be that easy. Don't I need to write a config
file?
For ordinary "vanilla" UNIX systems, this software is plug and
play; just build it, install it, and you're done. If you have a
modified system, then you may want to do additional work; most
of this is to a single source code file (env_unix.c on UNIX
systems). Read the file CONFIG for more details.
Yes, it's that easy. There are some additional options, such as
SSL or Kerberos, which require additional steps to build. See
the relevant questions below.
_________________________________________________________________
3.3 How do I make the IMAP and POP servers look for INBOX at some
place other than the mail spool directory?
3.4 How do I make the IMAP server look for secondary folders at some
place other than the user's home directory?
Please read the file CONFIG for discussion of this and other
issues.
_________________________________________________________________
3.5 How do I configure SSL?
3.6 How do I configure TLS and the STARTTLS facility?
imap-2007 supports SSL and TLS client functionality on UNIX and
32-bit Windows for IMAP, POP3, SMTP, and NNTP; and SSL and TLS
server functionality on UNIX for IMAP and POP3.
UNIX SSL build requires that a third-party software package,
OpenSSL, be installed on the system first. Read
imap-2007/docs/SSLBUILD for more information.
SSL is supported via undocumented Microsoft interfaces in
Windows 9x and NT4; and via standard interfaces in Windows
2000, Windows Millenium, and Windows XP.
_________________________________________________________________
3.7 How do I build/install OpenSSL and obtain/create certificates for
use with SSL?
If you need help in doing this, try the contacts mentioned in
the OpenSSL README. We do not offer support for OpenSSL or
certificates.
_________________________________________________________________
3.8 How do I configure CRAM-MD5 authentication?
3.9 How do I configure APOP authentication?
CRAM-MD5 authentication is enabled in the IMAP and POP3 client
code on all platforms. Read md5.txt to learn how to set up
CRAM-MD5 and APOP authentication on UNIX and NT servers.
There is no support for APOP client authentication.
_________________________________________________________________
3.10 How do I configure Kerberos V5?
imap-2007 supports client and server functionality on UNIX and
32-bit Windows.
Kerberos V5 is supported by default in Windows 2000 builds:
nmake -f makefile.w2k
Other builds require that a third-party Kerberos package, e.g.
MIT Kerberos, be installed on the system first.
To build with Kerberos V5 on UNIX, include
EXTRAAUTHENTICATORS=gss in the make command line, e.g.
make lnp EXTRAAUTHENTICATORS=gss
To build with Kerberos V5 on Windows 9x, Windows Millenium, and
NT4, use the "makefile.ntk" file instead of "makefile.nt":
nmake -f makefile.ntk
_________________________________________________________________
3.11 How do I configure PAM for plaintext passwords?
On Linux systems, use the lnp port, e.g.
make lnp
On Solaris systems and other systems with defective PAM
implementations, build with PASSWDTYPE=pmb, e.g.
make sol PASSWDTYPE=pmb
On all other systems, build with PASSWDTYPE=pam, e.g
make foo PASSWDTYPE=pam
If you build with PASSWDTYPE=pam and authentication does not
work, try rebuilding (after a "make clean") with
PASSWDTYPE=pmb.
_________________________________________________________________
3.12 It looks like all I have to do to make the server use Kerberos is
to build with PAM on my Linux system, and set it up in PAM for
Kerberos passwords. Right?
Yes and no.
Doing this will make plaintext password authentication use the
Kerberos password instead of the /etc/passwd password.
However, this will NOT give you Kerberos-secure authentication.
See the answer to the How do I configure Kerberos V5? question
for how to build with Kerberos-secure authentication.
_________________________________________________________________
3.13 How do I configure Kerberos 5 for plaintext passwords?
Build with PASSWDTYPE=gss, e.g.
make sol PASSWDTYPE=gss
However, this will NOT give you Kerberos-secure authentication.
See the answer to the How do I configure Kerberos V5? question
for how to build with Kerberos-secure authentication.
_________________________________________________________________
3.14 How do I configure AFS for plaintext passwords?
Build with PASSWDTYPE=afs, e.g
make sol PASSWDTYPE=afs
_________________________________________________________________
3.15 How do I configure DCE for plaintext passwords?
Build with PASSWDTYPE=dce, e.g
make sol PASSWDTYPE=dce
_________________________________________________________________
3.16 How do I configure the CRAM-MD5 database for plaintext passwords?
The CRAM-MD5 password database is automatically used for
plaintext password if it exists.
Note that this is NOT CRAM-MD5-secure authentication. You
probably want to consider disabling plaintext passwords for
non-SSL/TLS sessions. See the next two questions.
_________________________________________________________________
3.17 How do I disable plaintext passwords?
Server-level plaintext passwords can be disabled by setting
PASSWDTYPE=nul, e.g.
make lnx EXTRAAUTHENTICATORS=gss PASSWDTYPE=nul
Note that you must have a CRAM-MD5 database installed or
specify at least one EXTRAAUTHENTICATOR, otherwise it will not
be possible to log in to the server.
When plaintext passwords are disabled, the IMAP server will
advertise the LOGINDISABLED capability and the POP3 server will
not advertise the USER capability.
3.18 How do I disable plaintext passwords on unencrypted sessions, but
allow them in SSL or TLS sessions?
Do not set PASSWDTYPE=nul or SSLTYPE=unix. Set SSLTYPE=nopwd
instead, e.g.
make lnx SSLTYPE=nopwd
When plaintext passwords are disabled, the IMAP server will
advertise the LOGINDISABLED capability and the POP3 server will
not advertise the USER capability.
Plaintext passwords will always be enabled in SSL sessions; the
IMAP server will not advertise the LOGINDISABLED capability and
the POP3 server will advertise the USER capability.
If the client does a successful start-TLS in a non-SSL session,
plaintext passwords will be enabled, and a new CAPABILITY or
CAPA command (which is required after start-TLS) will show the
effect as in SSL sessions.
_________________________________________________________________
3.19 How do I configure virtual hosts?
This is automatic, but with certain restrictions.
The most important one is that each virtual host must have its
own IP address; otherwise the server has no way of knowing
which virtual host is desired.
As distributed, the software uses a global password file; hence
user "fred" on one virtual host is "fred" on all virtual hosts.
You may want to modify the checkpw() routine to implement some
other policy (e.g. separate password files).
Note that the security model assumes that all users have their
own unique UNIX UID number. So if you use separate password
files you should make certain that the UID numbers do not
overlap between different files.
More advanced virtual host support may be available as patches
from third parties.
_________________________________________________________________
3.20 Why do I get compiler warning messages such as:
passing arg 3 of `scandir' from incompatible pointer type
Pointers are not assignment-compatible.
Argument #4 is not the correct type.
during the build?
You can safely ignore these messages.
Over the years, the prototype for scandir() has changed, and
thus is variant across different UNIX platforms. In particular,
the definitions of the third argument (type select_t) and
fourth argument (type compar_t) have changed over the years,
the issue being whether or not the arguments to the functions
pointed to by these function pointers are of type const or not.
The way that c-client calls scandir() will tend to generate
these compiler warnings on newer systems such as Linux;
however, it will still build. The problem with fixing the call
is that then it won't build on older systems.
_________________________________________________________________
3.21 Why do I get compiler warning messages such as
Operation between types "void(*)(int)" and "void*" is not allowed.
Function argument assignment between types "void*" and "void(*)(int)" is not a
llowed.
Pointers are not assignment-compatible.
Argument #5 is not the correct type.
during the build?
You can safely ignore these messages.
All known systems have no problem with casting a function
pointer to/from a void* pointer, certain C compilers issue a
compiler diagnostic because this facility is listed as a
"Common extension" by the C standard:
K.5.7 Function pointer casts
[#1] A pointer to an object or to void may be cast to a pointer
to a function, allowing data to be invoked as a function (6.3.4).
[#2] A pointer to a function may be cast to a pointer to an
object or to void, allowing a function to be inspected or
modified (for example, by a debugger) (6.3.4).
It may be just a "common extension", but this facility is
relied upon heavily by c-client.
_________________________________________________________________
3.22 Why do I get linker warning messages such as:
mtest.c:515: the `gets' function is dangerous and should not be used.
during the build? Isn't this a security bug?
You can safely ignore this message.
Certain linkers, most notably on Linux, give this warning
message. It is indeed true that the traditional gets() function
is not a safe one.
However, the mtest program is only a demonstration program, a
model of a very basic application program using c-client. It is
not something that you would install, much less run in any
security-sensitive context.
mtest has numerous other shortcuts that you wouldn't want to do
in a real application program.
The only "security bug" with mtest would be if it was run by
some script in a security-sensitive context, but mtest isn't
particularly useful for such purposes. If you wanted to write a
script to automate some email task using c-client, you'd be
better off using imapd instead of mtest.
mtest only has two legitimate uses. It's a useful testbed for
me when debugging new versions of c-client, and it's useful as
a model for someone writing a simple c-client application to
see how the various calls work.
By the way, if you need a more advanced example of c-client
programming than mtest (and you probably will), I recommend
that you look at the source code for imapd and Pine.
_________________________________________________________________
3.23 Why do I get linker warning messages such as:
auth_ssl.c:92: the `tmpnam' function is dangerous and should not be used.
during the build? Isn't this a security bug?
You can safely ignore this message.
Certain linkers, most notably on Linux, give this warning
message, based upon two known issues with tmpnam():
there can be a buffer overflow if an inadequate buffer is
allocated.
there can be a timing race caused by certain incautious
usage of the return value.
Neither of these issues applies in the particular use that is
made of tmpnam(). More importantly, the tmpnam() call is never
executed on Linux systems.
_________________________________________________________________
3.24 OK, suppose I see a warning message about a function being
"dangerous and should not be used" for something other than this
gets() or tmpnam() call?
Please forward the details for investigation.
_________________________________________________________________
4. Operational Questions
_________________________________________________________________
4.1 How can I enable anonymous IMAP logins?
Create the file /etc/anonymous.newsgroups. At the present time,
this file should be empty. This will permit IMAP logins as
anonymous as well as the ANONYMOUS SASL authenticator.
Anonymous users have access to mailboxes in the #news., #ftp/,
and #public/ namespaces only.
_________________________________________________________________
4.2 How do I set up an alert message that each IMAP user will see?
Create the file /etc/imapd.alert with the text of the message.
This text should be kept to one line if possible. Note that
this will cause an alert to every IMAP user every time they
initiate an IMAP session, so it should only be used for
critical messages.
_________________________________________________________________
4.3 How does the c-client library choose which of its several
mechanisms to use to establish an IMAP connection to the server? I
noticed that it can connect on port 143, port 993, via rsh, and via
ssh.
c-client chooses how to establish an IMAP connection via the
following rules:
+ If /ssl is specified, use an SSL connection. Fail otherwise.
+ Else if client is a UNIX system and "ssh server exec
/etc/rimapd" works, use that
+ Else if /tryssl is specified and an SSL connection works, use
that.
+ Else if client is a UNIX system and "rsh server exec
/etc/rimapd" works, use that.
+ Else use a non-SSL connection.
_________________________________________________________________
4.4 I am using a TLS-capable IMAP server, so I don't need to use /ssl
to get encryption. However, I want to be certain that my session is
TLS encrypted before I send my password. How to I do this?
Use the /tls option in the mailbox name. This will cause an
error message and the connection to fail if the server does not
negotiate STARTTLS.
_________________________________________________________________
4.5 How do I use one of the alternative formats described in the
formats.txt document? In particular, I hear that mbx format will give
me better performance and allow shared access.
The rumors about mbx format being preferred are true. It is
faster than the traditional UNIX mailbox format and permits
shared access.
However, and this is very important, note that using an
alternative mailbox format is an advanced facility, and only
expert users should undertake it. If you don't understand any
of the following notes, you may not be enough of an expert yet,
and are probably better off not going this route until you are
more comfortable with your understanding.
Some of the formats, including mbx, are only supported by the
software based on the c-client library, and are not recognized
by other mailbox programs. The "vi" editor will corrupt any mbx
format mailbox that it encounters.
Another problem is that the certain formats, including mbx, use
advanced file access and locking techniques that do not work
reliably with NFS. NFS is not a real filesystem. Use IMAP
instead of NFS for distributed access.
Each of the following steps are in escalating order of
involvement. The further you go down this list, the more deeply
committed you become:
+ The simplest way to create a mbx-format mailbox is to prefix
the name with "#driver.mbx/" when creating a mailbox through
c-client. For example, if you create "#driver.mbx/foo", the
mailbox "foo" will be created in mbx format. Only use
"#driver.mbx/" when creating the mailbox. At all other times,
just use the name ("foo" in this example); the software will
automatically select the driver for mbx whenever that mailbox
is accessed without you doing anything else.
+ You can use the "mailutil copy" command to copy an existing
mailbox to a new mailbox in mbx format. Read the man page
provided with the mailutil program for details.
+ If you create an mbx-format INBOX, by creating
"#driver.mbx/INBOX" (note that "INBOX" must be all
uppercase), then subsequent access to INBOX by any c-client
based application will use the mbx-format INBOX. Any mail
delivered to the traditional format mailbox in the spool
directory (e.g. /var/spool/mail/$USER) will automatically be
copied into the mbx-format INBOX and the spool directory copy
removed.
+ You can cause any newly-created mailboxes to be in mbx-format
by default by changing the definition of
CREATEPROTO=unixproto to be CREATEPROTO=mbxproto in
src/osdep/unix/Makefile, then rebuilding the IMAP toolkit (do
a "make clean" first). Do not change EMPTYPROTO, since mbx
format mailboxes are never a zero-byte file. If you use Pine
or the imap-utils, you should probably also rebuild them with
the new IMAP toolkit too.
+ You can deliver directly to the mbx-format INBOX by use of
the tmail or dmail programs. tmail is for direct invocation
from sendmail (or whatever MTA program you use); dmail is for
calls from procmail. Both of these programs have man pages
which must be read carefully before making this change.
Most other servers (e.g. Cyrus) require use of a non-standard
format. A full-fledged format conversion is not significantly
different from what you have to do with other servers. The
difference, which makes format conversion procedures somewhat
more complicated with this server, is that there is no "all or
nothing" requirement with this server. There are many points in
between. A format conversion can be anything from a single
mailbox or single user, to systemwide.
This is good in that you can decide how far to go, or do the
steps incrementally as you become more comfortable with the
result. On the other hand, there's no "One True Way" which can
be boiled down to a simple set of pedagogical instructions.
A number of sites have done full-fledged format conversions,
and are reportedly quite happy with the results. Feel free to
ask in the comp.mail.imap newsgroup or the imap-uw mailing
list for advice or help.
_________________________________________________________________
4.6 How do I set up shared mailboxes?
At the simplest level, a shared mailbox is one which has UNIX
file and directory protections which permit multiple users to
access it. What this means is that your existing skills and
tools to create and manage shared files on your UNIX system
apply to shared mailboxes; e.g.
chmod 666 mailbox
You may want to consider the use of a mailbox format which
permits multiple simultaneous read/write sessions, such as the
mbx format. The traditional UNIX format only allows one
read/write session to a mailbox at a time.
An additional convenience item are three system directories,
which can be set up for shared namespaces. These are: #ftp,
#shared, and #public, and are defined by creating the
associated UNIX users and home directories as described below.
#ftp/ refers to the anonymous ftp filesystem exported by the
ftp server, and is equivalent to the home directory for UNIX
user "ftp". For example, #ftp/foo/bar refers to the file
/foo/bar in the anonymous FTP filesystem, or ~ftp/foo/bar for
normal users. Anonymous FTP files are available to anonymous
IMAP logins. By default, newly-created files in #ftp/ are
protected 644.
#public/ refers to an IMAP toolkit convention called "public"
files, and is equivalent to the home directory for UNIX user
"imappublic". For example, #public/foo/bar refers to the file
~imappublic/foo/bar. Public files are available to anonymous
IMAP logins. By default, newly-created files in #public are
created with protection 0666.
#shared/ refers to an IMAP toolkit convention called "shared"
files, and is equivalent to the home directory for UNIX user
"imapshared". For example, #shared/foo/bar refers to the file
~imapshared/foo/bar. Shared files are not available to
anonymous IMAP logins. By default, newly-created files in
#shared are created with protection 0660.
_________________________________________________________________
4.7 How can I make the server syslogs go to someplace other than the
mail syslog?
The openlog() call that sets the syslog facility is in
src/osdep/unix/env_unix.c in routine server_init(). You need to
edit this file to change the syslog facility from LOG_MAIL to
the facility you want, then rebuild. You also need to set up
your /etc/syslog.conf properly.
Refer to the man pages for syslog and syslogd for more
information on what the available syslog facilities are and how
to configure syslogs. If you still don't understand what to do,
find a UNIX system expert.
_________________________________________________________________
5. Security Questions
_________________________________________________________________
5.1 I see that the IMAP server allows access to arbitary files on the
system, including /etc/passwd! How do I disable this?
You should not worry about this if your IMAP users are allowed
shell access. The IMAP server does not permit any access that
the user can not have via the shell.
If, and only if, you deny your IMAP users shell access, you may
want to consider one of three choices. Note that these choices
reduce IMAP functionality, and may have undesirable side
effects. Each of these choices involves an edit to file
src/osdep/unix/env_unix.c
The first (and recommended) choice is to set restrictBox as
described in file CONFIG. This will disable access to the
filesystem root, to other users' home directory, and to
superior directory.
The second (and strongly NOT recommended) choice is to set
closedBox as described in file CONFIG. This puts each IMAP
session into a so-called "chroot jail", and thus setting this
option is extremely dangerous; it can make your system much
less secure and open to root compromise attacks. So do not use
this option unless you are absolutely certain that you
understand all the issues of a "chroot jail."
The third choice is to rewrite routine mailboxfile() to
implement whatever mapping from mailbox name to filesystem name
(and restrictions) that you wish. This is the most general
choice. As a guide, you can see at the start of routine
mailboxfile() what the restrictBox choice does.
_________________________________________________________________
5.2 I've heard that IMAP servers are insecure. Is this true?
There are no known security problems in this version of the
IMAP toolkit, including the IMAP and POP servers. The IMAP and
POP servers limit what can be done while not logged in, and as
part of the login process discard all privileges except those
of the user.
As with other software packages, there have been buffer
overflow vulnerabilities in past versions. All known problems
of this nature are fixed in this version.
There is every reason to believe that the bad guys are engaged
in an ongoing effort to find vulnerabilities in the IMAP
toolkit. We look for such problems, and when one is found we
fix it.
It's unfortunate that any vulnerabilities existed in past
versions, and we're doing my best to keep the IMAP toolkit free
of vulnerabilities. No new vulnerabilities have been discovered
in quite a while, but efforts will not be relaxed.
Beware of vendors who claim that their implementations can not
have vulnerabilities.
_________________________________________________________________
5.3 How do I know that I have the most secure version of the server?
The best way is to keep your server software up to date. The
bad guys are always looking for ways to crack software, and
when they find one, let all their friends know.
Oldtimers used to refer to a concept of software rot: if your
software hasn't been updated in a while, it would "rot" -- tend
to acquire problems that it didn't have when it was new.
The latest release version of the IMAP toolkit is always
available at ftp://ftp.cac.washington.edu/mail/imap.tar.Z
_________________________________________________________________
5.4 I see all these strcpy() and sprintf() calls, those are unsafe,
aren't they?
Yes and no.
It can be unsafe to do these calls if you do not know that the
string being written will fit in the buffer. However, they are
perfectly safe if you do know that.
Beware of programmers who advocate doing a brute-force change
of all instances of
strcpy (s,t);
to
strncpy (s,t,n)[n] = '\0';
and similar measures in the name of "fixing all possible buffer
overflows."
There are examples in which a security bug was introduced
because of this type of "fix", due to the programmer using the
wrong value for n. In one case, the programmer thought that n
was larger than it actually was, causing a NUL to be written
out of the buffer; in another, n was too small, and a security
credential was truncated.
What is particularly ironic was that in both cases, the
original strcpy() was safe, because the size of the source
string was known to be safe.
With all this in mind, the software has been inspected, and it
is believed that all places where buffer overflows can happen
have been fixed. The strcpy()s that are still are in the code
occur after a size check was done in some other way.
Note that the common C idiom of
*s++ = c;
is just as vulnerable to buffer overflows. You can't cure
buffer overflows by outlawing certain functions, nor is it
desirable to do so; sometimes operations like strcpy()
translate into fast machine instructions for better
performance.
Nothing replaces careful study of code. That's how the bad guys
find bugs. Security is not accomplished by means of brute-force
shortcuts.
_________________________________________________________________
5.5 Those /tmp lock files are protected 666, is that really right?
Yes. Shared mailboxes won't work otherwise. Also, you get into
accidental denial of service problems with old lock files left
lying around; this happens fairly frequently.
The deliberate mischief that can be caused by fiddling with the
lock files is small-scale; harassment level at most. There are
many -- and much more effective -- other ways of harassing
another user on UNIX. It's usually not difficult to determine
the culprit.
Before worrying about deliberate mischief, worry first about
things happening by accident!
_________________________________________________________________
6. Why Did You Do This Strange Thing? Questions
_________________________________________________________________
6.1 Why don't you use GNU autoconfig / automake / autoblurdybloop?
Autoconfig et al are not available on all the platforms where
the IMAP toolkit is supported; and do not work correctly on
some of the platforms where they do exist. Furthermore, these
programs add another layer of complexity to an already complex
process.
Coaxing software that uses autoconfig to build properly on
platforms which were not specifically considered by that
software wastes an inordinate amount of time. When (not if)
autoconfig fails to do the right thing, the result is an
inpenetrable morass to untangle in order to find the problem
and fix it.
The concept behind autoconfig is good, but the execution is
flawed. It rarely does the right thing on a platform that
wasn't specifically considered. Human life is too short to
debug autoconfig problems, especially since the current
mechanism is so much easier.
_________________________________________________________________
6.2 Why do you insist upon a build with -g? Doesn't it waste disk and
memory space?
From time to time a submitted port has snuck in without -g.
This has always ended up causing problems. There are only two
valid excuses for not using -g in a port:
+ The compiler does not support -g
+ An alternate form of -g is needed with optimization, e.g.
-g3.
There will be no new ports added without -g (or a suitable
alternative) being set.
-g has not been arbitrarily added to the ports which do not
currently have it because we don't know if doing so would break
the build. However, any support issues with one of those port
will lead to the correct -g setting being determined and
permanently added.
Processors are fast enough (and disk space is cheap enough)
that -g should be automatic in all compilers with no way of
turning it off, and /bin/strip should be a symlink to
/bin/true. Human life is too short to deal with binaries built
without -g. Such binaries should be a bad memory of the days of
KIPS processors and disks that costs several dollars per
kilobyte.
_________________________________________________________________
6.3 Why don't you make c-client a shared library?
All too often, shared libraries create far more problems than
they solve.
Remember that you only gain the benefit of a shared library
when there are multiple applications which use that shared
library. Even without shared libraries, on most modern
operating systems (and many ancient ones too!) applications
will share their text segments between across multiple
processes running the same application. This means that if your
system only runs one application (e.g. imapd) that uses the
c-client library, then you gain no benefit from making c-client
a shared library even if it has 100 imapd processes. You will,
however suffer added complexity.
If you have a server system that just runs imapd and ipop3d,
then making c-client a shared library will save just one copy
of c-client no matter how many IMAP/POP3 processes are running.
The problem with shared libraries is that you have to keep
around a copy of the library every time something changes in
the library that would affect the interface the library
presents to the application. So, you end up having many copies
of the same shared library.
If you don't keep multiple copies of the shared library, then
one of two things happens. If there was proper versioning, then
you'll get a message such as "cannot open shared object file"
or "minor versions don't match" and the application won't run.
Otherwise, the application will run, but will fail in
mysterious ways.
Several sites and third-party distributors have modified the
c-client makefile in order to make c-client be a shared
library. When (not if) a c-client based application fails in
mysterious ways because of a library compatibility problem, the
result is a bug report. A lot of time and effort ends up
getting wasted investigating such bug reports.
Memory is so cheap these days that it's not worth it. Human
life is too short to deal with shared library compatibility
problems.
_________________________________________________________________
6.4 Why don't you use iconv() for internationalization support?
iconv() is not ubiquitous enough.
_________________________________________________________________
6.5 Why is the IMAP server connected to the home directory by default?
The IMAP server has no way of knowing what you might call
"mail" as opposed to "some other file"; in fact, you can use
IMAP to access any file.
The IMAP server also doesn't know whether your preferred
subdirectory for mailbox files is "mail/", ".mail/", "Mail/",
"Mailboxes/", or any of a zillion other possibilities. If one
such name were chosen, it would undoubtably anger the partisans
of all the other names.
It is possible to modify the software so that the default
connected directory is someplace else. Please read the file
CONFIG for discussion of this and other issues.
_________________________________________________________________
6.6 I have a Windows system. Why isn't the server plug and play for
me?
There is no standard for how mail is stored on Windows; nor a
single standard SMTP server. The closest to either would be the
SMTP server in Microsoft's IIS.
So there's no default by which to make assumptions. As the
software is set up, it assumes that the each user has an
Windows login account and private home directory, and that mail
is stored on that home directory as files in one of the popular
UNIX formats. It also assumes that there is some tool
equivalent to inetd on UNIX that does the TCP/IP listening and
server startup.
Basically, unless you're an email software hacker, you probably
want to look elsewhere if you want IMAP/POP servers for
Windows.
_________________________________________________________________
6.7 I looked at the UNIX SSL code and saw that you have the SSL data
payload size set to 8192 bytes. SSL allows 16K; why aren't you using
the full size?
This is to avoid an interoperability problem with:
+ PC IMAP clients that use Microsoft's SChannel.DLL (SSPI) for
SSL support
+ Microsoft Exchange server (which also uses SChannel).
SChannel has a bug that makes it think that the maximum SSL
data payload size is 16379 bytes -- 5 bytes too small. Thus,
c-client has to make sure that it never transmits full sized
SSL packets.
The reason for using 8K (as opposed to, say, 16379 bytes, or
15K, or...) is that it corresponds with the TCP buffer size
that the software uses elsewhere for input; there's a slight
performance benefit to having the two sizes correspond or at
least be a multiple of each other. Also, it keeps the size as a
power of two, which might be significant on some platforms.
There wasn't a significant difference that we could measure
between 8K and 15K.
Microsoft has developed a hotfix for this bug. Look up MSKB
article number 300562. Contrary to the article text which
implies that this is a Pine issue, this bug also affects
Microsoft Exchange server with any client that transmits
full-sized SSL payloads.
_________________________________________________________________
6.8 Why is an mh format INBOX called #mhinbox instead of just INBOX?
It's a long story. In brief, the mh format driver is less
functional than any of the other drivers. It turned out that
there were some users (including high-level administrators) who
tried mh years ago and no longer use it, but still had an mh
profile left behind.
When the mh driver used INBOX, it would see the mh profile, and
proceed to move the user's INBOX into the mh format INBOX. This
caused considerable confusion as some things stopped working.
_________________________________________________________________
6.9 Why don't you support the maildir format?
It is technically difficult to support maildir in IMAP while
maintaining acceptable performance, robustness, following the
requirements of the IMAP protocol specification, and following
the requirements of maildir.
No one has succeeded in accomplishing all four together. The
various maildir drivers offered as patches all have these
problems. The problem is exacerbated because this
implementation supports multiple formats; consequently this
implementation can't make any performance shortcuts by assuming
that all the world is maildir.
We can't do a better job than the maildir fan community has
done with their maildir drivers. Similarly, if the maildir fan
community provides the maildir driver, they take on the
responsibility for answering maildir-specific support
questions. This is as it should be, and that is why maildir
support is left to the maildir fan community.
_________________________________________________________________
6.10 Why don't you support the Cyrus format?
There's no point to doing so. An implementation which supports
multiple formats will never do as well as one which is
optimized to support one single format.
If you want to use Cyrus mailbox format, you should use the
Cyrus server, which is the native implementation of that format
and is specifically optimized for that format. That's also why
Cyrus doesn't implement any other format.
_________________________________________________________________
6.11 Why is it creating extra forks on my SVR4 system?
This is because your system only has fcntl() style locking and
not flock() style locking. fcntl() locking has a design flaw
that causes a close() to release any locks made by that process
on the file opened on that file descriptor, even if the lock
was made on a different file descriptor.
This design flaw causes unexpected loss of lock, and consequent
mailbox corruption. The workaround is to do certain "dangerous
operations" in another fork, thus avoiding doing a close() in
the vulnerable fork.
The best way to solve this problem is to upgrade your SVR4
(Solaris, AIX, HP-UX, SGI) or OSF/1 system to a more advanced
operating system, such as Linux or BSD. These more advanced
operating systems have fcntl() locking for compatibility with
SVR4, but also have flock() locking.
Beware of certain SVR4 systems, such as AIX, which have an
"flock()" function in their C library that is just a jacket
that does an fcntl() lock. This is not a true flock(), and has
the same design flaw as fcntl().
_________________________________________________________________
6.12 Why are you so fussy about the date/time format in the internal
"From " line in traditional UNIX mailbox files? My other mail program
just considers every line that starts with "From " to be the start of
the message.
You just answered your own question. If any line that starts
with "From " is treated as the start of a message, then every
message text line which starts with "From " has to be quoted
(typically by prefixing a ">" character). People complain about
this -- "why did a > get stuck in my message?"
So, good mail reading software only considers a line to be a
"From " line if it follows the actual specification for a
"From " line. This means, among other things, that the day of
week is fixed-format: "May 14", but "May 7" (note the extra
space) as opposed to "May 7". ctime() format for the date is
the most common, although POSIX also allows a numeric timezone
after the year. For compatibility with ancient software, the
seconds are optional, the timezone may appear before the year,
the old 3-letter timezones are also permitted, and "remote from
xxx" may appear after the whole thing.
Unfortunately, some software written by novices use other
formats. The most common error is to have a variable-width day
of month, perhaps in the erroneous belief that RFC 2822 (or RFC
822) defines the format of the date/time in the "From " line
(it doesn't; no RFC describes internal formats). I've seen a
few other goofs, such as a single-digit second, but these are
less common.
If you are writing your own software that writes mailbox files,
and you really aren't all that savvy with all the ins and outs
and ancient history, you should seriously consider using the
c-client library (e.g. routine mail_append()) instead of doing
the file writes yourself. If you must do it yourself, use
ctime(), as in:
fprintf (mbx,"From %s@%h %s",user,host,ctime (time (0)));
rather than try to figure out a good format yourself. ctime()
is the most traditional format and nobody will flame you for
using it.
_________________________________________________________________
6.13 Why is traditional UNIX format the default format?
Compatibility with the past 30 or so years of UNIX history.
This server is the only one that completely interoperates with
legacy UNIX mail tools.
_________________________________________________________________
6.14 Why do you write this "DON'T DELETE THIS MESSAGE -- FOLDER
INTERNAL DATA" message at the start of traditional UNIX and MMDF
format mailboxes?
This pseudo-message serves two purposes.
First, it establishes the mailbox format even when the mailbox
has no messages. Otherwise, a mailbox with no messages is a
zero-byte file, which could be one of several formats.
Second, it holds mailbox metadata used by IMAP: the UID
validity, the last assigned UID, and mailbox keywords. Without
this metadata, which must be preserved even when the mailbox
has no messages, the traditional UNIX format wouldn't be able
to support the full capabilities of IMAP.
_________________________________________________________________
6.15 Why don't you stash the mailbox metadata in the first real
message of the mailbox instead of writing this fake FOLDER INTERNAL
DATA message?
In fact, that is what is done if the mailbox is non-empty and
does not already have a FOLDER INTERNAL DATA message.
One problem with doing that is that if some external program
removes the first message, the metadata is lost and must be
recreated, thus losing any prior UID or keyword list status
that IMAP clients may depend upon.
Another problem is that this doesn't help if the last message
is deleted. This will result in an empty mailbox, and the
necessity to create a FOLDER INTERNAL DATA message.
_________________________________________________________________
6.16 Why aren't "dual-use" mailboxes the default?
Compatibility with the past 30 or so years of UNIX history, not
to mention compatibility with user expectations when using
shell tools.
_________________________________________________________________
6.17 Why do you use ucbcc to build on Solaris?
It is a long, long story about why cc is set to ucbcc. You need
to invoke the C compiler so that it links with the SVR4
libraries and not the BSD libraries, otherwise readdir() will
return the wrong information.
Of all the names in the most common path, ucbcc is the only
name to be found (on /usr/ccs/bin) that points to a suitable
compiler. cc is likely to be /usr/ucb/cc which is absolutely
not the compiler that you want. The real SVR4 cc is probably
something like /opt/SUNWspro/bin/cc which is rarely in anyone's
path by default.
ucbcc is probably a link to acc, e.g.
/opt/SUNWspro/SC4.0/bin/acc, and is the UCB C compiler using
the SVR4 libraries.
If ucbcc isn't on your system, then punt on the SUN C compiler
and use gcc instead (the gso port instead of the sol port).
If, in spite of all the above warnings, you choose to change
"ucbcc" to "cc", you will probably find that the -O2 needs to
be changed to -O. If you don't get any error messages with -O2,
that's a pretty good indicator that you goofed and are running
the compiler that will link with the BSD libraries.
To recap:
+ The sol port is designed to be built using the UCB compiler
using the SVR4 libraries. This compiler is "ucbcc", which is
lunk to acc. You use -O2 as one of the CFLAGS.
+ If you build the sol port with the UCB compiler using the BSD
libraries, you will get no error messages but you will get
bad binaries (the most obvious symptom is dropping the first
two characters return filenames from the imapd LIST command.
This compiler also uses -O2, and is very often what the user
gets from "cc". BEWARE
+ If you build the sol port with the real SVR4 compiler, which
is often hidden away or unavailable on many systems, then you
will get errors from -O2 and you need to change that to -O.
But you will get a good binary. However, you should try it
with -O2 first, to make sure that you got this compiler and
not the UCB compiler using BSD libraries.
_________________________________________________________________
6.18 Why should I care about some old system with BSD libraries? cc is
the right thing on my Solaris system!
Because there still are sites that use such systems. On those
systems, the assumption that "cc" does the right thing will
lead to corrupt binaries with no error message or other warning
that anything is amiss.
Too many sites have fallen victim to this problem.
_________________________________________________________________
6.19 Why do you insist upon writing .lock files in the spool
directory?
Compatibility with the past 30 years of UNIX software which
deals with the spool directory, especially software which
delivers mail. Otherwise, it is possible to lose mail.
_________________________________________________________________
6.20 Why should I care about compatibility with the past?
This is one of those questions in which the answer never
convinces those who ask it. Somehow, everybody who ever asks
this question ends up answering it for themselves as they get
older, with the very answer that they rejected years earlier.
_________________________________________________________________
7. Problems and Annoyances
_________________________________________________________________
7.1 Help! My INBOX is empty! What happened to my messages?
If you are seeing "0 messages" when you open INBOX and you know
you have messages there (and perhaps have looked at your mail
spool file and see that messages are there), then probably
there is something wrong with the very first line of your mail
spool file. Make sure that the first five bytes of the file are
"From ", followed by an email address and a date/time in
ctime() format, e.g.:
From fred@foo.bar Mon May 7 20:54:30 2001
_________________________________________________________________
7.2 Help! All my messages in a non-INBOX mailbox have been
concatenated into one message which claims to be from me and has a
subject of the file name of the mailbox! What's going on?
Something wrong with the very first line of the mailbox. Make
sure that the first five bytes of the file are "From ",
followed by an email address and a date/time in ctime() format,
e.g.:
From fred@foo.bar Mon May 7 20:54:30 2001
_________________________________________________________________
7.3 Why do I get the message: CREATE failed: Can't create mailbox node
xxxxxxxxx: File exists and how do I fix it?
See the answer to the Are hierarchical mailboxes supported?
question.
_________________________________________________________________
7.4 Why can't I log in to the server? The user name and password are
right!
There are a myriad number of possible answers to this question.
The only way to say for sure what is wrong is run the server
under a debugger such as gdb while root (yes, you must be root)
with a breakpoint at routines checkpw() and loginpw(), then
single-step until you see which test rejected you. The server
isn't going to give any error messages other than "login
failed" in the name of not giving out any unnecessary
information to unauthorized individuals.
Here are some of the more common reasons why login may fail:
+ You didn't really give the correct user name and/or password.
+ Your client doesn't send the LOGIN command correctly; for
example, IMAP2 clients won't send a password containing a "*"
correctly to an IMAP4 server.
+ If you have set up a CRAM-MD5 database, remember that the
password used is the one in the CRAM-MD5 database, and
furthermore that there must also be an entry in /etc/passwd
(but the /etc/passwd password is not used).
+ If you are using PAM, have you created a service file for the
server in /etc/pam.d?
+ If you are using shadow passwords, have you used an
appropriate port when building? In particular, note that
"lnx" is for Linux systems without shadow passwords; you
probably want "slx" or "lnp" instead.
+ If your system has account or password expirations, check to
see that the expiration date hasn't passed.
+ You can't log in as root or any other UID 0 user. This is for
your own safety, not to mention the fact that the servers use
UID 0 as meaning "not logged in".
_________________________________________________________________
7.5 Help! My load average is soaring and I see hundreds of POP and
IMAP servers, many logged in as the same user!
Certain inferior losing GUI mail reading programs have a
"synchronize all mailboxes at startup" (IMAP) or "check for new
mail every second" (POP) feature which causes a rapid and
unchecked spawning of servers.
This is not a problem in the server; the client is really
asking for all those server sessions. Unfortunately, there
isn't much that the POP and IMAP servers can do about it; they
don't spawned themselves.
Some sites have added code to record the number of server
sessions spawned per user per hour, and disable login for a
user who has exceeded a predetermined rate. This doesn't stop
the servers from being spawned; it just means that a server
session will commit suicide a bit faster.
Another possibility is to detect excessive server spawning
activity at the level where the server is spawned, which would
be inetd or possibly tcpd. The problem here is that this is a
hard time to quantify. 50 sessions in a minute from a
multi-user timesharing system may be perfectly alright, whereas
10 sessions a minute from a PC may be too much.
The real solution is to fix the client configuration, by
disabling those evil features. Also tell the vendors of those
clients how you feel about distributing denial-of-service
attack tools in the guise of mail reading programs.
_________________________________________________________________
7.6 Why does mail disappear even though I set "keep mail on server"?
7.7 Why do I get the message Moved ##### bytes of new mail to
/home/user/mbox from /var/spool/mail/user and why did this happen?
This is probably caused by the mbox driver. If the file "mbox"
exists on the user's home directory and is in UNIX mailbox
format, then when INBOX is opened this file will be selected as
INBOX instead of the mail spool file. Messages will be
automatically transferred from the mail spool file into the
mbox file.
To disable this behavior, delete "mbox" from the EXTRADRIVERS
list in the top-level Makefile and rebuild. Note that if you do
this, users won't be able to access the messages that have
already been moved to mbox unless they open mbox instead of
INBOX.
_________________________________________________________________
7.8 Why isn't it showing the local host name as a fully-qualified
domain name?
7.9 Why is the local host name in the From/Sender/Message-ID headers
of outgoing mail not coming out as a fully-qualified domain name?
Your UNIX system is misconfigured. The entry for your system in
/etc/hosts must have the fully-qualified domain name first,
e.g.
105.69.1.234 myserver.example.com myserver
A common mistake of novice system administrators is to have the
short name first, e.g.
105.69.1.234 myserver myserver.example.com
or to omit the fully qualified domain name entirely, e.g.
105.69.1.234 myserver
The result of this is that when the IMAP toolkit does a
gethostbyname() call to get the fully-qualified domain name, it
would get "myserver" instead of "myserver.example.com".
On some systems, a configuration file (typically named
/etc/svc.conf, /etc/netsvc.conf, or /etc/nsswitch.conf) can be
used to configure the system to use the domain name system
(DNS) instead of /etc/hosts, so it doesn't matter if /etc/hosts
is misconfigured.
Check the man pages for gethostbyname, hosts, svc, and/or
netsvc for more information.
Unfortunately, certain vendors, most notably SUN, have failed
to make this clear in their documentation. Most of SUN's
documentation assumes a corporate network that is not connected
to the Internet.
net.folklore once (late 1980s) held that the proper procedure
was to append the results of getdomainname() to the name
returned by gethostname(), and some versions of sendmail
configuration files were distributed that did this. This was
incorrect; the string returned from getdomainname() is the
Yellow Pages (a.k.a NIS) domain name, which is a completely
different (albeit unfortunately named) entity from an Internet
domain. These were often fortuitously the same string, except
when they weren't. Frequently, this would result in host names
with spuriously doubled domain names, e.g.
myserver.example.com.example.com
This practice has been thoroughly discredited for many years,
but folklore dies hard.
_________________________________________________________________
7.10 What does the message: Mailbox vulnerable - directory
/var/spool/mail must have 1777 protection mean? How can I fix this?
In order to update a mailbox in the default UNIX format, it is
necessary to create a lock file to prevent the mailer from
delivering mail while an update is in progress. Some systems
use a directory protection of 775, requiring that all mail
handling programs be setgid mail; or of 755, requiring that all
mail handling programs be setuid root.
The IMAP toolkit does not run with any special privileges, and
I plan to keep it that way. It is antithetical to the concept
of a toolkit if users can't write their own programs to use it.
Also, I've had enough bad experiences with security bugs while
running privileged; the IMAP and POP servers have to be root
when not logged in, in order to be able to log themselves in. I
don't want to go any deeper down that slippery slope.
Directory protection 1777 is secure enough on most well-managed
systems. If you can't trust your users with a 1777 mail spool
(petty harassment is about the limit of the abuse exposure),
then you have much worse problems then that.
If you absolutely insist upon requiring privileges to create a
lock file, external file locking can be done via a setgid mail
program named /etc/mlock (this is defined by LOCKPGM in the
c-client Makefile). If the toolkit is unable to create a
<...mailbox...>.lock file in the directory by itself, it will
try to call mlock to do it. I do not recommend doing this for
performance reasons.
A sample mlock program is included as part of imap-2007. We
have tried to make this sample program secure, but it has not
been thoroughly audited.
_________________________________________________________________
7.11 What does the message: Mailbox is open by another process, access
is readonly mean? How do I fix this?
A problem occurred in applying a lock to a /tmp lock file.
Either some other program has the mailbox open and won't
relenquish it, or something is wrong with the protection of
/tmp or the lock.
Make sure that the /tmp directory is protected 1777. Some
security scripts incorrectly set the protection of the /tmp
directory to 775, which disables /tmp for all non-privileged
programs.
_________________________________________________________________
7.12 What does the message: Can't get write access to mailbox, access
is readonly mean?
The mailbox file is write-protected against you.
_________________________________________________________________
7.13 I set my POP3 client to "delete messages from server" but they
never get deleted. What is wrong?
Make sure that your mailbox is not read-only: that the mailbox
is owned by you and write enabled (protection 0600), and that
the /tmp directory is longer world-writeable. /tmp must be
world-writeable because lots of applications use it for scratch
space. To fix this, do
chmod 1777 /tmp
as root.
Make sure that your POP3 client issues a QUIT command when it
finishes. The POP3 protocol specifies that deletions are
discarded unless a proper QUIT is done.
Make sure that you are not opening multiple POP3 sessions to
the same mailbox. It is a requirement of the POP3 protocol than
only one POP3 session be in effect to a mailbox at a time,
however some, poorly-written POP3 clients violate this. Also,
some background "check for new mail" tasks also cause a
violation. See the answer to the What does the syslog message:
Killed (lost mailbox lock) user=... host=... mean? question for
more details.
_________________________________________________________________
7.14 What do messages such as:
Message ... UID ... already has UID ...
Message ... UID ... less than ...
Message ... UID ... greater than last ...
Invalid UID ... in message ..., rebuilding UIDs
mean?
Something happened to corrupt the unique identifier regime in
the mailbox. In traditional UNIX-format mailboxes, this can
happen if the user deleted the "DO NOT DELETE" internal
message.
This problem is relatively harmless; a new valid unique
identifier regime will be created. The main effect is that any
references to the old UIDs will no longer be useful.
So, unless it is a chronic problem or you feel like debugging,
you can safely ignore these messages.
_________________________________________________________________
7.15 What do the error messages:
Unable to read internal header at ...
Unable to find CRLF at ...
Unable to parse internal header at ...
Unable to parse message date at ...
Unable to parse message flags at ...
Unable to parse message UID at ...
Unable to parse message size at ...
Last message (at ... ) runs past end of file ...
mean? I am using mbx format.
The mbx-format mailbox is corrupted and needs to be repaired.
You should make an effort to find out why the corruption
happened. Was there an obvious system problem (crash or disk
failure)? Did the user accidentally access the file via NFS?
Mailboxes don't get corrupted by themselves; something caused
the problem.
Some people have developed automated scripts, but if you're
comfortable using emacs it's pretty easy to fix it manually. Do
not use vi or any other editor unless you are certain that
editor can handle binary!!!
If you are not comfortable with emacs, or if the file is too
large to read with emacs, see the "step-by-step" technique
later on for another way of doing it.
After the word "at" in the error message is the byte position
it got to when it got unhappy with the file, e.g. if you see:
Unable to parse internal header at 43921: ne bombastic blurdybloop
The problem occurs at the 43,931 byte in the file. That's the
point you need to fix. c-client is expecting an internal header
at that byte number, looking something like:
6-Jan-1998 17:42:24 -0800,1045;000000100001-00000001
The format of this internal line is:
dd-mmm-yyyy hh:mm:ss +zzzz,ssss;ffffffffFFFF-UUUUUUUU
The only thing that is variable is the "ssss" field, it can be
as many digits as needed. All other fields (inluding the "dd")
are fixed width. So, the easiest thing to do is to look forward
in the file for the next internal header, and delete everything
from the error point to that internal header.
Here's what to do if you want to be smarter and do a little bit
more work. Generally, you're in the middle of a message, and
there's nothing wrong with that message. The problem happened
in the *previous* message. So, search back to the previous
internal header. Now, remember that "ssss" field? That's the
size of that message.
Mark where you are in the file, move the cursor to the line
after the internal header, and skip that many bytes ("ssss")
forward. If you're at the point of the error in the file, then
that message is corrupt. If you're at a different point, then
perhaps the previous message is corrupt and has a too long size
count that "ate" into this message.
Basically, what you need to do is make sure that all those size
counts are right, and that moving "ssss" bytes from the line
after the internal header will land you at another internal
header.
Usually, once you know what you're looking at, it's pretty easy
to work out the corruption, and the best remedial action.
Repair scripts will make the problem go away but may not always
do the smartest/best salvage of the user's data. Manual repair
is more flexible and usually preferable.
Here is a step-by-step technique for fixing corrupt mbx files
that's a bit cruder than the procedure outlined above, but
works for any size file.
In this example, suppose that the corrupt file is INBOX, the
error message is
Unable to find CRLF at 132551754
and the size of the INBOX file is 132867870 bytes.
The first step is to split the mailbox file at the point of the
error:
+ Rename the INBOX file to some other name, such as INBOX.bad.
+ Copy the first 132,551,754 bytes of INBOX.bad to another
file, such as INBOX.new.
+ Extract the trailing 316,116 bytes (132867870-132551754) of
INBOX.bad into another file, such as INBOX.tail.
+ You no longer need INBOX.bad. Delete it.
In other words, use the number from the "Unable to find CRLF
at" as the point to split INBOX into two new files, INBOX.new
and INBOX.tail.
Now, remove the erroneous data:
+ Verify that you can open INBOX.new in IMAP or Pine.
+ The last message of INBOX.new is probably corrupted. Copy it
to another file, such as badmsg.1, then delete and expunge
that last message from INBOX.new
+ Locate the first occurance of text in INBOX.tail which looks
like an internal header, as described above.
+ Remove all the text which occurs prior to that point, and
place it into another file, such as badmsg.2. Note that in
the case of a single digit date, there is a leading space
which must not be removed (e.g. " 6-Nov-2001" not
"6-Nov-2001").
Reassemble the mailbox:
+ Append INBOX.tail to INBOX.new.
+ You no longer need INBOX.tail. Delete it.
+ Verify that you can open INBOX.new in IMAP or Pine.
Reinstall INBOX.new as INBOX:
+ Check to see if you have received any new messages while
repairing INBOX.
+ If you haven't received any new messages while repairing
INBOX, just rename INBOX.new to INBOX.
+ If you have received new messages, be sure to copy the new
messages from INBOX to INBOX.new before doing the rename.
You now have a working INBOX, as well as two files with
corrupted data (badmsg.1 and badmsg.2). There may be some
useful data in the two badmsg files that you might want to try
salvaging; otherwise you can delete the two badmsg files.
_________________________________________________________________
7.16 What do the syslog messages:
imap/tcp server failing (looping)
pop3/tcp server failing (looping)
mean? When it happens, the listed service shuts down. How can I fix
this?
The error message "server failing (looping), service
terminated" is not from either the IMAP or POP servers.
Instead, it comes from inetd, the daemon which listens for TCP
connections to a number of servers, including the IMAP and POP
servers.
inetd has a limit of 40 new server sessions per minute for any
particular service. If more than 40 sessions are initiated in a
minute, inetd will issue the "failing (looping), service
terminated" message and shut down the service for 10 minutes.
inetd does this to prevent system resource consumption by a
client which is spawning infinite numbers of servers. It should
be noted that this is a denial of service; however for some
systems the alternative is a crash which would be a worse
denial of service!
For larger server systems, the limit of 40 is much too low. The
limit was established many years ago when a system typically
only ran a few dozen servers.
On some versions of inetd, such as the one distributed with
most versions of Linux, you can modify the /etc/inetd.conf file
to have a larger number of servers by appending a period
followed by a number after the nowait word for the server
entry. For example, if your existing /etc/inetd.conf line
reads:
imap stream tcp nowait root /usr/etc/imapd imapd
try changing it to be:
imap stream tcp nowait.100 root /usr/etc/imapd imapd
Another example (using TCP wrappers):
imap stream tcp nowait root /usr/sbin/tcpd imapd
try changing it to be:
imap stream tcp nowait.100 root /usr/sbin/tcpd imapd
to increase the limit to 100 sessions/minute.
Before making this change, please read the information in "man
inetd" to determine whether or not your inetd has this feature.
If it does not, and you make this change, the likely outcome is
that you will disable IMAP service entirely.
Another way to fix this problem is to edit the inetd.c source
code (provided by your UNIX system vendor) to set higher
limits, rebuild inetd, install the new binary, and reboot your
system. This should only be done by a UNIX system expert. In
the inetd.c source code, the limits TOOMANY (normally 40) is
the maximum number of new server sessions permitted per minute,
and RETRYTIME (normally 600) is the number of seconds inetd
will shut down the server after it exceeds TOOMANY.
_________________________________________________________________
7.17 What does the syslog message: Mailbox lock file /tmp/.600.1df3
open failure: Permission denied mean?
This usually means that some "helpful" security script person
has protected /tmp so that it is no longer world-writeable.
/tmp must be world-writeable because lots of applications use
it for scratch space. To fix this, do
chmod 1777 /tmp
as root.
If that isn't the answer, check the protection of the named
file. If it is something other than 666, then either someone is
hacking or some "helpful" person modified the code to have a
different default lock file protection.
_________________________________________________________________
7.18 What do the syslog messages:
Command stream end of file, while reading line user=... host=...
Command stream end of file, while reading char user=... host=...
Command stream end of file, while writing text user=... host=...
mean?
This message occurs when the session is disconnected without a
proper LOGOUT (IMAP) or QUIT (POP) command being received by
the server first.
In many cases, this is perfectly normal; many client
implementations are impolite and do this. Some programmers
think this sort of rudeness is "more efficient".
The condition could, however, indicate a client or network
connectivity problem. The server has no way of knowing whether
there's a problem or just a rude client, so it issues this
message instead of a Logout.
Certain inferior losing clients disconnect abruptly after a
failed login, and instead of saying that the login failed, just
say that they can't access the mailbox. They then complain to
the system manager, who looks in the syslog and finds this
message. Not very helpful, eh? See the answer to the Why can't
I log in to the server? The user name and password are right!
question.
If the user isn't reporting a problem, you can probably ignore
this message.
_________________________________________________________________
7.19 Why did my POP or IMAP session suddenly disconnect? The syslog
has the message: Killed (lost mailbox lock) user=... host=...
This message only happens when either the traditional UNIX
mailbox format or MMDF format is in use. This format only
allows one session to have the mailbox open read/write at a
time.
The servers assume that if a second session attempts to open
the mailbox, that means that the first session is probably
owned by an abandoned client. The common scenario here is a
user who leaves his client running at the office, and then
tries to read his mail from home. Through an internal mechanism
called kiss of death, the second session requests the first
session to kill itself. When the first session receives the
"kiss of death", it issues the "Killed (lost mailbox lock)"
syslog message and terminates. The second session then seizes
read/write access, and becomes the new "first" session.
Certain poorly-designed clients routinely open multiple
sessions to the same mailbox; the users of those clients tend
to get this message a lot.
Another cause of this message is a background "check for new
mail" task which does its work by opening a POP session to
server every few seconds. They do this because POP doesn't have
a way to announce new mail.
The solution to both situations is to replace the client with a
good online IMAP client such as Pine. Life is too short to
waste on POP clients and poorly-designed IMAP clients.
_________________________________________________________________
7.20 Why does my IMAP client show all the files on the system,
recursively from the UNIX root directory?
7.21 Why does my IMAP client show all of my files, recursively from my
UNIX home directory?
A well-written client should only show one level of hierarchy
and then stop, awaiting explicit user action before going
lower. However, some poorly-designed clients will recursively
list all files, which may be a very long list (especially if
you have symbolic links to directories that create a loop in
the filesystem graph!).
This behavior has also been observed in some third-party
c-client drivers, including maildir drivers. Consequently, this
problem has even been observed in Pine. It is important to
understand that this is not a problem in Pine or c-client; it
is a problem in the third-party driver. A Pine built without
that third-party driver will not have this problem.
See also the answer to Why does my IMAP client show all my
files in my home directory?
_________________________________________________________________
7.22 Why does my IMAP client show that I have mailboxes named
"#mhinbox", "#mh", "#shared", "#ftp", "#news", and "#public"?
These are IMAP namespace names. They represent other
hierarchies in which messages may exist. These hierarchies may
not necessarily exist on a server, but the namespace name is
still in the namespace list in order to mark it as reserved.
A few poorly-designed clients display all namespace names as if
they were top-level mailboxes in a user's list of mailboxes,
whether or not they actually exist. This is a flaw in those
clients.
_________________________________________________________________
7.23 Why does my IMAP client show all my files in my home directory?
As distributed, the IMAP server is connected to your home
directory by default. It has no way of knowing what you might
call "mail" as opposed to "some other file"; in fact, you can
use IMAP to access any file.
Most clients have an option to configure your connected
directory on the IMAP server. For example, in Pine you can
specify this as the "Path" in your folder-collection, e.g.
Nickname : Secondary Folders
Server : imap.example.com
Path : mail/
View :
In this example, the user is connected to the "mail"
subdirectory of his home directory.
Other servers call this the "folder prefix" or similar term.
It is possible to modify the IMAP server so that all users are
automatically connected to some other directory, e.g. a
subdirectory of the user's home directory. Read the file CONFIG
for more details.
_________________________________________________________________
7.24 Why is there a long delay before I get connected to the IMAP or
POP server, no matter what client I use?
There are two common occurances of this problem:
+ You are running a system (e.g. certain versions of Linux)
which by default attempts to connect to an "IDENT" protocol
(port 113) server on your client. However, a firewall or NAT
box is blocking connections to that port, so the connection
attempt times out.
The IDENT protocol is a well-known bad idea that does not
deliver any real security but causes incredible problems. The
idea is that this will give the server a record of the user
name, or at least what some program listening on port 113
says is the user name. So, if somebody coming from port nnnnn
on a system does something bad, IDENT may give you the userid
of the bad guy.
The problem is, IDENT is only meaningful on a timesharing
system which has an administrator who is privileged and users
who are not. It is of no value on a personal system which has
no separate concept of "system administrator" vs.
"unprivileged user".
On either type of system, security-minded people either turn
IDENT off or replace it with an IDENT server that lies. Among
other things, IDENT gives spammers the ability to harvest
email addresses from anyone who connects to a web page.
This problem has been showing up quite frequently on systems
which use xinetd instead of inetd. Look for files named
/etc/xinetd.conf, /etc/xinetd.d/imapd, /etc/inetd.d/ipop2d,
and /etc/xinetd.d/ipop3d. In those files, look for lines
containing "USERID", e.g.
log_on_success += USERID
Hunt down such lines, and delete them ruthlessly from all
files in which they occur. Don't be shy about it.
+ The DNS is taking a long time to do a reverse DNS (PTR
record) lookup of the IP address of your client. This is a
problem in your DNS, which either you or you ISP need to
resolve. Ideally, the DNS should return the client's name;
but if it can't it should at least return an error quickly.
As you may have noticed, neither of these are actual problems
in the IMAP or POP servers; they are configuration issues with
either your system or your network infrastructure. If this is
all new to you, run (don't walk) to the nearest technical
bookstore and get yourself a good pedagogical text on system
administration for the type of system you are running.
_________________________________________________________________
7.25 Why is there a long delay in Pine or any other c-client based
application call before I get connected to the IMAP server? The hang
seems to be in the c-client mail_open() call. I don't have this
problem with any other IMAP client. There is no delay connecting to a
POP3 or NNTP server with mail_open().
By default, the c-client library attempts to make a connection
through rsh (and ssh, if you enable that). If the command:
rsh imapserver exec /etc/rimapd
(or ssh if that is enabled) returns with a "* PREAUTH"
response, it will use the resulting rsh session as the IMAP
session and not require an authentication step on the server.
Unfortunately, rsh has a design error that treats "TCP
connection refused" as "temporary failure, try again"; it
expects the "rsh not allowed" case to be implemented as a
successful connection followed by an error message and close
the connection.
It must be emphasized that this is a bug in rsh. It is not a
bug in the IMAP toolkit.
The use of rsh can be disabled in any the following ways:
+ You can disable it for this particular session by either:
o setting an explicit port number in the mailbox name,
e.g.
{imapserver.foo.com:143}INBOX
o using SSL (the /ssl switch)
+ You can disable rsh globally by setting the rsh timeout value
to 0 with the call:
mail_parameters (NIL,SET_RSHTIMEOUT,0);
_________________________________________________________________
7.26 Why does a message sometimes get split into two or more messages
on my SUN system?
This is caused by an interaction of two independent design
problems in SUN mail software. The first problem is that the
"forward message" option in SUN's mail tool program includes
the internal "From " header line in the text that it forwarded.
This internal header line is specific to traditional UNIX
mailbox files and is not suitable for use in forwarded
messages.
The second problem is that the mail delivery agent assumes that
mail reading programs will not use the traditional UNIX mailbox
format but instead an incompatible variant that depends upon a
Content-Length: message header. Content-Length is widely
recognized to have been a terrible mistake, and is no longer
recommended for use in mail (it is used in other facilities
that use MIME).
One symptom of the problem is that under certain circumstances,
a message may get broken up into several messages. I'm also
aware of security bugs caused by programs that foolishly trust
"Content-Length:" headers with evil values.
To fix the mailer on your system, edit your sendmail.cf to
change the Mlocal line to have the -E flag. A typical entry
will lool like:
Mlocal, P=/usr/lib/mail.local, F=flsSDFMmnPE, S=10, R=20,
A=mail.local -d $u
This fix will also work around the problem with mail tool,
because it will insert a ">" before the internal header line to
prevent it from being interpreted by mail reading software as
an internal header line.
_________________________________________________________________
7.27 Why did my POP or IMAP session suddenly disconnect? The syslog
has the message:
Autologout user=<...my user name...> host=<...my client system...>
This is a problem in your client.
In the case of IMAP, it failed to communicate with the IMAP
server for over 30 minutes; in the case of POP, it failed to
communicate with the POP server for over 10 minutes.
_________________________________________________________________
7.28 What does the UNIX error message: TLS/SSL failure: myserver: SSL
negotiation failed mean?
7.29 What does the PC error message: TLS/SSL failure: myserver:
Unexpected TCP input disconnect mean?
This usually means that an attempt to negotiate TLS encryption
via the STARTTLS command failed, because the server advertises
STARTTLS functionality, but doesn't actually have it (e.g.
because no certificates are installed).
Use the /notls option in the mailbox name to disable TLS
negotiation.
_________________________________________________________________
7.30 What does the error message: TLS/SSL failure: myserver: Server
name does not match certificate mean?
An SSL or TLS session encryption failed because the server name
in the server's certificate does not match the name that you
gave it. This could indicate that the server is not really the
system you think that it is, but can be also be called if you
gave a nickname for the server or name that was not
fully-qualified. You must use the fully-qualified domain name
for the server in order to validate its certificate
Use the /novalidate-cert option in the mailbox name to disable
validation of the certificate.
_________________________________________________________________
7.31 What does the UNIX error message: TLS/SSL failure: myserver:
self-signed certificate mean?
7.32 What does the PC error message: TLS/SSL failure: myserver:
Self-signed certificate or untrusted authority mean?
An SSL or TLS session encryption failed because your server's
certificate is "self-signed"; that is, it is not signed by any
Certificate Authority (CA) and thus can not be validated. A
CA-signed certificate costs money, and some smaller sites
either don't want to pay for it or haven't gotten one yet. The
bad part about this is that this means there is no guarantee
that the server is really the system you think that it is.
Use the /novalidate-cert option in the mailbox name to disable
validation of the certificate.
_________________________________________________________________
7.33 What does the UNIX error message: TLS/SSL failure: myserver:
unable to get local issuer certificate mean?
An SSL or TLS session encryption failed because your system
does not have the Certificate Authority (CA) certificates
installed on OpenSSL's certificates directory. On most systems,
this directory is /usr/local/ssl/certs). As a result, it is not
possible to validate the server's certificate.
If CA certificates are properly installed, you should see
factory.pem and about a dozen other .pem names such as
thawteCb.pem.
As a workaround, you can use the /novalidate-cert option in the
mailbox name to disable validation of the certificate; however,
note that you are then vulnerable to various security attacks
by bad guys.
The correct fix is to copy all the files from the certs/
directory in the OpenSSL distribution to the
/usr/local/ssl/certs (or whatever) directory. Note that you
need to do this after building OpenSSL, because the OpenSSL
build creates a number of needed symbolic links. For some
bizarre reason, the OpenSSL "make install" doesn't do this for
you, so you must do it manually.
_________________________________________________________________
7.34 Why does reading certain messages hang when using Netscape? It
works fine with Pine!
There are two possible causes.
Check the mail syslog. If you see the message "Killed (lost
mailbox lock)" for the impacted user(s), read the FAQ entry
regarding that message.
Check the affected mailbox to see if there are embedded NUL
characters in the message. NULs in message texts are a
technical violation of both the message format and IMAP
specifications. Most clients don't care, but apparently
Netscape does.
You can work around this by rebuilding imapd with the
NETSCAPE_BRAIN_DAMAGE option set (see src/imapd/Makefile); this
will cause imapd to convert all NULs to 0x80 characters. A
better solution is to enable the feature in your MTA to
MIME-convert messages with binary content. See the
documentation for your MTA for how to do this.
_________________________________________________________________
7.35 Why does Netscape say that there's a problem with the IMAP server
and that I should "Contact your mail server administrator."?
Certain versions of Netscape do this when you click the Manage
Mail button, which uses an undocumented feature of Netscape's
proprietary IMAP server.
You can work around this by rebuilding imapd with the
NETSCAPE_BRAIN_DAMAGE option set (see src/imapd/Makefile) to a
URL that points either to an alternative IMAP client (e.g.
Pine) or perhaps to a homebrew mail account management page.
_________________________________________________________________
7.36 Why is one user creating huge numbers of IMAP or POP server
sessions?
The user is probably using Outlook Express, Eudora, or a
similar program. See the answer to the Help! My load average is
soaring and I see hundreds of POP and IMAP servers, many logged
in as the same user! question.
_________________________________________________________________
7.37 Why don't I get any new mail notifications from Outlook Express
or Outlook after a while?
This is a known bug in Outlook Express. Microsoft is aware of
the problem and its cause. They have informed us that they do
not have any plans to fix it at the present time.
The problem is also reported in Outlook 2000, but not verified.
Outlook Express uses the IMAP IDLE command to avoid having to
"ping" the server every few minutes for new mail.
Unfortunately, Outlook Express overlooks the part in the IDLE
specification which requires that a client terminate and
restart the IDLE before the IMAP 30 minute inactivity
autologout timer triggers.
When this happens, Outlook Express displays "Not connected" at
the bottom of the window. Since it's no longer connected to the
IMAP server, it isn't going to notice any new mail.
As soon as the user does anything that would cause an IMAP
operation, Outlook Express will reconnect and new mail will
flow again. If the user does something that causes an IMAP
operation at least every 29 minutes, the problem won't happen.
Modern versions of imapd attempt to work around the problem by
automatically reporting fake new mail after 29 minutes. This
causes Outlook Express to exit the IDLE state; as soon as this
happens imapd revokes the fake new mail. As long as this
behavior isn't known to cause problems with other clients, this
workaround will remain in imapd.
_________________________________________________________________
7.38 Why don't I get any new mail notifications from Entourage?
This is a known bug in Entourage.
You built an older version of imapd with the
MICROSOFT_BRAIN_DAMAGE option set, in order to disable support
for the IDLE command. However, Entourage won't get new mail
unless IDLE command support exists.
Note: the MICROSOFT_BRAIN_DAMAGE option no longer exists in
modern versions, as the Outlook Express problem which it
attempted to solve has been worked around in another way.
_________________________________________________________________
7.39 Why doesn't Entourage work at all?
It's hard to know. Entourage breaks almost every rule in the
book for IMAP. It is highly instructive to do a packet trace on
Entourage, as an example of how not to use IMAP. It does things
like STATUS (MESSAGES) on the currently selected mailbox and
re-fetching the same static data over and over again.
It seems that every time we understand what it is doing wrong
in Entourage and come up with a workaround, we learn about
something else that's broken.
Try building imapd with the ENTOURAGE_BRAIN_DAMAGE option set,
in order to disable the diagnostic that occurs when doing
STATUS on the currently selected mailbox.
_________________________________________________________________
7.40 Why doesn't Netscape Notify (NSNOTIFY.EXE) work at all?
This is a bug in NSNOTIFY; it doesn't handle unsolicited data
from the server correctly.
Fortunately, there is no reason to use this program with IMAP;
NSNOTIFY is a polling program to let you know when new mail has
appeared in your maildrop. This is necessary with POP; but
since IMAP dynamically announces new mail in the session you're
better off (and will actually cause less load on the server!)
keeping your mail reading program's IMAP session open and let
IMAP do the notifying for you.
Consequently, the recommended fix for the NSNOTIFY problem is
to delete the NSNOTIFY binary.
_________________________________________________________________
7.41 Why can't I connect via SSL to Eudora? It says the connection has
been broken, and in the server syslogs I see "Command stream end of
file".
There is a report that you can fix the problem by going into
Eudora's advanced network configuration menu and increasing the
network buffer size to 8192.
_________________________________________________________________
7.42 Sheesh. Aren't there any good IMAP clients out there?
Yes!
Pine is a wonderful client. It's fast, it uses IMAP well, and
it generates text mail (life is too short to waste on HTML
mail). Also, there are some really wonderful things in progress
in the Pine world.
There are some good GUI clients out there, mostly from smaller
vendors. Without naming names, look for the vendors who are
active in the IMAP protocol development community, and their
products.
Netscape, Eudora, and Outlook can be configured with enough
effort to be good citizens and work well for users, but they
can also be badly misconfigured, and often the misconfiguration
is the default.
_________________________________________________________________
7.43 But wait! PC Pine (or other PC program build with c-client)
crashes with the message incomplete SecBuffer exceeds maximum buffer
size when I use SSL connections. This is a bug in c-client, right?
It's a bug in the Microsoft SChannel.DLL, which implements SSL.
Microsoft admits it (albeit with an unstatement: "it's not
fully RFC compliant"). The problem is that SChannel indicates
that the maximum SSL packet data size is 5 bytes smaller than
the actual maximum. Thus, any IMAP server which transmits a
maximum sized SSL packet will not work with PC Pine or any
other program which uses SChannel.
It can take a while for the problem to show up. The client has
to do something that causes at least 16K of contiguous data.
Many clients do partial fetching, which tends to reduce the
number of cases where this can happen. However, all software
which uses SChannel to support SSL is affected by this bug.
This problem does not affect UNIX code, since OpenSSL is used
on UNIX.
This problem most recently showed up with the CommunigatePro
IMAP server. They have an update which trims down their maximum
contiguous data to less than 16K, in order to work around the
problem.
This problem has also shown up with the Exchange IMAP server
with UNIX clients (including Pine built with an older version
of c-client) which sends full-sized 16K SSL packets. Modern
c-client works around the problem by trimming down its maximum
outgoing SSL packet size to 8K.
Microsoft has developed a hotfix for this bug. Look up MSKB
article number 300562. Contrary to the article text which
implies that this is a Pine issue, this bug also affect
Microsoft Exchange server with *any* UNIX based client that
transmits full-sized SSL payloads.
_________________________________________________________________
7.44 My qpopper users keep on getting the DON'T DELETE THIS MESSAGE --
FOLDER INTERNAL DATA if they also use Pine or IMAP. How can I fix
this?
This is an incompatibility between qpopper and the c-client
library used by Pine, imapd, and ipop[23]d.
Assuming that you want to continue using qpopper, look into
qpopper's --enable-uw-kludge-flag configuration flag, which is
documented as "check for and hide UW 'Folder Internal Data'
messages".
The other alternative is to switch from qpopper to ipop3d.
_________________________________________________________________
7.45 Help! I installed the servers but I can't connect to them from my
client!
Review the installation instructions carefully. Make sure that
you have not skipped any of the steps. Make sure that you have
made the correct entries in the configuration files; pay
careful attention to the exact spelling of the service names
and the path names. Make sure as well that you have properly
restarted inetd.
If you have a system with Yellow Pages/NIS such as Solaris,
have you updated the service names there as well as in
/etc/services?
If you have a system with TCP wrappers, have you properly
updated the TCP wrapper files (e.g. /etc/hosts.allow and
/etc/hosts.deny) for the servers?
If you have a system which uses xinetd instead of inetd, have
you made sure that you have made the correct corresponding
xinetd changes for those services?
Try telneting to the server port (143 for IMAP, 110 for POP3).
If you get a "refused" error, that probably means that you
don't have the service set up in inetd.conf. If the connection
opens and then closes with no message, the service is set up,
but either the path name of the server binary in inetd.conf is
wrong or your TCP wrappers are configured to deny access.
If you don't know how to make the corresponding changes to
these files, seek the help of a local expert for your system.
_________________________________________________________________
7.46 Why do I get the message Can not authenticate to SMTP server: 421
SMTP connection went away! and why did this happen? There was also
something about SECURITY PROBLEM: insecure server advertised
AUTH=PLAIN
Some versions of qmail, including that running on
mail.smtp.yahoo.com, disconnect the SMTP session if you fail to
authenticate prior to attempting to transmit mail. An attempt
to authenticate was made, but it failed because the server had
already disconnected.
To work around this, you need to specify /user=... in the host
name specification.
The SECURITY PROBLEM came about because the server advertised
the AUTH=PLAIN SASL authentication mechanism outside of a
TLS-encrypted session, in violation of RFC 4616. This message
is just a warning, and in fact occurred after the server had
disconnected.
_________________________________________________________________
7.47 Why do I get the message SMTP Authentication cancelled and why
did this happen? There was also something about SECURITY PROBLEM:
insecure server advertised AUTH=PLAIN
This is a bug in the SMTP server.
Some versions of qmail, including that running on
mail.smtp.yahoo.com, have a bug in their implementation of SASL
in their SMTP server, which renders it non-compliant with the
standard.
If the client does not provide an initial response in the
command line for an authentication mechanism whose profile does
not have an initial challenge, qmail issues a bogus response:
334 ok, go on
The problem is the "ok, go on". This violates RFC 4954's
requirement that the text part in a 334 response be a BASE64
encoded string; in other words, it is a protocol syntax error.
In the case of AUTH=PLAIN, RFC 4422 (page 7) requires that the
encoded string have no data. In other words, the appropropiate
standards-compliant server response is "334" followed by a
SPACE and a CRLF.
The SECURITY PROBLEM came about because the server advertised
the AUTH=PLAIN SASL authentication mechanism outside of a
TLS-encrypted session, in violation of RFC 4616. This message
is just a warning, and is not related the "Authentication
cancelled" problem.
_________________________________________________________________
7.48 Why do I get the message Invalid base64 string when I try to
authenticate to a Cyrus server?
This slightly misleading message is the way that a Cyrus server
indicates that an authentication exchange was cancelled. It is
not indicative of a bug or protocol violation.
The most common reason that this happens is if the Cyrus server
offers Kerberos authentication, c-client is built with Kerberos
support, but your client system is not within the Kerberos
realm. In this case, the client code will try to authenticate
via Kerberos, fail to get the Kerberos credentials, cancel the
authentication attempt, and try the next available
authentication technology.
_________________________________________________________________
8. Where to Go For Additional Information
_________________________________________________________________
8.1 Where can I go to ask questions?
8.2 I have some ideas for enhancements to IMAP. Where should I go?
If you have questions about the IMAP protocol, or want to
participate in discussions of future directions of the IMAP
protocol, the appropriate mailing list is
imap-protocol@u.washington.edu. You can subscribe to this
list via imap-protocol-request@u.washington.edu
If you have questions about this software, you can send me
email directly or use the imap-uw@u.washington.edu mailing
list. You can subscribe to this list via
imap-uw-request@u.washington.edu
If you have general questions about the use of IMAP software
(not specific to the UW IMAP toolkit) use the
imap-use@u.washington.edu mailing list. You can subscribe to
this list via imap-use-request@u.washington.edu
You must be a subscriber to post to these lists. As an
alternative, you can use the comp.mail.imap newsgroup.
_________________________________________________________________
8.3 Where can I read more about IMAP and other email protocols?
We recommend Internet Email Protocols: A Developer's Guide, by
Kevin Johnson, published by Addison Wesley, ISBN 0-201-43288-9.
_________________________________________________________________
8.4 Where can I find out more about setting up and administering an
IMAP server?
We recommend Managing IMAP, by Dianna Mullet & Kevin Mullet,
published by O'Reilly, ISBN 0-596-00012-X.
This book also has an excellent comparison of the UW and Cyrus
IMAP servers.
Last Updated: 15 November 2007
doc/alt-php-libc-client11/calendar.txt 0000644 00000035422 15157607776 0013550 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
ALL ABOUT CALENDARS
Although one can never be sure of what will happen at some future
time, there is strong historical precedent for presuming that the
present Gregorian calendar will still be in effect within the useful
lifetime of the IMAP toolkit. We have therefore chosen to adhere to
these precedents.
The purpose of a calendar is to reckon time in advance, to show
how many days have to elapse until a certain event takes place in the
future, such as the harvest or the release of a new version of Pine.
The earliest calendars, naturally, were crude and tended to be based
upon the seasons or the lunar cycle.
ANCIENT CALENDARS
The calendar of the Assyrians, for example, was based upon the
phases of the moon. They knew that a lunation (the time from one full
moon to the next) was 29 1/2 days long, so their lunar year had a
duration of 354 days. This fell short of the solar year by about 11
days. (The exact time for the solar year is approximately 365 days, 5
hours, 48 minutes, and 46 seconds.) After 3 years, such a lunar
calendar would be off by a whole month, so the Assyrians added an extra
month from time to time to keep their calendar in synchronization with
the seasons.
The best approximation that was possible in antiquity was a 19-year
period, with 7 of these 19 years having 13 months (leap months). This
scheme was adopted as the basis for the lunar calendar used by the
Hebrews. The Arabs also used this calendar until Mohammed forbade
shifting from 12 months to 13 months; this causes the Muslim holy month
of Ramadan to move backwards through the seasons, completing a cycle
every 32 1/2 years.
When Rome emerged as a world power, the difficulties of making a
calendar were well known, but the Romans complicated their lives because
of their superstition that even numbers were unlucky. Hence their
months were 29 or 31 days long, with the exception of February, which
had 28 days. Every second year, the Roman calendar included an extra
month called Mercedonius of 22 or 23 days to keep up with the solar
year.
JULIAN CALENDAR
Even this algorithm was very poor, so that in 45 BCE, Caesar,
advised by the astronomer Sosigenes, ordered a sweeping reform. By
imperial decree, the year 46 BCE was made 445 days long to bring the
calendar back in step with the seasons. The new calendar, similar to
the one we now use was called the Julian calendar (named after Julius
Caesar).
Months in the Julian calendar were 30 or 31 days in length and
every fourth year was made a leap year (having 366 days) by adding a day
to the end of the year. This leap year rule was not consistantly
applied until 8 CE. The year-ending month of February, never a popular
month, was presently shortened so that Julius Caesar and Emperor
Augustus could each have long months named after them.
Caesar also decreed that the year would start with the first of
January, which since 153 BCE was the day that Roman consuls took office,
and not the vernal equinox in late March. Not everyone accepted that
part of his reform, as we shall see.
GREGORIAN CALENDAR
Caesar's year was 11 1/2 minutes short of the calculations
recommended by Sosigenes and eventually the date of the vernal equinox
began to drift. Roger Bacon became alarmed and sent a note to Pope
Clement IV, who apparently was not impressed. Pope Sixtus IV later
became convinced that another reform was needed and called the German
astronomer, Regiomontanus, to Rome to advise him. Unfortunately,
Regiomontanus died of the plague shortly thereafter and the plans died
as well.
In 1545, the Council of Trent authorized Pope Gregory XIII to
reform the calendar once more. Most of the mathematical work was done
by Father Christopher Clavius, S.J. The immediate correction that was
adopted was that Thursday, October 4, 1582 was to be the last day of the
Julian calendar. The next day was Friday, with the date of October 15.
For long range accuracy, a formula suggested by the Vatican librarian
Aloysius Giglio was adopted. It said that every fourth year is a leap
year except for century years that are not divisible by 400. Thus 1700,
1800 and 1900 would not be leap years, but 2000 would be a leap year
since 2000 is divisible by 400. This rule eliminates 3 leap years every
4 centuries, making the calendar sufficiently correct for most ordinary
purposes. This calendar is known as the Gregorian calendar and is the
one that we now use today.
It is interesting to note that in 1582, all the Protestant princes
ignored the papal decree and so many countries continued to use the
Julian calendar until either 1698 or 1752. Britain and its American
colonies went from Wednesday, September 2, 1752 to Thursday, September
14. Prior to the changeover, the British used March 25 as the start of
the new year.
In Russia, it needed the revolution to introduce the Gregorian
calendar in 1918. Turkey didn't adopt it until 1927.
NUMBERING OF YEARS
The numbering of the year is generally done according to an "era",
such as the year of a ruler's reign.
In about 525, a monk named Dionysius Exiguus suggested that the
calculated year of Jesus' birth be designated as year 1 in the Julian
calendar. This suggestion was adopted over the next 500 years and
subsequently followed in the Gregorian calendar.
For the benefit of those who seek religious significance to the
calendar millenium, note that year 1 is too late by at least 4 years.
Herod the Great, named in the Christian Bible as having all children in
Bethlehem put to death in an attempt to kill the infant Jesus, died in 4
BCE.
Nothing particularly significant of an historic or religious nature
happened in Gregorian year 1; however it has become a worldwide standard
as the "common era." In modern times, the terms "CE" (common era) and
"BCE" (before common era) are preferred over the earlier (and, as we
have seen, less accurate) "AD" (anno Domini, "the year of the Lord") and
"BC" (before Christ).
The Hebrew lunar calendar begins at 3760 BCE, the year of creation
in Jewish tradition. The Muslim lunar calendar begins on July 16, 622,
when Mohammed fled from Mecca to Medina.
The Japanese, Taiwanese, and North Koreans use the Gregorian
calendar, but number the year by political era. In Japan, an era
begins when an emperor succeeds to the throne; year 1 of the Heisei
era was 1989 when Emperor Akihito ascended to the throne (the first
few days of 1989 was year 64 of the Shouwa era). In Taiwan, year 1 is
the first full year after the founding of the Republic of China in 1911.
In North Korea, year 1 is the year of the Juche (self-reliance) ideal,
corresponding to the birth year of founder Kim Il-Sung (1912). Thus,
year 2000 is Heisei 12 (Japan), 89th year of the Republic (Taiwan),
and Juche 89 (North Korea).
FURTHER MODIFICATIONS TO THE GREGORIAN CALENDAR
Despite the great accuracy of the Gregorian calendar, it still
falls behind very slightly every few years. The most serious problem
is that the earth's rotation is slowing gradually. If you are very
concerned about this problem, we suggest that you tune in short wave
radio station WWV or the Global Positioning System, which broadcasts
official time signals for use in the United States. About once every
3 years, they declare a leap second at which time you should be
careful to adjust your system clock. If you have trouble picking up
their signals, we suggest you purchase an atomic clock (not part of
the IMAP toolkit).
Another problem is that the Gregorian calendar represents a year
of 365.2425 days, whereas the actual time taken for the earth to
rotate around the Sun is 365.2421991 days. Thus, the Gregorian calendar
is actually 26 seconds slow each year, resulting in the calendar
being one day behind every 3,300 or so years (a Y3.3K problem).
Consequently, the Gregorian calendar has been modified with a
further rule, which is that years evenly divisible by 4000 are not
leap years. Thus, the year 4000 will not be a leap year. Or, at
least we assume that's what will happen assuming that the calendar
remains unchanged for the next 2000 years.
The modified Gregorian calendar represents a year of 365.24225
days. Thus, the modified Gregorian calendar is actually 4 seconds
slow each year, resulting in the calendar being one day slow every
20,000 or so years. So there will be a Y20K problem.
There is some dispute whether the modified Gregorian calendar was
officially adopted, or if it's just a proposal. Other options (see
below) exist; fortunately no decision needs to be made for several
centuries yet.
There is code in c-client to support the modified Gregorian
calendar, although it is currently disabled. Sometime in the next
2000 years, someone will need to enable this code so that c-client is
Y4K compiliant. Then, 18,000 years from now, someone will have to
tear into c-client's code to fix the Y20K bug.
EASTERN ORTHODOX MODIFICATION OF THE GREGORIAN CALENDAR
The Eastern Orthodox church in 1923 established its own rules to
correct the Julian calendar. In their calendar, century years modulo
900 must result in value of 200 or 600 to be considered a leap year.
Both the Orthodox and Gregorian calendar agree that the years 2000 and
2400 will be leap years, and the years 1900, 2100, 2200, 2300, 2500,
2600, 2700 are not. However, the year 2800 will be a leap year in the
Gregorian calendar but not in the Orthodox calendar; similarly, the
year 2900 will be a leap year in the Orthodox calendar but not in the
Gregorian calendar. Both calendars will agree that 3000 and
3100 are leap years, but will disagree again in 3200 and 3300.
There is code in c-client to support the Orthodox calendar. It
can be enabled by adding -DUSEORTHODOXCALENDAR=1 to the c-client
CFLAGS, e.g.
make xxx EXTRACFLAGS="-DUSEORTHODOXCALENDAR=1"
The Orthodox calendar represents a year of 365.24222222... days.
Thus, the Orthodox calendar is actually 2 seconds slow each year,
resulting in the calendar being one day slow every 40,000 or so years.
The Eastern Orthodox church has not yet made any statements on how the
Y40K bug will be fixed.
OTHER ISSUES AFFECTING THE CALENDAR IN THE FUTURE
The effect of leap seconds also needs to be considered when
looking at the Y3.3K/Y4K, Y20K, and Y40K problems. Leap seconds put
the clock back in line with the Earth's rotation, whereas leap years
put the calendar back in line with the Earth's revolution. Since leap
seconds slow down the clock (and hence the calendar), they actually
bring the day of reckoning for the Gregorian and Orthodox calendars
sooner.
Another factor is that the next ice age (technically, the end of
the current interglacial period; we are in the middle of an ice age
now!) is due around Y25K. It is not known what perturbations this will
cause on the Earth's rotation and revolution, nor what calendar
adjustments will be necessary at that time.
Hence my use of "or so" in predicting the years that the calendar
will fall behind. The actual point may be anywhere from decades (in the
case of Y3.3K) to millenia (in the case of Y40K) off from these predictions.
MEANINGS OF DAY NAMES
The names of days of the week from a combination of Roman and
Germanic names for celestial bodies:
. Sunday Latin "dies solis" => "Sun's day"
. Monday Latin "dies lunae" => "Moon's day"
. Tuesday Germanic "Tiw's day" => "Mars' day"
. Wednesday Germanic "Woden's day" => "Mercury's day"
. Thursday Germanic "Thor's day" => "Jupiter's day"
. Friday Germanic "Frigg's day" => "Venus' day"
. Saturday Latin "dies Saturni" => "Saturn's day"
MEANINGS OF MONTH NAMES
The names of the months are from the Roman calendar:
. January Janus, protector of doorways
. February Februalia, a time for sacrifice to atone for sins
. March Mars, god of war
. April Latin "aperire" => "to open" buds
. May Maia, goddess of plant growth
. June Latin "juvenis" => "youth"
. July Julius Caesar
. August Augustus Caesar
. September Latin "septem" => "seven"
. October Latin "octo" => "eight"
. November Latin "novem" => "nine"
. December Latin "decem" => "ten"
As you'll notice, the last four months are numbered 7 to 10, which
is an artifact of the time when the new year started in March.
INTERESTING FORMULAE
There's another reason why the historical starting of the new year
is significant. Starting with March, the length of months follows a
mathematical series:
31 30 31 30 31 31 30 31 30 31 31 28
This means that you can calculate the day of week for any
arbitrary day/month/year of the Gregorian calendar with the following
formula (note all divisions are integral):
_ _
| 7 + 31*(m - 1) y y y |
dow = | d + -------------- + y + - - --- + --- | MOD 7
|_ 12 4 100 400_|
where
d := day of month (1..31)
m := month in old style (March = 1..February = 12)
y := year in old style
dow := day of week (Tuesday = 0..Monday = 6)
To convert from new style month/year to old style:
if (m > 2) m -= 2; /* Mar-Dec: subtract 2 from month */
else m += 10,y--; /* Jan-Feb: months 11 & 12 of previous year */
Here's another fun formula. To find the number of days between two
days, calculate a pair of calendar days with the formula (again, all
divisions are integral), using new style month/year this time:
m
m + -
8 y y y
d + 30 * (m - 1) + ----- + y * 365 + - - --- + --- - ld
2 4 100 400
where:
d := day of month (1..31)
m := month in new style (January = 1..December = 12)
y := year in new style
ld := leap day correction factor:
0 for January and February in non-leap years
1 for January and February in leap years
2 for all other months in all years
In C code, the leap day correction factor is calculated as:
(m < 3) ? !(y % 4) && ((y % 100) || !(y % 400)) : 2
It's up to you to figure out how to adapt these formulas for the
Y4K bugfix and the Orthodox calendar. If you're really clever, try to
use these formulae to implement the C library ctime(), gmtime(), and
mktime() functions. Most C library implementations use a table of the
number of days in a month. You don't need it.
ACKNOWLEDGEMENT:
The original version is from an old Digital Equipment Corporation SPR
answer for VMS. Modifications for c-client, and additional information
added by Mark Crispin.
doc/alt-php-libc-client11/NOTICE 0000644 00000001367 15157610003 0012114 0 ustar 00 UW IMAP toolkit notices:
This software was developed by the University of Washington
(http://www.washington.edu/).
The Univerity of Washington IMAP Toolkit (c-client API, dmail, imapd,
ipop2d, ipop3d, mailutil, mlock, mtest, and tmail software; and its
included text) is Copyright 1988-2007 by the University of Washington.
The c-client library and mtest software are in part based upon code
developed by Mark Crispin at Stanford University, and is
* Copyright 1988 Stanford University and was developed in the
* Symbolic Systems Resources Group of the Knowledge Systems Laboratory
* at Stanford University in 1987-88, and was funded by the
* Biomedical Research Technology Program of the National Institutes of
* Health under grant number RR-00785.
doc/alt-php-libc-client11/mixfmt.txt 0000644 00000034312 15157610010 0013247 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
Last update: 18 December 2006
INTRODUCTION
This file is the descendant of a design document used to specify the
mix format. An attempt is being made to keep this document more or
less current with the way the mix format actually works.
1. Mix mailbox naming
Mailbox names correspond to directory names; thus mix format mailboxes
are "dual-use" (lack both \NoInferiors and \NoSelect). This will
satisfy some long-standing requests.
2. Mailbox files
A mix format mailbox is a directory with regular files with filenames
of:
.mixmeta mailbox metadata file
.mixindex message index file (message static data)
.mixstatus message status file (message dynamic data)
.mix######## (where ######### is a <hex8>) secondary message
data files.
.mix primary message data file (used in experimental
versions, supported for compatibility only)
2.1 Metadata, index, and status files
The mailbox metadata, index, and status files contain a sequence of
CRLF-terminated lines. These files have an update sequence, which is
a strictly-ascending sequence value. Any time the file is changed,
the update sequence is increased; this allows easy detection of
whether the file has been changed by another process. For now, this
update sequence is a modseq (see below).
2.1.1 Metadata file
The mailbox metadata file is called ".mixmeta". It contains a series
of CRLF-terminated lines. The first character of the line is a key that
identifies the payload of the line, and the remainder of the line is the
payload.
Key Payload
--- -------
S <hex8> ;; update sequence
V <hex8> ;; UIDVALIDITY
L <hex8> ;; UIDLAST
N <hex8> ;; current new message file
K [atom 0*(SP atom)] ;; keyword list
All other keys are reserved for future assignment and must be ignored
(and may be discarded) by software which does not recognize them. The
mailbox metadata file is rewritten as part of new mail delivery (so
APPENDUID/COPYUID can work) and when new keywords are added.
2.1.2 Message static index file
The mailbox message static index file is called ".mixindex". It contains
a series of CRLF-terminated lines. The first character of the line is a
key that identifies the payload of the line, and the remainder of the line
is the payload.
Key Payload
--- -------
S <hex8> ;; update sequence
: <uid>:<date>:<size>:<file>:<pos>:<isiz>:<hsiz>
;; per-message record
The per-message records contain the following data:
<uid> = <hex8> ;; message UID
<date> = <yyyymmddhhmmss+zzzz> ;; internal date
<size> = <hex8> ;; rfc822.size
<file> = <hex8> ;; message data file (0 = .mix file)
<pos> = <hex8> ;; message position in file
<isiz> = <hex8> ;; message internal data size
<hsiz> = <hex8> ;; header size (offset to body)
All other keys, and subsequent fields in per-message records, are
reserved for future assignment and must be ignored (and may be
discarded) by software which does not recognize them. The mailbox
metadata file is appended by new mail delivery and rewritten by
expunge "burping", and otherwise is not altered.
2.1.3 Message dynamic status file
The mailbox message dynamic status file is called ".mixstatus". It contains
a series of CRLF-terminated lines. The first character of the line is a
key that identifies the payload of the line, and the remainder of the line
is the payload.
Key Payload
--- -------
S <hex8> ;; update sequence
: <uid>:<uf>:<sf>:<mod>: ;; per-message record
The per-message records contain the following data:
<uid> = <hex8> ;; message UID
<keys> = <hex8> ;; keyword flags
<flag> = <hex4> ;; system flags
<mod> = <hex8> ;; date/time last modified (modseq)
All other keys, and subsequent fields in per-message records, are
reserved for future assignment and must be ignored (and may be
discarded) by software which does not recognize them. The mailbox
dynamic idex file is rewritten by flag changes (or any future change
that alters dynamic data) and is re-read when a session sees that the
mtime has changed (atime and ctime are not used).
The modseq is an unsigned 32-bit date/time, along with a guarantee
that this value can not go backwards. It currently corresponds to the
time from time(); however, since it is unsigned, it won't run out until
the year 2106. In the future, this may be used as a basic for implementing
the IMAP CONDSTORE extension.
2.2 Message data files
A mix message file is a regular file with filename starting with
".mix" followed by a <hex8> suffix which indicates the file number. It
contains a series of CRLF-terminated lines. By special dispensation, the
filename ".mix" is used for file number 0, which was used in experimental
versions of mix as a "primary" file (this concept no longer exists).
A file number is set to the current modseq when it is created. If a copy
or append causes the file to exceed the compiled-in file size limit, a new
file is started and the metadata is updated accordingly.
Preceeding each message is per-message record with the following format:
Key Payload
--- -------
;; per-message record
: :<code>:<uid>:<date>:<size>:
The per-message records contain the following data:
<code> = "msg" ;; fixed code
<uid> = <hex8> ;; message UID
<date> = <yyyymmddhhmmss+zzzz> ;; internal date
<size> = <hex8> ;; rfc822.size
The message data begins on the next line
Subsequent fields are reserved for future assignment and must be ignored.
3. New mail delivery
To deliver a new message, it is necessary to share lock the destination
metadata file, then get an exclusive lock on the destination index and
status files. Once this is done, the new message data is appended to the
new message file. The metadata (UIDLAST value), index, and status
files are all updated to add the new message.
Then all the destination mailbox files are closed.
4. Mailbox pinging
The index and status files are share locked. Initially, sequences are
remembered as zero, so at open time they are always "altered".
The sequence from the index file is checked; if it is altered the index
file is read and processed as follows:
. If expunge is permitted, then any messages that are not in the index
are reported as having been expunged via mm_expunged().
. new messages are announced via mm_exists()/mm_recent().
Next, the sequence from the status file is checked. If it is altered,
the status file is read and the status updated for any message which is
new or has an altered modseq in the status file. Altered modseq messages
are announced via mm_flags().
Then the index and status files are closed.
4. Flag alteration
The status file is exclusive locked.
The sequence from the status file is checked. If it is altered, the
status file is read and the status updated for any message which is
new or has an altered modseq in the status file. Altered modseq
messages are announced via mm_flags().
The alterations are then applied for all requested messages, updating
the modseq for each requestedmessage which changes flags as a result
of the alteration (alterations which do not result in a change do not
alter the modseq). Then the status file is rewritten with a new
sequence, but only if flags of at least one message was changed.
Then the status file is closed.
5. Checkpoint and expunge
Checkpoint is identical to expunge, however it skips the step of expunging
deleted messages.
The index and status files are locked exclusive. If expunging, all
deleted messages are expunged from the index and announced via
mm_expunged(). The message data is notremoved at this time.
If a checkpoint was requested, or if any messages were expunged, or if
it remembered that a "burp" was needed, then:
. the metadata file is locked exclusive. If this fails, remember that
a burp is needed. Otherwise perform a burp:
. calculate the file byte ranges occupied by expunged messages
. for each file needing "burping", open and slide down subsequent file
data on top of the expunged messages
. update the index and status files
Then the index and status files are closed.
5.1 More details on expunging and "burping"
Shared expunge presents a problem due to the requirements of the IMAP
protocol. You can't "burp" away a message until you are certain that
no sharers have a pointer to any longer. Consequently, for the nonce
"burping" out expunged data be defered to an exclusive expunge as in
mbx format.
If shared burping is ever implemented, then care will be needed not to
burp data that a session still relies upon. It's easy enough to burp
the index files; just create new index files, deleting the old, and
require that you look for a new one appearing at mailbox ping time
(when it's safe). The data files are a problem, since we
intentionally don't want to keep them open and do want to avoid quota
problems by overwriting in place. Also, when you burp you have to
change the pointers in the index file.
Bottom line: shared burping is too hairy right now, so the first
version will do exclusive-only burping and not worry about it. If
shared burping is really needed, then that routine will need to be
rewritten.
Shared burping has been a problem for every other IMAP server. Most
get it wrong, and cause terrible confusion to clients (including
client crashes).
6. Message data file file roll out strategy
The current new message file is finalized, and a new one started, when
an append or copy is done that would cause the file to grow to larger
than a preconfigured size (MIXDATAROLL). A multi-message copy or
append is written into its entirety to a single new message file. In
the case of multi-copy, the new message file is switched when the sum
of the sizes of all messages to be copied would cause the current new
message file to exceed MIXDATAROLL. In the case of multi-append, only
the first message is considered; this is due to technical limitations.
7. Error detection
Mix detects bad data in the metadata, index, and status files; and
declares the stream dead. It does not unilaterally reassign
UIDVALIDITY the way that the flat file formats do.
When mix reads a header from the message file, it also reads the
per-message record and verifies that there is a per-message record there.
This is a simple test for message file corruption. It doesn't declare
the stream dead; it simply issues an error message and returns a
zero-length string for the message header. This makes it possible for
the user to fix the mailbox simply by deleting and expunging any messages
that are in this state.
8. Reconstruct tool
[None of this is implemented yet.]
The layout of these files is designed to make the reconstruct tool be
as simple as possible. Much of the need for the reconstruct tool is
eliminated since the mix format has a much more limited scope of
writing than the flat file formats; thus there is "less collateral
damage."
If the metadata file is lost or corrupted, then all keywords are lost;
if the mailbox has any keywords used in the .mixstatus file, it'll be
necessary to create some placeholder names. Otherwise, a new
UIDVALIDITY can be assigned, and a good UIDLAST value calculated by
the reconstruct tool. Since this file is very small, it's not likely
to be damaged.
If the index file is lost or corrupted, it is possible to reconstruct
it with no loss by reading all the data files. However, this could
cause expunged but not yet burped messages to reappear.
If the status file is lost or corrupted, then flags are lost and
will revert to a default state of no flags set. Just deleting the
corrupted file is good enough.
The reconstruct tool can use the per-message record in the message
file to locate messages if the recorded sizes and/or messages are
corrupt. If that happens, it will need to rebuild the index file
(with associated changes to the metadata file to change the
UIDVALIDITY). That should probably be a manual operation and not be
part of the default operation or auto-reconstruct.
9. Locking strategy
The mix format does not use the traditional c-client /tmp file locking.
The metadata file is open and locked whenever the mailbox is open.
Normally this is a shared lock, but it will be upgraded to exclusive
if the mailbox is expunged. As a guard (since there is no true
lock-upgrade/downgrade on UNIX), the index exclusive lock must be
acquired first before upgrading to exclusive.
The index file is shared locked when reading the index, and exclusive
locked (and read) when appending new messages to the index or when
expunging (note that expunging also requires an exclusive lock on
metadata). Normally, the index file is not open or locked.
The status file is shared locked when reading status, and exclusive
locked (and read) when updating status. Normally, the status file is
not open or locked.
It isn't necessary to lock any of the data files as long as we only
have exclusive burping.
10. Memory usage
The mix format returns a file stringstruct, which is the modern
c-client behavior. This prevents imapd from growing to enormous sizes
due to a godzillagram (how it affects other programs depends upon what
they do with the returned stringstruct).
11. Future extensions
Cached ENVELOPE, BODYSTRUCTURE. Cyrus does, and this will eliminate
most of the reason to access the data files. Possibly cached overviews,
ala NNTP, instead?
Support for ANNOTATION.
12. RENAME issues
Mix currently makes no attempt to address the IMAP RENAME problem.
This occurs when a mailbox is deleted, and another mailbox is renamed
with that name in place, no attempt is made to reassign UIDVALIDITY
for this mailbox and all the inferior mailboxes. This potentially can
cause problems for a disconnected-use client that has cached status
for the old mailbox which had that name.
The RENAME problem is a well known flaw in the IMAP protocol. Few
servers correctly handle it (among other things, not only do all the
UIDVALIDITY values have to be changed but this has to be done
atomically!). It was a mistake to add RENAME into IMAP, but it's much
too late to remove it now.
doc/alt-php-libc-client11/internal.txt 0000644 00000340601 15157610015 0013565 0 ustar 00 /* ========================================================================
* Copyright 1988-2006 University of Washington
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
*
* ========================================================================
*/
Documentation of c-client Functions and Interfaces
REVISED: 19 August 1996
Credits
The original version of this document was written by Mark Crispin at
the University of Washington, and described the version of c-client that
supported the IMAP2 (RFC 1176) and IMAP2bis (unpublished) protocols.
This version is a substantial rewrite of that document, and was
written by Mark Crispin with funding from Sun Microsystems, Incorporated.
Sun's generous support of this work is gratefully acknowledged.
Road Map
This document is organized into the following sections. Except as
noted, an implementor of an application that uses c-client needs to be
familiar with all of these sections. Someone who plans to write a new
mailbox driver for c-client (or otherwise modify it) needs to be familiar
with all sections, no exception.
History
History of how c-client came about.
Overview
Read this before designing an application that uses c-client.
c-client Structures
Documentation of several important c-client structs which are
used in, and returned by, c-client calls.
String Structures
Documentation of the concept of a "string structure", which
provides random access to strings without requiring that the
string be in memory.
c-client Support Functions
Documentation of support functions for c-client; these deal
with c-client functionality.
Only mail_parameters() is of interest to most application
developers. Advanced application developers, particularly
for limited memory systems, may also need to know about the
readfn_t, mailgets_t, mailcache_t, and tcptimeout_t function
pointer types, and possibly also the mail_valid_net_parse()
function.
Mailbox Access Functions
Documentation of functions which deal with mailboxes;
listing, subscribing, creating, deleting, renaming, status
inquiries, opening, and closing mailboxes.
Handle Functions
Documentation of mail stream handles, which provide protection
for an advanced application which may have multiple pointers to
a single mail stream. If a stream has a handle on it, closing
the stream does not release its memory, so pointers to it in
the application remain valid. Freeing the last handle will free
the entire stream.
This is only of interest for advanced application developers.
Message Data Fetching Functions
Documentation on message data fetching in an open mailbox,
including parsed representations of RFC-822 and MIME headers
and message text. Also how to fetch message attributes (flags,
internal date, sizes).
Message Status Manipulation Functions
Documentation on altering message flags in an open mailbox.
Mailbox Searching
Documentation on searching an open mailbox for messages which
match certain criteria (e.g. "messages sent July 4 from Jones
with text `Paris'").
Miscellaneous Mailbox and Message Functions
Documentation on other operations that would be used by an
application but that don't fit into any of the above categories.
Date/Time Handling Functions
Documentation on functions that deal with date/time strings.
This is only of interest for advanced application developers
and for implementors of new c-client drivers.
Utility Functions
Documentation on internal utility functions.
This is primarily of interest for implementors of new c-client
drivers, but advanced application developers may also use some
of these functions.
Data Structure Instantiation/Destruction functions
Documentation on creating and destroy c-client structures.
This is primarily of interest for implementors of new c-client
drivers. However, application developers will need some of
these functions to create and destroy structures which are used
as arguments to various application functions.
Authentication Functions
Documentation on support for network protocol authentication
functions.
This is only of interest for implementors of new c-client
drivers which deal with authentication mechanisms.
Network Access Functions
Documentation on creating and destroy c-client structures.
This is primarily of interest for implementors of new c-client
drivers which deal with a network. However, advanced
application developers may need to use this information if they
wish to insert their own layer into a network session.
Subscription Management Functions
Documentation on managing the local (client-based) subscription
database file.
This is primarily of interest to advanced application developers.
Miscellaneous Utility Functions
Documentation on various useful utility functions, such as "make
a copy of this string."
SMTP Functions
Documentation on posting email messages via SMTP protocol.
NNTP Functions
Documentation on posting netnews messages via NNTP protocol.
RFC 822 Support Functions
Documentation on public RFC-822/MIME functions.
This is primarily of interest for implementors of new c-client
drivers and advanced application developers.
Operating System-Dependent Public Interface
Documentation on OS-dependent functions. With the exception of
fs_get(), fs_give(), and fs_resize(), which should be called
instead of malloc(), free(), and realloc(), these functions are
primarily of interest for implementors of new c-client drivers.
Main Program Callbacks
Documentation of functions which the main program must provide
as callbacks from c-client.
Driver Interface
Documentation of the driver dispatch vector and the functions
which a driver must supply.
This is primarily of interest for implementors of new c-client
drivers.
Driver Support Functions
Documentation of support functions which are called by drivers.
This is primarily of interest for implementors of new c-client
drivers.
History
The c-client API was originally written by Mark Crispin at Stanford
University as a set of routines to support IMAP and SMTP from a main
program which would handle the user interface. In its original form, it
was written as the low-level routines that were to be used as part of a
Macintosh client.
The first IMAP client, MM-D (for "MM on Xerox D machines" -- MM was a
popular DEC-20 mail program) was written in Interlisp for Xerox Lisp
machines. At that time, there was no name for the embryonic Mac client,
but since it was the first one to be written in C instead of Lisp, it was
given a development name of "C client". This name became "c-client"
because that is the name of the subdirectory on UNIX where the source files
were stored.
To exercise the routines, a minimal main program which uses c-client,
mtest, was written. mtest has subsequently been extended so that it runs
on every platform that c-client is ported.
The real Mac client, was eventually written by Frank Gilmurrary and
Bill Yeager at Stanford using the autumn 1988 version of c-client and named
"MacMS". In the winter of 1988-89, Mark Crispin, who had changed jobs to
the University of Washington, developed MS as an MM-like text-based program
for UNIX and MailManager as a GUI-based program for NeXT machines.
The realization sunk in that this API needed its own name. As early
as spring 1989, there were at least four programs (mtest, MS, MailManager,
and MacMS) that used it. The name c-client thus became permanent.
In its history, c-client has undergone two major redesigns, both by
Mark Crispin who is now on the staff at the University of Washington.
The first major redesign added the following:
1) ANSI C calling conventions throughout to assist in function
argument type checking.
2) Vectoring mail access calls through "driver" methods; thus
providing transparent access to multiple types of mail
stores with the same call.
3) MIME support.
The second major redesign was part of the IMAP4 project. Many
c-client functions were extended with additional arguments and options.
The driver interface was also made simpler, with more work done by
driver-independent code.
Overview
The most important file for the author of an application using the
c-client is mail.h. mail.h defines several important structures of
data which are passed between the main program and the c-client.
Although some functions (e.g. mail_fetchtext_body()) return the data
fetched, for certain other data items (e.g. flags) you need to get the
data as a structure reference. mail.h also defines a large number of
useful constants and structures.
When a function in mail.h exists to reference data, it MUST be
used instead of referencing the structures directly. This is because
in some cases the data is not actually fetched until a reference (via
the function call) is made. For example, although the MESSAGECACHE
element for a message can be obtained by indexing the proper cache
element in the stream, there is no guarantee that the item in fact
exists unless mail_fetchstructure_full() is called for that message.
Less costly functions. also exist to create and load a MESSAGECACHE
element.
The main program will probably also need to include smtp.h,
misc.h, and osdep.h, but this usage should be solely to receive
function prototypes. Any other definitions in those files should be
considered private to that module.
Two important predefined symbols are NIL and T. NIL is any sort
of "false"; T is any sort of "true". NIL is also used to null-specify
certain optional arguments.
* * * IMPORTANT * * *
Any multi-threaded application should test stream->lock prior to
calling any c-client stream functions. Any attempt to call a
mail_xxx() function while one is already in progress on the same
stream will cause the application to fail in unpredictable ways.
Note that this check is insufficient in a preemptive-scheduling
multi-tasking application due to the possibility of a timing race.
Such applications must be written so that only one process accesses
the stream, or to have a higher level lock.
Since MAIL operations will not finish until they are completed, a
single-tasking application does not have to worry about this problem,
except in the callback invoked from MAIL (e.g. mm_exists(), etc.) in which
case the stream is *always* locked.
c-client Structures
c-client has a large number of structures which are used for
multiple functions. The most important of these are described here.
The MAILSTREAM structure is used to reference open mailboxes.
Applications may reference the following:
char *mailbox; mailbox name
unsigned short use; stream use count, this is incremented
unsigned short sequence; stream sequence, this is incremented
each time a stream is reused (i.e.
mail_open() is called to open a
different mailbox on this stream)
unsigned int rdonly : 1; stream is open read-only
unsigned int anonymous : 1; stream is open with anonymous access
unsigned int halfopen : 1; stream is half-open; it can be
reopened or used for functions that
don't need a open mailbox such as
mail_create() but no message data
can be fetched
unsigned int perm_seen : 1; Seen flag can be set permanently
unsigned int perm_deleted : 1; Deleted flag can be set permanently
unsigned int perm_flagged : 1; Flagged flag can be set permanently
unsigned int perm_answered :1; Answered flag can be set permanently
unsigned int perm_draft : 1; Draft flag can be set permanently
unsigned int kwd_create : 1; new user flags can be created by
referencing then in mail_setflag() or
mail_clearflag(). Note: this can
change during a session (e.g. if
there is a limit on the number of
keywords), so check after creating a
new flag to see if any more can be
created before letting the user try
to do so
unsigned long perm_user_flags; corresponding user flags can be set
permanently. This is a bit mask
which matches the entries in
stream->user_flags[]
unsigned long gensym; generated unique value. Always
referenced with stream->gensys++
unsigned long nmsgs; number of messages in current mailbox
unsigned long recent; number of recent messages in current
mailbox
unsigned long uid_validity; UID validity value; this is used to
verify that recorded UIDs match the
UIDs that the stream has. If the
mailbox does not have matching UIDs
(e.g. the UIDs were lost or not
recorded) then the UID validity value
will be different
unsigned long uid_last; highest currently assigned UID in the
current mailbox; a new UID will be
assigned with ++stream->uid_last
char *user_flags[NUSERFLAGS]; pointers to user flag names in bit
order from stream->perm_user_flags or
elt->user_flags
The following MAILSTREAM values are only used internally:
DRIVER *dtb; dispatch table for this driver
void *local; pointer to driver local data
unsigned int lock : 1; stream lock flag (an operation is in
progress; used as a bug trap to
detect recursion back to c-client
from callback routines).
unsigned int debug : 1; debugging information should be logged
via mm_dlog().
unsigned int silent : 1; don't do main program callbacks on
this stream (used when a stream is
opened internally)
unsigned int scache : 1; short caching; don't cache information
in memory
The following MAILSTREAM values are only used by the cache
manager routine (see the documentation about mailcache_t above):
unsigned long cachesize; size of c-client message cache
union {
void **c; to get at the cache in general
MESSAGECACHE **s; message cache array
LONGCACHE **l; long cache array
} cache;
The following MAILSTREAM values are for the convenience of
drivers that use short caching and want to be able to garbage collect
any values that they returned:
unsigned long msgno; message number of `current' message
ENVELOPE *env; pointer to `current' message envelope
BODY *body; pointer to `current' message body
char *text; pointer to `current' text
The MESSAGECACHE structure (commonly called an "elt" as a
nickname for "cache ELemenT") contains information about messages.
Applications may use the following:
unsigned long msgno; message number. If the elt is locked
(by elt->lockcount++), then the elt
pointer can be stored (e.g. with the
data for a window which draws this
message) and elt->msgno will change
automatically whenever expunges are
done so the window will always view
the correct message. If elt->msgno
becomes 0, then the message has been
expunged, but the elt won't be freed
until the elt lock count is
decremented (by mail_free_elt()).
unsigned long uid; message unique ID
unsigned int hours: 5; internal date hours (0-23)
unsigned int minutes: 6; internal date minutes (0-59)
unsigned int seconds: 6; internal date seconds (0-59)
unsigned int zoccident : 1; non-zero if internal date time zone is
west of UTC
unsigned int zhours : 4; internal date time zone hours from UTC
(0-12)
unsigned int zminutes: 6; internal date time zone minutes (0-59)
unsigned int seen : 1; message Seen flag
unsigned int deleted : 1; message Deleted flag
unsigned int flagged : 1; message Flagged flag
unsigned int answered : 1; message Answered glag
unsigned int draft : 1; message Draft flag
unsigned int valid : 1; flags are valid in this elt; an elt
that was newly created but never
loaded with flags won't have this set.
unsigned int recent : 1; message recent flag
unsigned int searched : 1; message matches search criteria in
most recent mail_search_full() call
unsigned int spare : 1; reserved for application use
unsigned int spare2 : 1; reserved for application use
unsigned int spare3 : 1; reserved for application use
unsigned int lockcount : 8; non-zero if multiple references to
this elt. Refer to the msgno member
for more information.
unsigned int day : 5; internal date day of month (1-31)
unsigned int month : 4; internal date month of year (1-12)
unsigned int year : 7; internal date year since BASEYEAR
(currently 1970; was 1969 in older
versions so use BASEYEAR instead of
having the base year wired in)
unsigned long user_flags; message user flags; this is a bit mask
which matches the entries in
stream->user_flags[]
unsigned long rfc822_size; size of message in octets
The following MESSAGECACHE values are only used internally by
drivers:
unsigned int sequence : 1; message is in sequence from either
mail_sequence() or mail_uid_sequence()
unsigned long data1; first data item
unsigned long data2; second data item
unsigned long data3; third data item
unsigned long data4; fourth data item
The ADDRESS structure is a parsed form of a linked list of RFC 822
addresses. It contains the following information:
char *personal; personal name phrase
char *adl; at-domain-list (also called "source
route")
char *mailbox; mailbox name
char *host; domain name of mailbox's host
char *error; error in address from smtp_mail(); if
an error is returned from smtp_mail()
for one of the recipient addresses
the SMTP server's error text for that
recipient can be found here. If it
is null then there was no error (or
an error was found with a prior
recipient
ADDRESS *next; pointer to next address in list
The ENVELOPE structure is a parsed form of the RFC 822 header.
Its member names correspond to the RFC 822 field names. It contains
the following information:
char *remail; remail header if any
ADDRESS *return_path; error return address
char *date; message composition date string
ADDRESS *from; from address list
ADDRESS *sender; sender address list
ADDRESS *reply_to; reply address list
char *subject; message subject string
ADDRESS *to; primary recipient list
ADDRESS *cc; secondary recipient list
ADDRESS *bcc; blind secondary recipient list
char *in_reply_to; replied message ID
char *message_id; message ID
char *newsgroups; USENET newsgroups
char *followup_to; USENET reply newsgroups
char *references; USENET references
The BODY structure is a parsed form of a linked list of the MIME
structure of a message. It contains the following information.
unsigned short type; body primary type code. This is an
index into the body_types vector of
body type names. The following body
types are pre-defined:
TYPETEXT unformatted text
TYPEMULTIPART multiple part
TYPEMESSAGE encapsulated message
TYPEAPPLICATION application data
TYPEAUDIO audio
TYPEIMAGE static image (GIF, JPEG, etc.)
TYPEVIDEO video
TYPEOTHER unknown
Additional types up to TYPEMAX are
dynamically defined if they are
encountered by c-client.
unsigned short encoding; body transfer encoding. This is an
index into the body_encodings vector
of body encoding names. The
following body encodings are
pre-defined:
ENC7BIT 7 bit SMTP semantic data
ENC8BIT 8 bit SMTP semantic data
ENCBINARY 8 bit binary data
ENCBASE64 base-64 encoded data
ENCQUOTEDPRINTABLE human-readable 8-as-7 bit data
ENCOTHER unknown
Additional encodings up to ENCMAX are
dynamically defined if they are
encountered by c-client.
char *subtype; body subtype string
PARAMETER *parameter; parameter list
char *id; body content identifier
char *description; body content description
unsigned char *contents.text; when composing a message that is NOT
of TYPEMULTIPART, non-binary text of
the content is stored here. Note that
this happens even when the text is
of TYPEMESSAGE. Text of encoding
ENC8BIT may be converted to
ENCQUOTEDPRINTABLE when it is sent.
This should not be referenced for any
other reason; in particular, this is
NOT the way for an application to
access content data (use
mail_fetchbody_full() instead).
BINARY *contents.binary; when composing a message that is NOT
of TYPEMULTIPART, binary content (of
encoding ENCBINARY) is stored here.
It will be converted to ENCBASE64 when
it is sent.
This should not be referenced for any
other reason; in particular, this is
NOT the way for an application to
access content data (use
mail_fetchbody_full() instead).
PART *contents.part; for body parts of TYPEMULTIPART, this
contains the list of body parts in
this multipart
MESSAGE contents.msg; for body parts of TYPEMESSAGE with
subtype "RFC822", this contains the
encapsulated message
unsigned long size.lines; size in lines
unsigned long size.bytes; size in octets. This MUST be set when
composing a message if the encoding is
ENC8BIT or ENCBINARY.
char *md5; body content MD5 checksum
The following BODY information is used only by c-client
internally. The use of this data is driver-specific and it can not be
relied-upon by applications.
unsigned char *contents.text; drivers can store a pointer to the
body contents as text here.
unsigned long size.ibytes; internal size of the body content (prior
to newline conversion, etc.) in octets
The MESSAGE structure is a parsed form of a MESSAGE/RFC822 MIME
body part. It contains the following information:
ENVELOPE *env; encapsulated message RFC 822 header
BODY *body; encapsulated message MIME structure
The following MESSAGE information is used only by c-client
internally. The use of this data is driver-specific and it can not be
relied-upon by applications.
char *hdr; encapsulated message header
unsigned long hdrsize; message header size
char *text; message in RFC 822 form
unsigned long offset; offset of text from header
The PARAMETER structure is a parsed form of a linked list of
attribute/value pairs. It contains the following information:
char *attribute; attribute name
char *value; value
PARAMETER *next; next parameter in list
The PART structure is a parsed form of a linked list of MIME body
parts. It contains the following information:
BODY body; body information for this part
PART *next; next body part
The following PART information is used only by c-client
internally. The use of this data is driver-specific and it can not be
relied-upon by applications.
unsigned long offset; offset from body origin
The NETMBX structure is a parsed form of a network mailbox name:
char host[NETMAXHOST]; remote host name
char user[NETMAXUSER]; remote user name if specified
char mailbox[NETMAXMBX]; remote mailbox name
char service[NETMAXSRV]; remote service name (IMAP4, NNTP, etc.)
unsigned long port; TCP/IP port number if specified
unsigned int anoflag : 1; anonymous access requested
unsigned int dbgflag : 1; protocol debugging telemetry, via
mm_dlog(), requested
The STRINGLIST structure is a list of strings (which may have
embedded NULs) and their lengths:
char *text; string text
unsigned long size; string length
STRINGLIST *next; next string in list
String Structures
A string structure is analogous to a char*, and is used in some
functions as an input argument. It represents a string of data in a
way that does not necessarily require the entire string to be in
memory at once. This is essential for small machines with
highly-restricted memory limits (e.g. DOS).
String Structure Access
To use a string structure, the caller needs to know a string
driver and needs to know the driver-dependent data used by that string
structure. A simple string driver is mail_string, a string driver
that takes an in-memory char* string as the driver-dependent data.
The DOS port uses string drivers that take a struct holding a file
descriptor and a file offset. Often the user of a string driver is
the same module that defined it, so usually the programmer knows about
its conventions.
The following calls are used to access a string structure:
void INIT (STRING *s,STRINGDRIVER *d,void *data,unsigned long size);
s pointer to the string structure to be initialized
d pointer to the string driver
data pointer to driver-dependent data, from which the
driver can determine string data
size size of the string
This call initializes the string stucture.
unsigned long SIZE (STRING *s);
s pointer to the string structure
This call returns the number of characters remaining in the string
after the current string character pointer.
char CHR (STRING *s);
s pointer to the string structure
This call returns the character at the current string character
pointer.
char SNX (STRING *s);
s pointer to the string structure
This call returns the character at the current string character
pointer, and increments the string character pointer.
unsigned long GETPOS (STRING *s);
s pointer to the string structure
This returns the value of the current string character pointer.
void SETPOS (STRING *s,unsigned long i);
s pointer to the string structure
i new string pointer value
This method sets the string character pointer to the given value.
String Structure Internals
A string structure holds the following data:
void *data; used by the string driver as it likes
unsigned long data1; used by the string driver as it likes
unsigned long size; static, holds the total length of the string
from the INIT call
char *chunk; current chunk of in-memory data; this is used
for buffering to avoid unnecessary calls to
the string driver's next method.
unsigned long chunksize; size of an in-memory data chunk
unsigned long offset; position of first character of the chunk in
the overall string
char *curpos; current position; this is what CHR() will
access
unsigned long cursize; number of characters remaining in the current
string
STRINGDRIVER *dtb; the string driver for this string structure
A string structure is manipulated by a string driver, which has
the following access methods:
void (*init) (STRING *s,void *data,unsigned long size);
s pointer to the string structure to be initialized
data pointer to driver-dependent data, from which the
driver can determine string data
size size of the string
This method initializes the string stucture. It can use the data,
data1, and chunksize values as it likes. The remaining values must be
set up as follows:
size static, copied from the size argument
chunk pointer to a buffer loaded with initial data
chunksize size of the buffer
offset 0
curpos copied from chunk
cursize copied from chunksize
dtb STRINGDRIVER identity pointer
char (*next) (STRING *s);
s pointer to the string structure
This method returns the character at the current string character
pointer, and increments the string character pointer. This method
is likely to call the setpos method if the desired character is not in
the current chunk.
void (*setpos) (STRING *s,unsigned long i);
s pointer to the string structure
i new string pointer value
This method sets the string character pointer to the given value. If
the pointer is not in the current chunk, then a new chunk is loaded
and the associated values (chunk, offset, curpos, cursize) are
adjusted accordingly.
c-client Support Functions
void mail_string_init (STRING *s,void *data,unsigned long size);
char mail_string_next (STRING *s);
void mail_string_setpos (STRING *s,unsigned long i);
These three functions are the init, next, and setpos string
structure access methods for the build-in mail_string string driver.
mail_string is a basic string driver for a char* string. See the
documentation below on "String Structures" for more information.
void mail_link (DRIVER *driver);
driver pointer to the driver to be added
This function adds the specified driver to the list of mailbox
drivers. Initially there are no drivers lunk, so all programs which
intend to use c-client need to have at least one call to this function.
A function which uses IMAP4 would have a statement such as:
mail_link (&imapdriver); /* link in IMAP driver */
early in the program's initialization. Normally, this is done by the
statement
#include "linkage.c"
which will include the "system standard driver linkage" defined when
c-client was built. By using linkage.c instead of explicit mail_link()
calls, you are guaranteed that you will have a consistant linkage among
all software built on this system.
void auth_link (AUTHENTICATOR *auth);
auth pointer to the authenticator to be added
This function adds the specified authenticator to the list of
authenticators. Initially there are no authenticators lunk. Normally,
this is done by linkage.c so you don't need to call this routine
explicitly.
void *mail_parameters (MAILSTREAM *stream,long function,void *value);
stream stream to poll or NIL
function function code
value new value for function codes that change a parameter
This function fetches or changes the settings of various c-client
operational parameters depending upon the function. If the stream is
specified, only the action for the underlying driver for that stream is
taken; however, the scope of the operational parameters is global so
there is generally no reason for the stream argument ever to be
non-NIL.
The function codes ENABLE_DRIVER and DISABLE_DRIVER take a driver
pointer as a value. These functions enable and disable mailbox
processing by that driver. By default, all drivers are enabled.
The remaining function codes are in a pair named GET_xxx to
fetch an operational parameter and SET_xxx to set the parameter:
GET_DRIVERS / SET_DRIVERS
The list of currently lunk drivers.
GET_GETS / SET_GETS
If non-NIL, points to a function for reading message text.
Defaults to NIL.
This function is called with three arguments; a function
pointer to a "reading function", a stream for the reading
function, and a size in octets. The reading function is
in turn called with the stream, a size in octets, and a
pointer to a readin buffer.
This function returns with a char* string, which will be
returned by the mail_fetchheader(), mail_fetchtext(), or
mail_fetchbody() function which triggered the message text
reading.
The purpose is to permit reading of large strings, without
requiring an in-memory buffer for the entire string. The idea
is that this function can store the data in some form other
than a char* (e.g. a temporary file) and the main program will
recognize that it should get the text from there instead of
from the results from mail_fetch....().
This is only supported on DOS and Win16; on other platforms it
is inconsistent whether or not it works.
GET_CACHE / SET_CACHE
Points to the c-client cache manager function. Defaults to
mm_cache().
GET_SMTPVERBOSE / SET_SMTPVERBOSE
If non-NIL, points to a function that accepts a char* string.
This function is called any time the SMTP routines receive a
response code less than 100. The argument is the text of the
response code
GET_RFC822OUTPUT / SET_RFC822OUTPUT
If non-NIL, points to an alternate rfc822_output() function.
rfc822_output() will call this function and return instead of
doing its normal action. See the description of
rfc822_output() for more information.
GET_USERNAME / SET_USERNAME
The logged-in user name.
GET_HOMEDIR / SET_HOMEDIR
The home directory path name.
GET_LOCALHOST / SET_LOCALHOST
The local host name.
GET_SYSINBOX / SET_SYSINBOX
The "system INBOX" (where mail is delivered) path name.
GET_OPENTIMEOUT / SET_OPENTIMEOUT
TCP/IP open timeout in seconds. Defaults to 0 (system
default timeout, usually 75 seconds on Unix).
GET_READTIMEOUT / SET_READTIMEOUT
TCP/IP read timeout in seconds. Defaults to 0 (no timeout).
GET_WRITETIMEOUT / SET_WRITETIMEOUT
TCP/IP write timeout in seconds. Defaults to 0 (no timeout).
GET_CLOSETIMEOUT / SET_CLOSETIMEOUT
TCP/IP close timeout in seconds. Defaults to 0 (no timeout).
GET_TIMEOUT / SET_TIMEOUT
If non-NIL, points to the function called when a TCP/IP
timeout occurs. This function is called with the number of
seconds since the start of the TCP operation. If it returns
non-zero, the TCP/IP operation is continued; if it returns
non-zero, the TCP/IP connection is aborted.
GET_RSHTIMEOUT / SET_RSHTIMEOUT
rsh connection timeout in seconds. Defaults to 15 seconds.
GET_MAXLOGINTRIALS / SET_MAXLOGINTRIALS
The maximum number of login attempts permitted in an IMAP or
POP connection. Defaults to 3.
GET_LOOKAHEAD / SET_LOOKAHEAD
The number of subsequent envelopes prefetched in IMAP when an
envelope is fetched. Defaults to 20.
GET_IMAPPORT / SET_IMAPPORT
The IMAP port number. Defaults to 143.
GET_PREFETCH / SET_PREFETCH
The number of envelopes prefetched in IMAP from the results
of a SEARCH. Defaults to 20.
GET_CLOSEONERROR / SET_CLOSEONERROR
If non-NIL, close an opening IMAP connection if the SELECT
command fails instead of returning a half-open stream.
Defaults to NIL.
GET_POP3PORT / SET_POP3PORT
The POP3 port number. Defaults to 110.
GET_UIDLOOKAHEAD / SET_UIDLOOKAHEAD
The number of UIDs premapped when a message number is
translated to a UID. Defaults to 1000.
GET_MBXPROTECTION / SET_MBXPROTECTION
Default file protection for newly created mailboxes.
Defaults to 0600.
GET_DIRPROTECTION / SET_DIRPROTECTION
Default file protection for newly created directories.
Defaults to 0700.
GET_LOCKPROTECTION / SET_LOCKPROTECTION
Default file protection for locks. Defaults to 0666.
WARNING: don't blithely change this. If other processes
can't get access to a lock then they will have trouble in
locking properly.
GET_FROMWIDGET / SET_FROMWIDGET
If non-NIL, APPEND in the Unix mbox format will insert a
">" character in front of all lines which begin with the
string "From ". If NIL, it will only do so if the entire
line looks like a message delimiter (that is, the date is
also in correct format). Defaults to T.
GET_NEWSACTIVE / SET_NEWSACTIVE
Netnews active file path name.
GET_NEWSSPOOL / SET_NEWSSPOOL
Netnews spool directory path name.
GET_NEWSRC / SET_NEWSRC
Netnews newsgroup reading status file (.newsrc) path name.
GET_EXTENSION / SET_EXTENSION
If non-NIL, points to a string holding the extension for all
mailbox files. This is only supported on DOS and Win16.
GET_DISABLEFCNTLLOCK / SET_DISABLEFCNTLLOCK
If non-NIL, disables fcntl() locking on SVR4. This is done
if fcntl() tends to hang for no good reason. Now that the
fcntl() code checks for NFS files and no-ops the locking,
this problem usually doesn't happen much any more. Defaults
to NIL.
GET_LOCKEACCESERROR / SET_LOCKEACCESERROR
If non-NIL, give a warning if an attempt to create a .lock
file gets an EACCES ("Permission denied") error. This usually
means that somebody protected the system inbox directory (e.g.
/var/mail) instead of making it public-write with the sticky
bit. Defaults to non-NIL, since this is usually bad news.
GET_LISTMAXLEVEL / SET_LISTMAXLEVEL
The maximum depth of recusion that LIST will go on a *
wildcard. Defaults to 20.
GET_ANONYMOUSHOME / SET_ANONYMOUSHOME
The anonymous use home directory name.
typedef long (*readfn_t) (void *stream,unsigned long size,char *buffer);
stream a designator suitable
size a number of octets to read
buffer a buffer of at least size octets for readin
This function reads the given number of octets into the buffer,
using the given stream. What sort of object the stream is depends upon
the function and its caller, so you must make sure that the readfn is
suitable for the caller's purpose. Common uses include support of the
mailgets function (see below) and of reading from local files on systems
with limited address space.
typedef char *(*mailgets_t) (readfn_t f,void *stream,unsigned long size);
f the readfn to use
stream stream argument for the readfn
size total number of octets to read
This is the argument to the SET_GETS mail_parameter() call. This
function must read size octets from the stream, using the readfn f. It
may call f multiple times to accomplish this; this will read the data in
a serial fashion. So, for example, if size is a megabyte and there is
only 4K of available buffer space, it can call f 256 times to satisfy
the request. There is no way to back up in the reading, so any
processing or saving of the data must be done when it is read.
The function mm_gets() in mail.c is a sample mailgets function; it
reads the first MAXMESSAGESIZE of data into memory and discards the
rest.
typedef void *(*mailcache_t) (MAILSTREAM *stream,unsigned long msgno,long op);
stream stream to cache manage
msgno message to cache manage in the stream
op cache management operation
This function manages the c-client cache. Normally, a program will
use the default c-client cache manager routine mm_cache(). However, a
main program may want to supply its own cache manager, e.g. it may want
to store the data on a disk file instead of in memory on DOS and Win16
where memory is tight.
If you write your own cache manager, you need to examine the
default mm_cache() manager closely, as well as paying close attention to
what goes into an elt (a MESSAGECACHE element). It is highly likely
that if you roll elts out to disk, you will want to set stream->scache
and *NOT* use long elts (because long elts have ENVELOPE and BODY
pointers that you would have to know how to write to disk and read back).
The cache management functions are one of the following:
CH_INIT Initialize the entire cache for the stream. This is
called only when creating a new stream or when freeing
it. The msgno argument is ignored.
CH_SIZE Make sure that the cache is at least large enough to
support msgno. This is a request to grow the cache if
necessary, not shrink it.
CH_MAKELELT Return a long elt for msgno, creating it if necessary.
This is the underlying support function for mail_lelt().
CH_LELT Return the long elt for msgno, or NIL if it does not
already exist.
CH_MAKEELT Return an elt for msgno, creating it if necessary.
This is the underlying support function for mail_elt().
CH_ELT Return the elt for msgno, or NIL if it does not already
exist.
CH_FREE Free the [l]elt for msgno.
CH_EXPUNGE Free the [l]elt for msgno, and reclaim its position.
All subsequent elts are renumbered with their elt->msgno
decremented by 1. [Hence msgno+1 becomes msgno, etc.]
This supports message expunging from the cache.
typedef long (*tcptimeout_t) (long time);
time total time spent since TCP operation started
This function is called when a TCP operation times out. It is set
by the SET_TIMEOUT mail_parameter(). The function can return non-zero
to continue the TCP operation (e.g. after outputting a "do you still
want to wait" prompt) or zero if it wants the TCP operation to abort and
close. If the TCP operation aborts, it will likely cause the upper
level IMAP, SMTP, etc. stream to abort and close as well.
DRIVER *mail_valid (MAILSTREAM *stream,char *mailbox,char *purpose);
stream if non-NIL, stream to use for validation
mailbox mailbox name to validate
purpose filled in as xxx in "Can't xxx" in error messages
This function validates the given mailbox name. It successful, it
returns the driver that can open that name if successful, otherwise it
returns NIL. If stream is non-NIL, the mailbox name must be valid for
the type of mailbox associated with that stream (e.g. an NNTP name can
not be used with an IMAP stream). If purpose is non-NIL, an error
message is passed via mm_log() when an error occurs.
DRIVER *mail_valid_net (char *name,DRIVER *drv,char *host,char *mailbox);
name mailbox name to validate
drv driver name to validate against
host buffer to return host name if non-NIL
mailbox buffer to return remote mailbox name if non-NIL
This function is an alternative to mail_valid_net_parse(). It
validates the given mailbox name as a network name and makes sure that
its service name is the same as the driver in drv. If successful, it
returns drv, and copies the host and mailbox strings as needed.
Otherwise it returns NIL.
long mail_valid_net_parse (char *name,NETMBX *mb);
name mailbox name to parse
mb pointer to NETMBX structure to return
This function parses a network mailbox name. If the name is a
network mailbox name, it returns non-NIL, with the NETMBX structure
loaded with the results form the parse.
Mailbox Access Functions
void mail_list (MAILSTREAM *stream,char *ref,char *pat);
void mail_scan (MAILSTREAM *stream,char *ref,char *pat,char *contents);
stream if non-NIL, stream to use
ref mailbox reference string
pat mailbox pattern string
contents contents to search
This function returns a list of mailboxes via the mm_list()
callback. The reference is applied to the pattern in an implementation
dependent fashion, and the resulting string is used to search for
matching mailbox names. "*" is a wildcard which matches zero or more
characters; "%" is a variant which does not descend a hierarchy level.
Read the IMAP specification for more information.
mail_scan() is a variant which takes a string to search for in the
text of the mailbox. The string is a free-text string, without regard
for message boundaries, and thus the choice of strings must be made
with care.
void mail_lsub (MAILSTREAM *stream,char *ref,char *pat);
stream if non-NIL, stream to use
ref mailbox reference string
pat mailbox pattern string
This function returns a list of subscribed mailboxes via the
mm_lsub() callback. The reference is applied to the pattern in an
implementation dependent fashion, and the resulting string is used to
search for matching mailbox names in the subscription list. "*" is a
wildcard which matches zero or more characters; "%" is a variant which
does not descend a hierarchy level. Read the IMAP specification for
more information.
long mail_subscribe (MAILSTREAM *stream,char *mailbox);
stream if non-NIL, stream to use
mailbox mailbox name
This function adds the given name to the subscription list. It
returns T if successful, NIL if unsuccessful. If unsuccessful, an
error message is returned via the mm_log() callback.
long mail_unsubscribe (MAILSTREAM *stream,char *mailbox);
stream if non-NIL, stream to use
mailbox mailbox name
This function removes the given name from the subscription list.
It returns T if successful, NIL if unsuccessful. If unsuccessful, an
error message is returned via the mm_log() callback.
long mail_create (MAILSTREAM *stream,char *mailbox);
stream if non-NIL, stream to use
mailbox mailbox name
This function creates a mailbox with the given name. It returns T
if successful, NIL if unsuccessful. If unsuccessful, an error message
is returned via the mm_log() callback.
It is an error to create INBOX or a mailbox name which already
exists.
long mail_delete (MAILSTREAM *stream,char *mailbox);
stream if non-NIL, stream to use
mailbox mailbox name
This function deletes the named mailbox. It returns T if
successful, NIL if unsuccessful. If unsuccessful, an error message is
returned via the mm_log() callback.
It is an error to delete INBOX or a mailbox name which does not
already exist.
long mail_rename (MAILSTREAM *stream,char *old,char *newname);
stream if non-NIL, stream to use
old existing mailbox name
newname new (not yet existing) mailbox name
This function renames the old mailbox to the new mailbox name.
It returns T if successful, NIL if unsuccessful. If unsuccessful, an
error message is returned via the mm_log() callback.
It is an error to reanme a mailbox that does not exist, or rename
a mailbox to a name that already exists. It is permitted to rename
INBOX; a new empty INBOX is created in its place.
long mail_status (MAILSTREAM *stream,char *mbx,long flags);
stream if non-NIL, stream to use
mbx mailbox name
flags option flags
This function returns the status of the given mailbox name via the
mm_status() callback. It returns T if successful, NIL if unsuccessful.
If unsuccessful, an error message is returned via the mm_log()
callback.
The options are a bit mask with one or more of the following,
indicating the data which should be returned.
SA_MESSAGES number of messages in the mailbox
SA_RECENT number of recent messages in the mailbox
SA_UNSEEN number of unseen messages in the mailbox
SA_UIDNEXT next UID value to be assigned
SA_UIDVALIDITY UID validity value
Note that, depending upon implementation, some of these values may
be more costly to get than others. For example, calculating the
number of unseen messages may require opening the mailbox and scanning
all of the message flags. A mail_status() call should thus be used
with option flags specifying only the data that is actually needed.
MAILSTREAM *mail_open (MAILSTREAM *oldstream,char *name,long options);
oldstream if non-NIL, stream to recycle
name mailbox name to open
options option flags.
This function opens the mailbox and if successful returns a stream
suitable for use by the other MAIL functions.
If oldstream is non-NIL, an attempt is made to reuse oldstream as
the stream for this mailbox; this is useful when you want to open
another mailbox to the same IMAP or NNTP server without having to open
a new connection. Doing this will close the previously open mailbox.
The options are a bit mask with one or more of the following:
OP_DEBUG Log IMAP protocol telemetry through mm_debug()
OP_READONLY Open mailbox read-only.
OP_ANONYMOUS Don't use or update a .newsrc file for news.
OP_SHORTCACHE Don't cache envelopes or body structures
OP_SILENT Don't pass mailbox events (internal use only)
OP_PROTOTYPE Return the "prototype stream" for the driver
associated with this mailbox instead of
opening the stream
OP_HALFOPEN For IMAP and NNTP names, open a connection
to the server but don't open a mailbox.
OP_EXPUNGE Silently expunge the oldstream before recycling
NIL is returned if this function fails for any reason.
MAILSTREAM *mail_close (MAILSTREAM *stream);
MAILSTREAM *mail_close_full (MAILSTREAM *stream,long options);
stream stream to close
options option flags
This function closes the MAIL stream and frees all resources
associated with it that it may have created (subject to any handles
existing).
The options for mail_close_full() are a bit mask with one or more
of the following:
CL_EXPUNGE Silently expunge before closing
This function always returns NIL, so it can be used as:
stream = mail_close (stream);
Handle Functions
Handles are used when an entity that wishes to access the stream
may survive the stream without knowing that it outlived it. For
example, an object reading a message may have a handle to a stream,
but the message selection object that spawned it (and which owns the
stream) may have gone away. A stream can be closed or recycled while
handles are pointing at it, but it is not completely freed until all
handles are gone. A stream may have an arbitrary number of handles.
MAILHANDLE *mail_makehandle (MAILSTREAM *stream);
stream stream to make handle to
This function creates and returns a handle to the stream.
void mail_free_handle (MAILHANDLE **handle);
handle pointer to handle to release
This function frees the handle and notifies the stream that it has
one fewer handle. If this is the last handle on the stream and the
stream has been closed, then the stream is freed.
MAILSTREAM *mail_stream (MAILHANDLE *handle);
handle handle to look up
This function returns the stream associated with the handle if and
only if the stream still represents the same MAIL connection associated
with the handle. Otherwise, NIL is returned (meaning that there is no
active stream associated with this handle).
Message Data Fetching Functions
[Note!! There is an important difference between a "sequence" and a
"msgno". A sequence is a string representing one or more messages in
IMAP4-style sequence format ("n", "n:m", or combination of these
delimited by commas), whereas a msgno is an int representing a single
message.]
void mail_fetchfast (MAILSTREAM *stream,char *sequence);
void mail_fetchfast_full (MAILSTREAM *stream,char *sequence,long flags);
stream stream to fetch on
sequence IMAP-format set of message sequence numbers
flags option flags
This function causes a cache load of all the "fast" information
(internal date, RFC 822 size, and flags) for the given sequence. Since
all this information is also fetched by mail_fetchstructure(), this
function is generally not used unless the OP_SHORTCACHE option in the
mail_open() call is used.
The options for mail_fetchfast_full() are a bit mask with one or
more of the following:
FT_UID The sequence argument contains UIDs instead of
sequence numbers
void mail_fetchflags (MAILSTREAM *stream,char *sequence);
void mail_fetchflags_full (MAILSTREAM *stream,char *sequence,long flags);
This function causes a fetch of the flags for the given sequence.
This main reason for using this function is to update the flags in the
local cache in case some other process changed the flags (multiple
simultaneous write access is allowed to the flags) as part of a "check
entire mailbox" (as opposed to "check for new messages") operation.
The options for mail_fetchflags_full() are a bit mask with one or more
of the following:
FT_UID The sequence argument contains UIDs instead of
sequence numbers
ENVELOPE *mail_fetchenvelope (MAILSTREAM *stream,unsigned long msgno);
ENVELOPE *mail_fetchstructure (MAILSTREAM *stream,unsigned long msgno,
BODY **body);
ENVELOPE *mail_fetchstructure_full (MAILSTREAM *stream,unsigned long msgno,
BODY **body,long flags);
stream stream to fetch on
msgno message sequence number
body pointer to where to return BODY structure if non-NIL
flags option flags
This function causes a fetch of all the structured information
(envelope, internal date, RFC 822 size, flags, and body structure) for
the given msgno and, in the case of IMAP, up to MAPLOOKAHEAD (a
parameter in IMAP2.H) subsequent messages which are not yet in the
cache. No fetch is done if the envelope for the given msgno is already
in the cache. The ENVELOPE and the BODY for this msgno is returned.
It is possible for the BODY to be NIL, in which case no information is
available about the structure of the message body.
The options for mail_fetchstructure_full() are a bit mask with one
or more of the following:
FT_UID The msgno argument is a UID
This is the primary function for fetching non-text information
about messages, and should be called before any attempt to reference
cache information about this message via mail_elt().
char *mail_fetchheader (MAILSTREAM *stream,unsigned long msgno);
char *mail_fetchheader_full (MAILSTREAM *stream,unsigned long msgno,
STRINGLIST *lines,unsigned long *len,long flags);
stream stream to fetch on
msgno message sequence number
lines list of header lines to fetch
len returned length in octets
flags option flags
This function causes a fetch of the complete, unfiltered RFC 822
format header of the specified message as a text string and returns
that text string.
If the lines argument is non-NIL, it contains a list of header
field names to use in subsetting the header text. Only those lines
which have that header field name are returned, unless FT_NOT is set in
which case only those lines which do not have that header field name
are returned.
If the len argument is non-NIL, it holds a pointer in which the
length of the string in octets is returned. This is useful in cases
where there may be an embedded null in the string.
This function always returns a valid string pointer; if no header
exists or if it can not be fetched (e.g. by a deceased IMAP stream) an
empty string is returned.
The options for mail_fetchheader_full() are a bit mask with one or
more of the following:
FT_UID The msgno argument is a UID
FT_NOT The returned header lines are those that are
not in the lines argument
FT_INTERNAL The return string is in "internal" format,
without any attempt to canonicalize to CRLF
newlines
FT_PREFETCHTEXT The RFC822.TEXT should be pre-fetched at the
same time. This avoids an extra RTT on an
IMAP connection if a full message text is
desired (e.g. in a "save to local file"
operation)
char *mail_fetchtext (MAILSTREAM *stream,unsigned long msgno);
char *mail_fetchtext_full (MAILSTREAM *stream,unsigned long msgno,
unsigned long *len,long flags);
stream stream to fetch on
msgno message sequence number
len returned length in octets
flags option flags
This function causes a fetch of the non-header text of the
specified message as a text string and returns that text string. No
attempt is made to segregate individual body parts.
If the len argument is non-NIL, it holds a pointer in which the
length of the string in octets is returned. This is useful in cases
where there may be an embedded null in the string.
This function always returns a valid string pointer; if no header
exists or if it can not be fetched (e.g. by a deceased IMAP stream) an
empty string is returned.
The options for mail_fetchtext_full() are a bit mask with one or
more of the following:
FT_UID The msgno argument is a UID
FT_PEEK Do not set the \Seen flag if it not already set
FT_INTERNAL The return string is in "internal" format,
without any attempt to canonicalize to CRLF
newlines
char *mail_fetchbody (MAILSTREAM *stream,unsigned long msgno,char *sec,
unsigned long *len);
char *mail_fetchbody_full (MAILSTREAM *stream,unsigned long msgno,char *sec,
unsigned long *len,long flags);
stream stream to fetch on
msgno message sequence number
sec section specifier
len returned length in octets
flags option flags
This function causes a fetch of the particular section of the
body of the specified message as a text string and returns that text
string. The section specification is a string of integers delimited by
period which index into a body part list as per the IMAP4
specification. Body parts are not decoded by this function; see
rfc822_base64() and rfc822_quotedprintable().
If the len argument is non-NIL, it holds a pointer in which the
length of the string in octets is returned. This is useful in cases
where there may be an embedded null in the string.
This function may return NIL on error.
The options for mail_fetchbody_full() are a bit mask with one or
more of the following:
FT_UID The msgno argument is a UID
FT_PEEK Do not set the \Seen flag if it not already set
FT_INTERNAL The return string is in "internal" format,
without any attempt to canonicalize to CRLF
newlines
unsigned long mail_uid (MAILSTREAM *stream,unsigned long msgno);
stream stream to fetch on
msgno message sequence number
This function returns the UID for the given message sequence
number.
void mail_fetchfrom (char *s,MAILSTREAM *stream,unsigned long msgno,
long length);
s destination string
stream stream to fetch on
msgno message sequence number
length maximum field length
This function writes a "from" string of the specified length for
the specified message, suitable for display to the user in a menu line,
into the string pointed to by s.
If the personal name of the first address in the envelope's from
item is non-NIL, it is used; otherwise a string is created by appending
the mailbox of the first address, an "@", and the host of the first
address. The string is trimmed or padded with trailing spaces as
necessary to make its length match the length argument.
void mail_fetchsubject (char *s,MAILSTREAM *stream,unsigned long msgno,
long length);
s destination string
stream stream to fetch on
msgno message sequence number
length maximum field length
This function returns a "subject" string of the specified length
for the specified message, suitable for display to the user in a menu
line.
The envelope's subject item is copied and trimmed as necessary
to make its length be no more what the caller requested. Unlike
mail_fetchfrom(), this function can return a string of shorter length
than what the caller requested.
LONGCACHE *mail_lelt (MAILSTREAM *stream,unsigned long msgno);
MESSAGECACHE *mail_elt (MAILSTREAM *stream,unsigned long msgno);
stream stream to access
msgno message sequence number
This function returns the cache entry for the specified message.
Although it will create a cache entry if it does not already exist,
that functionality is for internal use only. This function should
never be called without having first called mail_fetchfast() or
mail_fetchstructure() on the message first.
A cache entry holds the internal date/time, flags, and RFC 822
size of a message. It holds other data as well, but that is for
internal use only.
mail_lelt() is a variant that returns a `long' cache entry, which
consists of an cache entry (as a structure, not a pointer), an envelope
pointer, and a body pointer. This is used in conjunction with the elt
lock count functionality, to allow an application to associate the
cached envelope and body of a message with an open window even if the
message is subsequently expunged or if the stream is closed.
Unless your application wants to look at cached envelopes and
bodies even after the message is expunged or the stream is closed, it
should not use mail_lelt(). Instead, it should use a returned elt from
mail_elt() and use the elt->msgsno as the argument to
mail_fetchstructure().
BEWARE: the behavior of mail_lelt() is undefined if the
stream is open with OP_SHORTCACHE. mail_lelt() is extremely
special purpose, and should only be used in sophisticated
special purpose applications after discussing its use with
the c-client author. If you think you need this function,
you are probably mistaken. In almost all cases, you should
use mail_elt() and mail_fetchstructure() instead.
Message Status Manipulation Functions
void mail_setflag (MAILSTREAM *stream,char *sequence,char *flag);
void mail_setflag_full (MAILSTREAM *stream,char *sequence,char *flag,
long flags);
stream stream to use
sequence IMAP-format set of message sequence numbers
flag IMAP-format flag string
flags option flags
This function causes a store to add the specified flag to the flags
set for the messages in the specified sequence. If there is any
problem in setting flags, a message will be passed to the application
via the mm_log() facility.
The options for mail_setflag_full() are a bit mask with one or
more of the following:
ST_UID The sequence argument contains UIDs instead of
sequence numbers
ST_SILENT Do not update the local cache with the new
value of the flags. This is useful to save
network bandwidth, at the cost of invalidating
the cache.
void mail_clearflag (MAILSTREAM *stream,char *sequence,char *flag);
void mail_clearflag_full (MAILSTREAM *stream,char *sequence,char *flag,
long flags);
stream stream to use
sequence IMAP-format set of message sequence numbers
flag IMAP-format flag string
flags option flags
This function causes a store to delete the specified flag from the
flags set for the messages in the specified sequence. If there is any
problem in clearing flags, a message will be passed to the application
via the mm_log() facility.
The options for mail_setflag_full() are a bit mask with one or
more of the following:
ST_UID The sequence argument contains UIDs instead of
sequence numbers
ST_SILENT Do not update the local cache with the new
value of the flags. This is useful to save
network bandwidth, at the cost of invalidating
the cache.
Mailbox Searching
void mail_search (MAILSTREAM *stream,char *criteria);
void mail_search_full (MAILSTREAM *stream,char *charset,SEARCHPGM *pgm,
long flags);
stream stream to search
charset MIME character set to use when searching strings
pgm search program
flags option flags
This function causes a mailbox search, using the given MIME
charset (NIL means the default, US-ASCII) and the given search program.
A search program is a structure that holds the following data:
SEARCHSET *msgno; a set of message sequence numbers
SEARCHSET *uid; a set of unique identifiers
SEARCHOR *or; OR result of two search programs
SEARCHPGMLIST *not; AND result of list of NOT'ed search programs
SEARCHHEADER *header; message headers
STRINGLIST *bcc; string(s) appear in bcc list
STRINGLIST *body; string(s) appear in message body text
STRINGLIST *cc; string(s) appear in cc list
STRINGLIST *from; string(s) appear in from
STRINGLIST *keyword; user flag string(s) set
STRINGLIST *unkeyword; user flag strings() not set
STRINGLIST *subject; string(s) appear in subject
STRINGLIST *text; string(s) appear in message header or body
STRINGLIST *to; string(s) appear in to list
unsigned long larger; larger than this many octets
unsigned long smaller; smaller than this many octes
The following dates are in form:
((year - BASEYEAR) << 9) + (month << 5) + day
unsigned short sentbefore;
sent before this date
unsigned short senton; sent on this date
unsigned short sentsince;
sent since this date
unsigned short before; received before this date
unsigned short on; received on this date
unsigned short since; received since this date
unsigned int answered : 1;
message answered
unsigned int unanswered : 1;
message not answered
unsigned int deleted : 1;
message deleted
unsigned int undeleted : 1;
message not deleted
unsigned int draft : 1; message is a draft
unsigned int undraft : 1;
message is not a draft
unsigned int flagged : 1;
message flagged as urgent
unsigned int unflagged : 1;
message not flagged as urgent
unsigned int recent : 1;
message recent since last parse of mailbox
unsigned int old : 1; message not recent since last parse of mailbox
unsigned int seen : 1; message read
unsigned int unseen : 1;
message not read
The following auxillary structures are used by search programs:
SEARCHHEADER: header line searching
char *line; header line field name
char *text; text header line
SEARCHHEADER *next; next SEARCHHEADER in list (AND'ed)
SEARCHSET: message number set
unsigned long first; first number in set
unsigned long last; if non-zero, last number in set
SEARCHSET *next; next SEARCHSET in list (AND'ed)
SEARCHOR: two search programs, OR'ed together
SEARCHPGM *first; first program
SEARCHPGM *second; second program
SEARCHOR *next; next SEARCHOR in list
SEARCHPGMLIST: list of search programs
SEARCHPGM *pgm; search program (AND'd with others in list)
SEARCHPGMLIST *next; next SEARCHPGM in list
mail_search(), the older interface, accepts a search criteria
argument as a character string in IMAP2 (RFC-1176) format. Do not try
to use any IMAP4 search criteria with this interface.
The application's mm_searched() function is called for each
message that matches the search criteria. In addition, after the
search is completed, the "fast" information (see mail_fetchfast_full()
and envelopes of the searched messages are fetched (this is called
pre-fetching).
If there is any problem in searching, a message will be passed to
the application via the mm_log() facility.
The flags for mail_search_full() are a bit mask with one or more
of the following:
SE_UID Return UIDs instead of sequence numbers
SE_FREE Return the search program to free storage after
finishing
SE_NOPREFETCH Don't prefetch searched messages.
unsigned long *mail_sort (MAILSTREAM *stream,char *charset,SEARCHPGM *spg,
SORTPGM *pgm,long flags);
stream stream to sort
charset MIME character set to use when sorting strings
spg search program
pgm sort program
flags option flags
This function is a variant of mail_search_full(). It accepts an
additional argument, a sort program, which specifies one or more sort
rules to be applied to the result. If the searching and sorting are
successful, it returns a 0-terminated vector of message sequence
numbers (or UIDs if SE_UID is set). This vector is created out of
free storage, and must be freed with fs_give() when finished with it.
A sort program is a structure that holds the following data:
unsigned int reverse : 1;
reverse sorting of this key
short function; sort rule, one of the following:
SORTDATE message Date
SORTARRIVAL arrival date
SORTFROM mailbox in first From address
SORTSUBJECT message Subject
SORTTO mailbox in first To address
SORTCC mailbox in first cc address
SORTSIZE size of message in octets
SORTPGM *next; next sort program to be applied if two or more
messages collate identically with this rule
The flags for mail_search_full() are a bit mask with one or more
of the following:
SE_UID Return UIDs instead of sequence numbers
SE_FREE Return the search program to free storage after
finishing
SE_NOPREFETCH Don't prefetch searched messages.
SO_FREE Return the sort program to free storage after
finishing
Miscellaneous Mailbox and Message Functions
long mail_ping (MAILSTREAM *stream);
stream string to ping
The function pings the stream to see if it is still active. It may
discover new mail; this is the preferred method for a periodic "new mail
check" as well as a "keep alive" for servers which have an inactivity
timeout. It returns T if the stream is still alive, NIL otherwise.
If new mail is found, the application's mm_exists() function is
called with the newly-determined number of messages in the mailbox.
void mail_check (MAILSTREAM *stream);
stream stream to checkpoint
This function causes a mailstore-defined checkpoint of the
mailbox. This may include such things as a writeback to disk, a check
for flag changes in a shared mailbox, etc. It is not a "check for new
mail"; mail_ping() performs this function (as potentially does any other
function). The status of the check is passed to the application via the
mm_log() facility.
void mail_expunge (MAILSTREAM *stream);
stream string to expunge
This function causes an expunge (permanent removal of messages
which are marked as deleted) of the mailbox. The application's
mm_expunged() function is called for each message that has been
expunged. The application's mm_exists() function is called at the start
and end of the expunge to ensure synchronization. The status of the
expunge is passed to the application via the mm_log() facility.
Note that the decrementing of msgno's for subsequent messages
happens immediately; for example, if three consequtive messages starting
at msgno 5 are expunged, mm_expunged() will be called with a msgno of 5
three times.
long mail_copy (MAILSTREAM *stream,char *sequence,char *mailbox);
long mail_move (MAILSTREAM *stream,char *sequence,char *mailbox);
long mail_copy_full (MAILSTREAM *stream,char *sequence,char *mailbox,
long options);
stream stream to copy
sequence IMAP-format set of message numbers
mailbox destination mailbox name
options option flags
This function causes the messages in the specified sequence to be
copied to the specified mailbox. T is returned if the copy is
successful. mail_move() is equivalent to setting CP_MOVE in the options.
If there is any problem in copying, a message will be passed to
the application via the mm_log() facility and the function returns NIL.
No copying is actually done in this case.
Note that the mailbox must be on the same host as the stream and
is a mailbox of the type of the source mailbox only.
The flags for mail_search_full() are a bit mask with one or more
of the following:
CP_UID The sequence argument contains UIDs instead of
sequence numbers
CP_MOVE Delete the messages from the current mailbox
after copying to the destination.
long mail_append (MAILSTREAM *stream,char *mailbox,STRING *message);
long mail_append_full (MAILSTREAM *stream,char *mailbox,char *flags,char *date,
STRING *message);
stream stream to use if non-NIL (in the IMAP case)
mailbox destination mailbox name
flags flags to set on message if non-NIL
date internal date (received date) to set on message if non-NIL
message string structure of message to write
This function writes the message in the string structure to the
destination mailbox, along with the flags and date if specified. This
is useful in those cases where you can't use mail_copy(), e.g. when
copying from one server to another; you can always fetch the message
and then mail_append() it to the destination. It may also be useful
for maintaining an outbox of your outgoing mail.
void mail_gc (MAILSTREAM *stream,long gcflags);
stream stream to GC if non-NIL (else GC's all streams)
flags option flags
This function garbage collects (purges) the cache of entries of
a specific type. Some drivers do not allow purging of particular
cache types, and an attempt to do so is ignored.
The flags for mail_gc() are a bit mask with one or more of the
following:
GC_ELT message cache elements
GC_ENV ENVELOPEs and BODYs
GC_TEXTS cached texts
Date/Time Handling Functions
char *mail_date (char *string,MESSAGECACHE *elt);
string destination string
elt message cache element containing date
This function accepts a message cache element that contains date
information, and writes an IMAP-4 date string, that is, one in form:
dd-mmm-yyyy hh:mm:ss +zzzz
based upon the data in the elt. The destination string must be large
enough to hold this string.
char *mail_cdate (char *string,MESSAGECACHE *elt);
string destination string
elt message cache element containing date
This function accepts a message cache element that contains date
information, and writes a ctime() format date string, that is, one in
form:
www mmm dd hh:mm:ss yyyy\n
based upon the data in the elt. The destination string must be large
enough to hold this string.
long mail_parse_date (MESSAGECACHE *elt,char *string);
elt message cache element to store parsed date
string source date string
This function parses the date/time stored in the given string,
in format:
[www,] date [[hh:mm[:ss][-zzz| +zzzz]
where the date can be any of:
mm/dd/yy, mm/dd/yyyy, dd-mmm-yy, dd-mmm-yyyy, dd mmm yy, dd mmm yyyy
and stores the result of the parse in the elt. If the parse is
successful, T is returned, else NIL.
unsigned long mail_longdate (MESSAGECACHE *elt);
elt message cache element containing date.
This function accepts a message cache element that contains date
information, and returns the number of days since the base time of the
imap-4 toolkit. At present, this is the same as the Unix time() value
for that date/time, and hence can be used for functions such as utime().
Utility Functions
void mail_debug (MAILSTREAM *stream);
stream stream to debug
This function enables telemetry logging for this stream. All
telemetry is passed to the application via the mm_dlog() facility.
void mail_nodebug (MAILSTREAM *stream);
stream stream to disable debugging
This function disables telemetry logging for this stream.
long mail_sequence (MAILSTREAM *stream,char *sequence);
stream stream to set the sequence bits
sequence IMAP-format message set string
This function parses the given sequence string for message
numbers, sets the sequence bit in the stream's message cache element
of all messages in the sequence (and turns it off in all other message
cache elements). If the parse is successful, T is returned, else NIL.
long mail_uid_sequence (MAILSTREAM *stream,char *sequence);
stream stream to set the sequence bits
sequence IMAP-format message set string
This function parses the given sequence string for unique
identifiers, sets the sequence bit in the stream's message cache
element of all messages in the sequence (and turns it off in all other
message cache elements). If the parse is successful, T is returned,
else NIL.
long mail_parse_flags (MAILSTREAM *stream,char *flag,unsigned long *uf);
stream stream (used to get user flags)
flag IMAP-format flag string to parse
uf returned location of user flags
The function parses the given flag string, and returns the system
flags as its return value and the user flags in the location pointed
to by the uf argument. If there is an error in parse, a log message
is issued via mm_log() and this function returns NIL.
unsigned long mail_filter (char *text,unsigned long len,STRINGLIST *lines,
long flags);
text RFC 822 text to filter
len length in octets in the text argument
lines string list of header file names to filter
flags option flags
This function supports the header lines filtering function of
mail_fetchheader_full(). The lines argument contains a list of header
field names to use in subsetting the header text. Only those lines
which have that header field name are returned, unless FT_NOT is set
in which case only those lines which do not have that header field
name are returned.
The options for mail_filter() are a bit mask with one or more of
the following:
FT_NOT The returned header lines are those that are
not in the lines argument
long mail_search_msg (MAILSTREAM *stream,unsigned long msgno,char *charset,
SEARCHPGM *pgm);
stream stream to search
msgno message number of message to inspect
charset character set of search strings
pgm search program to test
This function implements mail_search_full() locally in cases when
it is not done by a server (e.g. local mail files, NNTP/POP). It
inspects the given message on that stream to see if it matches the
criteria or not. If it matches, T is returned, else NIL.
SEARCHPGM *mail_criteria (char *criteria);
criteria IMAP2-format search criteria string
This function accepts an IMAP2-format search criteria string and
parses it. If the parse is successful, it returns a search program
suitable for use in mail_search_full().
WARNING: This function does not accept IMAP4 search criteria.
The source string must be writeable (this restriction was also
in the old IMAP2 c-client).
Data Structure Instantiation/Destruction functions
These functions are used to obtain structures from free storage and
to release them.
ENVELOPE *mail_newenvelope (void);
ADDRESS *mail_newaddr (void);
BODY *mail_newbody (void);
BODY *mail_initbody (BODY *body);
PARAMETER *mail_newbody_parameter (void);
PART *mail_newbody_part (void);
STRINGLIST *mail_newstringlist (void);
SEARCHPGM *mail_newsearchpgm (void);
SEARCHHEADER *mail_newsearchheader (char *line);
SEARCHSET *mail_newsearchset (void);
SEARCHOR *mail_newsearchor (void);
SEARCHPGMLIST *mail_newsearchpgmlist (void);
SORTPGM *mail_newsortpgm (void);
These functions, all named mail_new...(), create a new structure of
the given type and initialize all of its elements to zero or empty.
void mail_free_body (BODY **body);
void mail_free_body_parameter (PARAMETER **parameter);
void mail_free_body_part (PART **part);
void mail_free_cache (MAILSTREAM *stream);
void mail_free_elt (MESSAGECACHE **elt);
void mail_free_lelt (LONGCACHE **lelt);
void mail_free_envelope (ENVELOPE **env);
void mail_free_address (ADDRESS **address);
void mail_free_stringlist (STRINGLIST **string);
void mail_free_searchpgm (SEARCHPGM **pgm);
void mail_free_searchheader (SEARCHHEADER **hdr);
void mail_free_searchset (SEARCHSET **set);
void mail_free_searchor (SEARCHOR **orl);
void mail_free_searchpgmlist (SEARCHPGMLIST **pgl);
void mail_free_sortpgm (SORTPGM **pgm);
These functions, all named mail_free_...(), take a pointer to a
structure pointer, free all contained strings and structures within the
structure, and finally free the structure itself and set its pointer to
NIL. For example, mail_free_envelope() frees all the ADDRESS structures
contained in the envelope.
Normally, mail_free_elt() and mail_free_lelt() are used only if the
main program has a private pointer to cache elements. If so, it is
expected to increment the cache element's lockcount when it makes a
private pointer, and to call this function when it is finished with it.
Authentication Functions
char *mail_auth (char *mechanism,authresponse_t resp,int argc,char *argv[]);
mechanism authentication mechanism name
resp callback function for providing responses
argc main() function argc value
argv main() function argv value
This server function searches the list of authenticators that was
established by auth_link() for an authenticator with the given name. If
an authenticator is found, authentication is initialized. The function
pointed to by resp is called as the authenticator requires responses.
AUTHENTICATOR *mail_lookup_auth (unsigned int i);
i position in authenticator list
This function returns the nth authenticator in the list, where n is
the value of it.
unsigned int mail_lookup_auth_name (char *mechanism);
mechanism authentication mechanism name
This function searches the list of authenticators for an
authenticator with the given name, and returns its position in the
authenticator list.
The functions below are provided by c-client client drivers or by
servers to support the protocol-dependent parts of authentication.
typedef void *(*authchallenge_t) (void *stream,unsigned long *len);
stream stream to read challenge
len pointer to returned length in octets
This driver function is called by an authenticator to read a
challenge from the given protocol stream in a protocol-dependent way.
It returns that challenge in binary and its length in octets to the
authenticator.
typedef long (*authrespond_t) (void *stream,char *s,unsigned long size);
stream stream to send response
s response string
size length of response string in octets
This driver function is called by an authenticator to send a
challenge response to the given stream in a protocol-dependent way.
It returns T if successful, NIL if failure.
typedef char *(*authresponse_t) (void *challenge,unsigned long clen,
unsigned long *rlen);
challenge challenge string
clen length of challenge string in octets
rlen pointer to returned length of response string
This server function is called with a challenge string of clen
octets. It sends, according to whatever protocol (IMAP, POP, etc.) it
uses, and returns the received response and response length in octets.
typedef long (*authclient_t) (authchallenge_t challenger,
authrespond_t responder,NETMBX *mb,void *s,
unsigned long trial);
challenger pointer to protocol-dependent challenge reader function
responder pointer to protocol-dependent response sender function
mb NETMBX struct of the mailbox desired to open
s stream for protocol-dependent routines to use
trial number of authentication attempts remaining
This client authenticator function negotiates reading challenges
and sending responses for a particular authenticator (Kerberos, etc.)
over the protocol, and returns T if authenticated or NIL if failed.
typedef char *(*authserver_t) (authresponse_t responder,int argc,char *argv[]);
responder pointer to protocol-dependent responder function
argc main() function argc value
argv main() function argv value
This server authenticator function negotiates sending challenges and
reading responses for a particular authenticator (Kerberos, etc.), and
returns either the authenticated user name or NIL if authentication
failed.
Network Access Functions
These functions provide a layer of indirection between the TCP
routines and upper level routines. This makes it possible to insert
additional code (e.g. privacy or checksum handling).
NETSTREAM *net_open (char *host,char *service,unsigned long port);
host host name
service contact service name
port contact port number
This function opens a TCP connection to the given host and service
or port.
NETSTREAM *net_aopen (NETMBX *mb,char *service,char *usrbuf);
NETMBX parsed mailbox specification
service stream to open (at present, only /etc/rimapd is used)
usrbuf buffer to return login user name
This function attempts to open a preauthenticated connection to the
given mailbox and service. It will return the login user name of the
preauthenticated connection, as well as an open network stream, if
successful.
char *net_getline (NETSTREAM *stream);
stream network stream to read
This routine reads a text line from the stream. It calls
stream->dtb->getline, which normally points to tcp_getline() but can be
set to some other function.
long net_getbuffer (void *stream,unsigned long size,char *buffer);
stream network stream to read
size length of data in octets
buffer buffer of at least size octets
This routine reads data from the stream. It calls
stream->dtb->getbuffer, which normally points to tcp_getbuffer() but can
be set to some other function.
long net_soutr (NETSTREAM *stream,char *string);
stream network stream to write
string null-terminated string to output
This routine writes a null-terminated string to the stream. It
calls stream->dtb->soutr, which normally points to tcp_soutr() but can
be set to some other function.
long net_sout (NETSTREAM *stream,char *string,unsigned long size);
stream network stream to write
string string to output
size length of string in octets
This routine writes a string of length size to the stream. It
calls stream->dtb->sout, which normally points to tcp_sout() but can be
set to some other function.
void net_close (NETSTREAM *stream);
stream stream to close
This routine closes the stream. It calls stream->dtb->close, which
normally points to tcp_close() but can point to some other function.
char *net_host (NETSTREAM *stream);
stream stream to inspect
This routine returns the remote host name of the stream. It calls
stream->dtb->host, which normally points to tcp_host() but can point
to some other function.
unsigned long net_port (NETSTREAM *stream);
stream stream to inspect
This routine returns the remote port number of the stream. It calls
stream->dtb->port, which normally points to tcp_port() but can point
to some other function.
char *net_localhost (NETSTREAM *stream);
stream stream to inspect
This routine returns the local host name of the stream. It calls
stream->dtb->localhost, which normally points to tcp_localhost() but can
point to some other function.
Subscription Management Functions
long sm_subscribe (char *mailbox);
mailbox mailbox name to subscribe
This function adds the given mailbox name to the local subscription
list, and returns T if successful, NIL if failure.
long sm_unsubscribe (char *mailbox);
mailbox mailbox name to unsubscribe
This function removes the given mailbox name from the local
subscription list, and returns T if successful, NIL if failure.
char *sm_read (void **sdb);
sdb data to use in subsequent calls, or NIL if first call
This function returns the local subscription list as null
terminated strings. Each call returns the next element in the list.
The first call should be with sdb pointing to a NIL pointer; this will
be filled in for subsequent calls. At the last call, NIL will be
returned.
Miscellaneous Utility Functions
char *ucase (char *string);
string string to convert
This function converts each lowercase character of the specified
string to uppercase and returns the string.
char *lcase (char *string);
string string to convert
This function converts each uppercase character of the specified
string to lowercase and returns the string.
char *cpystr (char *string);
string string to copy
This function makes a copy of the string from free storage and returns
the copy.
long find_rightmost_bit (long *valptr);
valptr pointer to value to search
This function returns -1 if the 32-bit value pointed to by valptr
is non-zero, otherwise it returns the bit number (0 = LSB, 31 = MSB) of
the right-most bit in that value. This is used to convert from the bits
in the cache's userflags item to an index into the stream's userFlags
array of flag texts.
long min (long i,long j);
i first argument
j second argument
This function returns the minimum of the two integers.
long max (long i,long j);
i first argument
j second argument
This function returns the maximum of the two integers.
long search (char *s,long c,char *pat,long patc);
s string to search
c size of string
pat pattern to search in string
patc size of pattern
This function does a fast case-independent search for the given
pattern in pat (length patc) in base string s, and returns T if the
pattern is found in the string.
long pmatch (char *s,char *pat,delim);
long pmatch_full (char *s,char *pat,delim);
s string to match
pat wildcard (* and %) to match in pattern
delim hierarchy delimiter
This function returns T if the given wildcard pattern matches the
string in s with hierarchy delimiter delim. Otherwise NIL is returned.
long dmatch (char *s,char *pat,char delim);
s string to match
pat wildcard (* and %) to match in pattern
delim hierarchy delimiter
This function returns T if the given wildcard pattern matches the
directory. If not, then none of the elements in the directory are
considered for recursive checking with pmatch_full().
SMTP Functions
SMTPSTREAM *smtp_open (char **hostlist,long debug);
hostlist vector of SMTP server host names to try
debug non-zero if want protocol telemetry debugging
This function opens an SMTP connection to a one of the hosts in the
host list and if successful returns a stream suitable for use by the
other SMTP functions. The hosts are tried in order until a connection is
successfully opened. If debug is non-NIL, protocol telemetry is logged
via mm_dlog(). NIL is returned if this function fails to open a
connection to any of the hosts in the list.
void smtp_close (SMTPSTREAM *stream);
stream stream to close
This function closes the SMTP stream and frees all resources
associated with it that it may have created.
long smtp_mail (SMTPSTREAM *stream,char *type,ENVELOPE *msg,BODY *body);
stream stream to transmit mail
type mail type (MAIL, SEND, SAML, SOML)
msg message envelope
body message body
This function negotiates an SMTP transaction of the specified type
(one of "MAIL", "SEND", "SAML", or "SOML") to deliver the specified
message. This function returns T if success or NIL if there is any
failure. The text reason for the failure is in stream->reply item; if
it is associated with a recipient it is also in that address'
address->error item.
void smtp_debug (SMTPSTREAM *stream);
stream stream to enable debugging telemetry
This function enables SMTP protocol telemetry logging for this
stream. All SMTP protocol operations are passed to the application via
the mm_dlog() facility.
void smtp_nodebug (SMTPSTREAM *stream);
stream stream to disable debugging telemetry
This function disables SMTP protocol telemetry logging for this
stream.
typedef void (*smtpverbose_t) (char *buffer);
buffer pointer to verbose reply buffer
This is the argument to the SET_SMTPVERBOSE mail_parmameter() call.
If this function pointer is non-NIL, then if a verbose SMTP response
(with SMTP code less than 100) is received, this function is called with
that response text as its argument.
NNTP Functions
NNTPSTREAM *nntp_open (char **hostlist,long debug);
hostlist vector of NNTP server host names to try
debug non-zero if want protocol telemetry debugging
This function opens an NNTP connection to a one of the hosts in the
host list and if successful returns a stream suitable for use by the
other MTP functions. The hosts are tried in order until a connection is
successfully opened. If debug is non-NIL, protocol telemetry is logged
via mm_dlog(). NIL is returned if this function fails to open a
connection to any of the hosts in the list.
void nntp_close (NNTPSTREAM *stream);
stream stream to close
This function closes the NNTP stream and frees all resources
associated with it that it may have created.
long nntp_mail (NNTPSTREAM *stream,ENVELOPE *msg,BODY *body);
stream stream to transmit mail
msg message envelope
body message body
This function negotiates an NNTP posting transaction to deliver
the specified news message. This function returns T if success or NIL
if there is any failure. The text reason for the failure is in
stream->reply item; if it is associated with a recipient it is also in
that address' address->error item.
RFC 822 Support Functions
Although rfc822.c contains several additional functions besides
these, only the functions documented here should be used by
applications. The other functions are for internal use only.
void rfc822_header (char *header,ENVELOPE *env,BODY *body);
header buffer to write RFC 822 header
env message ENVELOPE (used to obtain RFC 822 information)
body message BODY (used to obtain MIME information)
This function writes an RFC 822 format header into header based
on the information in the envelope and body. The header buffer must
be large enough to contain the full text of the resulting header.
void rfc822_write_address (char *dest,ADDRESS *adr);
dest buffer to write address list
adr RFC 822 ADDRESS list
This function writes an RFC 822 format address list into dest
based on the information in adr. The dest buffer must be large enough
to contain the full text of the resulting address list.
void rfc822_parse_msg (ENVELOPE **en,BODY **bdy,char *s,unsigned long i,
STRING *b,char *host,char *tmp);
en destination pointer where message ENVELOPE will be stored
bdy destination pointer where message BODY will be stored
s RFC 822 header to parse (character string)
i length of RFC 822 header
b stringstruct of message body
host default host name if an address lacks an @host.
temp scratch buffer, must be long enough to hold unwound
header lines (a buffer that is i octets long is OK)
This function parses the RFC 822 header pointed to by s with body
pointed to by string structure b into the specified destination
envelope and body pointers, using host as the default host name and
tmp as a scratch buffer. New ENVELOPE and BODY structures are
created; when finished with them the application must free them with
mail_free_envelope() and mail_free_body(). Any parsing errors are
noted via the mm_log() mechanism using log type PARSE.
void rfc822_parse_adrlist (ADDRESS **lst,char *string,char *host);
lst destination pointer where ADDRESS will be stored
string string of addresses to parse
host default host name if an address lacks an @host.
This function parses the address list in the given string into an
address list in lst. Any addresses missing a host name are have the
host name defaulted from the host argument. If the destination list
is non-empty it appends the new addresses to the list. Any parsing
errors are noted via the mm_log() mechanism using log type PARSE.
long rfc822_output (char *t,ENVELOPE *env,BODY *body,soutr_t f,void *s,
long ok8bit);
t scratch buffer, large enough to hold message header
env message ENVELOPE
body message BODY
f I/O function to write to
s stream for I/O function f
ok8bit non-zero if OK to output 8-bit data
This function writes the message described with the given
envelope and body. Any body part contents of type ENCBINARY is
converted to ENCBASE64 before sending. If ok8bit is NIL, any message
data of type ENC8BIT is converted to ENCQUOTEDPRINTABLE before
sending; if ok8bit is non-NIL then ENC8BIT data is sent as-is. T is
returned if the function succeeds, else NIL is returned.
The function f is typically net_soutr(), but it can be any
function which matches
typedef long (*soutr_t) (void *stream,char *string);
where stream holds sufficient information to enable the output routine
to know where to output to, and the string is a null-terminated string
to output. This function returns either T or NIL, and that value is
passed up to rfc822_output() for its return.
void *rfc822_base64 (char *src,unsigned long srcl,unsigned long *len);
src source string
srcl size of source string in octets
len pointer to where destination string length in octets
will be returned
This function decodes a BASE64 body part given a source string
and its length. The decoded body part as a sequence of binary octets
is returned, and its length is returned in len.
char *rfc822_qprint (char *src,unsigned long srcl,unsigned long *len);
src source string
srcl size of source string in octets
len pointer to where destination string length in octets
will be returned
This function decodes a QUOTED-PRINTABLE body part given a source
string and its length. The decoded body part as an 8-bit character
string is returned, and its length is returned in len.
Operating System-Dependent Public Interface
These functions are in OS-dependent code, and are rewritten each
time c-client is ported to a new operating system.
void rfc822_date (char *date);
date buffer to write the date, must be large enough
This function is called to get the current date and time in an
RFC 822 format string into the given buffer.
void *fs_get (size_t size);
size number of octets requested
This function allocates and returns a block of free storage of
the specified size. Unlike malloc(), there is no failure return; this
function must return with the requested storage.
void fs_resize (void **block,size_t size);
block pointer to pointer to block to be resized
size new size in octets
This function resizes the free storage block, updating the
pointer if necessary. Unlike realloc(), there is no failure return;
this function must return with the requested storage.
void fs_give (void **block);
block pointer to pointer to block to free
This function releases a block of free storage allocated by
fs_get(). It also erases the block pointer, so it isn't necessary to
do this in the application.
void fatal (char *string);
string message string
This function is called when an "impossible" error is detected
and the client wishes to crash. The string should contain a reason.
char *strcrlfcpy (char **dst,long *dstl,char *src,long srcl);
dst pointer to destination string pointer
dstl pointer to destination string size
src source strin
srcl source string size
This function is called to copy into a destination string dst of
size dstl (resized if necessary), a CRLF newline form string from
local format string src of size srcl.
TCPSTREAM *tcp_open (char *host,long port);
TCPSTREAM *tcp_aopen (char *host,char *service);
char *tcp_getline (TCPSTREAM *stream);
long tcp_getbuffer (TCPSTREAM *stream,long size,char *buffer);
long tcp_soutr (TCPSTREAM *stream,char *string);
void tcp_close (TCPSTREAM *stream);
char *tcp_host (TCPSTREAM *stream);
unsigned long tcp_port (TCPSTREAM *stream);
char *tcp_localhost (TCPSTREAM *stream);
These functions are TCP-specific versions of the more general
net_xxx() functions. These should not be called directly by
applications.
char *tcp_clienthost (char *dst);
dst destination string buffer
This function should be called only by a server called by inetd
or similar mechanism which maps standard input to a network socket.
It returns the host name of the other end (e.g. the client of a
server) using the given string buffer, or NIL if it can't get this
information.
Main Program Callbacks
All applications which use the c-client must have the following
callbacks to handle events from c-client. Note that in any callback
which involves a mail stream, the stream is locked and you can not
recursively call c-client from the callback. This may also be true in
callbacks which do not have a stream; in general, the rule is "do not
call c-client, especially any mail_xxx() function, from a c-client
callback".
void mm_flags (MAILSTREAM *stream,unsigned long number);
stream stream where event happened
number message number
This function is called when c-client manipulates the flags for
the given message number. This alerts the application that it may
need to inspect that message's flags to see if there are any
interesting changes.
void mm_status (MAILSTREAM *stream,char *mailbox,MAILSTATUS *status);
stream stream where event happened
mailbox mailbox name for this status
status MAILSTATUS structure with message status
This function is called when c-client reports status of a mailbox
(generally as the result of a mail_status() function call). The
returned MAILSTATUS structure has the following members:
long flags; validity flags. These are the same as
the SA_xxx option flags in the
mail_status() call, and they indicate
which of the other members of the
MAILSTATUS structure have usable data
(i.e. if SA_MESSAGES is not set, do
not believe status->messages!!).
unsigned long messages; number of messages if SA_MESSAGES
unsigned long recent; number of recent messages if SA_RECENT
unsigned long unseen; number of unseen messages if SA_UNSEEN
unsigned long uidnext; next UID to be assigned if SA_UIDNEXT
unsigned long uidvalidity; UID validity value if SA_UIDVALIDITY
void mm_searched (MAILSTREAM *stream,unsigned long number);
stream stream where event happened
number message number
This function is called to notify the main program that this
message number matches a search (generally as the result of a
mail_search_full() function call).
void mm_exists (MAILSTREAM *stream,unsigned long number);
stream stream where event happened
number message number
This function is called to notify the main program that there are
this many messages in the mailbox. It is also used to notify the main
program of new mail, by announcing a higher number than the main
program was previously aware.
void mm_expunged (MAILSTREAM *stream,unsigned long number);
stream stream where event happened
number message number
This function is called to notify the main program that this
message number has been expunged from the mail file and that all
subsequent messages are now referenced by a message number one less
than before. This implicitly decrements the number of messages in the
mailbox.
void mm_list (MAILSTREAM *stream,char delim,char *name,long attrib);
stream stream where event happened
delim hierarchy delimiter
name mailbox name
attrib mailbox attributes
This function is called to notify the main program that this
mailbox name matches a mailbox listing request (generally as the
result of a mail_list() function call). The hierarchy delimiter is a
character that separates out levels of hierarchy in mailbox names.
The attributes are a bit mask with one of the following:
LATT_NOINFERIORS
it is not possible for there to be any
hierarchy inferiors to this name (that is,
this name followed by the hierarchy delimiter
and additional name characters).
LATT_NOSELECT this is not a mailbox name, just a hierarchy
level, and it may not be opened by mail_open()
LATT_MARKED this mailbox may have recent messages
LATT_UNMARKED this mailbox does not have any recent messages
void mm_lsub (MAILSTREAM *stream,char delim,char *name,long attrib);
stream stream where event happened
delim hierarchy delimiter
name mailbox name
attrib mailbox attributes
This function is called to notify the main program that this
mailbox name matches a subscribed mailbox listing request (generally
as the result of a mail_lsub() function call). The hierarchy
delimiter is a character that separates out levels of hierarchy in
mailbox names. The attributes are a bit mask with one of the
following:
LATT_NOINFERIORS
it is not possible for there to be any
hierarchy inferiors to this name (that is,
this name followed by the hierarchy delimiter
and additional name characters).
LATT_NOSELECT this is not a mailbox name, just a hierarchy
level, and it may not be opened by mail_open()
LATT_MARKED this mailbox may have recent messages
LATT_UNMARKED this mailbox does not have any recent messages
void mm_notify (MAILSTREAM *stream,char *string,long errflg);
stream stream where event happened
string message string
errflg message error level
This function is called to deliver a stream-oriented message
event. This is the mechanism by which any IMAP response codes for any
application (e.g. TRYCREATE) are delivered to the application.
No newline is included in the string, so this function has to output
its own.
The message error level is one of the following:
NIL normal operation. The text is `babble' that may be
interesting to the user, e.g. the greeting message
from a server.
WARN A warning event. This event should be displayed to
the user. Examples: a mailbox rewrite failed because
of disk full, but the previous mailbox contents were
recovered.
ERROR An error event. This event should be displayed to
the user, or at least logged someplace. This type of
error shouldn't happen, and so should be called to the
attention of support staff. Whatever happened has
probably disrupted the user's work. Examples: an
untagged BAD from an IMAP server.
void mm_log (char *string,long errflg);
string message string
errflg message error level
This function is called to deliver a log message. No newline is
included in the string, so this function has to output its own. In
general, it is intended that these messages are logged someplace, and
possibly shown to the user.
The message error level is one of the following:
NIL normal operation. The text is `babble' that may be
interesting to the user, e.g. "Expunged 3 messages".
PARSE An RFC 822 parsing error. Since bogus headers are
all-too-common in the real world, these can often be
ignored on the "garbage in, garbage out" princple.
However, since surprising results can be yielded when
trying to parse garbage, this message should be logged
somewhere so it can be figured out what happened.
WARN A warning event. This event should be displayed to
the user. It occurs when an error condition has
happened, but c-client knows what to do to recover.
Examples: "Can't open read-write, so opening
read-only", "Empty mailbox", "Login failed, try
again", "Waiting for mailbox to become unlocked",
"IMAP protocol error". Although a user should be
told about a warning, it's generally not necessary
to interrupt the flow of her work (e.g. it's alright
to display the warning in a scrolling window, but
not necessary to require the user to do anything).
ERROR An error event. This event should be displayed to
the user, or at least logged someplace. This is a
serious error condition occured that aborted the
requested operation and possibly also aborted the mail
stream. This ranges from normal error conditions such
as "Can't open mailbox", "too many login failures, go
away" to bizarre conditions such as "Apparent new mail
appeared in the mailbox that doesn't look like mail,
program aborting". Errors must be called to the
user's attention, and probably should require some
sort of acknowledgement (e.g. answering a modal panel)
before the application proceeds.
void mm_dlog (char *string);
string message string
This function is called to deliver a debugging telemetry
message. No newline is included in the string, so this function has
to output its own. This is called only when debugging is enabled.
void mm_login (NETMBX *mb,char *user,char *pwd,long trial);
mb parsed mailbox specification
user pointer to where to return user name
pwd pointer to where to return password
trial number of prior login attempts
This function is called to get a user name and password for the
given network mailbox. It stores the user name and password in the
strings pointed to by the appropriate arguments. The trial argument
is the number of attempts to perform the login and is initially zero
(e.g. for a default username and password login functionality). It is
incremented for each subsequent trial until the maximum number of
trials are made.
void mm_critical (MAILSTREAM *stream);
stream stream where event happened
This function is called to alert the application that c-client
is about to run some critical code on that stream that may result in a
clobbered mail file if it is interrupted. It may be desirable to
disable CTRL/C, etc. during this time.
void mm_nocritical (MAILSTREAM *stream);
stream stream where event happened
This function is called to alert the application that c-client
is no longer running critical code on that stream that may result in a
clobbered mail file if it is interrupted.
long mm_diskerror (MAILSTREAM *stream,long errcode,long serious);
stream stream where event happened
errcode OS error code for disk error
serious non-zero if c-client can not undo the operation (and
thus must retry to avoid mail file damage)
This function is called to alert the application that the
c-client has encountered an unrecoverable write error when trying to
update the mail file. errcode contains the system error code. If
serious is non-zero, then it is probable that the disk copy of the
mailbox has been damaged.
The return value from this function is the abort flag; if serious
is zero and the abort flag is non-zero, the operation is aborted. If
the abort flag is zero or if serious was non-zero, a return from this
function will retry the failing operation.
void mm_fatal (char *string);
string message string
This function is called from the fatal() routine in the
operating system code to notify the main program that it is about to
crash. The string contains a reason. At the very minimum, the main
program should do something like
mm_log (string,ERROR);
and then return. No newline is included in the string, so this
function has to output its own.
Driver interface
When writing a new driver for the c-client, you must provide a
DRIVER stucture giving a dispatch vector between MAIL and the driver.
The DRIVER dispatch vector is described in mail.h.
char *name;
Name by which the driver is known to c-client.
unsigned long flags;
Attribute flags for this driver:
DR_DISABLE This driver is currently disabled.
DR_LOCAL This driver deals with local mailboxes; if
this is off it deals with mailboxes over a
network.
DR_MAIL This driver supports e-mail messages.
DR_NEWS This driver supports netnews messages
DR_READONLY This driver only allows read-only access;
mail_setflag(), mail_expunge(), etc. are
no-ops.
DR_NOFAST This driver does not implement mail_fetchfast()
in a fast way (e.g. it may have to fetch the
entire message text over a network to
calculate sizes).
DR_NAMESPACE This driver accepts and uses namespace format
names.
DR_LOWMEM This driver is designed for systems with very
limited amounts of memory (e.g. DOS) and
support routines called by this driver should
try not to use much memory.
DRIVER *next;
Pointer to the next driver which this application supports (or NIL if
this is the last driver). Drivers are lunk together via the mail_link()
function.
DRIVER *driver_valid (char *mailbox);
This function returns a pointer to the driver's DRIVER dispatch
vector iff this driver accepts the given name as a valid mailbox for this
driver. Otherwise, it returns the value of the next driver's
driver_valid() or NIL if there is no next driver. In other words, calling
driver_valid() for the first driver will return the driver dispatch vector
for the driver which supports this type of mailbox.
void *driver_parameters (long function,void *value);
This function implements mail_parameters() for this driver.
void driver_scan (MAILSTREAM *stream,char *ref,char *pat,char *contents);
This function implements mail_scan() for this driver.
void driver_list (MAILSTREAM *stream,char *ref,char *pat);
This function implements mail_list() for this driver.
void driver_lsub (MAILSTREAM *stream,char *ref,char *pat);
This function implements mail_lsub() for this driver.
long driver_subscribe (MAILSTREAM *stream,char *mailbox);
This function implements mail_subscribe() for this driver.
long driver_unsubscribe (MAILSTREAM *stream,char *mailbox);
This function implements mail_unsubscribe() for this driver.
long driver_create (MAILSTREAM *stream,char *mailbox);
This function implements mail_create() for this driver.
long driver_delete (MAILSTREAM *stream,char *mailbox);
This function implements mail_delete() for this driver.
long driver_rename (MAILSTREAM *stream,char *old,char *new);
This function implements mail_rename() for this driver.
long driver_status (MAILSTREAM *stream,char *mailbox,long flags);
This function implements mail_status() for this driver.
MAILSTREAM *driver_open (MAILSTREAM *stream);
This function opens the mailbox identified by the given stream. It
may use the data on the stream and create additional data on stream->local
as necessary. It should return the given stream unless it failed to open
the mailbox, in which case it should return NIL.
void driver_close (MAILSTREAM *stream,long options);
This function implements mail_close() for this driver.
void driver_fetchfast (MAILSTREAM *stream,char *sequence,long flags);
This function implements mail_fetchfast() for this driver.
void driver_fetchflags (MAILSTREAM *stream,char *sequence,long flags);
This function implements mail_fetchflags() for this driver.
ENVELOPE *driver_fetchstructure (MAILSTREAM *stream,unsigned long msgno,
BODY **body,long flags);
This function implements mail_fetchstructure() for this driver.
char *driver_fetchheader (MAILSTREAM *stream,unsigned long msgno,
STRINGLIST *lines,unsigned long *len,long flags);
This function implements mail_fetchheader() for this driver.
char *driver_fetchtext (MAILSTREAM *stream,unsigned long msgno,
unsigned long *len,long flags);
This function implements mail_fetchtext() for this driver.
char *driver_fetchbody (MAILSTREAM *stream,unsigned long msgno,char *section,
unsigned long *len,long flags);
This function implements mail_fetchbody() for this driver.
void driver_setflag (MAILSTREAM *stream,char *sequence,char *flag,long flags);
This function implements mail_setflag() for this driver.
void driver_clearflag (MAILSTREAM *stream,char *sequence,char *flag,
long flags);
This function implements mail_clearflag() for this driver.
void driver_search (MAILSTREAM *stream,char *charset,SEARCHPGM *pgm,
long flags);
This function implements mail_search() for this driver.
unsigned long *driver_sort (MAILSTREAM *stream,char *charset,SEARCHPGM *spg,
SORTPGM *pgm,long flags);
This function implements mail_sort() for this driver.
void *driver_thread (MAILSTREAM *stream,char *seq,long function,long flag);
This dispatch is reserved for a future threading capability.
long driver_ping (MAILSTREAM *stream);
This function implements mail_ping() for this driver.
void driver_check (MAILSTREAM *stream);
This function implements mail_check() for this driver.
void driver_expunge (MAILSTREAM *stream);
This function implements mail_expunge() for this driver.
long driver_copy (MAILSTREAM *stream,char *sequence,char *mailbox,
long options);
This function implements mail_copy() for this driver.
long driver_append (MAILSTREAM *stream,char *mailbox,char *flags,char *date,
STRING *message);
This function implements mail_append() for this driver.
void driver_gc (MAILSTREAM *stream,long gcflags);
This function implements mail_gc() for this driver.
Driver Support Functions
void mail_searched (MAILSTREAM *stream,unsigned long msgno);
stream stream where event happened
msgno message number
This function is called by the driver to notify c-client that this
message number matches a search. It invokes the main program's
mm_searched() function.
void mail_exists (MAILSTREAM *stream,unsigned long nmsgs);
stream stream where event happened
nmsgs number of messages
This function is called by the driver to notify c-client that this
message number exists (i.e. there are this many messages in the mailbox).
It invokes the main program's mm_exists() function.
void mail_recent (MAILSTREAM *stream,unsigned long recent);
stream stream where event happened
recent number of messages
This function is called by the driver to notify c-client that this
many messages are "recent" (i.e. arrived in the mailbox since the previous
time the mailbox was opened).
void mail_expunged (MAILSTREAM *stream,unsigned long msgno);
stream stream where event happened
msgno number of messages
This function is called by the driver to notify MAIL that this
message number has been expunged from the mail file and that all subsequent
messages are now referenced by a message number one less than before. It
invokes the main program's mm_expunged() function.
void mail_lock (MAILSTREAM *stream);
stream stream where event happened
This function sets the stream lock. It is an error to set the stream
lock if the stream is already locked.
This is mainly used to catch errors due to a callback function
(e.g. mm_exists) inadvertantly recursing back to the MAIL routines and
establishing an infinite recursion. Normally, drivers will set the lock
prior to calling one of the callback functions above or, more likely, in
the beginning of the driver's non-reentrant "do operation" section. In the
IMAP4 driver, the stream lock is set when entering imap_send() and cleared
on exit.
void mail_unlock (MAILSTREAM *stream);
stream stream where event happened
This function releases the stream lock. It is an error to release the
stream lock if the stream is not locked.