PLP.pm

   1 package PLP;
   2
   3 # Not to be used without the CGI script;
   4
   5 our $VERSION = '3.00';
   6
   7 use PLP::Functions ();
   8 use PLP::Fields;
   9 use PLP::Tie::Headers;
  10 use PLP::Tie::Delay;
  11 use PLP::Tie::Print;
  12
  13 sub SendHeaders () {
  14     our $sentheaders = 1;
  15     print STDOUT "Content-Type: text/plain\n\n" if $DEBUG & 2;
  16     print STDOUT map("$_: $PLP::Script::header{$_}\n", keys %PLP::Script::header), "\n";
  17 };
  18
  19 sub source {
  20     my ($path, $level) = @_;
  21     our ($inA, $inB);
  22     (my $file = $path) =~ s[.*/][];
  23     my $source = $level
  24         ? qq/\cQ;\n#line 1 "$file"\nprint q\cQ/
  25         : qq/\n#line 1 "$file"\nprint q\cQ/;
  26     my $linenr = 0;
  27     local *SOURCE;
  28     open SOURCE, $path or return $level
  29         ? qq{\cQ; die qq[Can't open "\Q$path\E" (\Q$!\E)]; print q\cQ}
  30         : qq{\ndie qq[Can't open "\Q$path\e" (\Q$!\E)];};
  31     LINE: while (defined (my $line = <SOURCE>)) {
  32         $linenr++;
  33         for (;;) {
  34             $line =~ /
  35                 \G                  # Begin where left off
  36                 ( \z                # End
  37                 | <:=? | :>         # PLP tags     <:=? ... :>
  38                 | <\(.*?\)>         # Include tags <(...)>
  39                 | <[^:(][^<:]*      # Normal text
  40                 | :[^>][^<:]*       # Normal text
  41                 | [^<:]*            # Normal text
  42                 )
  43             /gxs;
  44             next LINE unless length $1;
  45             my $part = $1;
  46             if ($part eq '<:=' and not $inA || $inB) {
  47                 $inA = 1;
  48                 $source .= "\cQ, ";
  49             } elsif ($part eq '<:' and not $inA || $inB) {
  50                 $inB = 1;
  51                 $source .= "\cQ; ";
  52             } elsif ($part eq ':>' and $inA) {
  53                 $inA = 0;
  54                 $source .= ", q\cQ";
  55             } elsif ($part eq ':>' and $inB) {
  56                 $inB = 0;
  57                 $source .= "; print q\cQ";
  58             } elsif ($part =~ /^<\((.*?)\)>\z/ and not $inA || $inB) {
  59                 $source .= source($1, $level + 1) .
  60                            qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
  61             } else {
  62                 $part =~ s/\\/\\\\/ if not $inA || $inB;
  63                 $source .= $part;
  64             }
  65         }
  66     }
  67     $source .= "\cQ" unless $level;
  68     return $source;
  69 }
  70
  71 1;
  72