File Coverage

blib/lib/Language/Basic.pm
Criterion Covered Total %
statement 180 246 73.1
branch 25 64 39.0
condition 2 3 66.6
subroutine 39 42 92.8
pod n/a
total 246 355 69.3


line stmt bran cond sub pod time code
1             package Language::Basic;
2             # by Amir Karger (See below for copyright/license/etc.)
3              
4             =pod
5              
6             =head1 NAME
7              
8             Language::Basic - Perl Module to interpret BASIC
9              
10             =head1 SYNOPSIS
11              
12             use Language::Basic;
13              
14             my $Program = new Language::Basic::Program;
15             $Program->input("program.bas"); # Read lines from a file
16             $Program->parse; # Parse the Program
17             $Program->implement; # Run the Program
18             $Program->output_perl; # output Program as a Perl program
19              
20             $Program->line("20 PRINT X"); # add one line to existing Program
21              
22             Featured scripts:
23              
24             =over 4
25              
26             =item basic.pl
27              
28             Runs BASIC programs from the command line.
29              
30             =item termbasic.pl
31              
32             Term::Readline program. Input one line of BASIC at a time, then run the
33             program.
34              
35             =item basic2pl.pl
36              
37             Outputs a Perl program that does the same thing as the input BASIC program.
38              
39             =back
40              
41             =head1 DESCRIPTION
42              
43             This module lets you run any BASIC programs you may have lying around, or
44             may inspire you to write new ones!
45              
46             The aspects of the language that are supported are described below. Note
47             that I was pretty much aiming for Applesoft BASIC (tm) ca. 1985, not some
48             modern BASIC with real subroutines.
49              
50             =cut
51              
52 16     16   38403 use strict;
  16         37  
  16         760  
53             require 5.004; # I use 'foreach my'
54 16     16   16779 use IO::File;
  16         640714  
  16         2905  
55 16     16   141 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  16         43  
  16         2493  
56              
57             require Exporter;
58             @ISA = qw(Exporter);
59             @EXPORT = qw(
60             );
61              
62             # Stolen from `man perlmod`
63             $VERSION = do { my @r = (q$Revision: 1.44 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
64              
65             # Sub-packages
66 16     16   13194 use Language::Basic::Common;
  16         40  
  16         14620  
67 16     16   18469 use Language::Basic::Expression;
  16         56  
  16         704  
68 16     16   16286 use Language::Basic::Function;
  16         49  
  16         556  
69 16     16   29327 use Language::Basic::Statement;
  16         92  
  16         1337  
70 16     16   14540 use Language::Basic::Token;
  16         78  
  16         534  
71 16     16   17330 use Language::Basic::Variable;
  16         67  
  16         957  
72              
73             # sub-packages
74             {
75             package Language::Basic::Program;
76             package Language::Basic::Line;
77             }
78              
79             ######################################################################
80              
81             =head2 Class Language::Basic::Program
82              
83             This class handles a whole program. A Program is just a bunch of Lines,
84             each of which has one or more Statements on it. Running the program
85             involves moving through the lines, usually in numerical order, and
86             implementing each line.
87              
88             Methods:
89              
90             =over 4
91              
92             =cut
93              
94             {
95             package Language::Basic::Program;
96 16     16   107 use Language::Basic::Common;
  16         31  
  16         51084  
97              
98             # Fields:
99             # lines Keys are line numbers, values are LB::Line objects
100             # curr_line LB::Line currently being implemented/parsed/whatever
101             # end_program Done implementing the program?
102             # stack The subroutine stack. In BASIC, it's just a list of
103             # statements we GOSUB'ed from.
104             # data The data holder (stuff from DATA statements, read by READ)
105             # parsed Has this Program been parsed since the last time
106             # new lines were added?
107             # needed_subs Functions whose perl-equivalent subs we need to print out
108             # at the end of the program. (Keys are names of subs, values
109             # are sub descriptions.)
110             # column Current column of the screen the program is printing to
111             sub new {
112 21     21   18450 my ($class, $infile) = @_;
113              
114             #Initialize the intrinsic functions
115 21         142 &Language::Basic::Function::Intrinsic::initialize();
116              
117 21         212 my $in = {
118             "lines" => {},
119             "curr_line" => undef,
120             "end_program" => 0,
121             'stack' => [],
122             "for_statements" => {},
123             'data' => [],
124             'parsed' => 0,
125             "needed_subs" => {},
126             "column" => 0,
127             };
128 21         114 bless $in, $class;
129             } # end sub Language::Basic::Program::new
130              
131             =item current_program
132              
133             Returns the program currently being parsed/implemented/whatever
134              
135             =item set_current_program
136              
137             Sets arg0 to be the Current Program
138              
139             =cut
140              
141             my $_Current_Program; # Gasp! It's an Evil Global Variable!
142             sub current_program {
143 245     245   574 return $_Current_Program;
144             }
145             sub set_current_program {
146 190 50   190   614 my $self = shift or die "LBP::set_current_program must have argument!\n";
147 190         517 $_Current_Program = $self;
148             }
149              
150             =item current_line
151              
152             Returns the LB::line currently being parsed/implemented/whatever
153              
154             =item set_current_line
155              
156             Sets the current line in Program arg0 to be line I arg1
157              
158             =item first_line_number
159              
160             Returns (not surprisingly) the first line number in Program arg0
161              
162             =cut
163              
164 679     679   1841 sub current_line { return shift->{"curr_line"}; }
165             sub set_current_line {
166 507     507   812 my $prog = shift;
167 507         682 my $num = shift;
168 507 100 66     2467 if (defined $num && exists $prog->{"lines"}->{$num}) {
169 486         1682 $prog->{"curr_line"} = $prog->{"lines"}->{$num};
170             } else {
171 21         101 $prog->{"curr_line"} = undef;
172             }
173             }
174 42     42   82 sub first_line_number {return (sort {$a <=> $b} keys %{shift->{"lines"}})[0]; }
  656         923  
  42         309  
175              
176             =item current_line_number
177              
178             What line number in Program arg0 are we currently on?
179              
180             =cut
181              
182             sub current_line_number {
183 21     21   40 my $prog = shift;
184 21         63 my $line = $prog->current_line;
185 21 50       136 return (defined $line ? $line->line_number : undef);
186             }
187              
188             =item input
189              
190             This method reads in a program from a file, whose name is the string arg0. It
191             doesn't do any parsing, except for taking the line number out of the line.
192              
193             =cut
194              
195             sub input {
196 1     1   200 my ($self, $filename) = @_;
197 1         5 $self->set_current_program;
198 1         12 my $fh = new IO::File $filename;
199 1 50       116 die "Error opening $filename: $!\n" unless defined $fh;
200 1         3 my $old_num = -1;
201              
202 1         22 while (<$fh>) {
203 2 50       11 next if /^\s*$/; # empty lines
204 2         5 chomp;
205              
206             # Line Number
207 2         14 my $line_num = $self->_add_line($_);
208 2 0       8 defined $line_num
    50          
209             or die "Missing line number " .
210             ($old_num > 0 ? "after line $old_num\n" : "on first line\n");
211              
212             # In input files, we make sure lines are in numerical order.
213             # If they're not, it's most likely a bug.
214             # Same is not true for a Term::Readline interpreter
215 2 50       7 if ($line_num <= $old_num) {
216 0         0 die "Line $line_num: lines in file must be in increasing order.\n";
217             }
218              
219 2         12 $old_num = $line_num;
220             }
221 1         18 close ($fh);
222              
223             # order the lines
224 1         6 $self->_fix_lines;
225 1         6 $self->{'parsed'} = 0;
226              
227             } # end sub Language::Basic::Program::input
228              
229             =item line
230              
231             This method takes a line of BASIC (arg1, already chomped), forms a new LB::Line
232             with it, and adds it to the Program (arg0). It doesn't do any parsing,
233             except for taking the line number out of the line.
234              
235             =cut
236              
237             sub line {
238 147     147   846 my $self = shift;
239 147         480 $self->set_current_program;
240 147         706 my $line = shift; # sans \n
241              
242 147 50       300 defined $self->_add_line($line) or die "Missing line number in line()!\n";
243 147         464 $self->_fix_lines;
244 147         370 $self->{'parsed'} = 0;
245             } # end sub Language::Basic::Program::line
246              
247             sub _add_line {
248             # takes the line (sans \n), returns the line number read or undef if there
249             # is none.
250             # You must call _fix_lines between _add_line and returning to the
251             # user's program!
252              
253 149     149   174 my $self = shift;
254 149         353 my $line = shift;
255              
256             # Line Number
257 149 50       743 $line =~ s/^\s*(\d+)\s+// or return;
258 149         326 my $line_num = $1;
259              
260             # Create an LB::Line with what's left of the line
261 149         413 $self->{'lines'}{$line_num} = new Language::Basic::Line($line, $line_num);
262              
263 149         572 return $line_num;
264             } # end sub Language::Basic::Program::_add_line
265              
266             # fix the ordering of the lines in the program
267             sub _fix_lines {
268 148     148   190 my $self = shift;
269              
270 148         211 my @line_numbers = sort {$a <=> $b} keys %{$self->{"lines"}};
  2330         3208  
  148         691  
271              
272 148         579 for (my $i = 0; $i < @line_numbers - 1; $i++) { # process all but last
273 864         1404 my $line = $self->{'lines'}{ $line_numbers[$i] };
274 864         1606 $line->set_next( $line_numbers[ $i+1 ] );
275             }
276              
277 148         408 $self->{'lines'}{ $line_numbers[-1] }->set_next( undef );
278             } # end sub Language::Basic::Program::_fix_lines
279              
280             =item parse
281              
282             This method parses the program, which just involves looping over the lines
283             in the program and parsing each line.
284              
285             =cut
286              
287             sub parse {
288 21     21   244 my $self = shift;
289 21         82 $self->set_current_program;
290              
291 21 50       85 return if $self->{'parsed'};
292              
293 21         74 $self->set_current_line($self->first_line_number);
294              
295             # Loop through the lines in the program, parse each
296 21         84 while (defined (my $line = $self->current_line)) {
297             #print $line->line_number," ",$line->{"text"},"\n";
298 149         363 $line->parse;
299 149         440 $self->set_current_line($line->get_next);
300             }
301              
302 21         65 $self->{'parsed'} = 1;
303             } # end sub Language::Basic::Program::parse
304              
305             =item implement
306              
307             This method actually runs the program. That is, it starts on the first line,
308             and implements statements one at a time. It performs the statements on a
309             line in order, and goes from line to line in numerical order, unless a GOTO,
310             NEXT, etc. sends it somewhere else. It stops when it hits an END statement or
311             "falls off" the end of the program.
312              
313             =cut
314              
315             sub implement {
316 21     21   3059 my $self = shift;
317 21         81 $self->set_current_program;
318             # In case you're lazy & call implement w/out parsing first
319 21 100       165 $self->parse unless $self->{'parsed'};
320              
321             # Zero stack, etc., start at beginning of program
322 21         102 $self->start;
323             # Mini-kludge to get the program running
324 21         99 $self->goto_line($self->current_line_number);
325              
326             # Loop over statements while there are statements
327 21         90 while (defined(my $curr_statement = $self->increment)) {
328              
329             # TODO create a "trace" command that prints out line numbers
330             # for debugging
331             #my $line = $self->current_line;
332             #print $line->line_number," ",$line->{"text"},"\n";
333              
334             # Do the statement!
335             # Hooray for OO; just call "implement" on everything!
336             #print "Statement class ",ref($curr_statement),"\n";
337             # Note that this may well change where the next &increment will go
338 305         2424 $curr_statement->implement;
339             }
340              
341             #Done!
342             # TODO Exit more gracefully?
343             } # end sub Language::Basic::Program::implement
344              
345             # Return the next Statement we're supposed to execute, based on the Program's
346             # next_statement field. And set the default action for the subsequent call
347             # to increment, which is to do the next Statement in order. (Or return
348             # undef if the program is done.)
349             #
350             # In the simplest case, next_statement will just be the Statement after the
351             # current one on the current Line, although it my well be in a totally
352             # different place due to GOTOs, RETURNs, ELSEs or other interesting programming
353             # tools.
354             #
355             # If next_statement is undefined, we're done with this line (and haven't been
356             # directed to go somewhere more interesting), so go to the next line in order.
357             #
358             # TODO should this method be podded?
359             sub increment {
360 387     387   489 my $self = shift;
361              
362 387         390 my $next;
363 387 100       928 unless (defined($next = $self->{"next_statement"})) {
364             # Program is at the end of a line
365 233         502 my $line = $self->current_line;
366 233         448 my $number = $line->get_next;
367              
368             # goto_line will set Program's next_statement
369             # ($number = undef will set "end_program")
370 233         485 $self->goto_line($number);
371 233         400 $next = $self->{"next_statement"};
372             }
373             # Did we hit an END or "fall off" the last line of the program?
374 387 100       997 return undef if $self->{"end_program"};
375              
376             # By default, we're going to go on to the next statement after this one
377 366         576 $self->{"next_statement"} = $next->{"next_statement"};
378              
379             # Whether or not we were at end of line, we now know what next
380             # Statement is, so return it.
381 366         1806 return $next;
382              
383             }
384              
385             =item start
386              
387             This method erases program stack and moves line pointer to beginning of program
388              
389             It should be called any time we start going through the program.
390             (Either implement or output_perl.)
391              
392             =cut
393              
394             # Don't erase "data". It's set during parsing.
395             sub start {
396 21     21   42 my $self = shift;
397 21         61 $self->{"stack"} = [];
398 21         66 $self->{"for_statements"} = {};
399 21         55 $self->{"column"} = 0;
400              
401             # Start on the first line of the program
402 21         81 $self->set_current_line($self->first_line_number);
403             } # end sub Language::Basic::Program::start
404              
405             =item goto_line
406              
407             Continue Program execution at the first Statement on line number arg1.
408              
409             =cut
410              
411             sub goto_line {
412 277     277   336 my $self = shift;
413 277         321 my $next_line = shift;
414              
415 277 100       513 if (defined $next_line) {
416 255         630 $self->set_current_line($next_line);
417 255 50       1110 my $line = $self->current_line or
418             Exit_Error("Can't find line $next_line!");
419 255         604 $self->{"next_statement"} = $line->{"first_statement"};
420             } else {
421 22         70 $self->{"end_program"} = 1;
422             }
423              
424             } # end sub Language::Basic::Program::set_next_line
425              
426             =item goto_after_statement
427              
428             Kind of like goto_line, except go to the Statement I Statement arg1.
429             (Or the first statement on the line just after Statement arg1, if it's the last
430             Statement on its line.) E.g., when you RETURN from a GOSUB, you want to return
431             to the GOSUB line but start execution after the GOSUB. Same with FOR.
432              
433             =cut
434              
435             sub goto_after_statement {
436 61     61   80 my $self = shift;
437 61         81 my $st = shift;
438 61         107 $self->{"next_statement"} = $st;
439             # May have jumped to (the beginning or middle of) a new line,
440             # so we have to reset this. (It stays the same if we're jumping w/in
441             # one line, but that's OK.)
442 61         129 $self->set_current_line($st->{"line_number"});
443              
444             # Goto the statement, and set Program's next_statement field, so
445             # that when Program::implement calls increment, it goes to the
446             # statement *after* this one.
447 61         114 $self->increment;
448              
449             } # end sub Language::Basic::Program::goto_after_statement
450              
451             =pod
452              
453             =back
454              
455             The following methods are called from LB::Statement parse or implement
456             methods to implement various BASIC commands.
457              
458             =over 4
459              
460             =item push_stack
461              
462             (GOSUB) Call a subroutine, i.e. push the current Statement::Gosub onto the
463             Program's calling stack
464              
465             =item pop_stack
466              
467             (RETURN) Return from a subroutine, i.e., pop the top Statement::Gosub off of
468             the Program's calling stack
469              
470             =cut
471              
472             sub push_stack {
473 13     13   23 my $self = shift;
474 13         21 my $st = shift;
475 13         16 push @{ $self->{'stack'} }, $st;
  13         48  
476             }
477              
478             sub pop_stack {
479 13     13   18 my $self = shift;
480 13         16 return pop @{ $self->{'stack'} };
  13         76  
481             }
482              
483             =item store_for
484              
485             (FOR) Store a Statement::For arg1, so that when we get to the corresponding
486             Statement::Next, we know where to go back to
487              
488             =item pop_stack
489              
490             (NEXT) Get the Statement::For corresponding to Statement::Next arg1
491              
492             =cut
493              
494             sub store_for {
495 12     12   18 my $self = shift;
496 12         16 my $for_statement = shift;
497 12         23 my $lvalue = $for_statement->{"lvalue"};
498 12         26 my $name = $lvalue->{"name"};
499 12         81 $self->{"for_statements"}->{$name} = $for_statement;
500             } # end sub Language::Basic::Program::store_for
501              
502             sub get_for {
503 60     60   85 my $self = shift;
504 60         67 my $next_statement = shift;
505 60         87 my $lvalue = $next_statement->{"lvalue"};
506 60         108 my $name = $lvalue->{"name"};
507 60 50       145 if (exists $self->{"for_statements"}->{$name}) {
508 60         210 return $self->{"for_statements"}->{$name};
509             } else {
510 0         0 Exit_Error("NEXT $name without FOR!");
511             }
512             } # end sub Language::Basic::Program::get_for
513              
514             =item add_data
515              
516             (DATA) Add a piece of data to the Program's data storage, to be accessed
517             later.
518              
519             =cut
520              
521             sub add_data {
522 23     23   28 my $self = shift;
523 23         25 my $thing = shift;
524 23         23 push @{ $self->{'data'} }, $thing;
  23         119  
525             }
526              
527             =item get_data
528              
529             (READ) Get a piece of data that was stored earlier.
530              
531             =cut
532              
533             sub get_data {
534 23     23   30 my $self = shift;
535 23 50       37 @{ $self->{'data'} } or Exit_Error("More items READ than input in DATA!");
  23         77  
536 23         27 my $thing = shift @{ $self->{'data'} };
  23         41  
537 23         64 return $thing;
538             }
539              
540             =pod
541              
542             =back
543              
544             Finally, there are methods for translating a Program to Perl.
545              
546             =over 4
547              
548             =item output_perl
549              
550             This method translates a program to Perl and outputs it. It does so by
551             looping through the Lines of the program in order, and calling output_perl on
552             each one. It also prints some pre- and post- data, such as any subroutines it
553             needs to declare (e.g., subs that imitate BASIC functionality, as well as subs
554             that correspond to BASIC DEF statements).
555              
556             It attempts to print everything out nicely, with added whitespace et al. to
557             make the code somewhat readable. (Note that all of the subpackages'
558             output_perl methods I strings rather than printing them, so we can
559             handle all of the printing, indenting, etc. here.)
560              
561             =cut
562              
563             sub output_perl {
564 0     0   0 my $self = shift;
565 0         0 $self->set_current_program;
566             # In case you're lazy & call implement w/out parsing first
567 0 0       0 $self->parse unless $self->{'parsed'};
568              
569 0         0 my $sep = '#' x 78;
570             # TODO these variables should be changeable by switches to basic2pl!
571 0         0 my $spaces_per_indent = 4;
572             # Indenting for outputted Perl
573 0         0 my $Output_Indent = 2; # eight spaces by default
574              
575             # Beginning of the program
576             # TODO should basic2pl do these two lines?
577 0         0 print '#!/usr/bin/perl -w';
578 0         0 print "\n#Translated from BASIC by basic2pl\n\n";
579              
580 0 0       0 if (@{$self->{"data"}}) {
  0         0  
581 0         0 print "$sep\n# Setup\n#\n";
582 0         0 print "# Read data\n";
583 0         0 print "while () {chomp; push \@Data, \$_}\n\n";
584             }
585              
586             # Zero program stack, etc., start at beginning of program
587 0         0 $self->start;
588              
589             # Loop through the lines in the program
590 0         0 print "$sep\n# Main program\n#\n";
591 0         0 while (defined (my $line = $self->current_line)) {
592 0         0 my $line_num = $line->line_number;
593             #warn "Line $line_num\n";
594 0         0 my $label = "L$line_num:";
595              
596             # What's the line?
597 0         0 my $out = $label . $line->output_perl;
598            
599             # Print labels all the way against the left edge of the line,
600             # then indent the rest of the line.
601             # Split with -1 so final \n's don't get ignored
602 0         0 foreach (split (/\n/, $out, -1)) {
603             # Change indenting for next time?
604 0 0       0 $Output_Indent += 1, next if $_ eq "INDENT";
605 0 0       0 $Output_Indent -= 1, next if $_ eq "UNINDENT";
606 0 0       0 warn "weird indenting $Output_Indent\n" if $Output_Indent < 2;
607              
608             # If we didn't hit an indent-changing command, print the
609             # label (if any) and the actual string
610             # TODO only print out the labels we have to!
611 0 0       0 $label = (s/^A?L\d+:// ? $& : "");
612             # minus for left justify
613 0         0 my $indent = -$Output_Indent * $spaces_per_indent;
614 0         0 printf("%*s", $indent, $label);
615              
616             # print the actual string
617 0         0 print $_;
618 0         0 print "\n"; # the \n we lost from split, or the last \n
619             }
620              
621             # Go through lines in order
622 0         0 $self->set_current_line($line->get_next);
623             }
624              
625             # TODO why not indent these nicely?
626 0         0 my $n = $self->{"needed_subs"};
627 0 0       0 print "\n$sep\n# Subroutine Definitions\n#\n" if %$n;
628             # Print out required subroutines
629 0         0 foreach (sort keys %$n) {
630 0         0 my $out = join(" ", "sub", $_, $n->{$_}, "# end sub $_\n\n");
631 0         0 $Output_Indent = 0;
632              
633 0         0 foreach (split (/\n/, $out, -1)) {
634             # Change indenting for next time?
635 0 0       0 $Output_Indent += 1, next if $_ eq "INDENT";
636 0 0       0 $Output_Indent -= 1, next if $_ eq "UNINDENT";
637 0 0       0 warn "weird indenting $Output_Indent\n" if $Output_Indent < 0;
638              
639             # If we didn't hit an indent-changing command, print the string
640 0         0 my $indent = $Output_Indent * $spaces_per_indent;
641 0         0 print " " x $indent;
642              
643             # print the actual string
644 0         0 print $_;
645 0         0 print "\n"; # the \n we lost from split, or the last \n
646             }
647             }
648              
649             # If there were any DATA statements...
650 0 0       0 if (@{$self->{"data"}}) {
  0         0  
651 0         0 print "\n\n$sep\n# Data\n#\n__DATA__\n";
652 0         0 print join("\n", map {$_->output_perl} @{$self->{"data"}});
  0         0  
  0         0  
653 0         0 print "\n";
654             }
655             } # end sub Language::Basic::Program::output_perl
656              
657             =item need_sub
658              
659             Tells the Program that it needs to use the sub named arg0 (whose definition
660             is in arg1). This is used for outputting a Perl translation of a BASIC
661             program, so that you only write "sub mid_str {...}" if MID$ is used in
662             the BASIC program.
663              
664             =back
665              
666             =cut
667              
668             sub need_sub {
669 0     0   0 my $self = shift;
670 0         0 my $n = $self->{"needed_subs"};
671 0         0 my ($func_name, $func_desc) = @_;
672 0 0       0 return if exists $n->{$func_name};
673 0         0 $n->{$func_name} = $func_desc;
674             } # end sub Language::Basic::Program::need_sub
675              
676             } # end package Language::Basic::Program
677              
678             ######################################################################
679              
680             =head2 Class Language::Basic::Line
681              
682             This class handles one line of a BASIC program, which has one or more
683             Statements on it.
684              
685             This class has no implement method. The reason is that sometimes, you'll
686             jump to the middle of a line. (E.g., returning from the GOSUBs in
687             10 FOR A=1 TO 10: GOSUB 1000: NEXT A)
688              
689             Methods:
690              
691             =over 4
692              
693             =cut
694              
695             {
696             package Language::Basic::Line;
697 16     16   162 use Language::Basic::Common;
  16         33  
  16         9851  
698              
699             # Make a new LB::Line with the text given (don't parse it yet)
700             sub new {
701 149     149   190 my $class = shift;
702 149         202 my $text = shift;
703 149         203 my $line_number = shift;
704 149         585 my $in = {
705             # literal text of the line (not including line number)
706             "text" => $text,
707             # Pointer to first LB::Statement on the line
708             "first_statement" => 0,
709             # number of next line (accessed with set/get_next)
710             'next_line' => undef,
711             # BASIC line number of this Line
712             "line_number" => $line_number,
713             };
714 149         928 bless $in, $class;
715             } # end sub Language::Basic::Line::new
716              
717             =item get_next
718              
719             Returns the Line's line number
720              
721             =cut
722              
723 21     21   123 sub line_number { shift->{"line_number"} }
724              
725             =item get_next
726              
727             Returns the next line number in the Program
728              
729             =item set_next
730              
731             Sets the next line number in the Program to be arg1.
732              
733             =cut
734              
735 382     382   1489 sub get_next { return shift->{'next_line'}; }
736              
737             # TODO Should this be _set_next and undocumented? Only gets called by _fix_lines
738             sub set_next {
739 1012     1012   1059 my $self = shift;
740 1012         1025 my $next = shift;
741              
742 1012         3322 $self->{'next_line'} = $next;
743             } # end sub Language::Basic::Line::set_next
744              
745             =item parse
746              
747             This method breaks the line up into Statements (and removes whitespace, except
748             in strings), then parses the Statements in order.
749              
750             =cut
751              
752             sub parse {
753 149     149   190 my $self = shift;
754              
755             # Break the line up into Tokens for later eating/parsing
756 149         613 my $token_group = new Language::Basic::Token::Group;
757 149         555 $token_group->lex($self->{"text"});
758 149         246 my $oldst;
759              
760             # Parse Statement(s) in the Line
761 149         210 do {
762             # Create the new Statement and figure out what kind of statement it
763             # is. $statement will be an object of a subclass LB::Statement::*)
764 157         758 my $statement = new Language::Basic::Statement $token_group;
765              
766             # Actually parse the Statement
767 157         807 $statement->parse($token_group);
768              
769             # Each statement needs to know which line it's on, in case we
770             # RETURN or NEXT into the middle of a line.
771 157         960 $statement->set_line_number($self->{"line_number"});
772              
773             # Create a linked list of the Statements in the line
774 157 100       588 if (defined $oldst) {
775 8         15 $oldst->{"next_statement"} = $statement
776             } else {
777 149         266 $self->{"first_statement"} = $statement;
778             }
779 157         567 $oldst = $statement;
780              
781             # If there's a colon, eat it and parse the next Statement on the Line
782             } while ($token_group->eat_if_class("Statement_End"));
783              
784             # TODO make this error prettier
785 149 50       433 if ($token_group->stuff_left) {
786 0           my $p = "Extra tokens left after parsing!\n" . $token_group->print;
787 0           chomp($p);
788 0           Exit_Error($p);
789             }
790             }
791              
792             =item output_perl
793              
794             This method simply calls output_perl on each of the Line's Statements in
795             order.
796              
797             =back
798              
799             =cut
800              
801             sub output_perl {
802 0     0     my $self = shift;
803 0           my $statement = $self->{"first_statement"};
804 0           my $out = $statement->output_perl;
805             # Do each statement in the line in order
806             # Put each statement on a separate line.
807 0           while (defined ($statement = $statement->{"next_statement"})) {
808 0           $out .= "\n";
809 0           $out .= $statement->output_perl;
810             }
811              
812             # Output the statement
813 0           return $out;
814             } # end sub Language::Basic::Line::output_perl
815              
816             } # end package Language::Basic::Line
817              
818              
819             # end package Language::Basic
820             1;
821              
822             __END__