Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add bootstrap.sh and the ext/ directory with the needed libs

  • Loading branch information...
commit 11b3bdc86adb10afbf828a7e012276087c00ab20 1 parent 53769b3
@tadzik authored
View
3  bootstrap.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+PWD=`pwd`
+PERL6LIB=$PWD/ext:$PWD/lib perl6 bin/panda Pies
View
125 ext/File/Find.pm
@@ -0,0 +1,125 @@
+use v6;
+
+module File::Find;
+
+class File::Find::Result is Cool {
+ has $.dir;
+ has $.name;
+
+ method Str {
+ $.dir ~ '/' ~ $.name
+ }
+}
+
+sub checkrules ($elem, %opts) {
+ if %opts<name>.defined {
+ given %opts<name> {
+ when Regex {
+ return False unless $elem ~~ %opts<name>
+ }
+ when Str {
+ return False unless $elem.name ~~ %opts<name>
+ }
+ default {
+ die "name attribute has to be either Regex or Str"
+ }
+ }
+ }
+ if %opts<type>.defined {
+ given %opts<type> {
+ when 'dir' {
+ return False unless $elem.IO ~~ :d
+ }
+ when 'file' {
+ return False unless $elem.IO ~~ :f
+ }
+ when 'symlink' {
+ return False unless $elem.IO ~~ :l
+ }
+ default {
+ die "type attribute has to be dir, file or symlink";
+ }
+ }
+ }
+ return True
+}
+
+sub find (:$dir!, :$name, :$type) is export {
+ my @targets = dir($dir).map: {
+ File::Find::Result.new(dir => $dir, name => $_);
+ };
+ my $list = gather while @targets {
+ my $elem = @targets.shift;
+ take $elem if checkrules($elem, { :$name, :$type });
+ if $elem.IO ~~ :d {
+ for dir($elem) -> $file {
+ @targets.push(
+ File::Find::Result.new(dir => $elem, name => $file)
+ );
+ }
+ }
+ }
+ return $list;
+}
+
+=begin pod
+
+=head1 NAME
+
+File::Find - Get a lazy list of a directory tree
+
+=head1 SYNOPSIS
+
+ use File::Find;
+
+ my @list := find(dir => 'foo');
+ say @list[0..3];
+
+ my $list = find(dir => 'foo');
+ say $list[0..3];
+
+=head1 DESCRIPTION
+
+C<File::Find> allows you to get the contents of the given directory,
+recursively. The only exported function, C<find()>, generates a lazy
+list of files in given directory. Every element of the list is a
+C<File::Find::Result> object, described below.
+C<find()> takes one (or more) named arguments. The C<dir> argument
+is mandatory, and sets the directory C<find()> will traverse.
+There are also few optional arguments. If more than one is passed,
+all of them must match for a file to be returned.
+
+=head2 name
+
+Specify a name of the file C<File::Find> is ought to look for. If you
+pass a string here, C<find()> will return only the files with the given
+name. When passing a regex, only the files with path matching the
+pattern will be returned.
+
+=head2 type
+
+Given a type, C<find()> will only return files being the given type.
+The available types are C<file>, C<dir> or C<symlink>.
+
+=head1 File::Find::Result
+
+C<File::Find::Result> object acts like a normal string, having two
+additional accessors, C<dir> and C<name>, holding the directory
+the file is in and the filename respectively.
+
+=head1 Perl 5's File::Find
+
+Please note, that this module is not trying to be the verbatim port of
+Perl 5's File::Find module. Its interface is closer to Perl 5's
+File::Find::Rule, and its features are planned to be similar one day.
+
+=head1 CAVEATS
+
+List assignment is eager in Perl 6, so if You assign C<find()> result
+to an array, the elements will be copied and the laziness will be
+spoiled. For a proper lazy list, use either binding (C<:=>) or assign
+a result to a scalar value (see SYNOPSIS).
+
+=end pod
+
+# vim: ft=perl6
View
37 ext/File/Mkdir.pm
@@ -0,0 +1,37 @@
+use v6;
+
+module File::Mkdir;
+
+multi sub mkdir(Str $name, $mode = 0o777, :$p!) is export {
+ for [\~] $name.split('/').map({"$_/"}) {
+ mkdir($_) unless .IO.d
+ }
+}
+
+=begin pod
+
+=head1 NAME
+
+File::Mkdir -- provides recursive mkdir
+
+=head1 SYNOPSIS
+
+ use File::Mkdir;
+
+ # special mkdir exported in File::Mkdir
+ mkdir '/some/directory/tree', :p;
+ # just a casual, built-in mkdir
+ mkdir 'directory';
+
+=head1 DESCRIPTION
+
+C<File::Mkdir> provides an mkdir variant, which, when provided the :p
+parameter, will create the directory tree recursively. For example,
+calling C<mkdir 'foo/bar', :p> will create the foo directory (unless
+it alredy exists), then the foo/bar directory (unless it exists).
+The standard Perl 6 C<mkdir> is still available, and will be called
+when the :p parameter is not passed.
+
+=end pod
+
+# vim: ft=perl6
View
55 ext/JSON/Tiny.pm
@@ -0,0 +1,55 @@
+# =begin Pod
+#
+# =head1 JSON::Tiny
+#
+# C<JSON::Tiny> is a minimalistic module that reads and writes JSON.
+# It supports strings, numbers, arrays and hashes (no custom objects).
+#
+# =head1 Synopsis
+#
+# use JSON::Tiny;
+# my $json = to-json([1, 2, "a third item"]);
+# my $copy-of-original-data-structure = from-json($json);
+#
+# =end Pod
+
+module JSON::Tiny;
+
+use JSON::Tiny::Actions;
+use JSON::Tiny::Grammar;
+
+proto to-json($d) is export { _tj($d) }
+
+multi _tj(Real $d) { ~$d }
+multi _tj(Bool $d) { $d ?? 'true' !! 'false'; }
+multi _tj(Str $d) {
+ '"'
+ ~ (~$d).trans(['"', '\\', "\b", "\f", "\n", "\r", "\t"]
+ => ['\"', '\\\\', '\b', '\f', '\n', '\r', '\t'])\
+ # RAKUDO: This would be nicer to write as <-[\c32..\c126]>,
+ # but Rakudo doesn't do \c yet. [perl #73698]
+ .subst(/<-[\ ..~]>/, { ord(~$_).fmt('\u%04x') }, :g)
+ ~ '"'
+}
+multi _tj(Array $d) {
+ return '[ '
+ ~ (map { _tj($_) }, $d.values).join(', ')
+ ~ ' ]';
+}
+multi _tj(Hash $d) {
+ return '{ '
+ ~ (map { _tj(.key) ~ ' : ' ~ _tj(.value) }, $d.pairs).join(', ')
+ ~ ' }';
+}
+
+multi _tj($d where { $d.notdef }) { 'null' }
+multi _tj($s) {
+ die "Can't serialize an object of type " ~ $s.WHAT.perl
+}
+
+sub from-json($text) is export {
+ my $a = JSON::Tiny::Actions.new();
+ my $o = JSON::Tiny::Grammar.parse($text, :actions($a));
+ return $o.ast;
+}
+# vim: ft=perl6
View
55 ext/JSON/Tiny/Actions.pm
@@ -0,0 +1,55 @@
+class JSON::Tiny::Actions;
+
+method TOP($/) {
+ make $/.values.[0].ast;
+};
+method object($/) {
+ # RAKUDO
+ # the .item works around RT #78510
+ make $<pairlist>.ast.hash.item ;
+}
+
+method pairlist($/) {
+ # the .item works around RT #78510
+ make $<pair>>>.ast.flat.item;
+}
+
+method pair($/) {
+ make $<string>.ast => $<value>.ast;
+}
+
+method array($/) {
+ make [$<value>>>.ast];
+}
+
+method string($/) {
+ make join '', $/.caps>>.value>>.ast
+}
+method value:sym<number>($/) { make eval $/.Str }
+method value:sym<string>($/) { make $<string>.ast }
+method value:sym<true>($/) { make Bool::True }
+method value:sym<false>($/) { make Bool::False }
+method value:sym<null>($/) { make Any }
+method value:sym<object>($/) { make $<object>.ast }
+method value:sym<array>($/) { make $<array>.ast }
+
+method str($/) { make ~$/ }
+
+method str_escape($/) {
+ if $<xdigit> {
+ make chr(:16($<xdigit>.join));
+ } else {
+ my %h = '\\' => "\\",
+ '/' => "/",
+ 'b' => "\b",
+ 'n' => "\n",
+ 't' => "\t",
+ 'f' => "\f",
+ 'r' => "\r",
+ '"' => "\"";
+ make %h{~$/};
+ }
+}
+
+
+# vim: ft=perl6
View
43 ext/JSON/Tiny/Grammar.pm
@@ -0,0 +1,43 @@
+use v6;
+grammar JSON::Tiny::Grammar;
+
+rule TOP { ^[ <object> | <array> ]$ }
+rule object { '{' ~ '}' <pairlist> }
+rule pairlist { [ <pair> ** [ \, ] ]? }
+rule pair { <string> ':' <value> }
+rule array { '[' ~ ']' [ <value> ** [ \, ] ]? }
+
+proto token value { <...> };
+token value:sym<number> {
+ '-'?
+ [ 0 | <[1..9]> <[0..9]>* ]
+ [ \. <[0..9]>+ ]?
+ [ <[eE]> [\+|\-]? <[0..9]>+ ]?
+}
+token value:sym<true> { <sym> };
+token value:sym<false> { <sym> };
+token value:sym<null> { <sym> };
+token value:sym<object> { <object> };
+token value:sym<array> { <array> };
+token value:sym<string> { <string> }
+
+token string {
+ \" ~ \" [ <str> | \\ <str_escape> ]*
+}
+
+token str {
+ [
+ <!before \t>
+ <!before \n>
+ <!before \\>
+ <!before \">
+ .
+ ]+
+# <-["\\\t\n]>+
+}
+
+token str_escape {
+ <["\\/bfnrt]> | u <xdigit>**4
+}
+
+# vim: ft=perl6
View
78 ext/Test/Mock.pm
@@ -0,0 +1,78 @@
+use Test;
+
+class Test::Mock::Log {
+ has @!log-entries;
+
+ method log-method-call($name, $capture) {
+ @!log-entries.push({ :$name, :$capture });
+ }
+
+ method called($name, :$times, :$with) {
+ # Extract calls of the matching name.
+ my @calls = @!log-entries.grep({ .<name> eq $name });
+
+ # If we've an argument filter, apply it; we smart-match
+ # everything but captures, which we eqv.
+ my $with-args-note = "";
+ if defined($with) {
+ if $with ~~ Capture {
+ @calls .= grep({ .<capture> eqv $with });
+ }
+ else {
+ @calls .= grep({ .<capture> ~~ $with });
+ }
+ $with-args-note = " with arguments matching $with.perl()";
+ }
+
+ # Enforce times parameter, if given.
+ if defined($times) {
+ my $times-msg =
+ $times == 0 ?? "never called $name" !!
+ $times == 1 ?? "called $name 1 time" !!
+ "called $name $times times";
+ is +@calls, $times, "$times-msg$with-args-note";
+ }
+ else {
+ ok ?@calls, "called $name$with-args-note";
+ }
+ }
+
+ method never-called($name, :$with) {
+ self.called($name, times => 0, :$with);
+ }
+};
+
+module Test::Mock {
+ sub mocked($type, :%returning = {}) is export {
+ # Generate a subclass that logs each method call.
+ my %already-seen = :new;
+ my $mocker = ClassHOW.new;
+ $mocker.^add_parent($type.WHAT);
+ for $type, $type.^parents() -> $p {
+ last if $p === Mu;
+ for $p.^methods(:local) -> $m {
+ unless %already-seen{$m.name} {
+ $mocker.^add_method($m.name, method (|$c) {
+ $!log.log-method-call($m.name, $c);
+ %returning{$m.name} ~~ List ??
+ @(%returning{$m.name}) !!
+ %returning{$m.name}
+ });
+ %already-seen{$m.name} = True;
+ }
+ }
+ }
+
+ # Add log attribute and a method to access it.
+ $mocker.^add_attribute(Attribute.new( name => '$!log', has_accessor => False ));
+ $mocker.^add_method('!mock_log', method { $!log });
+
+ # Return a mock object.
+ my $mocked = $mocker.^compose();
+ return $mocked.new(log => Test::Mock::Log.new());
+ }
+
+ sub check-mock($mock, *@checker) is export {
+ .($mock!mock_log) for @checker;
+ }
+}
Please sign in to comment.
Something went wrong with that request. Please try again.