commit 9527875f96328b9a73f042cb6985f60fad6bd666
Author: Christian Grothoff <christian@grothoff.org>
Date: Sun, 13 Nov 2005 04:49:40 +0000
i
Diffstat:
| A | 01_basic.t | | | 7 | +++++++ |
| A | 02_basic.t | | | 11 | +++++++++++ |
| A | Extract.pm | | | 30 | ++++++++++++++++++++++++++++++ |
| A | Extract.xs | | | 133 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | Makefile.PL | | | 60 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | pextract.c | | | 58 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | pextract.h | | | 34 | ++++++++++++++++++++++++++++++++++ |
| A | typemap | | | 16 | ++++++++++++++++ |
8 files changed, 349 insertions(+), 0 deletions(-)
diff --git a/01_basic.t b/01_basic.t
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use_ok('File::Extract');
diff --git a/02_basic.t b/02_basic.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 2;
+use File::Extract;
+
+my $extractor = File::Extract->new();
+isa_ok($extractor, "File::Extract");
+
+ok($extractor->loadDefaultLibraries());
diff --git a/Extract.pm b/Extract.pm
@@ -0,0 +1,30 @@
+package File::Extract;
+
+use strict;
+use warnings;
+use DynaLoader;
+
+our $VERSION = 0.01;
+our @ISA = qw(DynaLoader);
+
+sub dl_load_flags { 0x01 }
+
+bootstrap File::Extract $VERSION;
+
+sub new {
+ my $class = shift;
+ $class = ref $class || $class;
+ my $self = {};
+ bless $self, $class;
+ return $self;
+}
+
+1;
+
+=pod
+
+=head1 DESCRIPTION
+
+File::Extract - Perl interface to libdoodle/libextractor
+
+=cut
diff --git a/Extract.xs b/Extract.xs
@@ -0,0 +1,133 @@
+#include "pextract.h"
+
+MODULE = File::Extract PACKAGE = File::Extract PREFIX = EXTRACTOR_
+
+SV*
+EXTRACTOR_loadDefaultLibraries(extractor)
+ SV* extractor
+ PREINIT:
+ HV* hv;
+ CODE:
+ RETVAL = newSvEXTRACTOR_ExtractorList_ornull(EXTRACTOR_loadDefaultLibraries());
+ hv = pextract_get_hv_from_file_extract_obj(extractor);
+ if (hv) {
+ SvREFCNT_inc(RETVAL);
+ hv_store(hv, "extractor_list", 14, RETVAL, 0);
+ } else
+ croak("foo");
+ OUTPUT:
+ RETVAL
+
+SV*
+EXTRACTOR_loadConfigLibraries(extractor, config)
+ SV* extractor
+ const char* config
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ CODE:
+ list = SvEXTRACTOR_ExtractorList_ornull(pextract_get_extractor_list(extractor));
+ RETVAL = newSvEXTRACTOR_ExtractorList_ornull(EXTRACTOR_loadConfigLibraries(list, config));
+ OUTPUT:
+ RETVAL
+
+SV*
+EXTRACTOR_addLibrary(extractor, library)
+ SV* extractor
+ const char* library
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ CODE:
+ list = SvEXTRACTOR_ExtractorList_ornull(pextract_get_extractor_list(extractor));
+ RETVAL = newSvEXTRACTOR_ExtractorList_ornull(EXTRACTOR_addLibrary(list, library));
+ OUTPUT:
+ RETVAL
+
+SV*
+EXTRACTOR_addLibraryLast(extractor, library)
+ SV* extractor
+ const char* library
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ CODE:
+ list = SvEXTRACTOR_ExtractorList_ornull(pextract_get_extractor_list(extractor));
+ RETVAL = newSvEXTRACTOR_ExtractorList_ornull(EXTRACTOR_addLibraryLast(list, library));
+ OUTPUT:
+ RETVAL
+
+SV*
+EXTRACTOR_removeLibrary(extractor, library)
+ SV* extractor
+ const char* library
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ CODE:
+ list = SvEXTRACTOR_ExtractorList_ornull(pextract_get_extractor_list(extractor));
+ RETVAL = newSvEXTRACTOR_ExtractorList_ornull(EXTRACTOR_removeLibrary(list, library));
+ OUTPUT:
+ RETVAL
+
+void
+EXTRACTOR_removeAll(extractor)
+ SV* extractor
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ CODE:
+ list = SvEXTRACTOR_ExtractorList_ornull(pextract_get_extractor_list(extractor));
+ EXTRACTOR_removeAll(list);
+
+void
+EXTRACTOR_getKeywords(extractor, filename)
+ SV* extractor
+ const char* filename
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ EXTRACTOR_KeywordList* result = NULL;
+ EXTRACTOR_KeywordList* i = NULL;
+ char* keyword_type;
+ PPCODE:
+ list = SvEXTRACTOR_ExtractorList(pextract_get_extractor_list(extractor));
+ result = EXTRACTOR_getKeywords(list, filename);
+ for (i = result; i != NULL; i = i->next) {
+ keyword_type = (char*)EXTRACTOR_getKeywordTypeAsString(i->keywordType);
+ XPUSHs (sv_2mortal(newSVpv(keyword_type, strlen(keyword_type))));
+ XPUSHs (sv_2mortal(newSVpv(i->keyword, strlen(i->keyword))));
+ }
+ EXTRACTOR_freeKeywords(result);
+
+void
+getKeywordsFromBuffer(extractor, buffer)
+ SV* extractor
+ SV* buffer
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ EXTRACTOR_KeywordList* result = NULL;
+ EXTRACTOR_KeywordList* i = NULL;
+ char* keyword_type;
+ size_t size;
+ const void* data;
+ PPCODE:
+ list = SvEXTRACTOR_ExtractorList(pextract_get_extractor_list(extractor));
+ data = SvPV(buffer, size);
+ result = EXTRACTOR_getKeywords2(list, data, size);
+ for (i = result; i != NULL; i = i->next) {
+ keyword_type = (char*)EXTRACTOR_getKeywordTypeAsString(i->keywordType);
+ XPUSHs (sv_2mortal(newSVpv(keyword_type, strlen(keyword_type))));
+ XPUSHs (sv_2mortal(newSVpv(i->keyword, strlen(i->keyword))));
+ }
+ EXTRACTOR_freeKeywords(result);
+
+void
+getLibraries(extractor)
+ SV* extractor
+ PREINIT:
+ EXTRACTOR_ExtractorList* list = NULL;
+ EXTRACTOR_ExtractorList* i = NULL;
+ PPCODE:
+ list = SvEXTRACTOR_ExtractorList(pextract_get_extractor_list(extractor));
+ for (i = list; i != NULL; i = i->next) {
+ XPUSHs(sv_2mortal(newSVpv(i->libname, strlen(i->libname))));
+ XPUSHs(sv_2mortal(newSVpv(i->options, strlen(i->libname))));
+ }
+
+#BOOT:
+# PEXTRACTOR_CALL_BOOT(boot_File__Extract__ExtractorList);
diff --git a/Makefile.PL b/Makefile.PL
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Cwd;
+use File::Spec;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'File::Extract',
+ ABSTRACT_FROM => 'pm/Extract.pm',
+ VERSION_FROM => 'pm/Extract.pm',
+ XSPROTOARG => '-noprototypes',
+ MAN3PODS => {
+ 'pm/Extract.pm' => '$(INST_MAN3DIR)/File::Extract.$(MAN3EXT)'
+ },
+ PM => {
+ 'pm/Extract.pm' => '$(INST_LIBDIR)/Extract.pm'
+ },
+ INC => '-Wall -I'.cwd(),
+ LIBS => '-lextractor',
+ do {
+ my @clean = ();
+ my @OBJECT = ();
+ my %XS = ();
+ for my $xs (<xs/*.xs>) {
+ (my $c = $xs) =~ s/\.xs$/\.c/i;
+ (my $o = $xs) =~ s/\.xs$/\$(OBJ_EXT)/i;
+ $XS{$xs} = $c;
+ push @OBJECT, $o;
+ push @clean, $o;
+ }
+
+ for my $c (<*.c>) {
+ (my $o = $c) =~ s/\.c$/\$(OBJ_EXT)/i;
+ push @OBJECT, $o;
+ push @clean, $o;
+ }
+
+ clean => { FILES => join(" ", @clean) }, OBJECT => join(" ", @OBJECT), XS => \%XS
+ },
+);
+
+package MY;
+
+sub const_cccmd {
+ my $inherited = shift->SUPER::const_cccmd(@_);
+ return '' unless $inherited;
+ use Config;
+ if ($Config{cc} eq 'cl') {
+ warn "you are using MSVC... my condolences.";
+ $inherited .= ' /Fo$@';
+ } else {
+ $inherited .= ' -o $@';
+ }
+
+ return $inherited;
+}
+
+1;
diff --git a/pextract.c b/pextract.c
@@ -0,0 +1,58 @@
+#include "pextract.h"
+
+void
+ _pextractor_call_XS(pTHX_ void (*subaddr) (pTHX_ CV*), CV* cv, SV** mark) {
+ dSP;
+ PUSHMARK(mark);
+ (*subaddr)(aTHX_ cv);
+ PUTBACK;
+ }
+
+SV*
+pextract_new_object(void* object, const char* package) {
+ SV* obj;
+ SV* sv;
+ HV* stash;
+
+ if (!object) {
+ return &PL_sv_undef;
+ }
+
+ obj = (SV*)newHV();
+ sv_magic(obj, 0, PERL_MAGIC_ext, (const char*)object, 0);
+ sv = newRV_inc(obj);
+ stash = gv_stashpv(package, 1);
+ sv_bless(sv, stash);
+
+ return sv;
+}
+
+void*
+pextract_get_object(SV* sv, const char* package) {
+ MAGIC* mg;
+
+ if (!sv || !SvOK(sv) || !SvROK(sv) || !sv_isobject(sv) || !sv_isa(sv, package) || !(mg = mg_find(SvRV(sv), PERL_MAGIC_ext)))
+ return NULL;
+ return (void*)mg->mg_ptr;
+}
+
+HV*
+pextract_get_hv_from_file_extract_obj(SV* hvref) {
+ if (!hvref
+ || !SvOK(hvref)
+ || !SvROK(hvref)
+ || !(SvTYPE(SvRV(hvref)) == SVt_PVHV)
+ || !sv_isobject(hvref)
+ || !sv_isa(hvref, "File::Extract"))
+ return NULL;
+ return (HV*)SvRV((SV*)hvref);
+}
+
+SV*
+pextract_get_extractor_list(SV* extractor) {
+ HV* hv = pextract_get_hv_from_file_extract_obj(extractor);
+ if (!hv)
+ return NULL;
+ return *hv_fetch(hv, "extractor_list", 14, 0);
+}
+
diff --git a/pextract.h b/pextract.h
@@ -0,0 +1,34 @@
+#ifndef __PEXTRACT_H__
+#define __PEXTRACT_H__
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "extractor.h"
+
+SV* pextract_new_object(void* object, const char* package);
+void* pextract_get_object(SV* sv, const char* package);
+
+HV* pextract_get_hv_from_file_extract_obj(SV* hvref);
+SV* pextract_get_extractor_list(SV* extractor);
+
+void _pextractor_call_XS(pTHX_ void (*subaddr) (pTHX_ CV*), CV* cv, SV** mark);
+
+#define PEXTRACTOR_CALL_BOOT(name) \
+ { \
+ extern XS(name); \
+ _pextractor_call_XS(aTHX_ name, cv, mark); \
+ }
+
+/*
+#define newSvExtractor(extractor) pextract_new_object(extractor, "File::Extract::Extractor");
+#define SvEXTRACTOR_Extractor(sv) (struct EXTRACTOR_Extractor*)pextract_get_object(sv, "File::Extract::Extractor");
+*/
+
+#define newSvEXTRACTOR_ExtractorList(val) pextract_new_object(val, "File::Extract::ExtractorList")
+#define SvEXTRACTOR_ExtractorList(sv) (EXTRACTOR_ExtractorList*)pextract_get_object(sv, "File::Extract::ExtractorList")
+typedef EXTRACTOR_ExtractorList EXTRACTOR_ExtractorList_ornull;
+#define SvEXTRACTOR_ExtractorList_ornull(sv) (((sv) && SvOK(sv)) ? SvEXTRACTOR_ExtractorList(sv) : NULL)
+#define newSvEXTRACTOR_ExtractorList_ornull(val) (((val) == NULL) ? &PL_sv_undef : newSvEXTRACTOR_ExtractorList(val))
+
+#endif /* __PEXTRACT_H__ */
diff --git a/typemap b/typemap
@@ -0,0 +1,16 @@
+TYPEMAP
+
+EXTRACTOR_ExtractorList* T_PEXTRACT_GENERIC_WRAPPER
+EXTRACTOR_ExtractorList_ornull* T_PEXTRACT_GENERIC_WRAPPER
+
+OUTPUT
+
+T_PEXTRACT_GENERIC_WRAPPER
+ $arg = newSv${(my $ntype = $type) =~ s/(?:const\s+)?([:\w]+)(?:\s*\*)$/$1/;
+ \$ntype} ($var);
+
+INPUT
+
+T_PEXTRACT_GENERIC_WRAPPER
+ $var = Sv${(my $ntype = $type) =~ s/(?:const\s+)?([:\w]+)(?:\s*\*)$/$1/x;
+ \$ntype} ($arg);
