Acme-Acotie

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
This is Perl module Acme::Acotie.
 
INSTALLATION
 
Acme::Acotie installation is straightforward. If your CPAN shell is set up,
you should just be able to do
 
    % cpan Acme::Acotie
 
Download it, unpack it, then build it as per the usual:
 
    % perl Makefile.PL
    % make && make test
 
Then install it:

inc/Module/Install.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#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
# }
 
BEGIN {
        require 5.004;
}
use strict 'vars';
 
use vars qw{$VERSION};
BEGIN {

inc/Module/Install.pm  view on Meta::CPAN

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
        *inc::Module::Install::VERSION = *VERSION;
        @inc::Module::Install::ISA     = __PACKAGE__;
 
}
 
 
 
 
 
# 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:

inc/Module/Install/Metadata.pm  view on Meta::CPAN

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
        }
 
        return 1;
}
 
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");
                }
        }
 
        # Some methods pull from POD instead of code.
        # If there is a matching .pod, use that instead

inc/Module/Install/Metadata.pm  view on Meta::CPAN

302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
        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);
                }
        }

inc/Spiffy.pm  view on Meta::CPAN

171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
    for my $base_class (@{"${class}::ISA"}) {
        push @bases, @{all_my_bases($base_class)};
    }
    my $used = {};
    $bases_map->{$class} = [grep {not $used->{$_}++} @bases];
}
 
my %code = ( 
    sub_start => 
      "sub {\n",
    set_default => 
      "  \$_[0]->{%s} = %s\n    unless exists \$_[0]->{%s};\n",
    init =>
      "  return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
      "    unless \$#_ > 0 or defined \$_[0]->{%s};\n",
    weak_init =>
      "  return do {\n" .
      "    \$_[0]->{%s} = do { my \$self = \$_[0]; %s };\n" .
      "    Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n" .
      "    \$_[0]->{%s};\n" .
      "  } unless \$#_ > 0 or defined \$_[0]->{%s};\n",
    return_if_get => 
      "  return \$_[0]->{%s} unless \$#_ > 0;\n",
    set => 
      "  \$_[0]->{%s} = \$_[1];\n",
    weaken => 
      "  Scalar::Util::weaken(\$_[0]->{%s}) if ref \$_[0]->{%s};\n",
    sub_end => 
      "  return \$_[0]->{%s};\n}\n",
);
 
sub field {
    my $package = caller;
    my ($args, @values) = do {

inc/Spiffy.pm  view on Meta::CPAN

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
        ? '[]'
        : (ref($default) eq 'HASH' and not keys %$default )
          ? '{}'
          : default_as_code($default);
 
    my $code = $code{sub_start};
    if ($args->{-init}) {
        my $fragment = $args->{-weak} ? $code{weak_init} : $code{init};
        $code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4;
    }
    $code .= sprintf $code{set_default}, $field, $default_string, $field
      if defined $default;
    $code .= sprintf $code{return_if_get}, $field;
    $code .= sprintf $code{set}, $field;
    $code .= sprintf $code{weaken}, $field, $field
      if $args->{-weak};
    $code .= sprintf $code{sub_end}, $field;
 
    my $sub = eval $code;
    die $@ if $@;
    no strict 'refs';
    *{"${package}::$field"} = $sub;
    return $code if defined wantarray;
}

inc/Test/Base.pm  view on Meta::CPAN

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
use 5.006001;
use Spiffy 0.30 -Base;
use Spiffy ':XXX';
our $VERSION = '0.52';
 
my @test_more_exports;
BEGIN {
    @test_more_exports = qw(
        ok isnt like unlike is_deeply cmp_ok
        skip todo_skip pass fail
        eq_array eq_hash eq_set
        plan can_ok isa_ok diag
        use_ok
        $TODO
    );
}
 
use Test::More import => \@test_more_exports;
use Carp;
 
our @EXPORT = (@test_more_exports, qw(

inc/Test/Base.pm  view on Meta::CPAN

373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
    croak $@ if $@;
    return $spec;
}
 
sub _block_list_init {
    my $spec = $self->spec;
    $spec = $self->_pre_eval($spec);
    my $cd = $self->block_delim;
    my @hunks = ($spec =~ /^(\Q${cd}\E.*?(?=^\Q${cd}\E|\z))/msg);
    my $blocks = $self->_choose_blocks(@hunks);
    $self->block_list($blocks); # Need to set early for possible filter use
    my $seq = 1;
    for my $block (@$blocks) {
        $block->blocks_object($self);
        $block->seq_num($seq++);
    }
    return $blocks;
}
 
sub _choose_blocks {
    my $blocks = [];

inc/Test/Base.pm  view on Meta::CPAN

419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
    my $block = $self->block_class->new;
    $hunk =~ s/\A\Q${cd}\E[ \t]*(.*)\s+// or die;
    my $name = $1;
    my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk;
    my $description = shift @parts;
    $description ||= '';
    unless ($description =~ /\S/) {
        $description = $name;
    }
    $description =~ s/\s*\z//;
    $block->set_value(description => $description);
     
    my $section_map = {};
    my $section_order = [];
    while (@parts) {
        my ($type, $filters, $value) = splice(@parts, 0, 3);
        $self->_check_reserved($type);
        $value = '' unless defined $value;
        $filters = '' unless defined $filters;
        if ($filters =~ /:(\s|\z)/) {
            croak "Extra lines not allowed in '$type' section"
              if $value =~ /\S/;
            ($filters, $value) = split /\s*:(?:\s+|\z)/, $filters, 2;
            $value = '' unless defined $value;
            $value =~ s/^\s*(.*?)\s*$/$1/;
        }
        $section_map->{$type} = {
            filters => $filters,
        };
        push @$section_order, $type;
        $block->set_value($type, $value);
    }
    $block->set_value(name => $name);
    $block->set_value(_section_map => $section_map);
    $block->set_value(_section_order => $section_order);
    return $block;
}
 
sub _spec_init {
    return $self->_spec_string
      if $self->_spec_string;
    local $/;
    my $spec;
    if (my $spec_file = $self->_spec_file) {
        open FILE, $spec_file or die $!;

inc/Test/Base.pm  view on Meta::CPAN

531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
    return;
}
 
sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;
        if (@_) {
            Carp::croak "Not allowed to set values for '$accessor'";
        }
        my @list = @{$self->{$accessor} || []};
        return wantarray
        ? (@list)
        : $list[0];
    };
}
 
block_accessor 'name';
block_accessor 'description';
Spiffy::field 'seq_num';
Spiffy::field 'is_filtered';
Spiffy::field 'blocks_object';
Spiffy::field 'original_values' => {};
 
sub set_value {
    no strict 'refs';
    my $accessor = shift;
    block_accessor $accessor
      unless defined &$accessor;
    $self->{$accessor} = [@_];
}
 
sub run_filters {
    my $map = $self->_section_map;
    my $order = $self->_section_order;

inc/Test/Base.pm  view on Meta::CPAN

587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
            }
            else {
                my $filter_object = $self->blocks_object->filter_class->new;
                die "Can't find a function or method for '$filter' filter\n"
                  unless $filter_object->can($filter);
                $filter_object->current_block($self);
                @value = $filter_object->$filter(@value);
            }
            # Set the value after each filter since other filters may be
            # introspecting.
            $self->set_value($type, @value);
        }
    }
    $self->is_filtered(1);
}
 
sub _get_filters {
    my $type = shift;
    my $string = shift || '';
    $string =~ s/\s*(.*?)\s*/$1/;
    my @filters = ();

inc/Test/Builder.pm  view on Meta::CPAN

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
    return $Test;
}
 
 
#line 132
 
sub create {
    my $class = shift;
 
    my $self = bless {}, $class;
    $self->reset;
 
    return $self;
}
 
#line 151
 
use vars qw($Level);
 
sub reset {
    my ($self) = @_;
 
    # We leave this a global because it has to be localized and localizing
    # hash keys is just asking for pain.  Also, it was documented.
    $Level = 1;
 
    $self->{Have_Plan}    = 0;
    $self->{No_Plan}      = 0;
    $self->{Original_Pid} = $$;

inc/Test/Builder.pm  view on Meta::CPAN

709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
 
# I'm not ready to publish this.  It doesn't deal with array return
# values from the code or context.
 
#line 1009
 
sub _try {
    my($self, $code) = @_;
     
    local $!;               # eval can mess up $!
    local $@;               # don't set $@ in the test
    local $SIG{__DIE__};    # don't trip an outside DIE handler.
    my $return = eval { $code->() };
     
    return wantarray ? ($return, $@) : $return;
}
 
#line 1031
 
sub is_fh {
    my $self = shift;

inc/Test/More.pm  view on Meta::CPAN

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
$VERSION = '0.80';
$VERSION = eval $VERSION;    # make the alpha version come out as a number
 
use Test::Builder::Module;
@ISA    = qw(Test::Builder::Module);
@EXPORT = qw(ok use_ok require_ok
             is isnt like unlike is_deeply
             cmp_ok
             skip todo todo_skip
             pass fail
             eq_array eq_hash eq_set
             $TODO
             plan
             can_ok  isa_ok
             diag
             BAIL_OUT
            );
 
 
#line 156

inc/Test/More.pm  view on Meta::CPAN

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
    }
 
    return $ok;
}
 
 
sub _eval {
    my($code) = shift;
    my @args = @_;
 
    # Work around oddities surrounding resetting of $@ by immediately
    # storing it.
    local($@,$!,$SIG{__DIE__});   # isolate eval
    my $eval_result = eval $code;
    my $eval_error  = $@;
 
    return($eval_result, $eval_error);
}
 
#line 718

inc/Test/More.pm  view on Meta::CPAN

652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
        pop @Data_Stack if $ok;
 
        last unless $ok;
    }
 
    return $ok;
}
 
#line 1377
 
sub eq_set  {
    my($a1, $a2) = @_;
    return 0 unless @$a1 == @$a2;
 
    # There's faster ways to do this, but this is easiest.
    local $^W = 0;
 
    # It really doesn't matter how we sort them, as long as both arrays are 
    # sorted with the same algorithm.
    #
    # Ensure that references are not accidentally treated the same as a
    # string containing the reference.
    #
    # Have to inline the sort routine due to a threading/sort bug.
    # See [rt.cpan.org 6782]
    #
    # I don't know how references would be sorted so we just don't sort
    # them.  This means eq_set doesn't really work with refs.
    return eq_array(
           [grep(ref, @$a1), sort( grep(!ref, @$a1) )],
           [grep(ref, @$a2), sort( grep(!ref, @$a2) )],
    );
}
 
#line 1567
 
1;