Text-MeCab-0.20016/000755 000765 000024 00000000000 12256221670 014346 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/Changes000644 000765 000024 00000016652 12256221652 015653 0ustar00daisukestaff000000 000000 Changes ======= 0.20016 24 Dec 2013 - Update MANIFEST 0.20015 18 Dec 2013 - Change how constants are handled so that things work with libmecab < 0.99 (https://github.com/lestrrat/Text-MeCab/pull/9) - Allow specifying mecab encoding from environment variable PERL_MECAB_TEXT_ENCODING, so that you can do (https://github.com/lestrrat/Text-MeCab/pull/7) PERL_MECAB_TEXT_ENCODING=utf-8 carton install - Silence some warnings 0.20014 26 Dec 2012 - You can now specify the default encpding to be used from command line via --encoding flag (https://github.com/lestrrat/Text-MeCab/pull/6): perl Makefile.PL --encoding=utf-8 - Fix author tests (https://github.com/lestrrat/Text-MeCab/pull/5) - Fix various Module::Install related stuff - Stop generating constants dynamically - Better error checking in XS - Lots of hackery to run tests on Travis-CI 0.20013 19 Sep 2011 - tokuhirom + http://kiyotakagoto.blog3.fc2.com/blog-entry-62.html remove auto_include - Use Module::Install::CheckLib 0.20012 09 Jun 2011 - Make sure to chdir back to the original directory upon call to Text::MeCab::Dict::rebuild() (nekokak) 0.20011 19 Dec 2010 - Make sure to include Devel::CheckLib in inc - Fix typo (tomita) - Fix author tests 0.20010 28 Aug 2010 - Remove left over Path::Class(::File) (nipotan) - Fix typo (nipotan) 0.20009 19 May 2010 - Make sure to expose all the constants proved by Makefile.PL - Fix author tests 0.20008 10 May 2010 - Fixes to work with threaded perl - Add tests for memleak and threads - Since mecab installed via ports and the like tend to come with euc-jp dictionary, change the default encoding in probe_mecab.pl Upgrade is strongly recommended if you use threaded perl 0.20007_01 09 May 2010 - Work with libmecab >= 0.98 - Reorganize file layout - Switch to Module::Install - Moved repository to github.com 0.20007 08 Mar 2008 - Now require mecab.h location. This is used to auto-generate constants. - Use Devel::CheckLib on non-Win32 platforms. (Various Win32 related patches by Kenichi Ishigaki) - Makefile.PL tweaks 0.20006 07 Mar 2008 - Makefile.PL tweak for Win32. Patched by Kenichi Ishigaki - We've also been reported that older libmecab doesn't work with Text::MeCab. This is a known issue mainly caused by the fact that I have no access to older libmecab in my dev environment. If you know of particular combo (libmecab version against a particular feature) that doesn't work, please send in patches and reports so we can fix them in future releases 0.20005 06 Mar 2008 - Now we use sv_setref_pv instead of sv_bless and such. This fixes a major leakage that prevented Text::MeCab::Node objects from being garbage collected until global destruction time. I have no other explanation other than that once I switched to sv_setref_pv, everything just worked. Upgrade from previous 0.2000x versions STRONGLY recommended. 0.20004 10 Jan 2008 - Text::MeCab::Dict has now been confirmed working with mecab-ipadic-20070801 * tweak the encoding * don't use Text::CSV_XS 0.20003 10 Jan 2008 - Of course, it's always a good idea to *actually* include the new module. Yikes. If you downloaded 0.20002 by some odd chance, please use this release instead. 0.20002 10 Jan 2008 - Add Text::MeCab::Dict, which is a simple wrapper to work with mecab dictionary. Only supports ipadic. 0.20001 09 Jan 2008 - Properly use ExtUtils::MakeMaker::prompt() to ask interactive questions. Pointed out by David Cantrell. 0.20000 08 Jan 2008 - No code change. Releasing. 0.20000_01 07 Jan 2008 - Complete rewrite * work with libmecab 0.96 * rework tests * use typemaps wisely * default encoding is now utf-8 * now require Encode 0.17 01 May 2007 - Fixup stupid Copy() problem. 0.16 16 Apr 2007 - Change the internal C structure to be thin wrappers around mecab_node_t - Implement a node->format() method 0.15 29 Jan 2007 - 0.14 had upload problems. Repackage. 0.14 28 Jan 2007 - Fix argument passing to mecab_new(). Reported by Naoki Tomita. 0.13 08 Aug 2006 - Fix tools/probe_mecab.pl so that there are not spurfulous whitespaces around the flags (http://d.hatena.ne.jp/t-tkzw/20060730/p2). 0.12 15 Jul 2006 - Apply "Poor Puppy" patch from Kenichi Ishigaki (charsbar) - Properly ask for the dictionary encoding when running perl Build.PL. This will create t/strings.dat with that encoding. 0.11 14 Jul 2006 - Silence more warnings - Force use of -Wall at compilation time 0.10 14 Jul 2006 - remove spurfuluous parse_wakati.pl - remove debug statements - silence warnings 0.09 12 Jul 2006 - "Hey, it's the day before my birthday, but I'm releasing a new module" release - Switch default behavior of Text::MeCab when it goes out of scope. See "Text::MeCab AND SCOPE" section in Text::MeCab POD. This all prompted by post at http://d.hatena.ne.jp/t-tkzw/20060710/p1. - Add new Text::MeCab::Node::Cloned to workaround. - Add warning about not using cloned node when Text::MeCab goes out of scope. 0.08 - 05 Jul 2006 - Apply suggestions by charsbar when prompting for compile/link options for Win32 (and actually release the changes -- this has been sitting on my SVK client for a month) 0.07 - 09 Jun 2006 - The way we were passing arguments to mecab_new() was totally wrong. Fixed. 0.06 - 08 May 2006 - Require ExtUtils::MakeMaker >= 6.25 to avoid Build.PL being executed after Makefile.PL - Fix INIT -> PREINIT (reported by charsbar) - Fix how XSRETURN_UNDEF was working (reported by charsbar) - Fix tools/probe_mecab.pl (reported by charsbar) - Use ppport.h. 0.05 - 04 May 2006 - Fix typos - Add tests to MANIFEST. argh. - Actually test against libmecab < 0.90. Now tests pass. - Bump up version to 0.05 for historical reasons. There was another version of Text::MeCab that MAKAMAKA had written which went up to 0.04. 0.02_03 - 04 May 2006 - Correct reference counting for prev(). - Add tests for detatched Text::MeCab::Node. - Tweak docs 0.02_02 - 04 May 2006 - Fix tools/probe_mecab.pl such that it prompts the user for some required parameters when installing on Windows. - Try fixing Makefile.PL once again. - Explicitly make copies of mecab_node_t in the XS, so that you can now manipulate the nodes even *after* your instance of Text::MeCab has gone away 0.02_01 - 03 May 2006 - Hey, I didn't know people were going to jump on to this module, seriously... - Fix building when using Makefile.PL instead of Build.PL (refactor important bits to tools/probe_mecab.pl). - Attempt to work with MeCab < 0.90. - Move benchmark.pl to tools/benchmark.pl. - Fix problem caused by Text::MeCab->new() (no parameters). - Add Text::MeCab::MECAB_VERSION to display the mecab version we compiled against. TODO: - Try to at least give out a warning when executing a code like this: my $node; { my $mecab = Text::MeCab->new; $mecab->parse("......"); $mecab = undef; } for(; $node; $node = $node->next) { print $node->surface, "\n"; } I'm having a hard time detecting when a node is deallocated, though. we shall see. 0.02 - 02 May 2006 - Accept command line arguments as well as the named parameters in hashref - Fixed problem where constants MECAB_ weren't declared int he correct namespace. 0.01 - 02 May 2006 - Initial release.Text-MeCab-0.20016/eg/000755 000765 000024 00000000000 12256221670 014741 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/inc/000755 000765 000024 00000000000 12256221670 015117 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/lib/000755 000765 000024 00000000000 12256221670 015114 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/Makefile.PL000644 000765 000024 00000012402 12254266256 016326 0ustar00daisukestaff000000 000000 BEGIN { my @missing; my @required = qw( inc::Module::Install Module::Install::AuthorTests Module::Install::CheckLib Module::Install::Repository Module::Install::XSUtil ); foreach my $module (@required) { eval <import; EOM if ($@) { push @missing, $module; } } if (@missing) { print "You don't seem to have some modules required for building this module.\nPlease install the following modules first:\n\n"; foreach my $module (@missing) { $module =~ s/^inc:://; print " + $module\n"; } print "\nBail out\n"; exit 1; } } sub cc_append_to_libs_mine ($); my $RUNNING_IN_HELL = $^O eq 'MSWin32'; my $config = run_probes(); check_lib($config); define_symbols($config); do 'tools/genfiles.pl'; die if $@; MeCabBuild::write_files($config->{version}); name 'Text-MeCab'; all_from 'lib/Text/MeCab.pm'; requires 'Class::Accessor::Fast'; requires 'Encode'; requires 'Exporter'; requires 'File::Spec'; use_ppport; cc_append_to_ccflags $config->{cflags}; cc_append_to_inc $config->{include}; cc_libs $config->{libs}; cc_define @{ $config->{define} }; cc_src_paths 'xs'; cc_warnings; auto_set_repository; build_requires 'Devel::CheckLib'; test_requires 'Test::More', 0.84; test_requires 'Test::Requires'; tests 't/*.t t/*/*.t'; author_tests 'xt'; WriteAll; sub cc_append_to_libs_mine ($) { my $ma = makemaker_args; if ($ma->{LIBS}) { $ma->{LIBS} .= " $_[0]"; } else { $ma->{LIBS} = $_[0]; } } sub run_probes { my $config = do 'tools/probe_mecab.pl'; die if $@; for(my $i = 0; $i < @ARGV; $i++) { if ($ARGV[$i] =~ /^--debugging$/) { splice(@ARGV, $i, 1); $config->{debugging} = 1; $i--; } } $config->{cflags} ||= ''; $config->{cflags} .= ' -I src'; print "Detected the following mecab information:\n", " version: $config->{version}\n", " cflags: $config->{cflags}\n", " libs: $config->{libs}\n", " include: $config->{include}\n", ; return $config; } sub check_lib { my $config = shift; if (! $RUNNING_IN_HELL) { checklibs( lib => 'mecab', LIBS => $config->{libs}, ); } } sub define_symbols { my $config = shift; my @define; if ($RUNNING_IN_HELL) { # save us, the Win32 puppies # XXX - Note to self: # (1) first there was the need to to protect the symbol value # from being garbled by the shell # (2) then the Redmond camp apparently decided that they don't like # my quoting. # (3) So charsbar provided this patch. @define = ( qq(-DTEXT_MECAB_ENCODING=\\"$config->{encoding}\\"), qq(-DTEXT_MECAB_CONFIG=\\"$config->{config}\\"), ); } else { @define = ( "-DTEXT_MECAB_ENCODING='\"$config->{encoding}\"'", "-DTEXT_MECAB_CONFIG='\"$config->{config}\"'", ); } if ($config->{debugging}) { push @define, "-DTEXT_MECAB_DEBUG=1"; } $config->{define} = \@define; } ## Legacy code. ## ## When the time comes, this will be deleted ## sub prepare_makefile ## { ## # Hack. I don't like the layout where .xs files are on the top level. ## link("lib/Text/MeCab.xs", "MeCab.xs"); ## ## # if no inc directory is found, I'm being executed via the author. ## # I'm going to create inc, and add Devel::CheckLib there ## if (! -d './inc' and ! $RUNNING_IN_HELL) { ## mkdir('inc') or die "Could not make inc directory: $!"; ## mkdir('inc/Devel') or die "Could not make inc/Devel directory: $!"; ## require Devel::CheckLib; ## ## link($INC{'Devel/CheckLib.pm'}, 'inc/Devel/CheckLib.pm') or ## die "Failed to copy Devel::CheckLib: $!"; ## } ## ## ## my $config = run_probes(); ## check_lib($config); ## define_symbols($config); ## extract_constants($config); ## ## # XXX For debug ## # use Data::Dumper; ## # print Dumper($config); ## my %INFO = ( ## ABSTRACT => 'Alternative Interface To libmecab', ## AUTHOR => 'Daisuke Maki ', ## CCFLAGS => $config->{cflags}, ## DEFINE => join( " ", @{ $config->{define} } ), ## DISTNAME => 'Text-MeCab', ## INSTALLDIRS => 'site', ## LIBS => $config->{libs}, ## LICENSE => 'perl', ## NAME => 'Text::MeCab', ## OBJECT => '$(O_FILES)', ## PREREQ_PM => { ## 'Class::Accessor::Fast' => 0, ## 'Encode' => 0, ## 'Exporter' => 0, ## 'File::Spec' => 0, ## 'Test::More' => 0, ## 'Path::Class' => 0, ## }, ## VERSION_FROM => 'lib/Text/MeCab.pm', ## clean => { ## FILES => 'lib/typemap MeCab.xs' ## }, ## test => { ## TESTS => 't/*.t t/*/*.t' ## } ## ); ## $INFO{OPTIMIZE} = '-g' if $config->{debugging}; ## ## WriteMakefile(%INFO); ## } Text-MeCab-0.20016/MANIFEST000644 000765 000024 00000001667 12256221551 015507 0ustar00daisukestaff000000 000000 Changes eg/add_custom.pl inc/Devel/CheckLib.pm inc/Module/Install.pm inc/Module/Install/AuthorTests.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/CheckLib.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Repository.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm inc/Module/Install/XSUtil.pm lib/Text/MeCab.pm lib/Text/MeCab/Dict.pm lib/Text/MeCab/Node.pod Makefile.PL MANIFEST This list of files META.yml t/01-sanity.t t/node/01_load.t t/node/02_api.t t/node/03_clone.t t/node/04_clone_free.t t/node/05_format.t t/regression/01_tomi_args.t t/strings.dat t/tagger/01_load.t t/tagger/02_api.t t/tagger/03_basic.t tools/benchmark.pl tools/genfiles.pl tools/probe_mecab.pl xs/MeCab.xs xs/text-mecab-clone.c xs/text-mecab-node.c xs/text-mecab.c xs/text-mecab.h xs/typemap xt/01_pod.t xt/02_pod-coverage.t xt/03_threads.t xt/04_leak.t xt/05_saba.t Text-MeCab-0.20016/META.yml000644 000765 000024 00000001463 12256221666 015630 0ustar00daisukestaff000000 000000 --- abstract: 'Alternate Interface To libmecab' author: - '-2011 Daisuke Maki ' build_requires: Devel::CheckLib: 0 Devel::PPPort: 3.19 ExtUtils::MakeMaker: 6.59 Test::More: 0.84 Test::Requires: 0 configure_requires: Devel::PPPort: 3.19 ExtUtils::MakeMaker: 6.59 ExtUtils::ParseXS: 2.21 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Text-MeCab no_index: directory: - inc - t - xt requires: Class::Accessor::Fast: 0 Encode: 0 Exporter: 0 File::Spec: 0 XSLoader: 0.02 perl: 5.6.0 resources: license: http://dev.perl.org/licenses/ repository: git://github.com/lestrrat/Text-MeCab.git version: 0.20016 Text-MeCab-0.20016/t/000755 000765 000024 00000000000 12256221670 014611 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/tools/000755 000765 000024 00000000000 12256221670 015506 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/xs/000755 000765 000024 00000000000 12256221670 015000 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/xt/000755 000765 000024 00000000000 12256221670 015001 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/xt/01_pod.t000644 000765 000024 00000000121 12235124744 016243 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Requires 'Test::Pod'; all_pod_files_ok(); Text-MeCab-0.20016/xt/02_pod-coverage.t000644 000765 000024 00000000176 12235124744 020047 0ustar00daisukestaff000000 000000 use Test::More; use Test::Requires 'Test::Pod::Coverage'; all_pod_coverage_ok({ also_private => [ qr/^xs_/, "constant" ] }); Text-MeCab-0.20016/xt/03_threads.t000644 000765 000024 00000001627 12235124744 017131 0ustar00daisukestaff000000 000000 use strict; use utf8; use Test::More; use Encode; use Test::Requires 'threads'; use_ok "Text::MeCab"; my $x = Text::MeCab->new; my $node = $x->parse( encode( &Text::MeCab::ENCODING, "あぁ、酒が飲みたい飲みたい。そんな日もあるよね。あはは" ) ); my @threads; { note( "before thread spawning" ); foreach(my $n = $node; $n; $n = $n->next) { note("node = " . encode_utf8( decode( &Text::MeCab::ENCODING, $n->surface) ) ); } } for (1..5) { push @threads, threads->create(sub{ note( "spawned thread : " . threads->tid() ); foreach(my $n = $node; $n; $n = $n->next) { if ( defined $n->surface ) { note("node = " . encode_utf8( decode( &Text::MeCab::ENCODING, $n->surface) ) ); } } }); } foreach my $thr (@threads) { note( "joining thread : " . $thr->tid ); $thr->join; } ok(1); done_testing();Text-MeCab-0.20016/xt/04_leak.t000644 000765 000024 00000000415 12235124744 016406 0ustar00daisukestaff000000 000000 use strict; use Test::More; BEGIN { if (! $ENV{TEST_MEMLEAK}) { plan skip_all => "TEST_MEMLEAK is not set"; } } use Test::Requires 'Test::Valgrind', 'XML::Parser', ; while ( my $f = ) { subtest $f => sub { do $f }; } done_testing; Text-MeCab-0.20016/xt/05_saba.t000644 000765 000024 00000000564 12235124744 016406 0ustar00daisukestaff000000 000000 use strict; use utf8; use Test::More; use Text::MeCab; use Encode; my $data = encode(Text::MeCab::ENCODING, "私はサバです"); my @expect = qw(私 は サバ です); my $mecab = Text::MeCab->new(); for ( my $node = $mecab->parse($data); $node; $node = $node->next ) { is decode(Text::MeCab::ENCODING, $node->surface), shift @expect; } done_testing; Text-MeCab-0.20016/xs/MeCab.xs000644 000765 000024 00000015566 12254266256 016347 0ustar00daisukestaff000000 000000 #include "text-mecab.h" #include "config-const.h" static int TextMeCab_mg_free(pTHX_ SV *const sv, MAGIC* const mg) { TextMeCab* const mecab = (TextMeCab*) mg->mg_ptr; PERL_UNUSED_VAR(sv); mecab_destroy(XS_2MECAB(mecab)); if (mecab->argc > 0) { unsigned int i; for ( i = 0; i < mecab->argc; i++) { Safefree(mecab->argv[i]); } Safefree(mecab->argv); } return 0; } static int TextMeCab_mg_dup(pTHX_ MAGIC *const mg, CLONE_PARAMS *const param) { #ifdef USE_ITHREADS TextMeCab* const mecab = (TextMeCab*) mg->mg_ptr; TextMeCab* newmecab; PERL_UNUSED_VAR(param); newmecab = TextMeCab_create(mecab->argv, mecab->argc); mg->mg_ptr = (char *) newmecab; #else PERL_UNUSED_VAR(mg); PERL_UNUSED_VAR(param); #endif return 0; } static MAGIC* TextMeCab_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl){ MAGIC* mg; assert(sv != NULL); assert(vtbl != NULL); for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){ if(mg->mg_virtual == vtbl){ assert(mg->mg_type == PERL_MAGIC_ext); return mg; } } croak("PerlMeCab: Invalid PerlMeCab object was passed"); return NULL; /* not reached */ } static MGVTBL TextMeCab_vtbl = { /* for identity */ NULL, /* get */ NULL, /* set */ NULL, /* len */ NULL, /* clear */ TextMeCab_mg_free, /* free */ NULL, /* copy */ TextMeCab_mg_dup, /* dup */ NULL, /* local */ }; static void register_constants() { HV *stash = gv_stashpv("Text::MeCab", TRUE); #if HAVE_MECAB_NOR_NODE newCONSTSUB(stash, "MECAB_NOR_NODE", newSViv(MECAB_NOR_NODE)); #endif #if HAVE_MECAB_UNK_NODE newCONSTSUB(stash, "MECAB_UNK_NODE", newSViv(MECAB_UNK_NODE)); #endif #if HAVE_MECAB_BOS_NODE newCONSTSUB(stash, "MECAB_BOS_NODE", newSViv(MECAB_BOS_NODE)); #endif #if HAVE_MECAB_EOS_NODE newCONSTSUB(stash, "MECAB_EOS_NODE", newSViv(MECAB_EOS_NODE)); #endif #if HAVE_MECAB_EON_NODE newCONSTSUB(stash, "MECAB_EON_NODE", newSViv(MECAB_EON_NODE)); #endif #if HAVE_MECAB_SYS_DIC newCONSTSUB(stash, "MECAB_SYS_DIC", newSViv(MECAB_SYS_DIC)); #endif #if HAVE_MECAB_USR_DIC newCONSTSUB(stash, "MECAB_USR_DIC", newSViv(MECAB_USR_DIC)); #endif #if HAVE_MECAB_UNK_DIC newCONSTSUB(stash, "MECAB_UNK_DIC", newSViv(MECAB_UNK_DIC)); #endif #if HAVE_MECAB_ONE_BEST newCONSTSUB(stash, "MECAB_ONE_BEST", newSViv(MECAB_ONE_BEST)); #endif #if HAVE_MECAB_NBEST newCONSTSUB(stash, "MECAB_NBEST", newSViv(MECAB_NBEST)); #endif #if HAVE_MECAB_PARTIAL newCONSTSUB(stash, "MECAB_PARTIAL", newSViv(MECAB_PARTIAL)); #endif #if HAVE_MECAB_MARGINAL_PROB newCONSTSUB(stash, "MECAB_MARGINAL_PROB", newSViv(MECAB_MARGINAL_PROB)); #endif #if HAVE_MECAB_ALTERNATIVE newCONSTSUB(stash, "MECAB_ALTERNATIVE", newSViv(MECAB_ALTERNATIVE)); #endif #if HAVE_MECAB_ALL_MORPHS newCONSTSUB(stash, "MECAB_ALL_MORPHS", newSViv(MECAB_ALL_MORPHS)); #endif #if HAVE_MECAB_ALLOCATE_SENTENCE newCONSTSUB(stash, "MECAB_ALLOCATE_SENTENCE", newSViv(MECAB_ALLOCATE_SENTENCE)); #endif } MODULE = Text::MeCab PACKAGE = Text::MeCab PREFIX = TextMeCab_ PROTOTYPES: DISABLE BOOT: TextMeCab_bootstrap(); register_constants(); TextMeCab * TextMeCab__xs_create(class_sv, args = NULL) SV *class_sv; AV *args; CODE: RETVAL = TextMeCab_create_from_av(args); OUTPUT: RETVAL TextMeCab_Node * TextMeCab_parse(mecab, string) TextMeCab *mecab; char *string; char * TextMeCab_version() CODE: RETVAL = (char *) mecab_version(); OUTPUT: RETVAL MODULE = Text::MeCab PACKAGE = Text::MeCab::Node PREFIX = TextMeCab_Node_ PROTOTYPES: DISABLE unsigned int TextMeCab_Node_id(node) TextMeCab_Node *node unsigned int TextMeCab_Node_length(node) TextMeCab_Node *node unsigned int TextMeCab_Node_rlength(node) TextMeCab_Node *node TextMeCab_Node * TextMeCab_Node_next(node) TextMeCab_Node *node TextMeCab_Node * TextMeCab_Node_prev(node) TextMeCab_Node *node SV * TextMeCab_Node_surface(node) TextMeCab_Node *node; const char * TextMeCab_Node_feature(node) TextMeCab_Node *node; unsigned short TextMeCab_Node_rcattr(node) TextMeCab_Node *node; unsigned short TextMeCab_Node_lcattr(node) TextMeCab_Node *node; unsigned short TextMeCab_Node_posid(node) TextMeCab_Node *node; unsigned char TextMeCab_Node_char_type(node) TextMeCab_Node *node; unsigned char TextMeCab_Node_stat(node) TextMeCab_Node *node; unsigned char TextMeCab_Node_isbest(node) TextMeCab_Node *node; float TextMeCab_Node_alpha(node) TextMeCab_Node *node; float TextMeCab_Node_beta(node) TextMeCab_Node *node; float TextMeCab_Node_prob(node) TextMeCab_Node *node; short TextMeCab_Node_wcost(node) TextMeCab_Node *node; long TextMeCab_Node_cost(node) TextMeCab_Node *node; const char * TextMeCab_Node_format(node, mecab) TextMeCab_Node *node; TextMeCab *mecab; TextMeCab_Node_Cloned* TextMeCab_Node_dclone(node) TextMeCab_Node *node; MODULE = Text::MeCab PACKAGE = Text::MeCab::Node::Cloned PREFIX = TextMeCab_Node_Cloned_ PROTOTYPES: DISABLE unsigned int TextMeCab_Node_Cloned_id(node) TextMeCab_Node_Cloned *node unsigned int TextMeCab_Node_Cloned_length(node) TextMeCab_Node_Cloned *node unsigned int TextMeCab_Node_Cloned_rlength(node) TextMeCab_Node_Cloned *node TextMeCab_Node_Cloned * TextMeCab_Node_Cloned_next(node) TextMeCab_Node_Cloned *node TextMeCab_Node_Cloned * TextMeCab_Node_Cloned_prev(node) TextMeCab_Node_Cloned *node const char * TextMeCab_Node_Cloned_surface(node) TextMeCab_Node_Cloned *node; const char * TextMeCab_Node_Cloned_feature(node) TextMeCab_Node_Cloned *node; unsigned short TextMeCab_Node_Cloned_rcattr(node) TextMeCab_Node_Cloned *node; unsigned short TextMeCab_Node_Cloned_lcattr(node) TextMeCab_Node_Cloned *node; unsigned short TextMeCab_Node_Cloned_posid(node) TextMeCab_Node_Cloned *node; unsigned char TextMeCab_Node_Cloned_char_type(node) TextMeCab_Node_Cloned *node; unsigned char TextMeCab_Node_Cloned_stat(node) TextMeCab_Node_Cloned *node; unsigned char TextMeCab_Node_Cloned_isbest(node) TextMeCab_Node_Cloned *node; float TextMeCab_Node_Cloned_alpha(node) TextMeCab_Node_Cloned *node; float TextMeCab_Node_Cloned_beta(node) TextMeCab_Node_Cloned *node; float TextMeCab_Node_Cloned_prob(node) TextMeCab_Node_Cloned *node; short TextMeCab_Node_Cloned_wcost(node) TextMeCab_Node_Cloned *node; long TextMeCab_Node_Cloned_cost(node) TextMeCab_Node_Cloned *node; const char * TextMeCab_Node_Cloned_format(node, mecab) TextMeCab_Node_Cloned *node; TextMeCab *mecab; void TextMeCab_Node_Cloned_DESTROY(node) TextMeCab_Node_Cloned *node; CODE: TextMeCab_Node_Cloned_free(node); Text-MeCab-0.20016/xs/text-mecab-clone.c000644 000765 000024 00000012046 12235124744 020277 0ustar00daisukestaff000000 000000 /* $Id$ * * Copyright (c) 2006-2008 Daisuke Maki * All rights reserved. */ #include "text-mecab.h" #ifndef __TEXT_MECAB_CLONE_C__ #define __TEXT_MECAB_CLONE_C__ /* Deep Copy Memory Management Strategy: * * When we call dclone(), we actually clone the *entire* node list. * that is, we go back to the first node in the list, and start from * there. * * When ->next, ->prev is called, we update the node->head struct's * refcnt. When this refcnt is zero, we finally free the struct */ void TextMeCab_Node_Cloned_free(TextMeCab_Node_Cloned *node) { TextMeCab_Node_Cloned_Meta *meta; TextMeCab_Node_Cloned *tmp; if (node == NULL || node->meta == NULL) { /* sanity */ return; } meta = node->meta; if (meta->refcnt != 0) return; meta->refcnt--; node = meta->first; while (node != NULL) { tmp = node->next; Safefree(node->actual); Safefree(node); node = tmp; } Safefree(meta); } #if 0 pmecab_node_clone_t * pmecab_deep_clone_node(mecab_node_t *node) { pmecab_node_clone_head_t *xs_head; pmecab_node_clone_t *xs_node; pmecab_node_clone_t *cur_xs_node; pmecab_node_clone_t *tmp_xs; mecab_node_t *cur_node; mecab_node_t *tmp; if (node == NULL) return NULL; /* First, create the clone node list head. Then create the node that * requested to be cloned. */ Newz(1234, xs_head, 1, pmecab_node_clone_head_t); xs_node = pmecab_clone_node(node); xs_node->head = xs_head; cur_node = node->prev; cur_xs_node = xs_node; while (cur_node != NULL) { tmp = cur_node->prev; tmp_xs = pmecab_clone_node(cur_node); tmp_xs->head = xs_head; if (tmp == NULL) { xs_head->first = tmp_xs; } cur_xs_node->prev = tmp_xs; cur_xs_node->actual->prev = tmp_xs->actual; tmp_xs->next = cur_xs_node; tmp_xs->actual->next = cur_xs_node->actual; cur_node = tmp; cur_xs_node = tmp_xs; } cur_node = node; cur_xs_node = xs_node; while (cur_node != NULL) { tmp = cur_node->next; tmp_xs = pmecab_clone_node(cur_node); tmp_xs->head = xs_head; cur_xs_node->next = tmp_xs; cur_xs_node->actual->next = tmp_xs->actual; tmp_xs->prev = cur_xs_node; tmp_xs->actual->prev = cur_xs_node->actual; cur_node = tmp; cur_xs_node = tmp_xs; } xs_head->refcnt++; return xs_node; } #endif unsigned int TextMeCab_Node_Cloned_id(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_ID(node->actual); } unsigned int TextMeCab_Node_Cloned_length(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_LENGTH(node->actual); } unsigned int TextMeCab_Node_Cloned_rlength(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_RLENGTH(node->actual); } TextMeCab_Node_Cloned * TextMeCab_Node_Cloned_next(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_NEXT(node); } TextMeCab_Node_Cloned * TextMeCab_Node_Cloned_prev(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_PREV(node); } const char * TextMeCab_Node_Cloned_surface(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_SURFACE(node->actual); } const char * TextMeCab_Node_Cloned_feature(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_FEATURE(node->actual); } unsigned short TextMeCab_Node_Cloned_rcattr(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_RCATTR(node->actual); } unsigned short TextMeCab_Node_Cloned_lcattr(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_LCATTR(node->actual); } unsigned short TextMeCab_Node_Cloned_posid(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_POSID(node->actual); } unsigned char TextMeCab_Node_Cloned_char_type(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_CHAR_TYPE(node->actual); } unsigned char TextMeCab_Node_Cloned_stat(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_STAT(node->actual); } unsigned char TextMeCab_Node_Cloned_isbest(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_ISBEST(node->actual); } float TextMeCab_Node_Cloned_alpha(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_ALPHA(node->actual); } float TextMeCab_Node_Cloned_beta(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_BETA(node->actual); } float TextMeCab_Node_Cloned_prob(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_PROB(node->actual); } long TextMeCab_Node_Cloned_cost(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_COST(node->actual); } short TextMeCab_Node_Cloned_wcost(node) TextMeCab_Node_Cloned *node; { return MECAB_NODE_WCOST(node->actual); } const char * TextMeCab_Node_Cloned_format(node, mecab) TextMeCab_Node_Cloned *node; TextMeCab *mecab; { return mecab_format_node(XS_2MECAB(mecab), node->actual); } #endif /* __TEXT_MECAB_CLONE_C__ */ Text-MeCab-0.20016/xs/text-mecab-node.c000644 000765 000024 00000011475 12235124744 020131 0ustar00daisukestaff000000 000000 /* $Id$ * * Copyright (c) 2006-2008 Daisuke Maki * All rights reserved. */ #include "text-mecab.h" #ifndef __TEXT_MECAB_NODE_C__ #define __TEXT_MECAB_NODE_C__ unsigned int TextMeCab_Node_id(node) TextMeCab_Node *node; { return MECAB_NODE_ID(node); } unsigned int TextMeCab_Node_length(node) TextMeCab_Node *node; { return MECAB_NODE_LENGTH(node); } unsigned int TextMeCab_Node_rlength(node) TextMeCab_Node *node; { return MECAB_NODE_RLENGTH(node); } TextMeCab_Node * TextMeCab_Node_next(node) TextMeCab_Node *node; { return MECAB_NODE_NEXT(node); } TextMeCab_Node * TextMeCab_Node_prev(node) TextMeCab_Node *node; { return MECAB_NODE_PREV(node); } SV * TextMeCab_Node_surface(node) TextMeCab_Node *node; { return (node->length > 0) ? newSVpvn(MECAB_NODE_SURFACE(node), MECAB_NODE_LENGTH(node)) : newSV(0) ; } const char * TextMeCab_Node_feature(node) TextMeCab_Node *node; { return MECAB_NODE_FEATURE(node); } unsigned short TextMeCab_Node_rcattr(node) TextMeCab_Node *node; { return MECAB_NODE_RCATTR(node); } unsigned short TextMeCab_Node_lcattr(node) TextMeCab_Node *node; { return MECAB_NODE_LCATTR(node); } unsigned short TextMeCab_Node_posid(node) TextMeCab_Node *node; { return MECAB_NODE_POSID(node); } unsigned char TextMeCab_Node_char_type(node) TextMeCab_Node *node; { return MECAB_NODE_CHAR_TYPE(node); } unsigned char TextMeCab_Node_stat(node) TextMeCab_Node *node; { return MECAB_NODE_STAT(node); } unsigned char TextMeCab_Node_isbest(node) TextMeCab_Node *node; { return MECAB_NODE_ISBEST(node); } float TextMeCab_Node_alpha(node) TextMeCab_Node *node; { return MECAB_NODE_ALPHA(node); } float TextMeCab_Node_beta(node) TextMeCab_Node *node; { return MECAB_NODE_BETA(node); } float TextMeCab_Node_prob(node) TextMeCab_Node *node; { return MECAB_NODE_PROB(node); } long TextMeCab_Node_cost(node) TextMeCab_Node *node; { return MECAB_NODE_COST(node); } short TextMeCab_Node_wcost(node) TextMeCab_Node *node; { return MECAB_NODE_WCOST(node); } const char * TextMeCab_Node_format(node, mecab) TextMeCab_Node *node; TextMeCab *mecab; { return mecab_format_node(XS_2MECAB(mecab), node); } TextMeCab_Node_Cloned * TextMeCab_Node_dclone(node) TextMeCab_Node *node; { TextMeCab_Node_Cloned *prev_node = NULL; TextMeCab_Node_Cloned *cloned_node = NULL; TextMeCab_Node *head = NULL; TextMeCab_Node *current = NULL; TextMeCab_Node_Cloned *tmp = NULL; TextMeCab_Node_Cloned_Meta *meta; /* XXX - We clone the entire node list, to make management easier */ head = node; while (head->prev != NULL) { head = head->prev; } Newz(1234, meta, 1, TextMeCab_Node_Cloned_Meta); current = head; while(current != NULL) { tmp = TextMeCab_Node_clone_single_node(current); if (current == node) { cloned_node = tmp; } tmp->meta = meta; tmp->prev = prev_node; if (prev_node != NULL) { prev_node->next = tmp; } else { meta->first = tmp; } prev_node = tmp; current = current->next; } meta->refcnt++; return cloned_node; } TextMeCab_Node_Cloned * TextMeCab_Node_clone_single_node(node) TextMeCab_Node *node; { TextMeCab_Node_Cloned *cloned; Newz(1234, cloned, 1, TextMeCab_Node_Cloned); Newz(1234, cloned->actual, 1, TextMeCab_Node); if (node->length <= 0) { cloned->actual->surface = NULL; } else { int len = node->length; /* node->length is actually unsigned short, but what the heck. * just cast it off to an int. */ Newz(1234, cloned->actual->surface, len + 1, char); Copy(node->surface, cloned->actual->surface, len, char); } Newz(1234, cloned->actual->feature, strlen(node->feature), char); Copy(node->feature, cloned->actual->feature, strlen(node->feature), char); cloned->actual->id = node->id; cloned->actual->length = node->length; cloned->actual->stat = node->stat; cloned->actual->cost = node->cost; cloned->actual->rlength = node->rlength; cloned->actual->rcAttr = node->rcAttr; cloned->actual->lcAttr = node->lcAttr; cloned->actual->posid = node->posid; cloned->actual->char_type = node->char_type; cloned->actual->isbest = node->isbest; cloned->actual->alpha = node->alpha; cloned->actual->prob = node->prob; cloned->actual->wcost = node->wcost; cloned->actual->next = NULL; cloned->actual->prev = NULL; return cloned; } #endif /* __TEXT_MECAB_NODE_C__ */ Text-MeCab-0.20016/xs/text-mecab.c000644 000765 000024 00000005470 12254266250 017204 0ustar00daisukestaff000000 000000 /* $Id$ * * Copyright (c) 2006-2008 Daisuke Maki * All rights reserved. */ #include "text-mecab.h" #ifndef __TEXT_MECAB_C__ #define __TEXT_MECAB_C__ void TextMeCab_bootstrap() { HV *stash; stash = gv_stashpv("Text::MeCab", 1); newCONSTSUB(stash, "MECAB_VERSION", newSVpvf("%s", mecab_version())); newCONSTSUB(stash, "MECAB_TARGET_VERSION", newSVpvf("%d.%02d", MECAB_MAJOR_VERSION, MECAB_MINOR_VERSION) ); newCONSTSUB(stash, "MECAB_TARGET_MAJOR_VERSION", newSVpvf("%d", MECAB_MAJOR_VERSION)); newCONSTSUB(stash, "MECAB_TARGET_MINOR_VERSION", newSVpvf("%d", MECAB_MINOR_VERSION)); newCONSTSUB(stash, "ENCODING", newSVpvf("%s", TEXT_MECAB_ENCODING) ); newCONSTSUB(stash, "MECAB_CONFIG", newSVpvf("%s", TEXT_MECAB_CONFIG)); } TextMeCab * TextMeCab_create(char **argv, unsigned int argc) { TextMeCab *mecab; mecab_t *tagger; #if TEXT_MECAB_DEBUG { unsigned int i; PerlIO_printf(PerlIO_stderr(), "TextMeCab_new called\n"); for(i = 0; i < argc; i++) { PerlIO_printf(PerlIO_stderr(), " arg %d: %s\n", i, argv[i]); } } #endif { tagger = mecab_new(argc, argv); if (tagger == NULL) { return NULL; } } Newxz( mecab, 1, TextMeCab ); mecab->mecab = tagger; mecab->argc = argc; if (argc > 0) { unsigned int i; Newxz( mecab->argv, argc, char *); for (i = 0; i < argc; i++) { int len = strlen(argv[i]) + 1; Newxz( mecab->argv[i], len, char ); Copy( argv[i], mecab->argv[i], len, char ); } } return mecab; } TextMeCab * TextMeCab_create_from_av(AV *av) { char **argv = NULL; unsigned int argc; TextMeCab *mecab; argc = av_len(av) + 1; if (argc > 0) { unsigned int i; SV **svr; Newz(1234, argv, argc, char *); for(i = 0; i < argc; i++) { svr = av_fetch(av, i, 0); if (svr == NULL || ! SvOK(*svr)) { Safefree(argv); croak("bad argument at index %d", i); } argv[i] = SvPV_nolen(*svr); } } mecab = TextMeCab_create(argv, argc); if( mecab == NULL ) { if (argc > 0) { Safefree(argv); } croak("Failed to create mecab instance"); } if (argc > 0) { Safefree(argv); } return mecab; } TextMeCab_Node * TextMeCab_parse(mecab, string) TextMeCab *mecab; char *string; { TextMeCab_Node *node; node = (TextMeCab_Node *) mecab_sparse_tonode(XS_2MECAB(mecab), string); if (node == NULL) { croak("mecab_sparse_tonode() failed: %s", mecab_strerror(XS_2MECAB(mecab))); } node = node->next; return node; } #endif /* __TEXT_MECAB_C__ */Text-MeCab-0.20016/xs/text-mecab.h000644 000765 000024 00000011447 12235124744 017212 0ustar00daisukestaff000000 000000 #ifndef __TEXT_MECAB_H__ #define __TEXT_MECAB_H__ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #define NEED_newCONSTSUB #define NEED_newRV_noinc #define NEED_sv_2pv_nolen #define NEED_sv_2pv_flags #include "ppport.h" #include #ifndef TEXT_MECAB_DEBUG #define TEXT_MECAB_DEBUG 0 #endif #define XS_STATE(type, x) \ INT2PTR(type, SvROK(x) ? SvIV(SvRV(x)) : SvIV(x)) #define XS_STRUCT2OBJ(sv, class, obj) \ if (obj == NULL) { \ sv_setsv(sv, &PL_sv_undef); \ } else { \ sv_setref_pv(sv, class, (void *) obj); \ } typedef struct { mecab_t *mecab; char **argv; unsigned int argc; } TextMeCab; typedef mecab_node_t TextMeCab_Node; typedef struct TextMeCab_Node_Cloned_Meta { IV refcnt; struct TextMeCab_Node_Cloned *first; } TextMeCab_Node_Cloned_Meta; typedef struct TextMeCab_Node_Cloned { struct TextMeCab_Node_Cloned *prev; struct TextMeCab_Node_Cloned *next; TextMeCab_Node_Cloned_Meta *meta; TextMeCab_Node *actual; } TextMeCab_Node_Cloned; #define XS_2MECAB(x) x->mecab #define MECAB_NODE_ID(x) x ? x->id : 0 #define MECAB_NODE_LENGTH(x) x ? x->length : -1 #define MECAB_NODE_RLENGTH(x) x ? x->rlength : -1 #define MECAB_NODE_NEXT(x) x ? x->next : NULL #define MECAB_NODE_PREV(x) x ? x->prev : NULL #define MECAB_NODE_SURFACE(x) x ? x->surface : NULL #define MECAB_NODE_FEATURE(x) x ? x->feature : NULL #define MECAB_NODE_RCATTR(x) x ? x->rcAttr : -1 #define MECAB_NODE_LCATTR(x) x ? x->lcAttr : -1 #define MECAB_NODE_POSID(x) x ? x->posid : -1 #define MECAB_NODE_CHAR_TYPE(x) x ? x->char_type : -1 #define MECAB_NODE_STAT(x) x ? x->stat : -1 #define MECAB_NODE_ISBEST(x) x ? x->isbest : -1 #define MECAB_NODE_ALPHA(x) x ? x->alpha : -1 #define MECAB_NODE_BETA(x) x ? x->beta : -1 #define MECAB_NODE_PROB(x) x ? x->prob : -1 #define MECAB_NODE_COST(x) x ? x->cost : -1 #define MECAB_NODE_WCOST(x) x ? x->wcost : -1 /* Text::MeCab */ void TextMeCab_bootstrap(); TextMeCab *TextMeCab_create(char **argv, unsigned int argc); TextMeCab *TextMeCab_create_from_av(AV *av); TextMeCab_Node *TextMeCab_parse(TextMeCab *mecab, char *string); /* Text::MeCab::Node */ unsigned int TextMeCab_Node_id(TextMeCab_Node *node); unsigned int TextMeCab_Node_length(TextMeCab_Node *node); unsigned int TextMeCab_Node_rlength(TextMeCab_Node *node); TextMeCab_Node *TextMeCab_Node_next(TextMeCab_Node *node); TextMeCab_Node *TextMeCab_Node_prev(TextMeCab_Node *node); SV *TextMeCab_Node_surface(TextMeCab_Node *node); const char *TextMeCab_Node_feature(TextMeCab_Node *node); unsigned short TextMeCab_Node_rcattr(TextMeCab_Node *node); unsigned short TextMeCab_Node_lcattr(TextMeCab_Node *node); unsigned short TextMeCab_Node_posid(TextMeCab_Node *node); unsigned char TextMeCab_Node_char_type(TextMeCab_Node *node); unsigned char TextMeCab_Node_stat(TextMeCab_Node *node); unsigned char TextMeCab_Node_isbest(TextMeCab_Node *node); float TextMeCab_Node_alpha(TextMeCab_Node *node); float TextMeCab_Node_beta(TextMeCab_Node *node); float TextMeCab_Node_prob(TextMeCab_Node *node); long TextMeCab_Node_cost(TextMeCab_Node *node); short TextMeCab_Node_wcost(TextMeCab_Node *node); const char *TextMeCab_Node_format(TextMeCab_Node *node, TextMeCab *mecab); TextMeCab_Node_Cloned *TextMeCab_Node_dclone(TextMeCab_Node *node); TextMeCab_Node_Cloned *TextMeCab_Node_clone_single_node(TextMeCab_Node *node); /* Text::MeCab::Node::Cloned */ void TextMeCab_Node_Cloned_free(TextMeCab_Node_Cloned *node); unsigned int TextMeCab_Node_Cloned_id(TextMeCab_Node_Cloned *node); unsigned int TextMeCab_Node_Cloned_length(TextMeCab_Node_Cloned *node); unsigned int TextMeCab_Node_Cloned_rlength(TextMeCab_Node_Cloned *node); TextMeCab_Node_Cloned *TextMeCab_Node_Cloned_next(TextMeCab_Node_Cloned *node); TextMeCab_Node_Cloned *TextMeCab_Node_Cloned_prev(TextMeCab_Node_Cloned *node); const char *TextMeCab_Node_Cloned_surface(TextMeCab_Node_Cloned *node); const char *TextMeCab_Node_Cloned_feature(TextMeCab_Node_Cloned *node); unsigned short TextMeCab_Node_Cloned_rcattr(TextMeCab_Node_Cloned *node); unsigned short TextMeCab_Node_Cloned_lcattr(TextMeCab_Node_Cloned *node); unsigned short TextMeCab_Node_Cloned_posid(TextMeCab_Node_Cloned *node); unsigned char TextMeCab_Node_Cloned_char_type(TextMeCab_Node_Cloned *node); unsigned char TextMeCab_Node_Cloned_stat(TextMeCab_Node_Cloned *node); unsigned char TextMeCab_Node_Cloned_isbest(TextMeCab_Node_Cloned *node); float TextMeCab_Node_Cloned_alpha(TextMeCab_Node_Cloned *node); float TextMeCab_Node_Cloned_beta(TextMeCab_Node_Cloned *node); float TextMeCab_Node_Cloned_prob(TextMeCab_Node_Cloned *node); long TextMeCab_Node_Cloned_cost(TextMeCab_Node_Cloned *node); short TextMeCab_Node_Cloned_wcost(TextMeCab_Node_Cloned *node); const char *TextMeCab_Node_Cloned_format(TextMeCab_Node_Cloned *node, TextMeCab *mecab); #endif /* __TEXT_MECAB_H__ */Text-MeCab-0.20016/xs/typemap000644 000765 000024 00000003307 12235437012 016401 0ustar00daisukestaff000000 000000 TYPEMAP TextMeCab* T_MECAB TextMeCab_Node* T_MECAB_NODE TextMeCab_Node_Cloned * T_MECAB_NODE_CLONE INPUT T_MECAB { MAGIC *mg; $var = NULL; mg = TextMeCab_mg_find(aTHX_ SvRV($arg), &TextMeCab_vtbl); if (mg) { $var = (TextMeCab *) mg->mg_ptr; } } T_MECAB_NODE $var = XS_STATE(TextMeCab_Node *, $arg); T_MECAB_NODE_CLONE $var = XS_STATE(TextMeCab_Node_Cloned *, $arg); OUTPUT T_MECAB if (!$var) /* if null */ SvOK_off($arg); /* then return as undef instead of reaf to undef */ else { /* setup $arg as a ref to a blessed hash hv */ MAGIC *mg; HV *hv = newHV(); const char *classname = \"Text::MeCab\"; /* take (sub)class name to use from class_sv if appropriate */ if (class_sv && SvOK(class_sv) && sv_derived_from(class_sv, classname)) classname = (SvROK(class_sv)) ? HvNAME(SvSTASH(class_sv)) : SvPV_nolen(class_sv); sv_setsv($arg, sv_2mortal(newRV_noinc((SV*)hv))); (void)sv_bless($arg, gv_stashpv(classname, TRUE)); /* now attach $var to the HV */ /* done as two steps to avoid sv_magic SvREFCNT_inc and MGf_REFCOUNTED */ /* sv_magic((SV*)hv, NULL, '~', NULL, 0);*/ /* PKETAMA_STATE_FROM_SV($arg) = (void *) $var; */ mg = sv_magicext((SV*)hv, NULL, PERL_MAGIC_ext, &TextMeCab_vtbl, (char*) $var, 0); /* sizeof($var)); */ mg->mg_flags |= MGf_DUP; } T_MECAB_NODE XS_STRUCT2OBJ($arg, "Text::MeCab::Node", $var); T_MECAB_NODE_CLONE XS_STRUCT2OBJ($arg, "Text::MeCab::Node::Cloned", $var); Text-MeCab-0.20016/tools/benchmark.pl000644 000765 000024 00000006526 12235124744 020007 0ustar00daisukestaff000000 000000 use strict; use Benchmark qw(cmpthese); use blib; use MeCab; use Text::MeCab; my @fields = qw(id surface feature length); my $text = <new(); for(my $node = $mecab->parseToNode($text); $node; $node = $node->{next} ) { for my $field (@fields) { $node->{$field}; } } } sub text_mecab { my $mecab = Text::MeCab->new(); for(my $node = $mecab->parse($text); $node; $node = $node->next ) { for my $field (@fields) { $node->$field(); } } } cmpthese(100, { mecab => \&mecab, text_mecab => \&text_mecab, });Text-MeCab-0.20016/tools/genfiles.pl000644 000765 000024 00000002315 12254266256 017647 0ustar00daisukestaff000000 000000 use strict; use warnings; package MeCabBuild; sub write_files { my $version = shift; write_config_const($version); } sub write_config_const { my ($version) = @_; my $contents; if ($version >= 0.99) { $contents = config_const_from_enum(); } else { $contents = config_const_from_symbol(); } open my $f, '>', 'xs/config-const.h' or die "Could not open file: $!"; print $f $contents; close $f; } my @const_names = qw( MECAB_NOR_NODE MECAB_UNK_NODE MECAB_BOS_NODE MECAB_EOS_NODE MECAB_EON_NODE MECAB_SYS_DIC MECAB_USR_DIC MECAB_UNK_DIC MECAB_ONE_BEST MECAB_NBEST MECAB_PARTIAL MECAB_MARGINAL_PROB MECAB_ALTERNATIVE MECAB_ALL_MORPHS MECAB_ALLOCATE_SENTENCE ); # for >= 0.99 sub config_const_from_enum { my $contents = ""; foreach my $name (@const_names) { $contents .= <<"END_TEMPLATE"; #define HAVE_$name 1 END_TEMPLATE } return $contents; } # for <= 0.98 sub config_const_from_symbol { my $contents = ""; foreach my $name (@const_names) { $contents .= <<"END_TEMPLATE"; #ifdef $name #define HAVE_$name 1 #endif END_TEMPLATE } return $contents; } Text-MeCab-0.20016/tools/probe_mecab.pl000644 000765 000024 00000007762 12235124744 020316 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use File::Spec; use Getopt::Long; use ExtUtils::MakeMaker (); # May specify encoding from ENV my $default_encoding = $ENV{PERL_TEXT_MECAB_ENCODING} || 'euc-jp'; my $default_config; if (! GetOptions( "encoding=s" => \$default_encoding, "mecab-config=s" => \$default_config, )) { exit 1; } # XXX Silly hack local *STDIN = *STDIN; if ($ENV{TRAVIS_TEST}) { close STDIN; } my($version, $cflags, $libs, $include, $mecab_config); $cflags = ''; $mecab_config = ''; # Save the poor puppies that run on Windows if ($^O eq 'MSWin32') { $version = ExtUtils::MakeMaker::prompt( join( "\n", "", "You seem to be running on an environment that may not have mecab-config", "available. This script uses mecab-config to auto-probe", " 1. The version string of libmecab that you are building Text::MeCab", " against. (e.g. 0.90)", " 2. Additional compiler flags that you may have built libmecab with, and", " 3. Additional linker flags that you may have build libmecab with.", " 4. Location where mecab.h header file may be found", "", "Since we can't auto-probe, you should specify the above three to proceed", "with compilation:", "", "Version of libmecab that you are compiling against (e.g. 0.90)? (REQUIRED) []" ) ); chomp $version; if (! $version) { print STDERR "no version specified! cowardly refusing to proceed."; exit; } $cflags = ExtUtils::MakeMaker::prompt("Additional compiler flags (e.g. -DWIN32 -Ic:\\path\\to\\mecab\\sdk)? []"); $libs = ExtUtils::MakeMaker::prompt("Additional linker flags (e.g. -lc:\\path\\to\\mecab\\sdk\\libmecab.lib)? [] "); $include = ExtUtils::MakeMaker::prompt("Directory containing mecab.h (e.g. c:\\path\\to\\include)? [] "); } else { # try probing in places where we expect it to be if (! defined $default_config || ! -x $default_config) { foreach my $path (qw(/usr/bin /usr/local/bin /opt/local/bin)) { my $tmp = File::Spec->catfile($path, 'mecab-config'); if (-f $tmp && -x _) { $default_config = $tmp; last; } } } $mecab_config = ExtUtils::MakeMaker::prompt( "Path to mecab config?", $default_config ); if (!-f $mecab_config || ! -x _) { print STDERR "Can't proceed without mecab-config. Aborting...\n"; exit; } $version = `$mecab_config --version`; chomp $version; $cflags = `$mecab_config --cflags`; chomp($cflags); $libs = `$mecab_config --libs`; chomp($libs); $include = `$mecab_config --inc-dir`; chomp $include; } print "detected mecab version $version\n"; if ($version < 0.90) { print " + mecab version < 0.90 doesn't contain some of the features\n", " + that are available in Text::MeCab. Please read the documentation\n", " + carefully before using\n"; } my($major, $minor, $micro) = map { s/\D+//g; $_ } split(/\./, $version); $cflags .= " -DMECAB_MAJOR_VERSION=$major -DMECAB_MINOR_VERSION=$minor"; # remove whitespaces from beginning and ending of strings $cflags =~ s/^\s+//; $cflags =~ s/\s+$//; print "Using compiler flags '$cflags'...\n"; if ($libs) { $libs =~ s/^\s+//; $libs =~ s/\s+$//; print "Using linker flags '$libs'...\n"; } else { print "No linker flags specified\n"; } my $encoding = ExtUtils::MakeMaker::prompt( join( "\n", "", "Text::MeCab needs to know what encoding you built your dictionary with", "to properly execute tests.", "", "Encoding of your mecab dictionary? (shift_jis, euc-jp, utf-8)", ), $default_encoding ); print "Using $encoding as your dictionary encoding\n"; return { version => $version, cflags => $cflags, libs => $libs, include => $include, encoding => $encoding, config => $mecab_config, }; Text-MeCab-0.20016/t/01-sanity.t000644 000765 000024 00000003614 12254266256 016536 0ustar00daisukestaff000000 000000 #!perl use strict; use Test::More; BEGIN { use_ok("Text::MeCab", ':all'); } my $version = Text::MeCab::version(); diag $version; is $version, Text::MeCab::MECAB_VERSION(), "version ok"; if ($version >= 0.90 && $version <= 0.996) { ok(eval { defined MECAB_NOR_NODE } && !$@, "MECAB_NOR_NODE ok"); ok(eval { defined MECAB_UNK_NODE } && !$@, "MECAB_UNK_NODE ok"); ok(eval { defined MECAB_BOS_NODE } && !$@, "MECAB_BOS_NODE ok"); ok(eval { defined MECAB_EOS_NODE } && !$@, "MECAB_EOS_NODE ok"); } if ($version >= 0.98 && $version <= 0.996) { ok(eval { defined MECAB_EON_NODE } && !$@, "MECAB_EON_NODE ok"); } if ($version >= 0.94 && $version <= 0.996) { ok(eval { defined MECAB_SYS_DIC } && !$@, "MECAB_SYS_DIC ok"); ok(eval { defined MECAB_USR_DIC } && !$@, "MECAB_USR_DIC ok"); ok(eval { defined MECAB_UNK_DIC } && !$@, "MECAB_UNK_DIC ok"); } if ($version >= 0.99 && $version <= 0.996) { ok(eval { defined MECAB_ONE_BEST } && !$@, "MECAB_ONE_BEST ok"); ok(eval { defined MECAB_NBEST } && !$@, "MECAB_NBEST ok"); ok(eval { defined MECAB_PARTIAL } && !$@, "MECAB_PARTIAL ok"); ok(eval { defined MECAB_MARGINAL_PROB } && !$@, "MECAB_MARGINAL_PROB ok"); ok(eval { defined MECAB_ALTERNATIVE } && !$@, "MECAB_ALTERNATIVE ok"); ok(eval { defined MECAB_ALL_MORPHS } && !$@, "MECAB_ALL_MORPHS ok"); ok(eval { defined MECAB_ALLOCATE_SENTENCE } && !$@, "MECAB_ALLOCATE_SENTENCE ok"); } can_ok("Text::MeCab", qw(new parse)); # Make sure that what Text::MeCab::Node can, Text::MeCab::Node::Cloned # also can do. my @methods = ( qw(id surface feature length prev next stat cost), qw(rlength rcattr lcattr posid char_type isbest alpha beta prob wcost) ); foreach my $method (@methods) { # test one by one to make it easier to read can_ok("Text::MeCab::Node", $method); can_ok("Text::MeCab::Node::Cloned", $method); } done_testing; Text-MeCab-0.20016/t/node/000755 000765 000024 00000000000 12256221670 015536 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/t/regression/000755 000765 000024 00000000000 12256221670 016771 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/t/strings.dat000644 000765 000024 00000000412 12235124744 016772 0ustar00daisukestaff000000 000000 do { require MIME::Base64; { sumomo => pack("H*","e38199e38282e38282e38282e38282e38282e38282e38282e38282e381aee38186e381a1e38082"), taro => MIME::Base64::decode("5aSq6YOO44Gv5qyh6YOO44GM5oyB44Gj44Gm44GE44KL5pys44KS6Iqx5a2Q44Gr5rih44GX44Gf44CC"), }; }Text-MeCab-0.20016/t/tagger/000755 000765 000024 00000000000 12256221670 016062 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/t/tagger/01_load.t000644 000765 000024 00000000155 12235124744 017470 0ustar00daisukestaff000000 000000 use strict; use Test::More (tests => 2); BEGIN { use_ok("Text::MeCab"); } can_ok("Text::MeCab", "new");Text-MeCab-0.20016/t/tagger/02_api.t000644 000765 000024 00000000165 12235124744 017324 0ustar00daisukestaff000000 000000 use strict; use Test::More (tests => 2); BEGIN { use_ok("Text::MeCab"); } can_ok("Text::MeCab", qw(new parse));Text-MeCab-0.20016/t/tagger/03_basic.t000644 000765 000024 00000002120 12235124744 017626 0ustar00daisukestaff000000 000000 #!perl use strict; use utf8; use Test::More qw(no_plan); use Encode; BEGIN { use_ok("Text::MeCab"); } my $data = encode(Text::MeCab::ENCODING, "太郎は次郎が持っている本を花子に渡した。"); my $mecab = Text::MeCab->new({ all_morphs => 1 }); ok($mecab); my @fields = qw(surface feature length cost); if (&Text::MeCab::MECAB_VERSION >= 0.90) { push @fields, qw(rcattr lcattr stat isbest alpha beta prob wcost); } for ( my $node = $mecab->parse($data); $node; $node = $node->next ) { foreach my $field (@fields) { my $p = eval { $node->$field }; ok(!$@, "$field ok (" . (defined $p ? encode_utf8(decode(Text::MeCab::ENCODING, $p)) : "(null)") . ")"); } } $mecab = Text::MeCab->new({ all_morphs => 1 }); ok($mecab); for ( my $node = $mecab->parse($data); $node; $node = $node->next ) { foreach my $field (@fields) { my $p = eval { $node->$field }; ok(!$@, "$field encoded ok (" . (defined $p ? encode_utf8(decode(Text::MeCab::ENCODING, $p)) : "(null)") . ")"); } } 1;Text-MeCab-0.20016/t/regression/01_tomi_args.t000644 000765 000024 00000001356 12235124744 021450 0ustar00daisukestaff000000 000000 use strict; use Test::More; BEGIN { eval "use MeCab"; if ($@) { plan skip_all => "SWIG MeCab not available"; } else { plan tests => 2; use_ok("Text::MeCab"); } } my $text = ""; my $swig_result = ''; { my $swig_mecab = MeCab::Tagger->new("--all-morphs"); for ( my $node = $swig_mecab->parseToNode($text); $node; $node = $node->{next} ) { $swig_result .= $node->{feature}."\n"; } } my $xs_result = ''; { my $xs_mecab = Text::MeCab->new({ all_morphs => 1 }); for ( my $node = $xs_mecab->parse($text); $node; $node = $node->next ) { $xs_result .= $node->feature . "\n"; } } is $xs_result, $swig_result; Text-MeCab-0.20016/t/node/01_load.t000644 000765 000024 00000000164 12235124744 017144 0ustar00daisukestaff000000 000000 use strict; use Test::More (tests => 2); BEGIN { use_ok("Text::MeCab"); } can_ok("Text::MeCab::Node", "next");Text-MeCab-0.20016/t/node/02_api.t000644 000765 000024 00000000362 12235124744 016777 0ustar00daisukestaff000000 000000 use strict; use Test::More (tests => 2); BEGIN { use_ok("Text::MeCab"); } can_ok("Text::MeCab::Node", qw(id surface feature length prev next stat cost), qw(rlength rcattr lcattr posid char_type isbest alpha beta prob wcost) ); Text-MeCab-0.20016/t/node/03_clone.t000644 000765 000024 00000002663 12235124744 017335 0ustar00daisukestaff000000 000000 #!perl use strict; use utf8; use Test::More; use Encode; BEGIN { use_ok("Text::MeCab"); } my $data = { taro => encode(Text::MeCab::ENCODING, "太郎は次郎が持っている本を花子に渡した。"), sumomo => encode(Text::MeCab::ENCODING, "すもももももももものうち。"), }; my $mecab = Text::MeCab->new; my ($node_A, $node_B); { my $node_A_orig = $mecab->parse($data->{taro}); ok($node_A_orig, "Original node A OK"); $node_A = $node_A_orig->dclone; ok $node_A, "Clone Node A successful"; my $node = $node_A; while ( $node_A_orig ) { check_node( $node, $node_A_orig ); $node = $node->next; $node_A_orig = $node_A_orig->next; } } { my $node_B_orig = $mecab->parse($data->{sumomo}); ok($node_B_orig, "Original node B OK"); $node_B = $node_B_orig->dclone; ok $node_B, "Clone Node B successful"; my $node = $node_B; while ( $node_B_orig ) { check_node( $node, $node_B_orig ); $node = $node->next; $node_B_orig = $node_B_orig->next; } } # finally, make sure that node_A, node_B are NOT identical ok $node_A; ok $node_B; isnt $node_A->surface, $node_B->surface; done_testing(); sub check_node { my ($clone, $orig) = @_; if (ok($clone, "Deep clone node OK")) { note $clone->surface; } isa_ok($clone, "Text::MeCab::Node::Cloned", "Deep clone node isa OK"); is $clone->surface, $orig->surface; } Text-MeCab-0.20016/t/node/04_clone_free.t000644 000765 000024 00000000572 12235124744 020334 0ustar00daisukestaff000000 000000 #!perl use strict; use utf8; use Test::More qw(no_plan); use Encode; BEGIN { use_ok("Text::MeCab"); } my $node; my $data = encode(Text::MeCab::ENCODING, "太郎は次郎が持っている本を花子に渡した。"); { my $mecab = Text::MeCab->new; $node = $mecab->parse($data); $mecab = undef; } ok($node); # yes, node exists, but DO NOT use node->surface. Text-MeCab-0.20016/t/node/05_format.t000644 000765 000024 00000002455 12235124744 017526 0ustar00daisukestaff000000 000000 use strict; use utf8; use Test::More qw(no_plan); use Encode qw(encode from_to); BEGIN { use_ok("Text::MeCab"); } my $text = encode(Text::MeCab::ENCODING, "となりの客は良く柿食う客だ"); my $mecab = Text::MeCab->new({ node_format => "%m", }); for( my $node = $mecab->parse($text); $node; $node = $node->next ) { my $surface = $node->surface; from_to( $surface, Text::MeCab::ENCODING, 'utf-8'); next unless $surface; my $format = $node->format($mecab); my $feature = $node->feature; if (ok($format, "format returns " . (defined $format ? $format : '(null)') . "'")) { unlike($format, qr/,/, "'$format' doesn't contain any comma"); like($feature, qr/,/, "'$feature' does contain commas"); } } for( my $node = $mecab->parse($text)->dclone; $node; $node = $node->next ) { my $surface = $node->surface; from_to( $surface, Text::MeCab::ENCODING, 'utf-8'); next unless $surface; my $format = $node->format($mecab); my $feature = $node->feature; if (ok($format, "format returns '" . (defined $format ? $format : '(null)') . "' for surface '$surface'") ) { unlike($format, qr/,/, "'$format' doesn't contain any comma"); like($feature, qr/,/, "'$feature' does contain commas"); } } Text-MeCab-0.20016/lib/Text/000755 000765 000024 00000000000 12256221670 016040 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/lib/Text/MeCab/000755 000765 000024 00000000000 12256221670 017007 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/lib/Text/MeCab.pm000644 000765 000024 00000020557 12256221631 017353 0ustar00daisukestaff000000 000000 package Text::MeCab; use strict; use warnings; use 5.006; use Exporter 'import'; our ($VERSION, @ISA, %EXPORT_TAGS, @EXPORT_OK); BEGIN { $VERSION = '0.20016'; if ($] > 5.006) { require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); } else { require DynaLoader; @ISA = qw(DynaLoader); __PACKAGE__->bootstrap; } %EXPORT_TAGS = (all => [ qw( MECAB_NOR_NODE MECAB_UNK_NODE MECAB_BOS_NODE MECAB_EOS_NODE MECAB_EON_NODE MECAB_SYS_DIC MECAB_USR_DIC MECAB_UNK_DIC MECAB_ONE_BEST MECAB_NBEST MECAB_PARTIAL MECAB_MARGINAL_PROB MECAB_ALTERNATIVE MECAB_ALL_MORPHS MECAB_ALLOCATE_SENTENCE ) ]); @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; } my %BOOLEAN_OPTIONS = ( map { ($_, 'bool') } qw( --all-morphs --partial --allocate-sentence --version --help ) ); sub new { my $class = shift; my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_; $args{'allocate-sentence'} = 1; my @args = ('perl-TextMeCab'); while (my($key, $value) = each %args) { $key =~ s/_/-/g; $key =~ s/^/--/; if (exists $BOOLEAN_OPTIONS{$key}) { push @args, $key; } else { push @args, join('=', $key, $value); } } $class->_xs_create(\@args); } 1; __END__ =head1 NAME Text::MeCab - Alternate Interface To libmecab =head1 SYNOPSIS use Text::MeCab; my $mecab = Text::MeCab->new({ rcfile => $rcfile, dicdir => $dicdir, userdic => $userdic, lattice_level => $lattice_level, all_morphs => $all_morphs, output_format_type => $output_format_type, partial => $partial, node_format => $node_format, unk_format => $unk_format, bos_format => $bos_format, eos_format => $eos_format, input_buffer_size => $input_buffer_size, allocate_sentence => $allocate_sentence, nbest => $nbest, theta => $theta, }); for (my $node = $mecab->parse($text); $node; $node = $node->next) { # See perdoc for Text::MeCab::Node for list of methods print $node->surface, "\n"; } # use constants use Text::MeCab qw(:all); use Text::MeCab qw(MECAB_NOR_NODE); # check what mecab version we compiled against? print "Compiled with ", &Text::MeCab::MECAB_VERSION, "\n"; =head1 DESCRIPTION libmecab (http://mecab.sourceforge.ne.jp) already has a perl interface built with it, so why a new module? I just feel that while a subtle difference, making the perl interface through a tied hash is just... weird. So Text::MeCab gives you a more natural, Perl-ish way to access libmecab! WARNING: Version 0.20015 has only been tested against libmecab 0.99. =head1 INSTALLATION You need to have mecab already installed. You also need a dictionary, such as ipadic. Because we want to work with UTF-8 internally, we need to know what your dictionary's charset is. You need to tell our probe script (which gets invoked by Makefile.PL) interactively asks you this. If you want to specify it from elsewhere, you need to specify via environment variable: PERL_TEXT_MECAB_ENCODING=utf-8 perl Makefile.PL # or, say, you're using cpanm PERL_TEXT_MECAB_ENCODING=utf-8 cpanm Text::MeCab If you want to build Text::MeCab with debugging info, specify it on the comamnd line to Makefile.PL: perl Makefile.PL --debugging =head1 Text::MeCab AND FORMATS mecab allows users to specify an output format, via --*-format options. These are respected ONLY if you use the format() method: my $mecab = Text::MeCab->new({ output_format_type => "user", node_format => "%m %pn" }); for(my $node = $mecab->parse($text); $node; $node = $node->next) { print $node->format($mecab); } Note that you also need to set the output_format_type parameter as well. =head1 Text::MeCab AND SCOPING [NOTE: The memory management issue has been changed since 0.09] libmecab's default behavior is such that when you analyze a text and get a node back, that node is tied to the mecab "tagger" object that performed the analysis. Therefore, when that tagger is destroyed via mecab_destroy(), all nodes that are associated to it are freed as well. Text::MeCab defaults to the same behavior, so the following won't work: sub get_mecab_node { my $mecab = Text::MeCab->new; my $node = $mecab->parse($_[0]); return $node; } my $node = get_mecab_node($text); By the time get_mecab_node() returns, the Text::MeCab object is DESTROY'ed, and so is $node (actually, the object exists, but it will complain when you try to access the node's internals, because the C struct that was there has already been freed). In such cases, use the dclone() method. This will copy the *entire* node structure and create a new Text::MeCab::Node::Cloned instance. sub get_mecab_node { my $mecab = Text::MeCab->new; my $node = $mecab->parse($_[0]); return $node->dclone(); } The returned Text::MeCab::Node::Cloned object is exactly the same as Text::MeCab::Node object on the surface. It just uses a different but very similar C struct underneath. It is blessed into a different namespace only because we need to use a different memory management strategy. Do be aware of the memory issue. You WILL use up twice as much memory. Also please note that if you try the first example, accessing the node *WILL* result in a segfault. This is *NOT* a bug: it's a feature :) While it is possible to control the memory management such that accessing a field in a node that has already expired results in a legal croak(), we do not go to the length to ensure this, because it will result in a performance penalty. Just remember that unless you dclone() a node, then you are NOT allowed to access it when the original tagger goes out scope: { my $mecab = Text::MeCab->new; $node = $mecab->parse(...); } $node->surface; # segfault!!!! Always remember to dclone() before doing this! =head1 PERFORMANCE Belows is the result of running tools/benchmark.pl on my PowerBook: daisuke@beefcake Text-MeCab$ perl tools/benchmark.pl Rate mecab text_mecab mecab 5.53/s -- -63% text_mecab 14.9/s 170% -- =head1 METHODS =head2 new HASHREF | LIST Creates a new Text::MeCab instance. You can either specify a hashref and use named parameters, or you can use the exact command line arguments that the mecab command accepts. Below is the list of accepted named options. See the man page for mecab for details about each option. =over 4 =item B =item B =item B =item B =item B =item B t =item B =item B =item B =item B =item B =item B =item B =item B =back =head2 $node = $tagger-Eparse(SCALAR) Parses the given text via mecab, and returns a Text::MeCab::Node object. =head2 $version = Text::MeCab::version() The version number, as returned by libmecab's mecab_version(); =head2 CONSTANTS =over 4 =item ENCODING my $encoding = Text::MeCab::ENCODING Returns the encoding of the underlying mecab library that was detected at compile time. =item MECAB_VERSION The version number, same as Text::MeCab::version() =item MECAB_TARGET_VERSION The version number detected at compile time of Text::MeCab. =item MECAB_TARGET_MAJOR_VERSION The version number detected at compile time of Text::MeCab. =item MECAB_TARGET_MINOR_VERSION The version number detected at compile time of Text::MeCab. =item MECAB_CONFIG Path to mecab-config, if available. =item MECAB_NOR_NODE =item MECAB_UNK_NODE =item MECAB_BOS_NODE =item MECAB_EOS_NODE =item MECAB_EON_NODE =item MECAB_SYS_DIC =item MECAB_USR_DIC =item MECAB_UNK_DIC =item MECAB_ONE_BEST =item MECAB_NBEST =item MECAB_PARTIAL =item MECAB_MARGINAL_PROB =item MECAB_ALTERNATIVE =item MECAB_ALL_MORPHS =item MECAB_ALLOCATE_SENTENCE =back =head1 SEE ALSO http://mecab.sourceforge.ne.jp =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://www.perl.com/perl/misc/Artistic.html =head1 AUTHOR Copyright (c) 2006-2011 Daisuke Maki Edaisuke@endeworks.jpE All rights reserved. =cut Text-MeCab-0.20016/lib/Text/MeCab/Dict.pm000644 000765 000024 00000013530 12235124737 020235 0ustar00daisukestaff000000 000000 package Text::MeCab::Dict; use strict; use warnings; use base qw(Class::Accessor::Fast); use Encode; use Text::MeCab; use File::Spec; use Cwd (); our $MAKE = 'make'; __PACKAGE__->mk_accessors($_) for qw(entries config dict_source libexecdir input_encoding output_encoding); sub new { my $class = shift; my %args = @_; my $libexecdir; my $config = $args{mecab_config} || &Text::MeCab::MECAB_CONFIG; my $dict_source = $args{dict_source}; # XXX - the way we're rebuilding the index is by combining the new # words with words that are already provided by mecab-ipadic distro. # So when later when we call mecab-dict-index, all of these words are # compiled together. # Naturally, the encoding parameter must match with the other words. # As of this writing, mecab-ipadic's original dictionary is in euc-jp, # and there fore that's what we shall use for default. my $ie = $args{ie} || $args{input_encoding} || 'euc-jp'; my $oe = $args{oe} || $args{output_encoding} || &Text::MeCab::ENCODING; if (! $config) { $libexecdir = $args{libexecdir}; } else { $libexecdir = `$config --libexecdir`; chomp $libexecdir; } if (! $dict_source || ! $libexecdir) { die "You must specify dict_source and libexecdir"; } my $self = bless { config => $config, entries => [], dict_source => $dict_source, libexecdir => $libexecdir, input_encoding => $ie, output_encoding => $oe, }, $class; } sub add { my $self = shift; my $entry; if (scalar @_ == 1) { $entry = shift @_; } else { my %args = @_; $entry = Text::MeCab::Dict::Entry->new(%args); } push @{ $self->entries }, $entry; } sub write { my $self = shift; my $file = shift; my @output; my $entries = $self->entries; my @columns = qw( surface left_id right_id cost pos category1 category2 category3 inflect inflect_type original yomi pronounce ); foreach my $entry (@$entries) { my @values = map { defined $entry->$_ ? $entry->$_ : '*' } @columns; if (my $extra = $entry->extra) { push @values, @$extra; } # We don't use Text::CSV_XS, because the csv format that mecab-dict-index # expects is a bit off (in terms of CSV-stricture) push @output, join(",", @values); } if (! File::Spec->file_name_is_absolute( $file )) { $file = File::Spec->catfile( $self->dict_source, $file ); } my $fh; open( $fh, '>>', $file ) or die "Could not open file $file for append writing: $!"; print $fh encode($self->input_encoding, join("\n", @output, "")); close $fh; $self->entries([]); } sub rebuild { my $self = shift; my $dict_source = $self->dict_source; my $dict_index = File::Spec->catfile($self->libexecdir, 'mecab-dict-index'); my $curdir = Cwd::cwd(); eval { chdir $dict_source; my @cmds = ( [ $dict_index, '-f', $self->input_encoding, '-t', $self->output_encoding ], [ $MAKE, "install" ] ); foreach my $cmd (@cmds) { if (system(@$cmd) != 0) { die "Failed to execute '@$cmd': $!"; } } chdir $curdir; }; if (my $e = $@) { chdir $curdir; die $e; } } package Text::MeCab::Dict::Entry; use strict; use warnings; use base qw(Class::Accessor::Fast); __PACKAGE__->mk_accessors($_) for qw( surface left_id right_id cost pos category1 category2 category3 inflect inflect_type original yomi pronounce extra ); sub new { my $class = shift; $class->SUPER::new({ left_id => -1, right_id => -1, cost => 0, @_ }); } 1; __END__ =encoding UTF-8 =head1 NAME Text::MeCab::Dict - Utility To Work With MeCab Dictionary =head1 SYNOPSIS use Text::MeCab::Dict; my $dict = Text::MeCab::Dict->new( dict_source => "/path/to/mecab-ipadic-source" ); $dict->add( surface => $surface, # 表層形 left_id => $left_id, # 左文脈ID right_id => $right_id, # 右文脈ID cost => $cost, # コスト pos => $part_of_speech, # 品詞 category1 => $category1, # 品詞細分類1 category2 => $category2, # 品詞細分類2 category3 => $category3, # 品詞細分類3 # XXX this below two parameter names need blessing from a knowing # expert, and is subject to change inflect => $inflect, # 活用形 inflect_type => $inflect_type, # 活用型 original => $original, # 原形 yomi => $yomi, # 読み pronounce => $pronounce, # 発音 extra => \@extras, # ユーザー設定 ); $dict->write('foo.csv'); $dict->rebuild(); =head1 METHODS =head2 new Creates a new instance of Text::MeCab::Dict. The path to the source of mecab-ipadic is required: my $dict = Text::MeCab::Dict->new( dict_source => "/path/to/mecab-ipadic-source" ); If you are in an environment where mecab-config is NOT available, you must also specify libexecdir, which is where mecab-dict-index is installed: my $dict = Text::MeCab::Dict->new( dict_source => "/path/to/mecab-ipadic-source", libexecdir => "/path/to/mecab/libexec/", ); =head2 add Adds a new entry to be appended to the dictionary. Please see SYNOPSIS for arguments. =head2 write Writes out the entries that were added via add() to the specified file location. If the file name does not look like an absolute path, the name will be treated relatively from dict_source =head2 rebuild Rebuilds the index. This usually requires that you are have root privileges =head1 SEE ALSO http://mecab.sourceforge.net/dic.html =cut Text-MeCab-0.20016/lib/Text/MeCab/Node.pod000644 000765 000024 00000001343 12235124737 020404 0ustar00daisukestaff000000 000000 =head1 NAME Text::MeCab::Node - MeCab Node Object =head1 SYNOPSIS use Text::MeCab; my $mecab = Text::MeCab->new(); my $node = $mecab->parse($text); $node->id; $node->surface; $node->length; $node->rlength; $node->feature; $node->next; $node->prev; $node->rcattr; $node->lcattr; $node->stat; $node->isbest; $node->alpha; $node->beta; $node->prob; $node->wcost; $node->cost; $node->format($mecab); =head1 DESCRIPTION Text::MeCab::Node encapsulates the mecab node structure returned by parsing some text. =head1 METHODS =head2 format($mecab) Given a mecab instance, formats the node as specified by the option arguments (e.g. --node-format) =head1 SEE ALSO L =cutText-MeCab-0.20016/inc/Devel/000755 000765 000024 00000000000 12256221670 016156 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/inc/Module/000755 000765 000024 00000000000 12256221670 016344 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/inc/Module/Install/000755 000765 000024 00000000000 12256221670 017752 5ustar00daisukestaff000000 000000 Text-MeCab-0.20016/inc/Module/Install.pm000644 000765 000024 00000030135 12256221664 020315 0ustar00daisukestaff000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Text-MeCab-0.20016/inc/Module/Install/AuthorTests.pm000644 000765 000024 00000002215 12256221666 022602 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::AuthorTests; use 5.005; use strict; use Module::Install::Base; use Carp (); #line 16 use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.002'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } #line 42 sub author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 0); } #line 56 sub recursive_author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 1); } sub _wanted { my $href = shift; sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } } sub _add_author_tests { my ($self, $dirs, $recurse) = @_; return unless $Module::Install::AUTHOR; my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t'; # XXX: pick a default, later -- rjbs, 2008-02-24 my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests"; @dirs = grep { -d } @dirs; if ($recurse) { require File::Find; my %test_dir; File::Find::find(_wanted(\%test_dir), @dirs); $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir ); } else { $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs ); } } #line 107 1; Text-MeCab-0.20016/inc/Module/Install/Base.pm000644 000765 000024 00000002147 12256221666 021173 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Text-MeCab-0.20016/inc/Module/Install/Can.pm000644 000765 000024 00000006157 12256221666 021027 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Text-MeCab-0.20016/inc/Module/Install/CheckLib.pm000644 000765 000024 00000002442 12256221666 021763 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::CheckLib; use strict; use warnings; use File::Spec; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.08'; sub checklibs { my $self = shift; my @parms = @_; return unless scalar @parms; unless ( $Module::Install::AUTHOR ) { require Devel::CheckLib; Devel::CheckLib::check_lib_or_exit( @parms ); return; } _author_side(); } sub assertlibs { my $self = shift; my @parms = @_; return unless scalar @parms; unless ( $Module::Install::AUTHOR ) { require Devel::CheckLib; Devel::CheckLib::assert_lib( @parms ); return; } _author_side(); } sub _author_side { mkdir 'inc'; mkdir 'inc/Devel'; print "Extra directories created under inc/\n"; require Devel::CheckLib; local $/ = undef; open(CHECKLIBPM, $INC{'Devel/CheckLib.pm'}) || die("Can't read $INC{'Devel/CheckLib.pm'}: $!"); (my $checklibpm = ) =~ s/package Devel::CheckLib/package #\nDevel::CheckLib/; close(CHECKLIBPM); open(CHECKLIBPM, '>'.File::Spec->catfile(qw(inc Devel CheckLib.pm))) || die("Can't write inc/Devel/CheckLib.pm: $!"); print CHECKLIBPM $checklibpm; close(CHECKLIBPM); print "Copied Devel::CheckLib to inc/ directory\n"; return 1; } 'All your libs are belong'; __END__ #line 126 Text-MeCab-0.20016/inc/Module/Install/Fetch.pm000644 000765 000024 00000004627 12256221666 021357 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Text-MeCab-0.20016/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 12256221666 022047 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Text-MeCab-0.20016/inc/Module/Install/Metadata.pm000644 000765 000024 00000043277 12256221666 022052 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Text-MeCab-0.20016/inc/Module/Install/Repository.pm000644 000765 000024 00000004256 12256221666 022503 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Repository; use strict; use 5.005; use vars qw($VERSION); $VERSION = '0.06'; use base qw(Module::Install::Base); sub _execute { my ($command) = @_; `$command`; } sub auto_set_repository { my $self = shift; return unless $Module::Install::AUTHOR; my $repo = _find_repo(\&_execute); if ($repo) { $self->repository($repo); } else { warn "Cannot determine repository URL\n"; } } sub _find_repo { my ($execute) = @_; if (-e ".git") { # TODO support remote besides 'origin'? if ($execute->('git remote show -n origin') =~ /URL: (.*)$/m) { # XXX Make it public clone URL, but this only works with github my $git_url = $1; $git_url =~ s![\w\-]+\@([^:]+):!git://$1/!; return $git_url; } elsif ($execute->('git svn info') =~ /URL: (.*)$/m) { return $1; } } elsif (-e ".svn") { if (`svn info` =~ /URL: (.*)$/m) { return $1; } } elsif (-e "_darcs") { # defaultrepo is better, but that is more likely to be ssh, not http if (my $query_repo = `darcs query repo`) { if ($query_repo =~ m!Default Remote: (http://.+)!) { return $1; } } open my $handle, '<', '_darcs/prefs/repos' or return; while (<$handle>) { chomp; return $_ if m!^http://!; } } elsif (-e ".hg") { if ($execute->('hg paths') =~ /default = (.*)$/m) { my $mercurial_url = $1; $mercurial_url =~ s!^ssh://hg\@(bitbucket\.org/)!https://$1!; return $mercurial_url; } } elsif (-e "$ENV{HOME}/.svk") { # Is there an explicit way to check if it's an svk checkout? my $svk_info = `svk info` or return; SVK_INFO: { if ($svk_info =~ /Mirrored From: (.*), Rev\./) { return $1; } if ($svk_info =~ m!Merged From: (/mirror/.*), Rev\.!) { $svk_info = `svk info /$1` or return; redo SVK_INFO; } } return; } } 1; __END__ =encoding utf-8 #line 128 Text-MeCab-0.20016/inc/Module/Install/Win32.pm000644 000765 000024 00000003403 12256221666 021217 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Text-MeCab-0.20016/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002376 12256221666 022050 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Text-MeCab-0.20016/inc/Module/Install/XSUtil.pm000644 000765 000024 00000045650 12256221666 021517 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::XSUtil; use 5.005_03; $VERSION = '0.44'; use Module::Install::Base; @ISA = qw(Module::Install::Base); use strict; use Config; use File::Spec; use File::Find; use constant _VERBOSE => $ENV{MI_VERBOSE} ? 1 : 0; my %ConfigureRequires = ( 'ExtUtils::ParseXS' => 2.21, ); my %BuildRequires = ( ); my %Requires = ( 'XSLoader' => 0.02, ); my %ToInstall; my $UseC99 = 0; my $UseCplusplus = 0; sub _verbose{ print STDERR q{# }, @_, "\n"; } sub _xs_debugging{ return $ENV{XS_DEBUG} || scalar( grep{ $_ eq '-g' } @ARGV ); } sub _xs_initialize{ my($self) = @_; unless($self->{xsu_initialized}){ $self->{xsu_initialized} = 1; if(!$self->cc_available()){ warn "This distribution requires a C compiler, but it's not available, stopped.\n"; exit; } $self->configure_requires(%ConfigureRequires); $self->build_requires(%BuildRequires); $self->requires(%Requires); $self->makemaker_args->{OBJECT} = '$(O_FILES)'; $self->clean_files('$(O_FILES)'); $self->clean_files('*.stackdump') if $^O eq 'cygwin'; if($self->_xs_debugging()){ # override $Config{optimize} if(_is_msvc()){ $self->makemaker_args->{OPTIMIZE} = '-Zi'; } else{ $self->makemaker_args->{OPTIMIZE} = '-g -ggdb -g3'; } $self->cc_define('-DXS_ASSERT'); } } return; } # GNU C Compiler sub _is_gcc{ return $Config{gccversion}; } # Microsoft Visual C++ Compiler (cl.exe) sub _is_msvc{ return $Config{cc} =~ /\A cl \b /xmsi; } { my $cc_available; sub cc_available { return defined $cc_available ? $cc_available : ($cc_available = shift->can_cc()) ; } # cf. https://github.com/sjn/toolchain-site/blob/219db464af9b2f19b04fec05547ac10180a469f3/lancaster-consensus.md my $want_xs; sub want_xs { my($self, $default) = @_; return $want_xs if defined $want_xs; # you're using this module, you must want XS by default # unless PERL_ONLY is true. $default = !$ENV{PERL_ONLY} if not defined $default; foreach my $arg(@ARGV){ my ($k, $v) = split '=', $arg; # MM-style named args if ($k eq 'PUREPERL_ONLY' && defined $v) { return $want_xs = !$v; } elsif($arg eq '--pp'){ # old-style return $want_xs = 0; } elsif($arg eq '--xs'){ return $want_xs = 1; } } if ($ENV{PERL_MM_OPT}) { my($v) = $ENV{PERL_MM_OPT} =~ /\b PUREPERL_ONLY = (\S+) /xms; if (defined $v) { return $want_xs = !$v; } } return $want_xs = $default; } } sub use_ppport{ my($self, $dppp_version) = @_; return if $self->{_ppport_ok}++; $self->_xs_initialize(); my $filename = 'ppport.h'; $dppp_version ||= 3.19; # the more, the better $self->configure_requires('Devel::PPPort' => $dppp_version); $self->build_requires('Devel::PPPort' => $dppp_version); print "Writing $filename\n"; my $e = do{ local $@; eval qq{ use Devel::PPPort; Devel::PPPort::WriteFile(q{$filename}); }; $@; }; if($e){ print "Cannot create $filename because: $@\n"; } if(-e $filename){ $self->clean_files($filename); $self->cc_define('-DUSE_PPPORT'); $self->cc_append_to_inc('.'); } return; } sub use_xshelper { my($self, $opt) = @_; $self->_xs_initialize(); $self->use_ppport(); my $file = 'xshelper.h'; open my $fh, '>', $file or die "Cannot open $file for writing: $!"; print $fh $self->_xshelper_h(); close $fh or die "Cannot close $file: $!"; if(defined $opt) { if($opt eq '-clean') { $self->clean_files($file); } else { $self->realclean_files($file); } } return; } sub _gccversion { my $res = `$Config{cc} --version`; my ($version) = $res =~ /\(GCC\) ([0-9.]+)/; no warnings 'numeric', 'uninitialized'; return sprintf '%g', $version; } sub cc_warnings{ my($self) = @_; $self->_xs_initialize(); if(_is_gcc()){ $self->cc_append_to_ccflags(qw(-Wall)); my $gccversion = _gccversion(); if($gccversion >= 4.0){ $self->cc_append_to_ccflags(qw(-Wextra)); if(!($UseC99 or $UseCplusplus)) { # Note: MSVC++ doesn't support C99, # so -Wdeclaration-after-statement helps # ensure C89 specs. $self->cc_append_to_ccflags(qw(-Wdeclaration-after-statement)); } if($gccversion >= 4.1 && !$UseCplusplus) { $self->cc_append_to_ccflags(qw(-Wc++-compat)); } } else{ $self->cc_append_to_ccflags(qw(-W -Wno-comment)); } } elsif(_is_msvc()){ $self->cc_append_to_ccflags(qw(-W3)); } else{ # TODO: support other compilers } return; } sub c99_available { my($self) = @_; return 0 if not $self->cc_available(); require File::Temp; require File::Basename; my $tmpfile = File::Temp->new(SUFFIX => '.c'); $tmpfile->print(<<'C99'); // include a C99 header #include inline // a C99 keyword with C99 style comments int test_c99() { int i = 0; i++; int j = i - 1; // another C99 feature: declaration after statement return j; } C99 $tmpfile->close(); system "$Config{cc} -c " . $tmpfile->filename; (my $objname = File::Basename::basename($tmpfile->filename)) =~ s/\Q.c\E$/$Config{_o}/; unlink $objname or warn "Cannot unlink $objname (ignored): $!"; return $? == 0; } sub requires_c99 { my($self) = @_; if(!$self->c99_available) { warn "This distribution requires a C99 compiler, but $Config{cc} seems not to support C99, stopped.\n"; exit; } $self->_xs_initialize(); $UseC99 = 1; return; } sub requires_cplusplus { my($self) = @_; if(!$self->cc_available) { warn "This distribution requires a C++ compiler, but $Config{cc} seems not to support C++, stopped.\n"; exit; } $self->_xs_initialize(); $UseCplusplus = 1; return; } sub cc_append_to_inc{ my($self, @dirs) = @_; $self->_xs_initialize(); for my $dir(@dirs){ unless(-d $dir){ warn("'$dir' not found: $!\n"); } _verbose "inc: -I$dir" if _VERBOSE; } my $mm = $self->makemaker_args; my $paths = join q{ }, map{ s{\\}{\\\\}g; qq{"-I$_"} } @dirs; if($mm->{INC}){ $mm->{INC} .= q{ } . $paths; } else{ $mm->{INC} = $paths; } return; } sub cc_libs { my ($self, @libs) = @_; @libs = map{ my($name, $dir) = ref($_) eq 'ARRAY' ? @{$_} : ($_, undef); my $lib; if(defined $dir) { $lib = ($dir =~ /^-/ ? qq{$dir } : qq{-L$dir }); } else { $lib = ''; } $lib .= ($name =~ /^-/ ? qq{$name} : qq{-l$name}); _verbose "libs: $lib" if _VERBOSE; $lib; } @libs; $self->cc_append_to_libs( @libs ); } sub cc_append_to_libs{ my($self, @libs) = @_; $self->_xs_initialize(); return unless @libs; my $libs = join q{ }, @libs; my $mm = $self->makemaker_args; if ($mm->{LIBS}){ $mm->{LIBS} .= q{ } . $libs; } else{ $mm->{LIBS} = $libs; } return $libs; } sub cc_assert_lib { my ($self, @dcl_args) = @_; if ( ! $self->{xsu_loaded_checklib} ) { my $loaded_lib = 0; foreach my $checklib (qw(inc::Devel::CheckLib Devel::CheckLib)) { eval "use $checklib 0.4"; if (!$@) { $loaded_lib = 1; last; } } if (! $loaded_lib) { warn "Devel::CheckLib not found in inc/ nor \@INC"; exit 0; } $self->{xsu_loaded_checklib}++; $self->configure_requires( "Devel::CheckLib" => "0.4" ); $self->build_requires( "Devel::CheckLib" => "0.4" ); } Devel::CheckLib::check_lib_or_exit(@dcl_args); } sub cc_append_to_ccflags{ my($self, @ccflags) = @_; $self->_xs_initialize(); my $mm = $self->makemaker_args; $mm->{CCFLAGS} ||= $Config{ccflags}; $mm->{CCFLAGS} .= q{ } . join q{ }, @ccflags; return; } sub cc_define{ my($self, @defines) = @_; $self->_xs_initialize(); my $mm = $self->makemaker_args; if(exists $mm->{DEFINE}){ $mm->{DEFINE} .= q{ } . join q{ }, @defines; } else{ $mm->{DEFINE} = join q{ }, @defines; } return; } sub requires_xs_module { my $self = shift; return $self->requires() unless @_; $self->_xs_initialize(); my %added = $self->requires(@_); my(@inc, @libs); my $rx_lib = qr{ \. (?: lib | a) \z}xmsi; my $rx_dll = qr{ \. dll \z}xmsi; # for Cygwin while(my $module = each %added){ my $mod_basedir = File::Spec->join(split /::/, $module); my $rx_header = qr{\A ( .+ \Q$mod_basedir\E ) .+ \. h(?:pp)? \z}xmsi; SCAN_INC: foreach my $inc_dir(@INC){ my @dirs = grep{ -e } File::Spec->join($inc_dir, 'auto', $mod_basedir), File::Spec->join($inc_dir, $mod_basedir); next SCAN_INC unless @dirs; my $n_inc = scalar @inc; find(sub{ if(my($incdir) = $File::Find::name =~ $rx_header){ push @inc, $incdir; } elsif($File::Find::name =~ $rx_lib){ my($libname) = $_ =~ /\A (?:lib)? (\w+) /xmsi; push @libs, [$libname, $File::Find::dir]; } elsif($File::Find::name =~ $rx_dll){ # XXX: hack for Cygwin my $mm = $self->makemaker_args; $mm->{macro}->{PERL_ARCHIVE_AFTER} ||= ''; $mm->{macro}->{PERL_ARCHIVE_AFTER} .= ' ' . $File::Find::name; } }, @dirs); if($n_inc != scalar @inc){ last SCAN_INC; } } } my %uniq = (); $self->cc_append_to_inc (grep{ !$uniq{ $_ }++ } @inc); %uniq = (); $self->cc_libs(grep{ !$uniq{ $_->[0] }++ } @libs); return %added; } sub cc_src_paths{ my($self, @dirs) = @_; $self->_xs_initialize(); return unless @dirs; my $mm = $self->makemaker_args; my $XS_ref = $mm->{XS} ||= {}; my $C_ref = $mm->{C} ||= []; my $_obj = $Config{_o}; my @src_files; find(sub{ if(/ \. (?: xs | c (?: c | pp | xx )? ) \z/xmsi){ # *.{xs, c, cc, cpp, cxx} push @src_files, $File::Find::name; } }, @dirs); my $xs_to = $UseCplusplus ? '.cpp' : '.c'; foreach my $src_file(@src_files){ my $c = $src_file; if($c =~ s/ \.xs \z/$xs_to/xms){ $XS_ref->{$src_file} = $c; _verbose "xs: $src_file" if _VERBOSE; } else{ _verbose "c: $c" if _VERBOSE; } push @{$C_ref}, $c unless grep{ $_ eq $c } @{$C_ref}; } $self->clean_files(map{ File::Spec->catfile($_, '*.gcov'), File::Spec->catfile($_, '*.gcda'), File::Spec->catfile($_, '*.gcno'), } @dirs); $self->cc_append_to_inc('.'); return; } sub cc_include_paths{ my($self, @dirs) = @_; $self->_xs_initialize(); push @{ $self->{xsu_include_paths} ||= []}, @dirs; my $h_map = $self->{xsu_header_map} ||= {}; foreach my $dir(@dirs){ my $prefix = quotemeta( File::Spec->catfile($dir, '') ); find(sub{ return unless / \.h(?:pp)? \z/xms; (my $h_file = $File::Find::name) =~ s/ \A $prefix //xms; $h_map->{$h_file} = $File::Find::name; }, $dir); } $self->cc_append_to_inc(@dirs); return; } sub install_headers{ my $self = shift; my $h_files; if(@_ == 0){ $h_files = $self->{xsu_header_map} or die "install_headers: cc_include_paths not specified.\n"; } elsif(@_ == 1 && ref($_[0]) eq 'HASH'){ $h_files = $_[0]; } else{ $h_files = +{ map{ $_ => undef } @_ }; } $self->_xs_initialize(); my @not_found; my $h_map = $self->{xsu_header_map} || {}; while(my($ident, $path) = each %{$h_files}){ $path ||= $h_map->{$ident} || File::Spec->join('.', $ident); $path = File::Spec->canonpath($path); unless($path && -e $path){ push @not_found, $ident; next; } $ToInstall{$path} = File::Spec->join('$(INST_ARCHAUTODIR)', $ident); _verbose "install: $path as $ident" if _VERBOSE; my @funcs = $self->_extract_functions_from_header_file($path); if(@funcs){ $self->cc_append_to_funclist(@funcs); } } if(@not_found){ die "Header file(s) not found: @not_found\n"; } return; } my $home_directory; sub _extract_functions_from_header_file{ my($self, $h_file) = @_; my @functions; ($home_directory) = <~> unless defined $home_directory; # get header file contents through cpp(1) my $contents = do { my $mm = $self->makemaker_args; my $cppflags = q{"-I}. File::Spec->join($Config{archlib}, 'CORE') . q{"}; $cppflags =~ s/~/$home_directory/g; $cppflags .= ' ' . $mm->{INC} if $mm->{INC}; $cppflags .= ' ' . ($mm->{CCFLAGS} || $Config{ccflags}); $cppflags .= ' ' . $mm->{DEFINE} if $mm->{DEFINE}; my $add_include = _is_msvc() ? '-FI' : '-include'; $cppflags .= ' ' . join ' ', map{ qq{$add_include "$_"} } qw(EXTERN.h perl.h XSUB.h); my $cppcmd = qq{$Config{cpprun} $cppflags $h_file}; # remove all the -arch options to workaround gcc errors: # "-E, -S, -save-temps and -M options are not allowed # with multiple -arch flags" $cppcmd =~ s/ -arch \s* \S+ //xmsg; _verbose("extract functions from: $cppcmd") if _VERBOSE; `$cppcmd`; }; unless(defined $contents){ die "Cannot call C pre-processor ($Config{cpprun}): $! ($?)"; } # remove other include file contents my $chfile = q/\# (?:line)? \s+ \d+ /; $contents =~ s{ ^$chfile \s+ (?!"\Q$h_file\E") .*? ^(?= $chfile) }{}xmsig; if(_VERBOSE){ local *H; open H, "> $h_file.out" and print H $contents and close H; } while($contents =~ m{ ([^\\;\s]+ # type \s+ ([a-zA-Z_][a-zA-Z0-9_]*) # function name \s* \( [^;#]* \) # argument list [\w\s\(\)]* # attributes or something ;) # end of declaration }xmsg){ my $decl = $1; my $name = $2; next if $decl =~ /\b typedef \b/xms; next if $name =~ /^_/xms; # skip something private push @functions, $name; if(_VERBOSE){ $decl =~ tr/\n\r\t / /s; $decl =~ s/ (\Q$name\E) /<$name>/xms; _verbose("decl: $decl"); } } return @functions; } sub cc_append_to_funclist{ my($self, @functions) = @_; $self->_xs_initialize(); my $mm = $self->makemaker_args; push @{$mm->{FUNCLIST} ||= []}, @functions; $mm->{DL_FUNCS} ||= { '$(NAME)' => [] }; return; } sub _xshelper_h { my $h = <<'XSHELPER_H'; :/* THIS FILE IS AUTOMATICALLY GENERATED BY Module::Install::XSUtil $VERSION. */ :/* :=head1 NAME : :xshelper.h - Helper C header file for XS modules : :=head1 DESCRIPTION : : // This includes all the perl header files and ppport.h : #include "xshelper.h" : :=head1 SEE ALSO : :L, where this file is distributed as a part of : :=head1 AUTHOR : :Fuji, Goro (gfx) Egfuji at cpan.orgE : :=head1 LISENCE : :Copyright (c) 2010, Fuji, Goro (gfx). All rights reserved. : :This library is free software; you can redistribute it and/or modify :it under the same terms as Perl itself. : :=cut :*/ : :#ifdef __cplusplus :extern "C" { :#endif : :#define PERL_NO_GET_CONTEXT /* we want efficiency */ :#include :#include :#define NO_XSLOCKS /* for exceptions */ :#include : :#ifdef __cplusplus :} /* extern "C" */ :#endif : :#include "ppport.h" : :/* portability stuff not supported by ppport.h yet */ : :#ifndef STATIC_INLINE /* from 5.13.4 */ :# if defined(__GNUC__) || defined(__cplusplus) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)) :# define STATIC_INLINE static inline :# else :# define STATIC_INLINE static :# endif :#endif /* STATIC_INLINE */ : :#ifndef __attribute__format__ :#define __attribute__format__(a,b,c) /* nothing */ :#endif : :#ifndef LIKELY /* they are just a compiler's hint */ :#define LIKELY(x) (!!(x)) :#define UNLIKELY(x) (!!(x)) :#endif : :#ifndef newSVpvs_share :#define newSVpvs_share(s) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(s), 0U) :#endif : :#ifndef get_cvs :#define get_cvs(name, flags) get_cv(name, flags) :#endif : :#ifndef GvNAME_get :#define GvNAME_get GvNAME :#endif :#ifndef GvNAMELEN_get :#define GvNAMELEN_get GvNAMELEN :#endif : :#ifndef CvGV_set :#define CvGV_set(cv, gv) (CvGV(cv) = (gv)) :#endif : :/* general utility */ : :#if PERL_BCDVERSION >= 0x5008005 :#define LooksLikeNumber(x) looks_like_number(x) :#else :#define LooksLikeNumber(x) (SvPOKp(x) ? looks_like_number(x) : (I32)SvNIOKp(x)) :#endif : :#define newAV_mortal() (AV*)sv_2mortal((SV*)newAV()) :#define newHV_mortal() (HV*)sv_2mortal((SV*)newHV()) :#define newRV_inc_mortal(sv) sv_2mortal(newRV_inc(sv)) :#define newRV_noinc_mortal(sv) sv_2mortal(newRV_noinc(sv)) : :#define DECL_BOOT(name) EXTERN_C XS(CAT2(boot_, name)) :#define CALL_BOOT(name) STMT_START { \ : PUSHMARK(SP); \ : CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \ : } STMT_END XSHELPER_H $h =~ s/^://xmsg; $h =~ s/\$VERSION\b/$Module::Install::XSUtil::VERSION/xms; return $h; } package MY; # XXX: We must append to PM inside ExtUtils::MakeMaker->new(). sub init_PM { my $self = shift; $self->SUPER::init_PM(@_); while(my($k, $v) = each %ToInstall){ $self->{PM}{$k} = $v; } return; } # append object file names to CCCMD sub const_cccmd { my $self = shift; my $cccmd = $self->SUPER::const_cccmd(@_); return q{} unless $cccmd; if (Module::Install::XSUtil::_is_msvc()){ $cccmd .= ' -Fo$@'; } else { $cccmd .= ' -o $@'; } return $cccmd } sub xs_c { my($self) = @_; my $mm = $self->SUPER::xs_c(); $mm =~ s/ \.c /.cpp/xmsg if $UseCplusplus; return $mm; } sub xs_o { my($self) = @_; my $mm = $self->SUPER::xs_o(); $mm =~ s/ \.c /.cpp/xmsg if $UseCplusplus; return $mm; } 1; __END__ #line 1030 Text-MeCab-0.20016/inc/Devel/CheckLib.pm000644 000765 000024 00000035441 12256221666 020174 0ustar00daisukestaff000000 000000 # $Id: CheckLib.pm,v 1.25 2008/10/27 12:16:23 drhyde Exp $ package # Devel::CheckLib; use 5.00405; #postfix foreach use strict; use vars qw($VERSION @ISA @EXPORT); $VERSION = '1.01'; use Config qw(%Config); use Text::ParseWords 'quotewords'; use File::Spec; use File::Temp; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(assert_lib check_lib_or_exit check_lib); # localising prevents the warningness leaking out of this module local $^W = 1; # use warnings is a 5.6-ism _findcc(); # bomb out early if there's no compiler =head1 NAME Devel::CheckLib - check that a library is available =head1 DESCRIPTION Devel::CheckLib is a perl module that checks whether a particular C library and its headers are available. =head1 SYNOPSIS use Devel::CheckLib; check_lib_or_exit( lib => 'jpeg', header => 'jpeglib.h' ); check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] ); # or prompt for path to library and then do this: check_lib_or_exit( lib => 'jpeg', libpath => $additional_path ); =head1 USING IT IN Makefile.PL or Build.PL If you want to use this from Makefile.PL or Build.PL, do not simply copy the module into your distribution as this may cause problems when PAUSE and search.cpan.org index the distro. Instead, use the use-devel-checklib script. =head1 HOW IT WORKS You pass named parameters to a function, describing to it how to build and link to the libraries. It works by trying to compile some code - which defaults to this: int main(void) { return 0; } and linking it to the specified libraries. If something pops out the end which looks executable, it gets executed, and if main() returns 0 we know that it worked. That tiny program is built once for each library that you specify, and (without linking) once for each header file. If you want to check for the presence of particular functions in a library, or even that those functions return particular results, then you can pass your own function body for main() thus: check_lib_or_exit( function => 'foo();if(libversion() > 5) return 0; else return 1;' incpath => ... libpath => ... lib => ... header => ... ); In that case, it will fail to build if either foo() or libversion() don't exist, and main() will return the wrong value if libversion()'s return value isn't what you want. =head1 FUNCTIONS All of these take the same named parameters and are exported by default. To avoid exporting them, C. =head2 assert_lib This takes several named parameters, all of which are optional, and dies with an error message if any of the libraries listed can not be found. B: dying in a Makefile.PL or Build.PL may provoke a 'FAIL' report from CPAN Testers' automated smoke testers. Use C instead. The named parameters are: =over =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 the compiler found, library names will be fed to the compiler either as C<-l> arguments or as C<.lib> file names. (E.g. C<-ljpeg> or C) =item libpath a string or an array of strings representing additional paths to search for libraries. =item LIBS a C-style space-seperated list of libraries (each preceded by '-l') and directories (preceded by '-L'). This can also be supplied on the command-line. =item debug If true - emit information during processing that can be used for debugging. =back And libraries are no use without header files, so ... =over =item header Must be either a string with the name of a single header file or a reference to an array of strings of header file names. =item incpath a string or an array of strings representing additional paths to search for headers. =item INC a C-style space-seperated list of incpaths, each preceded by '-I'. This can also be supplied on the command-line. =back =head2 check_lib_or_exit This behaves exactly the same as C except that instead of dieing, it warns (with exactly the same error message) and exits. This is intended for use in Makefile.PL / Build.PL when you might want to prompt the user for various paths and things before checking that what they've told you is sane. If any library or header is missing, it exits with an exit value of 0 to avoid causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this result -- which is what you want if an external library dependency is not available. =head2 check_lib This behaves exactly the same as C except that it is silent, returning false instead of dieing, or true otherwise. =cut sub check_lib_or_exit { eval 'assert_lib(@_)'; if($@) { warn $@; exit; } } sub check_lib { eval 'assert_lib(@_)'; return $@ ? 0 : 1; } sub assert_lib { my %args = @_; my (@libs, @libpaths, @headers, @incpaths); # FIXME: these four just SCREAM "refactor" at me @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) if $args{lib}; @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) if $args{libpath}; @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) if $args{header}; @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) if $args{incpath}; # work-a-like for Makefile.PL's LIBS and INC arguments # if given as command-line argument, append to %args for my $arg (@ARGV) { for my $mm_attr_key (qw(LIBS INC)) { if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) { # it is tempting to put some \s* into the expression, but the # MM command-line parser only accepts LIBS etc. followed by =, # so we should not be any more lenient with whitespace than that $args{$mm_attr_key} .= " $mm_attr_value"; } } } # using special form of split to trim whitespace if(defined($args{LIBS})) { foreach my $arg (split(' ', $args{LIBS})) { die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-[lLR]/); push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2); } } if(defined($args{INC})) { foreach my $arg (split(' ', $args{INC})) { die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/); push @incpaths, substr($arg, 2); } } my ($cc, $ld) = _findcc(); my @missing; my @wrongresult; my @use_headers; # first figure out which headers we can't find ... for my $header (@headers) { push @use_headers, $header; my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} for @use_headers; print $ch qq{int main(void) { return 0; }\n}; close($ch); my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; # FIXME: re-factor - almost identical code later when linking if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; @sys_cmd = ( @$cc, $cfile, "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld ); } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, (map { "-I$_" } @incpaths), "-o$exefile", $cfile ); } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ... @sys_cmd = ( @$cc, @$ld, $cfile, (map { "-I$_" } @incpaths), "-o", "$exefile" ); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $header if $rv != 0 || ! -x $exefile; _cleanup_exe($exefile); unlink $ofile if -e $ofile; unlink $cfile; } # now do each library in turn with headers my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} foreach (@headers); print $ch "int main(void) { ".($args{function} || 'return 0;')." }\n"; close($ch); for my $lib ( @libs ) { my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; my @libpath = map { q{/libpath:} . Win32::GetShortPathName($_) } @libpaths; # this is horribly sensitive to the order of arguments @sys_cmd = ( @$cc, $cfile, "${lib}.lib", "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld, (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths), ); } elsif($Config{cc} eq 'CC/DECC') { # VMS } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, "-o$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", $cfile); } else { # Unix-ish # gcc, Sun, AIX (gcc, cc) @sys_cmd = ( @$cc, @$ld, $cfile, "-o", "$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", ); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $lib if $rv != 0 || ! -x $exefile; my $absexefile = File::Spec->rel2abs($exefile); $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/; push @wrongresult, $lib if $rv == 0 && -x $exefile && system($absexefile) != 0; unlink $ofile if -e $ofile; _cleanup_exe($exefile); } unlink $cfile; my $miss_string = join( q{, }, map { qq{'$_'} } @missing ); die("Can't link/include C library $miss_string, aborting.\n") if @missing; my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult); die("wrong result: $wrong_string\n") if @wrongresult; } sub _cleanup_exe { my ($exefile) = @_; my $ofile = $exefile; $ofile =~ s/$Config{_exe}$/$Config{_o}/; unlink $exefile if -f $exefile; unlink $ofile if -f $ofile; unlink "$exefile\.manifest" if -f "$exefile\.manifest"; if ( $Config{cc} eq 'cl' ) { # MSVC also creates foo.ilk and foo.pdb my $ilkfile = $exefile; $ilkfile =~ s/$Config{_exe}$/.ilk/; my $pdbfile = $exefile; $pdbfile =~ s/$Config{_exe}$/.pdb/; unlink $ilkfile if -f $ilkfile; unlink $pdbfile if -f $pdbfile; } return } # return ($cc, $ld) # where $cc is an array ref of compiler name, compiler flags # where $ld is an array ref of linker flags sub _findcc { # Need to use $keep=1 to work with MSWin32 backslashes and quotes my $Config_ccflags = $Config{ccflags}; # use copy so ASPerl will compile my @Config_ldflags = (); for my $config_val ( @Config{qw(ldflags perllibs)} ){ push @Config_ldflags, $config_val if ( $config_val =~ /\S/ ); } my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||''); my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags); my @paths = split(/$Config{path_sep}/, $ENV{PATH}); my @cc = split(/\s+/, $Config{cc}); return ( [ @cc, @ccflags ], \@ldflags ) if -x $cc[0]; foreach my $path (@paths) { my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe}; return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags) if -x $compiler; } die("Couldn't find your C compiler\n"); } # code substantially borrowed from IPC::Run3 sub _quiet_system { my (@cmd) = @_; # save handles local *STDOUT_SAVE; local *STDERR_SAVE; open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT"; open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR"; # redirect to nowhere local *DEV_NULL; open DEV_NULL, ">" . File::Spec->devnull or die "CheckLib: $! opening handle to null device"; open STDOUT, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDOUT to null handle"; open STDERR, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDERR to null handle"; # run system command my $rv = system(@cmd); # restore handles open STDOUT, ">&" . fileno STDOUT_SAVE or die "CheckLib: $! restoring STDOUT handle"; open STDERR, ">&" . fileno STDERR_SAVE or die "CheckLib: $! restoring STDERR handle"; return $rv; } =head1 PLATFORMS SUPPORTED You must have a C compiler installed. We check for C<$Config{cc}>, both literally as it is in Config.pm and also in the $PATH. It has been tested with varying degrees on rigourousness on: =over =item gcc (on Linux, *BSD, Mac OS X, Solaris, Cygwin) =item Sun's compiler tools on Solaris =item IBM's tools on AIX =item SGI's tools on Irix 6.5 =item Microsoft's tools on Windows =item MinGW on Windows (with Strawberry Perl) =item Borland's tools on Windows =item QNX =back =head1 WARNINGS, BUGS and FEEDBACK This is a very early release intended primarily for feedback from people who have discussed it. The interface may change and it has not been adequately tested. Feedback is most welcome, including constructive criticism. Bug reports should be made using L or by email. When submitting a bug report, please include the output from running: perl -V perl -MDevel::CheckLib -e0 =head1 SEE ALSO L L =head1 AUTHORS David Cantrell Edavid@cantrell.org.ukE David Golden Edagolden@cpan.orgE Yasuhiro Matsumoto Emattn@cpan.orgE Thanks to the cpan-testers-discuss mailing list for prompting us to write it in the first place; to Chris Williams for help with Borland support; to Tony Cook for help with Microsoft compiler command-line options =head1 COPYRIGHT and LICENCE Copyright 2007 David Cantrell. Portions copyright 2007 David Golden. This module is free-as-in-speech software, and may be used, distributed, and modified under the same conditions as perl itself. =head1 CONSPIRACY This module is also free-as-in-mason software. =cut 1; Text-MeCab-0.20016/eg/add_custom.pl000644 000765 000024 00000001741 12235124737 017426 0ustar00daisukestaff000000 000000 #!perl # Example for adding to the mecab dictionary. # # Since this is just a toy example, it is assumed that the words you are # adding to the dictionary area simply a names of people, and their # corresponding phonetic representation. # # eg/add_custom.pl 牧大輔 マキダイスケ /path/to/mecab-ipadic-source # # You should execute this script as superuser so that $dict->rebuild() # can properly call 'make install' use strict; use warnings; use utf8; use blib; use YAML; use Path::Class::Dir; use Path::Class::File; use Text::MeCab::Dict; use encoding 'utf-8'; my ($name, $yomi, $dict_source) = @ARGV; my $dict = Text::MeCab::Dict->new( dict_source => $dict_source ); my %args = ( surface => $name, original => $name, yomi => $yomi, cost => 3000, left_id => 1291, right_id => 1291, pos => '名詞', category1 => '固有名詞', category2 => '人名', ); $dict->add(%args); $dict->write('custom.csv'); $dict->rebuild();