examples/perldoc.pl

   1 use v6;
   2
   3 # naive version of perldoc implemented in and for perl6
   4
   5 my $VERSION = '0.01';
   6
   7 if (not defined %*ENV<HOME>) {
   8    die "Cannot work without a HOME directory";
   9 }
  10 #my $dir =  %*ENV<HOME> ~ ($*OS ~~ m:i/win/ ?? "/p6pod" !! "/.p6pod");
  11 my $dir =  %*ENV<HOME> ~ "/.p6pod";
  12
  13 # is there an ARGS parser already Getopt::* ?
  14 @*ARGS or usage();
  15 if (@*ARGS[0] eq "--index") {
  16     index_pods();
  17 } elsif (@*ARGS[0] eq "--keyword" and defined @*ARGS[1]) {
  18     lookup(@*ARGS[1]);
  19 } elsif (@*ARGS[0] eq "--list") {
  20     list_pod_files();
  21 } else {
  22     display_pod(@*ARGS[0]);
  23     #usage();
  24 }
  25
  26 sub list_pod_files {
  27     # for now assume we run in the same directory where pugs is and the docs are in
  28     # ./docs/Perl6
  29     my $ROOT = dirname($PROGRAM_NAME) ~ "/..";
  30     my $dir = $ROOT ~ "/docs/Perl6";
  31     say "processing $dir tree";
  32     my $prefix_length = $dir.chars;
  33     my @podfiles;
  34     for list_files($dir, 1) -> $podfile {
  35         @podfiles.push(substr $podfile, $prefix_length+1, -4);
  36     }
  37     for 0..@podfiles -> $i {
  38         say "$i) @podfiles[$i]";
  39     }
  40     print '$ ';
  41     my $selection = $*IN.get;
  42     say "selected '$selection'";
  43     display_pod("$dir/@podfiles[$selection].pod");
  44 }
  45
  46 sub display_pod {
  47     my ($podfile) = @_;
  48     my $fh = open $podfile orelse die "Could not open '$podfile'\n";
  49     for $fh.lines -> $line {
  50         say $line;
  51     }
  52 }
  53
  54 sub index_pods {
  55     say "Should index the files now";
  56     mkdir $dir unless $dir ~~ :e;
  57     # TODO: go over all the files in the standard directory, whatever the standard will be
  58
  59     #my @files = list_files(dirname($PROGRAM_NAME));
  60     #say @files.perl;
  61     my %data;
  62     for list_files(dirname($PROGRAM_NAME)) -> $podfile {
  63         say "Processing '$podfile'";
  64         my $fh = open $podfile orelse die "Could not open '$podfile'\n";
  65         my $row = 0;
  66         my $section;
  67         for $fh.lines -> $line {
  68             $row++;
  69             if ($line ~~ m:P5/^=head\d\ (.*)/) {
  70                 $section = $0;
  71             }
  72             if ($line ~~ /X\<(.*?)\>/) {
  73                 #say "Found $row $0";
  74                 #my %h = ("file" =>  $podfile,  "row" =>  $row);
  75                 push @(%data{$0}), "$row.$podfile"; # only one dimension work in pugs so we have this workaround
  76             }
  77             # always remember in which entry are we in (row number or =head? name or both)
  78             # if there is one or more X<> tags in a row, remember the values and in the end save to
  79             # an index file
  80         }
  81     }
  82     return %data;
  83 }
  84
  85 # I think File::Find does not work currently...
  86 sub list_files ($dir, $full) {
  87     #say "opening $dir";
  88     my $dh = opendir $dir orelse die "Could not open $dir";
  89     my @entries;
  90     for $dh.readdir -> $entry {
  91         next if $entry eq "." or $entry eq "..";
  92         #say "Entry $entry";
  93         if (substr($entry, -4) eq ".pod") {
  94             @entries.push($full ?? "$dir/$entry" !! $entry);
  95         }
  96         if ("$dir/$entry" ~~ :d) {
  97             @entries.push(list_files("$dir/$entry", $full));
  98         }
  99     }
 100     return @entries;
 101 }
 102
 103 sub lookup($keyword) {
 104     say "Now look up $keyword";
 105     my %data = index_pods();
 106     #say %data.keys;
 107     #say "-----";
 108
 109     if (%data{$keyword}) {
 110         for %data{$keyword}[] -> $entry {
 111             my ($row, $file) = split /\./, $entry, 2;
 112             say "here: $file  $row";
 113             my $fh = open $file orelse die "Could not open $file";
 114             for (0..$row) {
 115                 $fh.get;
 116             }
 117             # TODO: I guess the display should show a few lines before and a few lines after
 118             # max to the next section start, I am not sure.
 119             for (1..10) {
 120                 my $line = $fh.get;
 121                 say $line;
 122             }
 123         }
 124     }
 125 }
 126
 127 # TODO: especailly now that pugs is a bit slow starting up, we might want an interactive
 128 # help system, that onces loads itself will not go down till exiting
 129
 130
 131 # should be improved and moved to File::Basename, or better yet we should have one module with all
 132 # frequently needed filesystem related functions....
 133 sub dirname($path is copy) {
 134     $path ~~ s:P5{/<-[/]>*$} = '';
 135     return $path;
 136 }
 137
 138 sub usage {
 139     say "Usage:";
 140 #    say "    $PROGRAM_NAME --index";
 141 #    say "    $PROGRAM_NAME --keyword KEYWORD";
 142     say "    $PROGRAM_NAME PODFILE     - display the given podfile";
 143     say "    $PROGRAM_NAME --list      - list the available podfiles";
 144     exit;
 145 }
 146
 147
 148