├── .Rbuildignore ├── .gitattributes ├── .github └── workflows │ └── pkgdown.yaml ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── import.R ├── microhaplot.R ├── runHaplot.R └── runMicroHap.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── cran-comments.md ├── docs ├── 404.html ├── LICENSE.html ├── articles │ ├── field_selection.png │ ├── index.html │ ├── locus_annotation.png │ ├── main_tab.png │ ├── microhaplot-data-prep.html │ ├── microhaplot-data-prep_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── microhaplot-walkthrough.html │ ├── microhaplot-walkthrough_files │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ ├── read_criteria_tab.png │ ├── troubleshoot.html │ └── troubleshoot_files │ │ └── accessible-code-block-0.0.1 │ │ └── empty-anchor.js ├── authors.html ├── bootstrap-toc.css ├── bootstrap-toc.js ├── docsearch.css ├── docsearch.js ├── index.html ├── link.svg ├── news │ └── index.html ├── pkgdown.css ├── pkgdown.js ├── pkgdown.yml ├── reference │ ├── Rplot001.png │ ├── index.html │ ├── mvShinyHaplot.html │ ├── prepHaplotFiles.html │ └── runShinyHaplot.html └── sitemap.xml ├── inst ├── extdata │ └── sebastes_sam.tar.gz ├── perl │ ├── fatlib │ │ ├── Algorithm │ │ │ └── C3.pm │ │ ├── B │ │ │ └── Hooks │ │ │ │ ├── EndOfScope.pm │ │ │ │ └── EndOfScope │ │ │ │ ├── PP.pm │ │ │ │ ├── PP │ │ │ │ ├── FieldHash.pm │ │ │ │ └── HintHash.pm │ │ │ │ └── XS.pm │ │ ├── Bio │ │ │ └── Cigar.pm │ │ ├── Class │ │ │ ├── C3.pm │ │ │ └── C3 │ │ │ │ └── next.pm │ │ ├── Devel │ │ │ ├── GlobalDestruction.pm │ │ │ └── TypeTiny │ │ │ │ ├── Perl56Compat.pm │ │ │ │ └── Perl58Compat.pm │ │ ├── Error │ │ │ ├── TypeTiny.pm │ │ │ └── TypeTiny │ │ │ │ ├── Assertion.pm │ │ │ │ ├── Compilation.pm │ │ │ │ └── WrongNumberOfParameters.pm │ │ ├── Eval │ │ │ └── TypeTiny.pm │ │ ├── Exporter │ │ │ ├── Shiny.pm │ │ │ └── Tiny.pm │ │ ├── MRO │ │ │ └── Compat.pm │ │ ├── Method │ │ │ └── Generate │ │ │ │ ├── Accessor.pm │ │ │ │ ├── BuildAll.pm │ │ │ │ ├── Constructor.pm │ │ │ │ └── DemolishAll.pm │ │ ├── Module │ │ │ ├── Implementation.pm │ │ │ └── Runtime.pm │ │ ├── Moo.pm │ │ ├── Moo │ │ │ ├── HandleMoose.pm │ │ │ ├── HandleMoose │ │ │ │ ├── FakeMetaClass.pm │ │ │ │ └── _TypeMap.pm │ │ │ ├── Object.pm │ │ │ ├── Role.pm │ │ │ ├── _Utils.pm │ │ │ ├── _mro.pm │ │ │ ├── _strictures.pm │ │ │ └── sification.pm │ │ ├── Package │ │ │ ├── Stash.pm │ │ │ └── Stash │ │ │ │ ├── Conflicts.pm │ │ │ │ └── PP.pm │ │ ├── Reply │ │ │ └── Plugin │ │ │ │ └── TypeTiny.pm │ │ ├── Sub │ │ │ ├── Defer.pm │ │ │ ├── Exporter │ │ │ │ └── Progressive.pm │ │ │ └── Quote.pm │ │ ├── Test │ │ │ └── TypeTiny.pm │ │ ├── Try │ │ │ └── Tiny.pm │ │ ├── Type │ │ │ ├── Coercion.pm │ │ │ ├── Coercion │ │ │ │ ├── FromMoose.pm │ │ │ │ └── Union.pm │ │ │ ├── Library.pm │ │ │ ├── Params.pm │ │ │ ├── Parser.pm │ │ │ ├── Registry.pm │ │ │ ├── Tiny.pm │ │ │ ├── Tiny │ │ │ │ ├── Class.pm │ │ │ │ ├── Duck.pm │ │ │ │ ├── Enum.pm │ │ │ │ ├── Intersection.pm │ │ │ │ ├── Manual.pod │ │ │ │ ├── Manual │ │ │ │ │ ├── Coercions.pod │ │ │ │ │ ├── Libraries.pod │ │ │ │ │ ├── Optimization.pod │ │ │ │ │ ├── Params.pod │ │ │ │ │ ├── Policies.pod │ │ │ │ │ ├── UsingWithMoo.pod │ │ │ │ │ ├── UsingWithMoose.pod │ │ │ │ │ ├── UsingWithMouse.pod │ │ │ │ │ └── UsingWithOther.pod │ │ │ │ ├── Role.pm │ │ │ │ ├── Union.pm │ │ │ │ └── _HalfOp.pm │ │ │ └── Utils.pm │ │ ├── Types │ │ │ ├── Common │ │ │ │ ├── Numeric.pm │ │ │ │ └── String.pm │ │ │ ├── Standard.pm │ │ │ ├── Standard │ │ │ │ ├── ArrayRef.pm │ │ │ │ ├── Dict.pm │ │ │ │ ├── HashRef.pm │ │ │ │ ├── Map.pm │ │ │ │ ├── ScalarRef.pm │ │ │ │ └── Tuple.pm │ │ │ └── TypeTiny.pm │ │ ├── darwin-thread-multi-2level │ │ │ ├── .meta │ │ │ │ ├── Bio-Cigar-1.01 │ │ │ │ │ ├── MYMETA.json │ │ │ │ │ └── install.json │ │ │ │ ├── Exporter-Tiny-0.042 │ │ │ │ │ ├── MYMETA.json │ │ │ │ │ └── install.json │ │ │ │ └── Type-Tiny-1.000005 │ │ │ │ │ ├── MYMETA.json │ │ │ │ │ └── install.json │ │ │ ├── auto │ │ │ │ ├── Bio │ │ │ │ │ └── Cigar │ │ │ │ │ │ └── .packlist │ │ │ │ ├── Exporter │ │ │ │ │ └── Tiny │ │ │ │ │ │ └── .packlist │ │ │ │ └── Type │ │ │ │ │ └── Tiny │ │ │ │ │ └── .packlist │ │ │ └── perllocal.pod │ │ ├── namespace │ │ │ ├── clean.pm │ │ │ └── clean │ │ │ │ └── _Util.pm │ │ └── oo.pm │ ├── fatpacker.trace │ ├── hapture │ └── hapture.pl └── shiny │ └── microhaplot │ ├── fish1.rds │ ├── fish1_posinfo.rds │ ├── fish2.rds │ ├── fish2_posinfo.rds │ ├── server.R │ └── ui.R ├── man ├── figures │ └── microhaplot-sticker.png ├── mvShinyHaplot.Rd ├── prepHaplotFiles.Rd └── runShinyHaplot.Rd ├── microhaplot.Rproj └── vignettes ├── .gitignore ├── field_selection.png ├── locus_annotation.png ├── main_panel_choice_tabset.png ├── main_tab.png ├── microhaplot-data-prep.Rmd ├── microhaplot-walkthrough.Rmd ├── read_criteria_tab.png └── troubleshoot.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^R/runMicroHap\.R$ 2 | ^CRAN-RELEASE$ 3 | ^Meta$ 4 | ^doc$ 5 | ^\.travis\.yml$ 6 | ^.*\.Rproj$ 7 | ^\.Rproj\.user$ 8 | ^cran-comments\.md$ 9 | ^LICENSE\.md$ 10 | ^inst/perl/fatlib/*$ 11 | ^inst/perl/fatpacker\.trace$ 12 | ^_pkgdown\.yml$ 13 | ^docs$ 14 | ^pkgdown$ 15 | ^\.github$ 16 | ^README.Rmd 17 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | 7 | name: pkgdown 8 | 9 | jobs: 10 | pkgdown: 11 | runs-on: macOS-latest 12 | env: 13 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 14 | steps: 15 | - uses: actions/checkout@v2 16 | 17 | - uses: r-lib/actions/setup-r@v1 18 | 19 | - uses: r-lib/actions/setup-pandoc@v1 20 | 21 | - name: Query dependencies 22 | run: | 23 | install.packages('remotes') 24 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 25 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 26 | shell: Rscript {0} 27 | 28 | - name: Cache R packages 29 | uses: actions/cache@v2 30 | with: 31 | path: ${{ env.R_LIBS_USER }} 32 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 33 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 34 | 35 | - name: Install dependencies 36 | run: | 37 | remotes::install_deps(dependencies = TRUE) 38 | install.packages("pkgdown", type = "binary") 39 | shell: Rscript {0} 40 | 41 | - name: Install package 42 | run: R CMD INSTALL . 43 | 44 | - name: Deploy package 45 | run: | 46 | git config --local user.email "actions@github.com" 47 | git config --local user.name "GitHub Actions" 48 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 49 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Meta 2 | doc 3 | .Rproj.user 4 | .Rhistory 5 | .RData 6 | .Ruserdata 7 | inst/doc 8 | fish2_example_posinfo.rds 9 | fish2_example.rds 10 | example_438fish_324loci.rds 11 | example_438fish_324loci_posinfo.rds 12 | .DS_Store 13 | docs 14 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | sudo: false 5 | cache: packages 6 | warnings_are_errors: true 7 | 8 | os: 9 | - linux 10 | - osx 11 | 12 | addons: 13 | apt: 14 | packages: 15 | - perl 16 | - libmoo-perl 17 | - libnamespace-clean-perl 18 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: microhaplot 2 | Type: Package 3 | Title: Microhaplotype Constructor and Visualizer 4 | Version: 1.0.2 5 | Authors@R: person("Thomas", "Ng", email = "tngthomasng@gmail.com", role = c("aut", "cre")) 6 | Description: A downstream bioinformatics tool to construct and assist 7 | curation of microhaplotypes from short read sequences. 8 | Depends: 9 | R (>= 3.5.0) 10 | Encoding: UTF-8 11 | License: GPL-3 12 | LazyData: TRUE 13 | Imports: 14 | DT (>= 0.1), 15 | dplyr (>= 0.4.3), 16 | ggplot2 (>= 2.1.0), 17 | grid (>= 3.1.2), 18 | gtools (>= 3.5.0), 19 | magrittr (>= 1.5), 20 | scales (>= 0.4.0), 21 | shiny (>= 0.13.2), 22 | shinyBS (>= 0.61), 23 | tidyr (>= 0.4.1), 24 | shinyWidgets (>= 0.4.3), 25 | ggiraph (>= 0.6.0) 26 | URL: https://github.com/ngthomas/microhaplot 27 | BugReports: https://github.com/ngthomas/microhaplot/issues 28 | RoxygenNote: 7.1.1 29 | Suggests: 30 | knitr, 31 | rmarkdown 32 | VignetteBuilder: knitr 33 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(mvShinyHaplot) 4 | export(prepHaplotFiles) 5 | export(runShinyHaplot) 6 | importFrom(magrittr,"%>%") 7 | importFrom(utils,combn) 8 | importFrom(utils,read.table) 9 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # microhaplot 1.0.0 2 | * added new parameter for `prepHaplotFiles`: `n.jobs`. For any non-window OS, you can specific the number of SAM files to be parallel processed. We recommend two times the number of processors/cores. (9/18/19) 3 | * Introduces 3 main functions: `prepHaplotFiles`, `runShinyHaplot`, `mvShinyHaplot` 4 | 5 | -------------------------------------------------------------------------------- /R/import.R: -------------------------------------------------------------------------------- 1 | 2 | #### Import the pipe operator from magrittr #### 3 | #' Pipe operator 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @importFrom magrittr %>% 9 | #' @usage lhs \%>\% rhs 10 | #' @noRd 11 | NULL 12 | 13 | 14 | #' @importFrom utils combn read.table 15 | NULL 16 | 17 | -------------------------------------------------------------------------------- /R/microhaplot.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # quiets concerns of R CMD check re: the . and other column names 4 | # that appear in dplyr chains 5 | if (getRversion() >= "2.15.1") { 6 | utils::globalVariables( 7 | c( 8 | ".", 9 | "V1", 10 | "V2", 11 | "allele.balance", 12 | "depth", 13 | "group", 14 | "grp.indx", 15 | "haplo", 16 | "id", 17 | "indx", 18 | "locus", 19 | "max.Phred.C", 20 | "max.uniq.hapl", 21 | "n.haplo.per.indiv", 22 | "n.indiv.per.locus", 23 | "sum.Phred.C", 24 | "summary.tbl", 25 | "uniq.id" 26 | ) 27 | ) 28 | } 29 | 30 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://ngthomas.github.io/microhaplot 2 | 3 | template: 4 | params: 5 | bootswatch: cosmo 6 | 7 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | * local OS X install, R 3.5.3 3 | * ubuntu 14.04 (on travis-ci), R 3.6.0 4 | * macOS High Sierra 10.13.3 (on travis-ci), R 3.6.0 5 | * win-builder R 3.6.0 and R 3.7.0 6 | * local Window 10 install, R 3.5.2 7 | 8 | ## R CMD check results 9 | 10 | 0 errors ✔ | 0 warnings ✔ | 0 notes ✔ 11 | 12 | ## Downstream dependencies 13 | There are currently no downstream dependencies for this package 14 | 15 | ## Resubmission 16 | * Fixed Win-builder Error through add perl version checkup 17 | -------------------------------------------------------------------------------- /docs/404.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 |
5 | 6 | 7 | 8 | 9 |
56 |
57 | The Perl source code being compiled.
58 |
59 | =item C
60 |
61 | Hashref of variables being closed over.
62 |
63 | =item C
64 |
65 | Error message from Perl compiler.
66 |
67 | =back
68 |
69 | =head1 BUGS
70 |
71 | Please report any bugs to
72 | L.
73 |
74 | =head1 SEE ALSO
75 |
76 | L.
77 |
78 | =head1 AUTHOR
79 |
80 | Toby Inkster Etobyink@cpan.orgE.
81 |
82 | =head1 COPYRIGHT AND LICENCE
83 |
84 | This software is copyright (c) 2013-2014 by Toby Inkster.
85 |
86 | This is free software; you can redistribute it and/or modify it under
87 | the same terms as the Perl 5 programming language system itself.
88 |
89 | =head1 DISCLAIMER OF WARRANTIES
90 |
91 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
92 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
93 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
94 |
95 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Error/TypeTiny/WrongNumberOfParameters.pm:
--------------------------------------------------------------------------------
1 | package Error::TypeTiny::WrongNumberOfParameters;
2 |
3 | use 5.006001;
4 | use strict;
5 | use warnings;
6 |
7 | BEGIN {
8 | $Error::TypeTiny::WrongNumberOfParameters::AUTHORITY = 'cpan:TOBYINK';
9 | $Error::TypeTiny::WrongNumberOfParameters::VERSION = '1.000005';
10 | }
11 |
12 | require Error::TypeTiny;
13 | our @ISA = 'Error::TypeTiny';
14 |
15 | sub minimum { $_[0]{minimum} };
16 | sub maximum { $_[0]{maximum} };
17 | sub got { $_[0]{got} };
18 |
19 | sub has_minimum { exists $_[0]{minimum} };
20 | sub has_maximum { exists $_[0]{maximum} };
21 |
22 | sub _build_message
23 | {
24 | my $e = shift;
25 | if ($e->has_minimum and $e->has_maximum and $e->minimum == $e->maximum)
26 | {
27 | return sprintf(
28 | "Wrong number of parameters; got %d; expected %d",
29 | $e->got,
30 | $e->minimum,
31 | );
32 | }
33 | elsif ($e->has_minimum and $e->has_maximum and $e->minimum < $e->maximum)
34 | {
35 | return sprintf(
36 | "Wrong number of parameters; got %d; expected %d to %d",
37 | $e->got,
38 | $e->minimum,
39 | $e->maximum,
40 | );
41 | }
42 | elsif ($e->has_minimum)
43 | {
44 | return sprintf(
45 | "Wrong number of parameters; got %d; expected at least %d",
46 | $e->got,
47 | $e->minimum,
48 | );
49 | }
50 | else
51 | {
52 | return sprintf(
53 | "Wrong number of parameters; got %d",
54 | $e->got,
55 | );
56 | }
57 | }
58 |
59 | 1;
60 |
61 | __END__
62 |
63 | =pod
64 |
65 | =encoding utf-8
66 |
67 | =head1 NAME
68 |
69 | Error::TypeTiny::WrongNumberOfParameters - exception for Type::Params
70 |
71 | =head1 STATUS
72 |
73 | This module is covered by the
74 | L.
75 |
76 | =head1 DESCRIPTION
77 |
78 | Thrown when a Type::Params compiled check is called with the wrong number
79 | of parameters.
80 |
81 | This package inherits from L; see that for most
82 | documentation. Major differences are listed below:
83 |
84 | =head2 Attributes
85 |
86 | =over
87 |
88 | =item C
89 |
90 | The minimum expected number of parameters.
91 |
92 | =item C
93 |
94 | The maximum expected number of parameters.
95 |
96 | =item C
97 |
98 | The number of parameters actually passed to the compiled check.
99 |
100 | =back
101 |
102 | =head2 Methods
103 |
104 | =over
105 |
106 | =item C, C
107 |
108 | Predicate methods.
109 |
110 | =back
111 |
112 | =head1 BUGS
113 |
114 | Please report any bugs to
115 | L.
116 |
117 | =head1 SEE ALSO
118 |
119 | L.
120 |
121 | =head1 AUTHOR
122 |
123 | Toby Inkster Etobyink@cpan.orgE.
124 |
125 | =head1 COPYRIGHT AND LICENCE
126 |
127 | This software is copyright (c) 2013-2014 by Toby Inkster.
128 |
129 | This is free software; you can redistribute it and/or modify it under
130 | the same terms as the Perl 5 programming language system itself.
131 |
132 | =head1 DISCLAIMER OF WARRANTIES
133 |
134 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
135 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
136 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
137 |
138 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Exporter/Shiny.pm:
--------------------------------------------------------------------------------
1 | package Exporter::Shiny;
2 |
3 | use 5.006001;
4 | use strict;
5 | use warnings;
6 |
7 | use Exporter::Tiny ();
8 |
9 | our $AUTHORITY = 'cpan:TOBYINK';
10 | our $VERSION = '0.042';
11 |
12 | sub import {
13 | my $me = shift;
14 | my $caller = caller;
15 |
16 | (my $nominal_file = $caller) =~ s(::)(/)g;
17 | $INC{"$nominal_file\.pm"} ||= __FILE__;
18 |
19 | if (@_ == 2 and $_[0] eq -setup)
20 | {
21 | my (undef, $opts) = @_;
22 | @_ = @{ delete($opts->{exports}) || [] };
23 |
24 | if (%$opts) {
25 | Exporter::Tiny::_croak(
26 | 'Unsupported Sub::Exporter-style options: %s',
27 | join(q[, ], sort keys %$opts),
28 | );
29 | }
30 | }
31 |
32 | ref($_) && Exporter::Tiny::_croak('Expected sub name, got ref %s', $_) for @_;
33 |
34 | no strict qw(refs);
35 | push @{"$caller\::ISA"}, 'Exporter::Tiny';
36 | push @{"$caller\::EXPORT_OK"}, @_;
37 | }
38 |
39 | 1;
40 |
41 | __END__
42 |
43 | =pod
44 |
45 | =encoding utf-8
46 |
47 | =head1 NAME
48 |
49 | Exporter::Shiny - shortcut for Exporter::Tiny
50 |
51 | =head1 SYNOPSIS
52 |
53 | use Exporter::Shiny qw( foo bar );
54 |
55 | Is a shortcut for:
56 |
57 | use base "Exporter::Tiny";
58 | push our(@EXPORT_OK), qw( foo bar );
59 |
60 | For compatibility with L, the following longer syntax is
61 | also supported:
62 |
63 | use Exporter::Shiny -setup => {
64 | exports => [qw( foo bar )],
65 | };
66 |
67 | =head1 DESCRIPTION
68 |
69 | This is a very small wrapper to simplify using L.
70 |
71 | It does the following:
72 |
73 | =over
74 |
75 | =item * Marks your package as loaded in C<< %INC >>;
76 |
77 | =item * Pushes any function names in the import list onto your C<< @EXPORT_OK >>; and
78 |
79 | =item * Pushes C<< "Exporter::Tiny" >> onto your C<< @ISA >>.
80 |
81 | =back
82 |
83 | It doesn't set up C<< %EXPORT_TAGS >> or C<< @EXPORT >>, but there's
84 | nothing stopping you doing that yourself.
85 |
86 | =head1 BUGS
87 |
88 | Please report any bugs to
89 | L.
90 |
91 | =head1 SEE ALSO
92 |
93 | L.
94 |
95 | =head1 AUTHOR
96 |
97 | Toby Inkster Etobyink@cpan.orgE.
98 |
99 | =head1 COPYRIGHT AND LICENCE
100 |
101 | This software is copyright (c) 2014 by Toby Inkster.
102 |
103 | This is free software; you can redistribute it and/or modify it under
104 | the same terms as the Perl 5 programming language system itself.
105 |
106 | =head1 DISCLAIMER OF WARRANTIES
107 |
108 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
109 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
110 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
111 |
112 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Method/Generate/BuildAll.pm:
--------------------------------------------------------------------------------
1 | package Method::Generate::BuildAll;
2 |
3 | use Moo::_strictures;
4 | use Moo::Object ();
5 | BEGIN { our @ISA = qw(Moo::Object) }
6 | use Sub::Quote qw(quote_sub quotify);
7 | use Moo::_Utils qw(_getglob);
8 | use Moo::_mro;
9 |
10 | sub generate_method {
11 | my ($self, $into) = @_;
12 | quote_sub "${into}::BUILDALL"
13 | => join('',
14 | $self->_handle_subbuild($into),
15 | qq{ my \$self = shift;\n},
16 | $self->buildall_body_for($into, '$self', '@_'),
17 | qq{ return \$self\n},
18 | )
19 | => {}
20 | => { no_defer => 1 }
21 | ;
22 | }
23 |
24 | sub _handle_subbuild {
25 | my ($self, $into) = @_;
26 | ' if (ref($_[0]) ne '.quotify($into).') {'."\n".
27 | ' return shift->Moo::Object::BUILDALL(@_)'.";\n".
28 | ' }'."\n";
29 | }
30 |
31 | sub buildall_body_for {
32 | my ($self, $into, $me, $args) = @_;
33 | my @builds =
34 | grep *{_getglob($_)}{CODE},
35 | map "${_}::BUILD",
36 | reverse @{mro::get_linear_isa($into)};
37 | ' (('.$args.')[0]->{__no_BUILD__} or ('."\n"
38 | .join('', map qq{ ${me}->${_}(${args}),\n}, @builds)
39 | ." )),\n";
40 | }
41 |
42 | 1;
43 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Method/Generate/DemolishAll.pm:
--------------------------------------------------------------------------------
1 | package Method::Generate::DemolishAll;
2 |
3 | use Moo::_strictures;
4 | use Moo::Object ();
5 | BEGIN { our @ISA = qw(Moo::Object) }
6 | use Sub::Quote qw(quote_sub quotify);
7 | use Moo::_Utils qw(_getglob);
8 | use Moo::_mro;
9 |
10 | sub generate_method {
11 | my ($self, $into) = @_;
12 | quote_sub "${into}::DEMOLISHALL", join '',
13 | $self->_handle_subdemolish($into),
14 | qq{ my \$self = shift;\n},
15 | $self->demolishall_body_for($into, '$self', '@_'),
16 | qq{ return \$self\n};
17 | quote_sub "${into}::DESTROY", join '',
18 | q! my $self = shift;
19 | my $e = do {
20 | local $?;
21 | local $@;
22 | require Devel::GlobalDestruction;
23 | eval {
24 | $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction);
25 | };
26 | $@;
27 | };
28 |
29 | # fatal warnings+die in DESTROY = bad times (perl rt#123398)
30 | no warnings FATAL => 'all';
31 | use warnings 'all';
32 | die $e if $e; # rethrow
33 | !;
34 | }
35 |
36 | sub demolishall_body_for {
37 | my ($self, $into, $me, $args) = @_;
38 | my @demolishers =
39 | grep *{_getglob($_)}{CODE},
40 | map "${_}::DEMOLISH",
41 | @{mro::get_linear_isa($into)};
42 | join '', map qq{ ${me}->${_}(${args});\n}, @demolishers;
43 | }
44 |
45 | sub _handle_subdemolish {
46 | my ($self, $into) = @_;
47 | ' if (ref($_[0]) ne '.quotify($into).') {'."\n".
48 | ' return shift->Moo::Object::DEMOLISHALL(@_)'.";\n".
49 | ' }'."\n";
50 | }
51 |
52 | 1;
53 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Moo/HandleMoose/FakeMetaClass.pm:
--------------------------------------------------------------------------------
1 | package Moo::HandleMoose::FakeMetaClass;
2 | use Moo::_strictures;
3 | use Carp ();
4 | BEGIN { our @CARP_NOT = qw(Moo::HandleMoose) }
5 |
6 | sub DESTROY { }
7 |
8 | sub AUTOLOAD {
9 | my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
10 | my $self = shift;
11 | Carp::croak "Can't call $meth without object instance"
12 | if !ref $self;
13 | Carp::croak "Can't inflate Moose metaclass with Moo::sification disabled"
14 | if $Moo::sification::disabled;
15 | require Moo::HandleMoose;
16 | Moo::HandleMoose::inject_real_metaclass_for($self->{name})->$meth(@_)
17 | }
18 | sub can {
19 | my $self = shift;
20 | return $self->SUPER::can(@_)
21 | if !ref $self or $Moo::sification::disabled;
22 | require Moo::HandleMoose;
23 | Moo::HandleMoose::inject_real_metaclass_for($self->{name})->can(@_)
24 | }
25 | sub isa {
26 | my $self = shift;
27 | return $self->SUPER::isa(@_)
28 | if !ref $self or $Moo::sification::disabled;
29 | require Moo::HandleMoose;
30 | Moo::HandleMoose::inject_real_metaclass_for($self->{name})->isa(@_)
31 | }
32 | sub make_immutable { $_[0] }
33 |
34 | 1;
35 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Moo/HandleMoose/_TypeMap.pm:
--------------------------------------------------------------------------------
1 | package Moo::HandleMoose::_TypeMap;
2 | use Moo::_strictures;
3 |
4 | package
5 | Moo::HandleMoose;
6 | our %TYPE_MAP;
7 |
8 | package Moo::HandleMoose::_TypeMap;
9 |
10 | use Scalar::Util ();
11 | use Config;
12 |
13 | our %WEAK_TYPES;
14 |
15 | sub _str_to_ref {
16 | my $in = shift;
17 | return $in
18 | if ref $in;
19 |
20 | if ($in =~ /(?:^|=)([A-Z]+)\(0x([0-9a-zA-Z]+)\)$/) {
21 | my $type = $1;
22 | my $id = do { no warnings 'portable'; hex "$2" };
23 | require B;
24 | my $sv = bless \$id, 'B::SV';
25 | my $ref = eval { $sv->object_2svref };
26 | if (!defined $ref or Scalar::Util::reftype($ref) ne $type) {
27 | die <<'END_ERROR';
28 | Moo initialization encountered types defined in a parent thread - ensure that
29 | Moo is require()d before any further thread spawns following a type definition.
30 | END_ERROR
31 | }
32 | return $ref;
33 | }
34 | return $in;
35 | }
36 |
37 | sub TIEHASH { bless {}, $_[0] }
38 |
39 | sub STORE {
40 | my ($self, $key, $value) = @_;
41 | my $type = _str_to_ref($key);
42 | $WEAK_TYPES{$type} = $type;
43 | Scalar::Util::weaken($WEAK_TYPES{$type})
44 | if ref $type;
45 | $self->{$key} = $value;
46 | }
47 |
48 | sub FETCH { $_[0]->{$_[1]} }
49 | sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
50 | sub NEXTKEY { each %{$_[0]} }
51 | sub EXISTS { exists $_[0]->{$_[1]} }
52 | sub DELETE { delete $_[0]->{$_[1]} }
53 | sub CLEAR { %{$_[0]} = () }
54 | sub SCALAR { scalar %{$_[0]} }
55 |
56 | sub CLONE {
57 | my @types = map {
58 | defined $WEAK_TYPES{$_} ? ($WEAK_TYPES{$_} => $TYPE_MAP{$_}) : ()
59 | } keys %TYPE_MAP;
60 | %WEAK_TYPES = ();
61 | %TYPE_MAP = @types;
62 | }
63 |
64 | sub DESTROY {
65 | my %types = %{$_[0]};
66 | untie %TYPE_MAP;
67 | %TYPE_MAP = %types;
68 | }
69 |
70 | if ($Config{useithreads}) {
71 | my @types = %TYPE_MAP;
72 | tie %TYPE_MAP, __PACKAGE__;
73 | %TYPE_MAP = @types;
74 | }
75 |
76 | 1;
77 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Moo/Object.pm:
--------------------------------------------------------------------------------
1 | package Moo::Object;
2 |
3 | use Moo::_strictures;
4 | use Carp ();
5 |
6 | our %NO_BUILD;
7 | our %NO_DEMOLISH;
8 | our $BUILD_MAKER;
9 | our $DEMOLISH_MAKER;
10 |
11 | sub new {
12 | my $class = shift;
13 | unless (exists $NO_DEMOLISH{$class}) {
14 | unless ($NO_DEMOLISH{$class} = !$class->can('DEMOLISH')) {
15 | ($DEMOLISH_MAKER ||= do {
16 | require Method::Generate::DemolishAll;
17 | Method::Generate::DemolishAll->new
18 | })->generate_method($class);
19 | }
20 | }
21 | my $proto = $class->BUILDARGS(@_);
22 | $NO_BUILD{$class} and
23 | return bless({}, $class);
24 | $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class};
25 | $NO_BUILD{$class}
26 | ? bless({}, $class)
27 | : bless({}, $class)->BUILDALL($proto);
28 | }
29 |
30 | # Inlined into Method::Generate::Constructor::_generate_args() - keep in sync
31 | sub BUILDARGS {
32 | my $class = shift;
33 | scalar @_ == 1
34 | ? ref $_[0] eq 'HASH'
35 | ? { %{ $_[0] } }
36 | : Carp::croak("Single parameters to new() must be a HASH ref"
37 | . " data => ". $_[0])
38 | : @_ % 2
39 | ? Carp::croak("The new() method for $class expects a hash reference or a"
40 | . " key/value list. You passed an odd number of arguments")
41 | : {@_}
42 | ;
43 | }
44 |
45 | sub BUILDALL {
46 | my $self = shift;
47 | $self->${\(($BUILD_MAKER ||= do {
48 | require Method::Generate::BuildAll;
49 | Method::Generate::BuildAll->new
50 | })->generate_method(ref($self)))}(@_);
51 | }
52 |
53 | sub DEMOLISHALL {
54 | my $self = shift;
55 | $self->${\(($DEMOLISH_MAKER ||= do {
56 | require Method::Generate::DemolishAll;
57 | Method::Generate::DemolishAll->new
58 | })->generate_method(ref($self)))}(@_);
59 | }
60 |
61 | sub does {
62 | return !!0
63 | unless ($INC{'Moose/Role.pm'} || $INC{'Role/Tiny.pm'});
64 | require Moo::Role;
65 | my $does = Moo::Role->can("does_role");
66 | { no warnings 'redefine'; *does = $does }
67 | goto &$does;
68 | }
69 |
70 | # duplicated in Moo::Role
71 | sub meta {
72 | require Moo::HandleMoose::FakeMetaClass;
73 | my $class = ref($_[0])||$_[0];
74 | bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
75 | }
76 |
77 | 1;
78 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Moo/_Utils.pm:
--------------------------------------------------------------------------------
1 | package Moo::_Utils;
2 | use Moo::_strictures;
3 |
4 | {
5 | no strict 'refs';
6 | sub _getglob { \*{$_[0]} }
7 | sub _getstash { \%{"$_[0]::"} }
8 | }
9 |
10 | BEGIN {
11 | my ($su, $sn);
12 | $su = $INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname
13 | or $sn = $INC{'Sub/Name.pm'}
14 | or $su = eval { require Sub::Util; } && defined &Sub::Util::set_subname
15 | or $sn = eval { require Sub::Name; };
16 |
17 | *_subname = $su ? \&Sub::Util::set_subname
18 | : $sn ? \&Sub::Name::subname
19 | : sub { $_[1] };
20 | *_CAN_SUBNAME = ($su || $sn) ? sub(){1} : sub(){0};
21 | }
22 |
23 | use Module::Runtime qw(use_package_optimistically module_notional_filename);
24 |
25 | use Devel::GlobalDestruction ();
26 | use Exporter qw(import);
27 | use Config;
28 | use Carp qw(croak);
29 |
30 | our @EXPORT = qw(
31 | _getglob _install_modifier _load_module _maybe_load_module
32 | _getstash _install_coderef _name_coderef
33 | _unimport_coderefs _set_loaded
34 | );
35 |
36 | sub _install_modifier {
37 | my ($into, $type, $name, $code) = @_;
38 |
39 | if ($INC{'Sub/Defer.pm'} and my $to_modify = $into->can($name)) { # CMM will throw for us if not
40 | Sub::Defer::undefer_sub($to_modify);
41 | }
42 |
43 | require Class::Method::Modifiers;
44 | Class::Method::Modifiers::install_modifier(@_);
45 | }
46 |
47 | sub _load_module {
48 | my $module = $_[0];
49 | my $file = eval { module_notional_filename($module) } or croak $@;
50 | use_package_optimistically($module);
51 | return 1
52 | if $INC{$file};
53 | my $error = $@ || "Can't locate $file";
54 |
55 | # can't just ->can('can') because a sub-package Foo::Bar::Baz
56 | # creates a 'Baz::' key in Foo::Bar's symbol table
57 | my $stash = _getstash($module)||{};
58 | return 1 if grep +(ref($_) || *$_{CODE}), values %$stash;
59 | return 1
60 | if $INC{"Moose.pm"} && Class::MOP::class_of($module)
61 | or Mouse::Util->can('find_meta') && Mouse::Util::find_meta($module);
62 | croak $error;
63 | }
64 |
65 | our %MAYBE_LOADED;
66 | sub _maybe_load_module {
67 | my $module = $_[0];
68 | return $MAYBE_LOADED{$module}
69 | if exists $MAYBE_LOADED{$module};
70 | if(! eval { use_package_optimistically($module) }) {
71 | warn "$module exists but failed to load with error: $@";
72 | }
73 | elsif ( $INC{module_notional_filename($module)} ) {
74 | return $MAYBE_LOADED{$module} = 1;
75 | }
76 | return $MAYBE_LOADED{$module} = 0;
77 | }
78 |
79 | sub _set_loaded {
80 | $INC{Module::Runtime::module_notional_filename($_[0])} ||= $_[1];
81 | }
82 |
83 | sub _install_coderef {
84 | my ($glob, $code) = (_getglob($_[0]), _name_coderef(@_));
85 | no warnings 'redefine';
86 | if (*{$glob}{CODE}) {
87 | *{$glob} = $code;
88 | }
89 | # perl will sometimes warn about mismatched prototypes coming from the
90 | # inheritance cache, so disable them if we aren't redefining a sub
91 | else {
92 | no warnings 'prototype';
93 | *{$glob} = $code;
94 | }
95 | }
96 |
97 | sub _name_coderef {
98 | shift if @_ > 2; # three args is (target, name, sub)
99 | _CAN_SUBNAME ? _subname(@_) : $_[1];
100 | }
101 |
102 | sub _unimport_coderefs {
103 | my ($target, $info) = @_;
104 | return unless $info and my $exports = $info->{exports};
105 | my %rev = reverse %$exports;
106 | my $stash = _getstash($target);
107 | foreach my $name (keys %$exports) {
108 | if ($stash->{$name} and defined(&{$stash->{$name}})) {
109 | if ($rev{$target->can($name)}) {
110 | my $old = delete $stash->{$name};
111 | my $full_name = join('::',$target,$name);
112 | # Copy everything except the code slot back into place (e.g. $has)
113 | foreach my $type (qw(SCALAR HASH ARRAY IO)) {
114 | next unless defined(*{$old}{$type});
115 | no strict 'refs';
116 | *$full_name = *{$old}{$type};
117 | }
118 | }
119 | }
120 | }
121 | }
122 |
123 | if ($Config{useithreads}) {
124 | require Moo::HandleMoose::_TypeMap;
125 | }
126 |
127 | 1;
128 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Moo/_mro.pm:
--------------------------------------------------------------------------------
1 | package Moo::_mro;
2 | use Moo::_strictures;
3 |
4 | if ("$]" >= 5.010_000) {
5 | require mro;
6 | } else {
7 | require MRO::Compat;
8 | }
9 |
10 | 1;
11 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Moo/_strictures.pm:
--------------------------------------------------------------------------------
1 | package Moo::_strictures;
2 | use strict;
3 | use warnings;
4 |
5 | sub import {
6 | if ($ENV{MOO_FATAL_WARNINGS}) {
7 | require strictures;
8 | strictures->VERSION(2);
9 | @_ = ('strictures');
10 | goto &strictures::import;
11 | }
12 | else {
13 | strict->import;
14 | warnings->import;
15 | warnings->unimport('once');
16 | }
17 | }
18 |
19 | 1;
20 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Moo/sification.pm:
--------------------------------------------------------------------------------
1 | package Moo::sification;
2 |
3 | use Moo::_strictures;
4 | no warnings 'once';
5 | use Devel::GlobalDestruction qw(in_global_destruction);
6 | use Carp qw(croak);
7 | BEGIN { our @CARP_NOT = qw(Moo::HandleMoose) }
8 |
9 | sub unimport {
10 | croak "Can't disable Moo::sification after inflation has been done"
11 | if $Moo::HandleMoose::SETUP_DONE;
12 | our $disabled = 1;
13 | }
14 |
15 | sub Moo::HandleMoose::AuthorityHack::DESTROY {
16 | unless (our $disabled or in_global_destruction) {
17 | require Moo::HandleMoose;
18 | Moo::HandleMoose->import;
19 | }
20 | }
21 |
22 | sub import {
23 | return
24 | if our $setup_done;
25 | if ($INC{"Moose.pm"}) {
26 | require Moo::HandleMoose;
27 | Moo::HandleMoose->import;
28 | } else {
29 | $Moose::AUTHORITY = bless({}, 'Moo::HandleMoose::AuthorityHack');
30 | }
31 | $setup_done = 1;
32 | }
33 |
34 | 1;
35 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Package/Stash/Conflicts.pm:
--------------------------------------------------------------------------------
1 | package # hide from PAUSE
2 | Package::Stash::Conflicts;
3 |
4 | use strict;
5 | use warnings;
6 |
7 | # this module was generated with Dist::Zilla::Plugin::Conflicts 0.19
8 |
9 | use Dist::CheckConflicts
10 | -dist => 'Package::Stash',
11 | -conflicts => {
12 | 'Class::MOP' => '1.08',
13 | 'MooseX::Method::Signatures' => '0.36',
14 | 'MooseX::Role::WithOverloading' => '0.08',
15 | 'namespace::clean' => '0.18',
16 | },
17 | -also => [ qw(
18 | B
19 | Carp
20 | Dist::CheckConflicts
21 | Getopt::Long
22 | Module::Implementation
23 | Scalar::Util
24 | Symbol
25 | constant
26 | strict
27 | warnings
28 | ) ],
29 |
30 | ;
31 |
32 | 1;
33 |
34 | # ABSTRACT: Provide information on conflicts for Package::Stash
35 | # Dist::Zilla: -PodWeaver
36 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Reply/Plugin/TypeTiny.pm:
--------------------------------------------------------------------------------
1 | package Reply::Plugin::TypeTiny;
2 |
3 | use strict;
4 | use warnings;
5 |
6 | BEGIN {
7 | $Reply::Plugin::TypeTiny::AUTHORITY = 'cpan:TOBYINK';
8 | $Reply::Plugin::TypeTiny::VERSION = '1.000005';
9 | };
10 |
11 | require Reply::Plugin;
12 | our @ISA = 'Reply::Plugin';
13 |
14 | use Scalar::Util qw(blessed);
15 | use Term::ANSIColor;
16 |
17 | sub mangle_error {
18 | my $self = shift;
19 | my ($err) = @_;
20 |
21 | if (blessed $err and $err->isa("Error::TypeTiny::Assertion"))
22 | {
23 | my $explain = $err->explain;
24 | if ($explain)
25 | {
26 | print color("cyan");
27 | print "Error::TypeTiny::Assertion explain:\n";
28 | $self->_explanation($explain, "");
29 | local $| = 1;
30 | print "\n";
31 | print color("reset");
32 | }
33 | }
34 |
35 | return @_;
36 | }
37 |
38 | sub _explanation
39 | {
40 | my $self = shift;
41 | my ($ex, $indent) = @_;
42 |
43 | for my $line (@$ex)
44 | {
45 | if (ref($line) eq q(ARRAY))
46 | {
47 | print "$indent * Explain:\n";
48 | $self->_explanation($line, "$indent ");
49 | }
50 | else
51 | {
52 | print "$indent * $line\n";
53 | }
54 | }
55 | }
56 |
57 | 1;
58 |
59 | __END__
60 |
61 | =pod
62 |
63 | =encoding utf-8
64 |
65 | =head1 NAME
66 |
67 | Reply::Plugin::TypeTiny - improved type constraint exceptions in Reply
68 |
69 | =head1 STATUS
70 |
71 | This module is not covered by the
72 | L.
73 |
74 | =head1 DESCRIPTION
75 |
76 | This is a small plugin to improve error messages in L.
77 | Not massively tested.
78 |
79 | =begin trustme
80 |
81 | =item mangle_error
82 |
83 | =end trustme
84 |
85 | =head1 BUGS
86 |
87 | Please report any bugs to
88 | L.
89 |
90 | =head1 SEE ALSO
91 |
92 | L, L.
93 |
94 | =head1 AUTHOR
95 |
96 | Toby Inkster Etobyink@cpan.orgE.
97 |
98 | =head1 COPYRIGHT AND LICENCE
99 |
100 | This software is copyright (c) 2013-2014 by Toby Inkster.
101 |
102 | This is free software; you can redistribute it and/or modify it under
103 | the same terms as the Perl 5 programming language system itself.
104 |
105 | =head1 DISCLAIMER OF WARRANTIES
106 |
107 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
108 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
109 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
110 |
111 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Sub/Exporter/Progressive.pm:
--------------------------------------------------------------------------------
1 | package Sub::Exporter::Progressive;
2 | $Sub::Exporter::Progressive::VERSION = '0.001013';
3 | use strict;
4 | use warnings;
5 |
6 | # ABSTRACT: Only use Sub::Exporter if you need it
7 |
8 | sub _croak {
9 | require Carp;
10 | &Carp::croak;
11 | }
12 |
13 | sub import {
14 | my ($self, @args) = @_;
15 |
16 | my $inner_target = caller;
17 | my $export_data = sub_export_options($inner_target, @args);
18 |
19 | my $full_exporter;
20 | no strict 'refs';
21 | no warnings 'once';
22 | @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
23 | @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
24 | %{"${inner_target}::EXPORT_TAGS"} = %{$export_data->{tags}};
25 | *{"${inner_target}::import"} = sub {
26 | use strict;
27 | my ($self, @args) = @_;
28 |
29 | if ( grep {
30 | length ref $_
31 | or
32 | $_ !~ / \A [:-]? \w+ \z /xm
33 | } @args ) {
34 | _croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed'
35 | unless eval { require Sub::Exporter };
36 | $full_exporter ||= Sub::Exporter::build_exporter($export_data->{original});
37 |
38 | goto $full_exporter;
39 | } elsif ( defined( (my ($num) = grep { m/^\d/ } @args)[0] ) ) {
40 | _croak "cannot export symbols with a leading digit: '$num'";
41 | } else {
42 | require Exporter;
43 | s/ \A - /:/xm for @args;
44 | @_ = ($self, @args);
45 | goto \&Exporter::import;
46 | }
47 | };
48 | return;
49 | }
50 |
51 | my $too_complicated = <<'DEATH';
52 | You are using Sub::Exporter::Progressive, but the features your program uses from
53 | Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well
54 | just use vanilla Sub::Exporter
55 | DEATH
56 |
57 | sub sub_export_options {
58 | my ($inner_target, $setup, $options) = @_;
59 |
60 | my @exports;
61 | my @defaults;
62 | my %tags;
63 |
64 | if ( ($setup||'') eq '-setup') {
65 | my %options = %$options;
66 |
67 | OPTIONS:
68 | for my $opt (keys %options) {
69 | if ($opt eq 'exports') {
70 |
71 | _croak $too_complicated if ref $options{exports} ne 'ARRAY';
72 | @exports = @{$options{exports}};
73 | _croak $too_complicated if grep { length ref $_ } @exports;
74 |
75 | } elsif ($opt eq 'groups') {
76 | %tags = %{$options{groups}};
77 | for my $tagset (values %tags) {
78 | _croak $too_complicated if grep {
79 | length ref $_
80 | or
81 | $_ =~ / \A - (?! all \b ) /x
82 | } @{$tagset};
83 | }
84 | @defaults = @{$tags{default} || [] };
85 | } else {
86 | _croak $too_complicated;
87 | }
88 | }
89 | @{$_} = map { / \A [:-] all \z /x ? @exports : $_ } @{$_} for \@defaults, values %tags;
90 | $tags{all} ||= [ @exports ];
91 | my %exports = map { $_ => 1 } @exports;
92 | my @errors = grep { not $exports{$_} } @defaults;
93 | _croak join(', ', @errors) . " is not exported by the $inner_target module\n" if @errors;
94 | }
95 |
96 | return {
97 | exports => \@exports,
98 | defaults => \@defaults,
99 | original => $options,
100 | tags => \%tags,
101 | };
102 | }
103 |
104 | 1;
105 |
106 | __END__
107 |
108 | =pod
109 |
110 | =encoding UTF-8
111 |
112 | =head1 NAME
113 |
114 | Sub::Exporter::Progressive - Only use Sub::Exporter if you need it
115 |
116 | =head1 VERSION
117 |
118 | version 0.001013
119 |
120 | =head1 SYNOPSIS
121 |
122 | package Syntax::Keyword::Gather;
123 |
124 | use Sub::Exporter::Progressive -setup => {
125 | exports => [qw( break gather gathered take )],
126 | groups => {
127 | default => [qw( break gather gathered take )],
128 | },
129 | };
130 |
131 | # elsewhere
132 |
133 | # uses Exporter for speed
134 | use Syntax::Keyword::Gather;
135 |
136 | # somewhere else
137 |
138 | # uses Sub::Exporter for features
139 | use Syntax::Keyword::Gather 'gather', take => { -as => 'grab' };
140 |
141 | =head1 DESCRIPTION
142 |
143 | L is an incredibly powerful module, but with that power comes
144 | great responsibility, er- as well as some runtime penalties. This module
145 | is a C wrapper that will let your users just use L
146 | if all they are doing is picking exports, but use C if your
147 | users try to use C's more advanced features, like
148 | renaming exports, if they try to use them.
149 |
150 | Note that this module will export C<@EXPORT>, C<@EXPORT_OK> and
151 | C<%EXPORT_TAGS> package variables for C to work. Additionally, if
152 | your package uses advanced C features like currying, this module
153 | will only ever use C, so you might as well use it directly.
154 |
155 | =head1 CONTRIBUTORS
156 |
157 | ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI)
158 |
159 | mst - Matt S. Trout (cpan:MSTROUT)
160 |
161 | leont - Leon Timmermans (cpan:LEONT)
162 |
163 | =head1 AUTHOR
164 |
165 | Arthur Axel "fREW" Schmidt
166 |
167 | =head1 COPYRIGHT AND LICENSE
168 |
169 | This software is copyright (c) 2016 by Arthur Axel "fREW" Schmidt.
170 |
171 | This is free software; you can redistribute it and/or modify it under
172 | the same terms as the Perl 5 programming language system itself.
173 |
174 | =cut
175 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Coercion/FromMoose.pm:
--------------------------------------------------------------------------------
1 | package Type::Coercion::FromMoose;
2 |
3 | use 5.006001;
4 | use strict;
5 | use warnings;
6 |
7 | BEGIN {
8 | $Type::Coercion::FromMoose::AUTHORITY = 'cpan:TOBYINK';
9 | $Type::Coercion::FromMoose::VERSION = '1.000005';
10 | }
11 |
12 | use Scalar::Util qw< blessed >;
13 | use Types::TypeTiny ();
14 |
15 | sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
16 |
17 | require Type::Coercion;
18 | our @ISA = 'Type::Coercion';
19 |
20 | sub type_coercion_map
21 | {
22 | my $self = shift;
23 |
24 | my @from;
25 | if ($self->type_constraint)
26 | {
27 | my $moose = $self->type_constraint->{moose_type};
28 | @from = @{ $moose->coercion->type_coercion_map } if $moose && $moose->has_coercion;
29 | }
30 | else
31 | {
32 | _croak "The type constraint attached to this coercion has been garbage collected... PANIC";
33 | }
34 |
35 | my @return;
36 | while (@from)
37 | {
38 | my ($type, $code) = splice(@from, 0, 2);
39 | $type = Moose::Util::TypeConstraints::find_type_constraint($type)
40 | unless ref $type;
41 | push @return, Types::TypeTiny::to_TypeTiny($type), $code;
42 | }
43 |
44 | return \@return;
45 | }
46 |
47 | sub add_type_coercions
48 | {
49 | my $self = shift;
50 | _croak "Adding coercions to Type::Coercion::FromMoose not currently supported" if @_;
51 | }
52 |
53 | sub _build_moose_coercion
54 | {
55 | my $self = shift;
56 |
57 | if ($self->type_constraint)
58 | {
59 | my $moose = $self->type_constraint->{moose_type};
60 | return $moose->coercion if $moose && $moose->has_coercion;
61 | }
62 |
63 | $self->SUPER::_build_moose_coercion(@_);
64 | }
65 |
66 | sub can_be_inlined
67 | {
68 | 0;
69 | }
70 |
71 | 1;
72 |
73 | __END__
74 |
75 | =pod
76 |
77 | =encoding utf-8
78 |
79 | =head1 NAME
80 |
81 | Type::Coercion::FromMoose - a set of coercions borrowed from Moose
82 |
83 | =head1 STATUS
84 |
85 | This module is considered part of Type-Tiny's internals. It is not
86 | covered by the
87 | L.
88 |
89 | =head1 DESCRIPTION
90 |
91 | This package inherits from L; see that for most documentation.
92 | The major differences are that C always throws an
93 | exception, and the C is automatically populated from
94 | Moose.
95 |
96 | This is mostly for internal purposes.
97 |
98 | =head1 BUGS
99 |
100 | Please report any bugs to
101 | L.
102 |
103 | =head1 SEE ALSO
104 |
105 | L.
106 |
107 | L.
108 |
109 | =head1 AUTHOR
110 |
111 | Toby Inkster Etobyink@cpan.orgE.
112 |
113 | =head1 COPYRIGHT AND LICENCE
114 |
115 | This software is copyright (c) 2013-2014 by Toby Inkster.
116 |
117 | This is free software; you can redistribute it and/or modify it under
118 | the same terms as the Perl 5 programming language system itself.
119 |
120 | =head1 DISCLAIMER OF WARRANTIES
121 |
122 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
123 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
124 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
125 |
126 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Coercion/Union.pm:
--------------------------------------------------------------------------------
1 | package Type::Coercion::Union;
2 |
3 | use 5.006001;
4 | use strict;
5 | use warnings;
6 |
7 | BEGIN {
8 | $Type::Coercion::Union::AUTHORITY = 'cpan:TOBYINK';
9 | $Type::Coercion::Union::VERSION = '1.000005';
10 | }
11 |
12 | use Scalar::Util qw< blessed >;
13 | use Types::TypeTiny ();
14 |
15 | sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
16 |
17 | require Type::Coercion;
18 | our @ISA = 'Type::Coercion';
19 |
20 | sub _preserve_type_constraint
21 | {
22 | my $self = shift;
23 | $self->{_union_of} = $self->{type_constraint}->type_constraints
24 | if $self->{type_constraint};
25 | }
26 |
27 | sub _maybe_restore_type_constraint
28 | {
29 | my $self = shift;
30 | if ( my $union = $self->{_union_of} )
31 | {
32 | return Type::Tiny::Union->new(type_constraints => $union);
33 | }
34 | return;
35 | }
36 |
37 | sub type_coercion_map
38 | {
39 | my $self = shift;
40 |
41 | Types::TypeTiny::TypeTiny->assert_valid(my $type = $self->type_constraint);
42 | $type->isa('Type::Tiny::Union')
43 | or _croak "Type::Coercion::Union must be used in conjunction with Type::Tiny::Union";
44 |
45 | my @c;
46 | for my $tc (@$type)
47 | {
48 | next unless $tc->has_coercion;
49 | push @c, @{$tc->coercion->type_coercion_map};
50 | }
51 | return \@c;
52 | }
53 |
54 | sub add_type_coercions
55 | {
56 | my $self = shift;
57 | _croak "Adding coercions to Type::Coercion::Union not currently supported" if @_;
58 | }
59 |
60 | sub _build_moose_coercion
61 | {
62 | my $self = shift;
63 |
64 | my %options = ();
65 | $options{type_constraint} = $self->type_constraint if $self->has_type_constraint;
66 |
67 | require Moose::Meta::TypeCoercion::Union;
68 | my $r = "Moose::Meta::TypeCoercion::Union"->new(%options);
69 |
70 | return $r;
71 | }
72 |
73 | sub can_be_inlined
74 | {
75 | my $self = shift;
76 |
77 | Types::TypeTiny::TypeTiny->assert_valid(my $type = $self->type_constraint);
78 |
79 | for my $tc (@$type)
80 | {
81 | next unless $tc->has_coercion;
82 | return !!0 unless $tc->coercion->can_be_inlined;
83 | }
84 |
85 | !!1;
86 | }
87 |
88 | 1;
89 |
90 | __END__
91 |
92 | =pod
93 |
94 | =encoding utf-8
95 |
96 | =head1 NAME
97 |
98 | Type::Coercion::Union - a set of coercions to a union type constraint
99 |
100 | =head1 STATUS
101 |
102 | This module is covered by the
103 | L.
104 |
105 | =head1 DESCRIPTION
106 |
107 | This package inherits from L; see that for most documentation.
108 | The major differences are that C always throws an
109 | exception, and the C is automatically populated from
110 | the child constraints of the union type constraint.
111 |
112 | =head1 BUGS
113 |
114 | Please report any bugs to
115 | L.
116 |
117 | =head1 SEE ALSO
118 |
119 | L.
120 |
121 | L.
122 |
123 | =head1 AUTHOR
124 |
125 | Toby Inkster Etobyink@cpan.orgE.
126 |
127 | =head1 COPYRIGHT AND LICENCE
128 |
129 | This software is copyright (c) 2013-2014 by Toby Inkster.
130 |
131 | This is free software; you can redistribute it and/or modify it under
132 | the same terms as the Perl 5 programming language system itself.
133 |
134 | =head1 DISCLAIMER OF WARRANTIES
135 |
136 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
137 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
138 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
139 |
140 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Tiny/Duck.pm:
--------------------------------------------------------------------------------
1 | package Type::Tiny::Duck;
2 |
3 | use 5.006001;
4 | use strict;
5 | use warnings;
6 |
7 | BEGIN {
8 | $Type::Tiny::Duck::AUTHORITY = 'cpan:TOBYINK';
9 | $Type::Tiny::Duck::VERSION = '1.000005';
10 | }
11 |
12 | use Scalar::Util qw< blessed >;
13 |
14 | sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
15 |
16 | use Type::Tiny ();
17 | our @ISA = 'Type::Tiny';
18 |
19 | sub new {
20 | my $proto = shift;
21 |
22 | my %opts = (@_==1) ? %{$_[0]} : @_;
23 | _croak "Duck type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent};
24 | _croak "Duck type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint};
25 | _croak "Duck type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined};
26 | _croak "Need to supply list of methods" unless exists $opts{methods};
27 |
28 | $opts{methods} = [$opts{methods}] unless ref $opts{methods};
29 |
30 | if (Type::Tiny::_USE_XS)
31 | {
32 | my $methods = join ",", sort(@{$opts{methods}});
33 | my $xsub = Type::Tiny::XS::get_coderef_for("HasMethods[$methods]");
34 | $opts{compiled_type_constraint} = $xsub if $xsub;
35 | }
36 | elsif (Type::Tiny::_USE_MOUSE)
37 | {
38 | require Mouse::Util::TypeConstraints;
39 | my $maker = "Mouse::Util::TypeConstraints"->can("generate_can_predicate_for");
40 | $opts{compiled_type_constraint} = $maker->($opts{methods}) if $maker;
41 | }
42 |
43 | return $proto->SUPER::new(%opts);
44 | }
45 |
46 | sub methods { $_[0]{methods} }
47 | sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined }
48 |
49 | sub has_inlined { !!1 }
50 |
51 | sub _build_constraint
52 | {
53 | my $self = shift;
54 | my @methods = @{$self->methods};
55 | return sub { blessed($_[0]) and not grep(!$_[0]->can($_), @methods) };
56 | }
57 |
58 | sub _build_inlined
59 | {
60 | my $self = shift;
61 | my @methods = @{$self->methods};
62 |
63 | if (Type::Tiny::_USE_XS)
64 | {
65 | my $methods = join ",", sort(@{$self->methods});
66 | my $xsub = Type::Tiny::XS::get_subname_for("HasMethods[$methods]");
67 | return sub { my $var = $_[1]; "$xsub\($var\)" } if $xsub;
68 | }
69 |
70 | sub {
71 | my $var = $_[1];
72 | local $" = q{ };
73 | # If $var is $_ or $_->{foo} or $foo{$_} or somesuch, then we
74 | # can't use it within the grep expression, so we need to save
75 | # it into a temporary variable ($tmp).
76 | ($var =~ /\$_/)
77 | ? qq{ Scalar::Util::blessed($var) and not do { my \$tmp = $var; grep(!\$tmp->can(\$_), qw/@methods/) } }
78 | : qq{ Scalar::Util::blessed($var) and not grep(!$var->can(\$_), qw/@methods/) };
79 | };
80 | }
81 |
82 | sub _instantiate_moose_type
83 | {
84 | my $self = shift;
85 | my %opts = @_;
86 | delete $opts{parent};
87 | delete $opts{constraint};
88 | delete $opts{inlined};
89 |
90 | require Moose::Meta::TypeConstraint::DuckType;
91 | return "Moose::Meta::TypeConstraint::DuckType"->new(%opts, methods => $self->methods);
92 | }
93 |
94 | sub has_parent
95 | {
96 | !!1;
97 | }
98 |
99 | sub parent
100 | {
101 | require Types::Standard;
102 | Types::Standard::Object();
103 | }
104 |
105 | sub validate_explain
106 | {
107 | my $self = shift;
108 | my ($value, $varname) = @_;
109 | $varname = '$_' unless defined $varname;
110 |
111 | return undef if $self->check($value);
112 | return ["Not a blessed reference"] unless blessed($value);
113 |
114 | require Type::Utils;
115 | return [
116 | sprintf(
117 | '"%s" requires that the reference can %s',
118 | $self,
119 | Type::Utils::english_list(map qq["$_"], @{$self->methods}),
120 | ),
121 | map sprintf('The reference cannot "%s"', $_),
122 | grep !$value->can($_),
123 | @{$self->methods}
124 | ];
125 | }
126 |
127 | 1;
128 |
129 | __END__
130 |
131 | =pod
132 |
133 | =encoding utf-8
134 |
135 | =head1 NAME
136 |
137 | Type::Tiny::Duck - type constraints based on the "can" method
138 |
139 | =head1 STATUS
140 |
141 | This module is covered by the
142 | L.
143 |
144 | =head1 DESCRIPTION
145 |
146 | Type constraints of the general form C<< { $_->can("method") } >>.
147 |
148 | This package inherits from L; see that for most documentation.
149 | Major differences are listed below:
150 |
151 | =head2 Attributes
152 |
153 | =over
154 |
155 | =item C
156 |
157 | An arrayref of method names.
158 |
159 | =item C
160 |
161 | Unlike Type::Tiny, you I pass a constraint coderef to the constructor.
162 | Instead rely on the default.
163 |
164 | =item C
165 |
166 | Unlike Type::Tiny, you I pass an inlining coderef to the constructor.
167 | Instead rely on the default.
168 |
169 | =item C
170 |
171 | Parent is always Types::Standard::Object, and cannot be passed to the
172 | constructor.
173 |
174 | =back
175 |
176 | =head1 BUGS
177 |
178 | Please report any bugs to
179 | L.
180 |
181 | =head1 SEE ALSO
182 |
183 | L.
184 |
185 | L.
186 |
187 | L.
188 |
189 | =head1 AUTHOR
190 |
191 | Toby Inkster Etobyink@cpan.orgE.
192 |
193 | =head1 COPYRIGHT AND LICENCE
194 |
195 | This software is copyright (c) 2013-2014 by Toby Inkster.
196 |
197 | This is free software; you can redistribute it and/or modify it under
198 | the same terms as the Perl 5 programming language system itself.
199 |
200 | =head1 DISCLAIMER OF WARRANTIES
201 |
202 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
203 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
204 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
205 |
206 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Tiny/Enum.pm:
--------------------------------------------------------------------------------
1 | package Type::Tiny::Enum;
2 |
3 | use 5.006001;
4 | use strict;
5 | use warnings;
6 |
7 | BEGIN {
8 | $Type::Tiny::Enum::AUTHORITY = 'cpan:TOBYINK';
9 | $Type::Tiny::Enum::VERSION = '1.000005';
10 | }
11 |
12 | sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
13 |
14 | use overload q[@{}] => 'values';
15 |
16 | use Type::Tiny ();
17 | our @ISA = 'Type::Tiny';
18 |
19 | sub new
20 | {
21 | my $proto = shift;
22 |
23 | my %opts = (@_==1) ? %{$_[0]} : @_;
24 | _croak "Enum type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent};
25 | _croak "Enum type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint};
26 | _croak "Enum type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined};
27 | _croak "Need to supply list of values" unless exists $opts{values};
28 |
29 | my %tmp =
30 | map { $_ => 1 }
31 | @{ ref $opts{values} eq "ARRAY" ? $opts{values} : [$opts{values}] };
32 | $opts{values} = [sort keys %tmp];
33 |
34 | if (Type::Tiny::_USE_XS and not grep /[^-\w]/, @{$opts{values}})
35 | {
36 | my $enum = join ",", @{$opts{values}};
37 | my $xsub = Type::Tiny::XS::get_coderef_for("Enum[$enum]");
38 | $opts{compiled_type_constraint} = $xsub if $xsub;
39 | }
40 |
41 | return $proto->SUPER::new(%opts);
42 | }
43 |
44 | sub values { $_[0]{values} }
45 | sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint }
46 |
47 | sub _build_display_name
48 | {
49 | my $self = shift;
50 | sprintf("Enum[%s]", join q[,], @$self);
51 | }
52 |
53 | sub _build_constraint
54 | {
55 | my $self = shift;
56 |
57 | my $regexp = join "|", map quotemeta, @$self;
58 | return sub { defined and m{\A(?:$regexp)\z} };
59 | }
60 |
61 | sub can_be_inlined
62 | {
63 | !!1;
64 | }
65 |
66 | sub inline_check
67 | {
68 | my $self = shift;
69 |
70 | if (Type::Tiny::_USE_XS)
71 | {
72 | my $enum = join ",", @{$self->values};
73 | my $xsub = Type::Tiny::XS::get_subname_for("Enum[$enum]");
74 | return "$xsub\($_[0]\)" if $xsub;
75 | }
76 |
77 | my $regexp = join "|", map quotemeta, @$self;
78 | $_[0] eq '$_'
79 | ? "(defined and !ref and m{\\A(?:$regexp)\\z})"
80 | : "(defined($_[0]) and !ref($_[0]) and $_[0] =~ m{\\A(?:$regexp)\\z})";
81 | }
82 |
83 | sub _instantiate_moose_type
84 | {
85 | my $self = shift;
86 | my %opts = @_;
87 | delete $opts{parent};
88 | delete $opts{constraint};
89 | delete $opts{inlined};
90 | require Moose::Meta::TypeConstraint::Enum;
91 | return "Moose::Meta::TypeConstraint::Enum"->new(%opts, values => $self->values);
92 | }
93 |
94 | sub has_parent
95 | {
96 | !!1;
97 | }
98 |
99 | sub parent
100 | {
101 | require Types::Standard;
102 | Types::Standard::Str();
103 | }
104 |
105 | sub validate_explain
106 | {
107 | my $self = shift;
108 | my ($value, $varname) = @_;
109 | $varname = '$_' unless defined $varname;
110 |
111 | return undef if $self->check($value);
112 |
113 | require Type::Utils;
114 | !defined($value) ? [
115 | sprintf(
116 | '"%s" requires that the value is defined',
117 | $self,
118 | ),
119 | ] :
120 | @$self < 13 ? [
121 | sprintf(
122 | '"%s" requires that the value is equal to %s',
123 | $self,
124 | Type::Utils::english_list(\"or", map B::perlstring($_), @$self),
125 | ),
126 | ] :
127 | [
128 | sprintf(
129 | '"%s" requires that the value is one of an enumerated list of strings',
130 | $self,
131 | ),
132 | ];
133 | }
134 |
135 |
136 | 1;
137 |
138 | __END__
139 |
140 | =pod
141 |
142 | =encoding utf-8
143 |
144 | =head1 NAME
145 |
146 | Type::Tiny::Enum - string enum type constraints
147 |
148 | =head1 STATUS
149 |
150 | This module is covered by the
151 | L.
152 |
153 | =head1 DESCRIPTION
154 |
155 | Enum type constraints.
156 |
157 | This package inherits from L; see that for most documentation.
158 | Major differences are listed below:
159 |
160 | =head2 Attributes
161 |
162 | =over
163 |
164 | =item C
165 |
166 | Arrayref of allowable value strings. Non-string values (e.g. objects with
167 | overloading) will be stringified in the constructor.
168 |
169 | =item C
170 |
171 | Unlike Type::Tiny, you I pass a constraint coderef to the constructor.
172 | Instead rely on the default.
173 |
174 | =item C
175 |
176 | Unlike Type::Tiny, you I pass an inlining coderef to the constructor.
177 | Instead rely on the default.
178 |
179 | =item C
180 |
181 | Parent is always Types::Standard::Str, and cannot be passed to the
182 | constructor.
183 |
184 | =back
185 |
186 | =head2 Overloading
187 |
188 | =over
189 |
190 | =item *
191 |
192 | Arrayrefification calls C.
193 |
194 | =back
195 |
196 | =head1 BUGS
197 |
198 | Please report any bugs to
199 | L.
200 |
201 | =head1 SEE ALSO
202 |
203 | L.
204 |
205 | L.
206 |
207 | L.
208 |
209 | =head1 AUTHOR
210 |
211 | Toby Inkster Etobyink@cpan.orgE.
212 |
213 | =head1 COPYRIGHT AND LICENCE
214 |
215 | This software is copyright (c) 2013-2014 by Toby Inkster.
216 |
217 | This is free software; you can redistribute it and/or modify it under
218 | the same terms as the Perl 5 programming language system itself.
219 |
220 | =head1 DISCLAIMER OF WARRANTIES
221 |
222 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
223 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
224 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
225 |
226 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Tiny/Intersection.pm:
--------------------------------------------------------------------------------
1 | package Type::Tiny::Intersection;
2 |
3 | use 5.006001;
4 | use strict;
5 | use warnings;
6 |
7 | BEGIN {
8 | $Type::Tiny::Intersection::AUTHORITY = 'cpan:TOBYINK';
9 | $Type::Tiny::Intersection::VERSION = '1.000005';
10 | }
11 |
12 | use Scalar::Util qw< blessed >;
13 | use Types::TypeTiny ();
14 |
15 | sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
16 |
17 | use overload q[@{}] => sub { $_[0]{type_constraints} ||= [] };
18 |
19 | use Type::Tiny ();
20 | our @ISA = 'Type::Tiny';
21 |
22 | sub new {
23 | my $proto = shift;
24 |
25 | my %opts = (@_==1) ? %{$_[0]} : @_;
26 | _croak "Intersection type constraints cannot have a parent constraint" if exists $opts{parent};
27 | _croak "Intersection type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint};
28 | _croak "Intersection type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined};
29 | _croak "Need to supply list of type constraints" unless exists $opts{type_constraints};
30 |
31 | $opts{type_constraints} = [
32 | map { $_->isa(__PACKAGE__) ? @$_ : $_ }
33 | map Types::TypeTiny::to_TypeTiny($_),
34 | @{ ref $opts{type_constraints} eq "ARRAY" ? $opts{type_constraints} : [$opts{type_constraints}] }
35 | ];
36 |
37 | if (Type::Tiny::_USE_XS)
38 | {
39 | my @constraints = @{$opts{type_constraints}};
40 | my @known = map {
41 | my $known = Type::Tiny::XS::is_known($_->compiled_check);
42 | defined($known) ? $known : ();
43 | } @constraints;
44 |
45 | if (@known == @constraints)
46 | {
47 | my $xsub = Type::Tiny::XS::get_coderef_for(
48 | sprintf "AllOf[%s]", join(',', @known)
49 | );
50 | $opts{compiled_type_constraint} = $xsub if $xsub;
51 | }
52 | }
53 |
54 | return $proto->SUPER::new(%opts);
55 | }
56 |
57 | sub type_constraints { $_[0]{type_constraints} }
58 | sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint }
59 |
60 | sub _build_display_name
61 | {
62 | my $self = shift;
63 | join q[&], @$self;
64 | }
65 |
66 | sub _build_constraint
67 | {
68 | my @checks = map $_->compiled_check, @{+shift};
69 | return sub
70 | {
71 | my $val = $_;
72 | $_->($val) || return for @checks;
73 | return !!1;
74 | }
75 | }
76 |
77 | sub can_be_inlined
78 | {
79 | my $self = shift;
80 | not grep !$_->can_be_inlined, @$self;
81 | }
82 |
83 | sub inline_check
84 | {
85 | my $self = shift;
86 |
87 | if (Type::Tiny::_USE_XS and !exists $self->{xs_sub})
88 | {
89 | $self->{xs_sub} = undef;
90 |
91 | my @constraints = @{$self->type_constraints};
92 | my @known = map {
93 | my $known = Type::Tiny::XS::is_known($_->compiled_check);
94 | defined($known) ? $known : ();
95 | } @constraints;
96 |
97 | if (@known == @constraints)
98 | {
99 | $self->{xs_sub} = Type::Tiny::XS::get_subname_for(
100 | sprintf "AllOf[%s]", join(',', @known)
101 | );
102 | }
103 | }
104 |
105 | if (Type::Tiny::_USE_XS and $self->{xs_sub}) {
106 | return "$self->{xs_sub}\($_[0]\)";
107 | }
108 |
109 | sprintf '(%s)', join " and ", map $_->inline_check($_[0]), @$self;
110 | }
111 |
112 | sub has_parent
113 | {
114 | !!@{ $_[0]{type_constraints} };
115 | }
116 |
117 | sub parent
118 | {
119 | $_[0]{type_constraints}[0];
120 | }
121 |
122 | sub validate_explain
123 | {
124 | my $self = shift;
125 | my ($value, $varname) = @_;
126 | $varname = '$_' unless defined $varname;
127 |
128 | return undef if $self->check($value);
129 |
130 | require Type::Utils;
131 | for my $type (@$self)
132 | {
133 | my $deep = $type->validate_explain($value, $varname);
134 | return [
135 | sprintf(
136 | '"%s" requires that the value pass %s',
137 | $self,
138 | Type::Utils::english_list(map qq["$_"], @$self),
139 | ),
140 | @$deep,
141 | ] if $deep;
142 | }
143 |
144 | # This should never happen...
145 | return; # uncoverable statement
146 | }
147 |
148 |
149 | 1;
150 |
151 | __END__
152 |
153 | =pod
154 |
155 | =encoding utf-8
156 |
157 | =head1 NAME
158 |
159 | Type::Tiny::Intersection - intersection type constraints
160 |
161 | =head1 STATUS
162 |
163 | This module is covered by the
164 | L.
165 |
166 | =head1 DESCRIPTION
167 |
168 | Intersection type constraints.
169 |
170 | This package inherits from L; see that for most documentation.
171 | Major differences are listed below:
172 |
173 | =head2 Attributes
174 |
175 | =over
176 |
177 | =item C
178 |
179 | Arrayref of type constraints.
180 |
181 | When passed to the constructor, if any of the type constraints in the
182 | intersection is itself an intersection type constraint, this is "exploded"
183 | into the new intersection.
184 |
185 | =item C
186 |
187 | Unlike Type::Tiny, you I pass a constraint coderef to the constructor.
188 | Instead rely on the default.
189 |
190 | =item C
191 |
192 | Unlike Type::Tiny, you I pass an inlining coderef to the constructor.
193 | Instead rely on the default.
194 |
195 | =item C
196 |
197 | Unlike Type::Tiny, you I pass an inlining coderef to the constructor.
198 | A parent will instead be automatically calculated.
199 |
200 | (Technically any of the types in the intersection could be treated as a
201 | parent type; we choose the first arbitrarily.)
202 |
203 | =back
204 |
205 | =head2 Overloading
206 |
207 | =over
208 |
209 | =item *
210 |
211 | Arrayrefification calls C.
212 |
213 | =back
214 |
215 | =head1 BUGS
216 |
217 | Please report any bugs to
218 | L.
219 |
220 | =head1 SEE ALSO
221 |
222 | L.
223 |
224 | L.
225 |
226 | L.
227 |
228 | =head1 AUTHOR
229 |
230 | Toby Inkster Etobyink@cpan.orgE.
231 |
232 | =head1 COPYRIGHT AND LICENCE
233 |
234 | This software is copyright (c) 2013-2014 by Toby Inkster.
235 |
236 | This is free software; you can redistribute it and/or modify it under
237 | the same terms as the Perl 5 programming language system itself.
238 |
239 | =head1 DISCLAIMER OF WARRANTIES
240 |
241 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
242 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
243 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
244 |
245 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Tiny/Manual/Params.pod:
--------------------------------------------------------------------------------
1 | =pod
2 |
3 | =encoding utf-8
4 |
5 | =head1 NAME
6 |
7 | Type::Tiny::Manual::Params - coerce and validate arguments to functions and methods
8 |
9 | =head1 DESCRIPTION
10 |
11 | There is a module called L available to wrap up type coercion
12 | and constraint checks into a single, simple and fast check. If you care
13 | about speed, and your sub signatures are fairly simple, then this is the way
14 | to go...
15 |
16 | use feature qw( state );
17 | use Types::Standard qw( Str );
18 | use Type::Utils;
19 | use Type::Params qw( compile );
20 |
21 | my $Invocant = class_type { class => __PACKAGE__ };
22 |
23 | sub set_name
24 | {
25 | state $check = compile($Invocant, Str);
26 | my ($self, $name) = $check->(@_);
27 |
28 | ...;
29 | }
30 |
31 | See the COOKBOOK section of L for further information.
32 |
33 | =head2 The Somewhat More Manual Way...
34 |
35 | In general, Type::Params should be sufficient to cover most needs, and
36 | will probably run faster than almost anything you could cook up yourself.
37 | However, sometimes you need to deal with unusual function signatures that
38 | it does not support. For example, imagine function C<< format_string >>
39 | takes an optional hashref of formatting instructions, followed by a
40 | required string. You might expect to be able to handle it like this:
41 |
42 | sub format_string
43 | {
44 | state $check = compile(Optional[HashRef], Str);
45 | my ($instructions, $string) = $check->(@_);
46 |
47 | ...;
48 | }
49 |
50 | However, this won't work, as Type::Params expects required parameters to
51 | always precede optional ones. So there are times you need to handle
52 | parameters more manually.
53 |
54 | In these cases, bear in mind that for any type constraint object you
55 | have several useful checking methods available:
56 |
57 | Str->check($var) # returns a boolean
58 | is_Str($var) # ditto
59 | Str->($var) # returns $var or dies
60 | assert_Str($var) # ditto
61 |
62 | Here's how you might handle the C function:
63 |
64 | sub format_string
65 | {
66 | my $instructions;
67 | $instructions = shift if HashRef->check($_[0]);
68 |
69 | my $string = Str->(shift);
70 |
71 | ...;
72 | }
73 |
74 | Alternatively, you could manipulate @_ before passing it to the compiled
75 | check:
76 |
77 | sub format_string
78 | {
79 | state $check = compile(HashRef, Str);
80 | my ($instructions, $str) = $check->(@_==1 ? ({}, @_) : @_);
81 |
82 | ...;
83 | }
84 |
85 | =head2 Signatures
86 |
87 | Don't you wish your subs could look like this?
88 |
89 | sub set_name (Object $self, Str $name)
90 | {
91 | $self->{name} = $name;
92 | }
93 |
94 | Well; here are a few solutions for sub signatures that work with
95 | L...
96 |
97 | =head3 Kavorka
98 |
99 | L is a sub signatures implementation written to natively use
100 | L' C for type constraints, and take advantage
101 | of Type::Tiny's features such as inlining, and coercions.
102 |
103 | method set_name (Str $name)
104 | {
105 | $self->{name} = $name;
106 | }
107 |
108 | Kavorka's signatures provide a lot more flexibility, and slightly more
109 | speed than Type::Params. (The speed comes from inlining almost all type
110 | checks into the body of the sub being declared.)
111 |
112 | Kavorka also includes support for type checking of the returned value.
113 |
114 | Kavorka can also be used as part of L, a larger framework for
115 | object oriented programming in Perl.
116 |
117 | =head3 Function::Parameters
118 |
119 | The following should work with L 1.0201 or above:
120 |
121 | use Type::Utils;
122 | use Function::Parameters {
123 | method => {
124 | strict => 1,
125 | reify_type => sub { Type::Utils::dwim_type($_[0]) },
126 | },
127 | };
128 |
129 | method set_name (Str $name)
130 | {
131 | $self->{name} = $name;
132 | }
133 |
134 | Note that by default, Function::Parameters uses Moose's type
135 | constraints. The C option above (introduced in
136 | Function::Parameters 1.0201) allows you to "divert" type constraint
137 | lookups. Using Type::Tiny constraints will gain you about a 7%
138 | speed-up in function signature checks.
139 |
140 | An alternative way to use Function::Parameter with Type::Tiny is to
141 | provide type constraint expressions in parentheses:
142 |
143 | use Types::Standard;
144 | use Function::Parameters ':strict';
145 |
146 | method set_name ((Str) $name)
147 | {
148 | $self->{name} = $name;
149 | }
150 |
151 | =head3 Attribute::Contract
152 |
153 | Both Kavorka and Function::Parameters require a relatively recent
154 | version of Perl. L supports older versions by
155 | using a lot less magic.
156 |
157 | You want Attribute::Contract 0.03 or above.
158 |
159 | use Attribute::Contract -types => [qw/Object Str/];
160 |
161 | sub set_name :ContractRequires(Object, Str)
162 | {
163 | my ($self, $name) = @_;
164 | $self->{name} = $name;
165 | }
166 |
167 | Attribute::Contract also includes support for type checking of the
168 | returned value.
169 |
170 | =head1 AUTHOR
171 |
172 | Toby Inkster Etobyink@cpan.orgE.
173 |
174 | =head1 COPYRIGHT AND LICENCE
175 |
176 | This software is copyright (c) 2013-2014 by Toby Inkster.
177 |
178 | This is free software; you can redistribute it and/or modify it under
179 | the same terms as the Perl 5 programming language system itself.
180 |
181 | =head1 DISCLAIMER OF WARRANTIES
182 |
183 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
184 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
185 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
186 |
187 | =cut
188 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Tiny/Manual/Policies.pod:
--------------------------------------------------------------------------------
1 | =pod
2 |
3 | =encoding utf-8
4 |
5 | =for stopwords versioning
6 |
7 | =head1 NAME
8 |
9 | Type::Tiny::Manual::Policies - Type::Tiny policies
10 |
11 | =head1 STABILITY
12 |
13 | =head2 Type::Tiny Stability Policy
14 |
15 | Type::Tiny 1.000000 is considered stable. Any changes to the API that
16 | are big enough to I changes to the test suite will be preceded
17 | by a I<< six month >> notice period, with the following exceptions:
18 |
19 | =over
20 |
21 | =item *
22 |
23 | Any changes which are necessary to maintain compatibility with new
24 | releases of L, L, and other software that Type::Tiny needs
25 | to integrate with.
26 |
27 | =item *
28 |
29 | Changes to maintain compatibility with future versions of Perl itself.
30 |
31 | =item *
32 |
33 | Where a change fixes a contradiction between the implementation and
34 | documentation of Type::Tiny.
35 |
36 | =item *
37 |
38 | Where a feature is explicitly documented as being "experimental" or
39 | "unstable".
40 |
41 | =item *
42 |
43 | Improvements to the text of error messages.
44 |
45 | =back
46 |
47 | =head2 Experimental and Unstable Type::Tiny Features
48 |
49 | The following list is currently non-exhaustive.
50 |
51 | =over
52 |
53 | =item *
54 |
55 | L inlining subs (i.e. C) may return a list of
56 | strings (with C being allowed as the first item on the list).
57 | This is experimental. See L.
58 |
59 | =item *
60 |
61 | L's C attribute and the functionality it
62 | provides is experimental.
63 |
64 | =item *
65 |
66 | The L is subject to change.
67 |
68 | =item *
69 |
70 | The interaction of deep coercions and mutable coercions currently results
71 | in ill-defined behaviour. This could change at any time.
72 | (See L.)
73 |
74 | =item *
75 |
76 | L's ability to import L and L
77 | type libraries is experimental.
78 |
79 | =item *
80 |
81 | Integration with L.
82 |
83 | =item *
84 |
85 | These modules are considered part of Type::Tiny's internals, and not
86 | covered by the stability policy:
87 | L,
88 | L,
89 | L,
90 | L,
91 | L,
92 | L,
93 | L,
94 | L,
95 | L,
96 | L, and
97 | L.
98 |
99 | =item *
100 |
101 | L is not covered by the stability policy.
102 |
103 | =back
104 |
105 | =head2 Type::Tiny Versioning Policy
106 |
107 | As of 1.000000, this distribution follows a versioning scheme similar
108 | to L, which is based on a L -like three
109 | component version number, but with the last two components each
110 | represented by three decimal digits in the fractional part of the
111 | version number. That is, version 1.003002 of the software represents
112 | "1.3.2".
113 |
114 | Additionally, releases where the second component is an odd number will
115 | be considered unstable/trial releases. (These will also include an
116 | underscore in the version number as per the usual CPAN convention.)
117 |
118 | =head1 BUGS
119 |
120 | Please report any bugs to
121 | L.
122 |
123 | =head1 AUTHOR
124 |
125 | Toby Inkster Etobyink@cpan.orgE.
126 |
127 | =head1 COPYRIGHT AND LICENCE
128 |
129 | This software is copyright (c) 2013-2014 by Toby Inkster.
130 |
131 | This is free software; you can redistribute it and/or modify it under
132 | the same terms as the Perl 5 programming language system itself.
133 |
134 | =head1 DISCLAIMER OF WARRANTIES
135 |
136 | THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
137 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
138 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
139 |
140 | =cut
141 |
--------------------------------------------------------------------------------
/inst/perl/fatlib/Type/Tiny/Manual/UsingWithMoo.pod:
--------------------------------------------------------------------------------
1 | =pod
2 |
3 | =encoding utf-8
4 |
5 | =head1 NAME
6 |
7 | Type::Tiny::Manual::UsingWithMoo - how to use Type::Tiny and Type::Library with Moo
8 |
9 | =head1 SYNOPSIS
10 |
11 | {
12 | package Person;
13 |
14 | use Moo;
15 | use Types::Standard qw( Str Int );
16 | use Type::Utils qw( declare as where inline_as coerce from );
17 |
18 | has name => (
19 | is => "ro",
20 | isa => Str,
21 | );
22 |
23 | my $PositiveInt = declare
24 | as Int,
25 | where { $_ > 0 },
26 | inline_as { "$_ =~ /^[0-9]+\$/ and $_ > 0" };
27 |
28 | coerce $PositiveInt, from Int, q{ abs $_ };
29 |
30 | has age => (
31 | is => "rwp",
32 | isa => $PositiveInt,
33 | coerce => $PositiveInt->coercion,
34 | );
35 |
36 | sub get_older {
37 | my $self = shift;
38 | my ($years) = @_;
39 | $PositiveInt->assert_valid($years);
40 | $self->_set_age($self->age + $years);
41 | }
42 | }
43 |
44 | =head1 DESCRIPTION
45 |
46 | Type::Tiny is tested with L 1.001000 and above.
47 |
48 | Type::Tiny overloads C<< &{} >>. Moo supports using objects that overload
49 | C<< &{} >> as C constraints, so Type::Tiny objects can directly be used
50 | in C.
51 |
52 | Moo doesn't support C<< coerce => 1 >> but requires a coderef as a coercion.
53 | However, again it supports using objects that overload C<< &{} >>, which
54 | Type::Coercion does, allowing C<< coerce => $Type->coercion >> to work.
55 |
56 | Type::Tiny hooks into Moo's HandleMoose interface to ensure that type
57 | constraints get inflated to Moose type constraints if and when Moo inflates
58 | your class to a full Moose class.
59 |
60 | =head2 Optimization
61 |
62 | The usual advice for optimizing type constraints applies: use type constraints
63 | which can be inlined whenever possible, and define coercions as strings rather
64 | than coderefs.
65 |
66 | Upgrading to Moo 1.002000 or above should provide a slight increase in speed
67 | for type constraints, as it allows them to be inlined into accessors and
68 | constructors.
69 |
70 | If creating your own type constraints using C<< Type::Tiny->new >>, then
71 | consider using L to quote the coderef; this allows you to take
72 | advantage of inlining without having to write your own inlining routines.
73 |
74 | See also L.
75 |
76 | =head1 SEE ALSO
77 |
78 | For examples using Type::Tiny with L see the SYNOPSIS sections of
79 | L and L