dslinux/user/perl/os2/OS2/ExtAttr Changes ExtAttr.pm ExtAttr.xs MANIFEST Makefile.PL myea.h typemap

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:01:23 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/os2/OS2/ExtAttr
In directory antilope:/tmp/cvs-serv17422/os2/OS2/ExtAttr

Added Files:
	Changes ExtAttr.pm ExtAttr.xs MANIFEST Makefile.PL myea.h 
	typemap 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: myea.h ---
#include <sys/ea.h>
#include <sys/ead.h>

--- NEW FILE: ExtAttr.xs ---
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif

#include "myea.h"

SV *
my_eadvalue(pTHX_ _ead ead, int index)
{
    SV *sv;
    int size = _ead_value_size(ead, index);
    const char *p;

    if (size == -1) {
	Perl_die(aTHX_ "Error getting size of EA: %s", strerror(errno));
    }
    p = _ead_get_value(ead, index);
    return  newSVpv(p, size);
}

#define my_eadreplace(ead, index, sv, flag)	\
	_ead_replace((ead), (index), flag, SvPVX(sv), SvCUR(sv))

#define my_eadadd(ead, name, sv, flag)	\
	_ead_add((ead), (name), flag, SvPVX(sv), SvCUR(sv))


MODULE = OS2::ExtAttr		PACKAGE = OS2::ExtAttr	PREFIX = my_ead

SV *
my_eadvalue(ead, index)
	_ead	ead
	int	index
    CODE:
	RETVAL = my_eadvalue(aTHX_ ead, index);
    OUTPUT:
	RETVAL

int
my_eadreplace(ead, index, sv, flag = 0)
	_ead	ead
	int	index
	SV *	sv
	int	flag

int
my_eadadd(ead, name, sv, flag = 0)
	_ead	ead
	char *	name
	SV *	sv
	int	flag

MODULE = OS2::ExtAttr		PACKAGE = OS2::ExtAttr	PREFIX = _ea


void
_ea_free(ptr)
	struct _ea *	ptr

int
_ea_get(dst, path, handle, name)
	struct _ea *	dst
	char *	path
	int	handle
	char *	name

int
_ea_put(src, path, handle, name)
	struct _ea *	src
	char *	path
	int	handle
	char *	name

int
_ea_remove(path, handle, name)
	char *	path
	int	handle
	char *	name

MODULE = OS2::ExtAttr		PACKAGE = OS2::ExtAttr	PREFIX = _ead

int
_ead_add(ead, name, flags, value, size)
	_ead	ead
	char *	name
	int	flags
	void *	value
	int	size

void
_ead_clear(ead)
	_ead	ead

int
_ead_copy(dst_ead, src_ead, src_index)
	_ead	dst_ead
	_ead	src_ead
	int	src_index

int
_ead_count(ead)
	_ead	ead

_ead
_ead_create()

int
_ead_delete(ead, index)
	_ead	ead
	int	index

void
_ead_destroy(ead)
	_ead	ead

int
_ead_fea2list_size(ead)
	_ead	ead

void *
_ead_fea2list_to_fealist(src)
	void *	src

void *
_ead_fealist_to_fea2list(src)
	void *	src

int
_ead_find(ead, name)
	_ead	ead
	char *	name

const void *
_ead_get_fea2list(ead)
	_ead	ead

int
_ead_get_flags(ead, index)
	_ead	ead
	int	index

const char *
_ead_get_name(ead, index)
	_ead	ead
	int	index

const void *
_ead_get_value(ead, index)
	_ead	ead
	int	index

int
_ead_name_len(ead, index)
	_ead	ead
	int	index

int
_ead_read(ead, path, handle, flags)
	_ead	ead
	char *	path
	int	handle
	int	flags

int
_ead_replace(ead, index, flags, value, size)
	_ead	ead
	int	index
	int	flags
	void *	value
	int	size

void
_ead_sort(ead)
	_ead	ead

int
_ead_use_fea2list(ead, src)
	_ead	ead
	void *	src

int
_ead_value_size(ead, index)
	_ead	ead
	int	index

int
_ead_write(ead, path, handle, flags)
	_ead	ead
	char *	path
	int	handle
	int	flags

--- NEW FILE: ExtAttr.pm ---
package OS2::ExtAttr;

use strict;
use XSLoader;

our $VERSION = '0.02';
XSLoader::load 'OS2::ExtAttr', $VERSION;

# Preloaded methods go here.

# Format of the array: 
# 0 ead, 1 file name, 2 file handle. 3 length, 4 position, 5 need to write.

sub TIEHASH {
  my $class = shift;
  my $ea = _create() || die "Cannot create EA: $!";
  my $file = shift;
  my ($name, $handle);
  if (ref $file eq 'GLOB' or ref \$file eq 'GLOB') {
    die "File handle is not opened" unless $handle = fileno $file;
    _read($ea, undef, $handle, 0);
  } else {
    $name = $file;
    _read($ea, $name, 0, 0);
  }
  bless [$ea, $name, $handle, 0, 0, 0], $class;
}

sub DESTROY {
  my $eas = shift;
  # 0 means: discard eas which are not in $eas->[0].
  _write( $eas->[0], $eas->[1], $eas->[2], 0) and die "Cannot write EA: $!"
    if $eas->[5];
  _destroy( $eas->[0] );
}

sub FIRSTKEY {
  my $eas = shift;
  $eas->[3] = _count($eas->[0]);
  $eas->[4] = 1;
  return undef if $eas->[4] > $eas->[3];
  return _get_name($eas->[0], $eas->[4]);
}

sub NEXTKEY {
  my $eas = shift;
  $eas->[4]++;
  return undef if $eas->[4] > $eas->[3];
  return _get_name($eas->[0], $eas->[4]);
}

sub FETCH {
  my $eas = shift;
  my $index = _find($eas->[0], shift);
  return undef if $index <= 0;
  return value($eas->[0], $index);
}

sub EXISTS {
  my $eas = shift;
  return _find($eas->[0], shift) > 0;
}

sub STORE {
  my $eas = shift;
  $eas->[5] = 1;
  add($eas->[0], shift, shift) > 0 or die "Error setting EA: $!";
}

sub DELETE {
  my $eas = shift;
  my $index = _find($eas->[0], shift);
  return undef if $index <= 0;
  my $value = value($eas->[0], $index);
  _delete($eas->[0], $index) and die "Error deleting EA: $!";
  $eas->[5] = 1;
  return $value;
}

sub CLEAR {
  my $eas = shift;
  _clear($eas->[0]);
  $eas->[5] = 1;
}

# Here are additional methods:

*new = \&TIEHASH;

sub copy {
  my $eas = shift;
  my $file = shift;
  my ($name, $handle);
  if (ref $file eq 'GLOB' or ref \$file eq 'GLOB') {
    die "File handle is not opened" unless $handle = fileno $file;
    _write($eas->[0], undef, $handle, 0) or die "Cannot write EA: $!";
  } else {
    $name = $file;
    _write($eas->[0], $name, 0, 0) or die "Cannot write EA: $!";
  }
}

sub update {
  my $eas = shift;
  # 0 means: discard eas which are not in $eas->[0].
  _write( $eas->[0], $eas->[1], $eas->[2], 0) and die "Cannot write EA: $!";
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

OS2::ExtAttr - Perl access to extended attributes.

=head1 SYNOPSIS

  use OS2::ExtAttr;
  tie %ea, 'OS2::ExtAttr', 'my.file';
  print $ea{eaname};
  $ea{myfield} = 'value';
  
  untie %ea;

=head1 DESCRIPTION

The package provides low-level and high-level interface to Extended
Attributes under OS/2. 

=head2 High-level interface: C<tie>

The only argument of tie() is a file name, or an open file handle.

Note that all the changes of the tied hash happen in core, to
propagate it to disk the tied hash should be untie()ed or should go
out of scope. Alternatively, one may use the low-level C<update>
method on the corresponding object. Example:

  tied(%hash)->update;

Note also that setting/getting EA flag is not supported by the
high-level interface, one should use the low-level interface
instead. To use it on a tied hash one needs undocumented way to find
C<eas> give the tied hash.

=head2 Low-level interface

Two low-level methods are supported by the objects: copy() and
update(). The copy() takes one argument: the name of a file to copy
the attributes to, or an opened file handle. update() takes no
arguments, and is discussed above.

Three convenience functions are provided:

  value($eas, $key)
  add($eas, $key, $value [, $flag])
  replace($eas, $key, $value [, $flag])

The default value for C<flag> is 0.

In addition, all the C<_ea_*> and C<_ead_*> functions defined in EMX
library are supported, with leading C<_ea/_ead> stripped.

=head1 AUTHOR

Ilya Zakharevich, ilya at math.ohio-state.edu

=head1 SEE ALSO

perl(1).

=cut

--- NEW FILE: MANIFEST ---
Changes
ExtAttr.pm
ExtAttr.xs
MANIFEST
Makefile.PL
myea.h
t/os2_ea.t
typemap

--- NEW FILE: Changes ---
Revision history for Perl extension OS2::ExtAttr.

0.01  Sun Apr 21 11:07:04 1996
	- original version; created by h2xs 1.16

0.02  Update to XSLoader and 'our'.
      Remove Exporter.

--- NEW FILE: typemap ---
struct _ea *		T_PTR
_ead			T_PTR
const void *            T_PTR
const char *            T_PV

--- NEW FILE: Makefile.PL ---
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
    'NAME'	=> 'OS2::ExtAttr',
    'VERSION_FROM' => 'ExtAttr.pm', # finds $VERSION
    MAN3PODS 	=> {}, 	# Pods will be built by installman.
    'LIBS'	=> [''],   # e.g., '-lm' 
    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
    'INC'	=> '',     # e.g., '-I/usr/include/other' 
);




More information about the dslinux-commit mailing list