Added Multisub.nqp to generate multisubs/multimethods.
[kakapo:rurbans-kakapo.git] / src / Pmc / File.nqp
1 # Copyright (C) 2009, Austin Hastings. See accompanying LICENSE file, or 
2 # http://www.opensource.org/licenses/artistic-license-2.0.php for license.
3
4 module File;
5 # Wrapper for File PMC type, providing a few extra functions. 
6
7 use('Dumper');
8         
9 sub _get_pmc() {
10         our $_Pmc;
11
12         unless Opcode::defined($_Pmc) {
13                 $_Pmc := Q:PIR {
14                         %r = root_new [ 'parrot' ; 'File' ]
15                 };
16         }
17         
18         return $_Pmc;
19 }
20
21 sub copy($from, $to) {
22         _get_pmc().copy($from, $to);
23 }
24
25 sub exists($path) {
26         return _get_pmc().exists($path);
27 }
28
29 sub find_all($path, @search_list) {
30         NOTE("Finding all paths matching '", $path, "' in ", +@search_list, " directories");
31         my @results := Array::new();
32         
33         if String::char_at($path, 0) eq '/' {
34                 NOTE("Path is rooted - not using search paths");
35                 @search_list := Array::new('');
36         }
37         else {
38                 $path := '/' ~ $path;
39         }
40         
41         for @search_list {
42                 my $name := $_ ~ $path;
43                 NOTE("Trying ", $name);
44                 
45                 if exists($name) {
46                         NOTE("Success! it's a match");
47                         @results.push($name);
48                 }
49         }
50         
51         NOTE("Found ", +@results, " results");
52         DUMP(@results);
53         return @results;
54 }
55                         
56 sub find_first($path, @search_list) {
57         return find_all($path, @search_list)[0];
58 }
59
60 sub is_dir($path) {
61         return _get_pmc().is_dir($path);
62 }
63
64 sub is_file($path) {
65         return _get_pmc().is_file($path);
66 }
67
68 sub is_link($path) {
69         return _get_pmc().is_link($path);
70 }
71
72 sub rename($from, $to) {
73         _get_pmc().rename($from, $to);
74 }
75
76 sub slurp($path) {
77         my $fh := pir::new__PS('FileHandle');
78         my $data := $fh.readall($path);
79 }