%{
##########################################################################
#
# This is the Parse::Yapp grammar file. To reproduce a modul out of it
# you should have CPAN module Parse::Yapp installed on your
# system and run
#
#yapp -s -m'VCS::Rcs::YappRcsParser' -o'lib/Rcs/YappRcsParser.pm' YappRcsParser.yp
#
# But you won't need Parse::Yapp unless you want to reproduce the module.
#
#
# Here is Parse::Yapp's COPYRIGHT
#
# The Parse::Yapp module and its related modules and shell
# scripts are copyright (c) 1998-2001 Francois Desarmenien,
# France. All rights reserved.
#
# You may use and distribute them under the terms of either
# the GNU General Public License or the Artistic License, as
# specified in the Perl README file.
#
# If you use the "standalone parser" option so people don't
# need to install Parse::Yapp on their systems in order to
# run you software, this copyright noticed should be
# included in your software copyright too, and the copyright
# notice in the embedded driver should be left untouched.
#
# End of Parse::Yapp's COPYRIGHT
#
#
# Copyright (c) 2001 by RIPE-NCC. All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# You should have received a copy of the Perl license along with
# Perl; see the file README in Perl distribution.
#
# You should have received a copy of the GNU General Public License
# along with Perl; see the file Copying. If not, write to
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
# You should have received a copy of the Artistic License
# along with Perl; see the file Artistic.
#
# NO WARRANTY
#
# BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
# FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
# OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
# PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
# OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
# TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
# PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
# REPAIR OR CORRECTION.
#
# IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
# WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
# REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
# INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
# TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
# YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
# PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGES.
#
# END OF TERMS AND CONDITIONS
#
#
#
##########################################################################
require 5.8.0;
use VCS::Rcs::Deltatext;
use Data::Dumper;
our ($VERSION) = (q$Revision: 1.11 $ =~ /([\d\.]+)/);
my $dt;
my $input;
my $state;
my $ft;
# my $init_rev_no;
my $revs_to_co;
my $dates_to_co;
our $debug = 0;
%}
%start rcstext
%%
rcstext:
admin {warn "admin OK\n" if $debug}
delta {warn "delta OK\n" if $debug}
desc {warn "desc OK\n" if $debug}
deltatext
{warn "Parsed OK!\n" if $debug;}
;
admin: head {warn "head OK\n" if $debug}
branch {warn "branc OK\n" if $debug}
access {warn "acces OK\n" if $debug}
symbols {warn "symbl OK\n" if $debug}
locks strict {warn "lock OK\n" if $debug}
comment {warn "commt OK\n" if $debug}
expand {warn "expan OK\n" if $debug}
newphrase
;
head: HEAD ';' | HEAD num ';' #{$ta->{LastRev} = $_[2][0];}
;
branch: /* empty */
{warn "branch OK(EMPTY)\n" if $debug}
| BRANCH {$state='nums'} nums ';'
{warn "branch OK",$_[1]," ",$_[3][0],"\n" if $debug}
;
access: ACCESS ';'
{warn "access OK",$_[1],"\n" if $debug}
| ACCESS {$state='ids'} ids ';'
{warn "access OK",$_[1]," ",$_[3][0],"\n" if $debug}
;
symbols: SYMBOLS {$state='symnums'} symnums ';'
;
locks: LOCKS {$state='idnums'} idnums ';'
;
strict: /* empty */ | STRICT ';'
;
comment: /* empty */
| COMMENT ';'
| COMMENT string ';'
#{$ta->{Comment} = $_[2][0];}
;
expand: /* empty */
| EXPAND ';'
| EXPAND string ';'
;
delta: /* empty */
| delta
num
DATE num ';'
AUTHOR id ';'
STATE {$state='ido'} ido ';'
BRANCHES {$state='nums'} nums ';'
NEXT {$state='nums'} nums ';'
newphrase
{&as_other( $_[2][0], $_[4][0]);}
;
desc: DESC string
{&revs_to_co();}
;
deltatext: /* empty */
| deltatext
num
LOG string
newphrase
TEXT {$state='longstring';} string
{
print STDERR $_[2][0]," \r" if($debug);
&co_rev( $_[8][0], $_[2][0] );
}
;
newphrase: /* empty */ | newphrase id word ';'
;
word: /* empty */ | id | num | string | ':'
;
%%
sub revs_to_co {
my $revs = $revs_to_co;
unless ($dates_to_co) {
$dt->revs2co($revs);
return;
}
my $rev;
my $rdate;
my %date;
for $rev ($dt->revs) {
$rdate = $dt->date($rev);
$rdate = '19'.$rdate if (length($rdate) == 17);
$date{$rdate} = $rev;
}
my @alldates = sort keys %date;
my @dates2add = @$dates_to_co;
my $bi=0;
my($a,$b,@dates2add_proper);
for $b (@dates2add) {
for $a (@alldates) {
$dates2add_proper[$bi]=$a if ($a lt $b);
}
$bi++;
}
for (@dates2add_proper) {
push @$revs, $date{$_} if (defined $date{$_});
}
if($debug){
print STDERR "$_\n" for(@$revs);
print STDERR "$_\n" for(@dates2add_proper);
print STDERR "$_\n" for(@dates2add);
}
$dt->revs2co($revs);
}
sub as_other {
my $rev = shift;
my $date = shift;
# $init_rev_no = $rev;
$dt->date($rev, $date);
}
sub co_rev {
my $ptext = shift;
my $rev = shift;
if ($ft) {
$ft = 0;
$dt->lastrev($ptext, $rev);
return;
}
$dt->deltarev($ptext, $rev);
}
sub _Error {
exists $_[0]->YYData->{ERRMSG}
and do {
print $_[0]->YYData->{ERRMSG};
delete $_[0]->YYData->{ERRMSG};
return;
};
warn "\nSyntax error.\n";
}
sub _Lexer {
my($parser)=shift;
#
# EOF
#
pos($$input) >= length($$input) and return('',[ undef, -1 ]);
#
# longstring
#
$state eq 'longstring' and do {
$state = 'norm';
return('',[ undef, -1 ]) if ($$input !~ m/\G[\s\n]*@/sgc);
my $text_tmp='';
my $text;
while ($$input =~ m/\G((?:[^@\n]|@@)*\n?)/gcs) {
$text_tmp = $1;
$text_tmp =~ s/@@/@/g;
$text .= $text_tmp;
}
return('',[ undef, -1 ]) if ($$input !~ m/\G[\s\n]*@/sgc);
return('string',[\$text]);
};
#
# Ignore blanks
#
$$input=~m/\G\s+/scg;
#
# norm
#
$state eq 'norm' and do {
# SIMPLE TOKENS
$$input =~ m/\Ghead/gc and return('HEAD', 'head');
$$input =~ m/\Gbranches/gc and return('BRANCHES','branches');
$$input =~ m/\Gbranch/gc and return('BRANCH', 'access');
$$input =~ m/\Gaccess/gc and return('ACCESS', 'access');
$$input =~ m/\Gsymbols/gc and return('SYMBOLS', 'symbols');
$$input =~ m/\Glocks/gc and return('LOCKS', 'locks');
$$input =~ m/\Gstrict/gc and return('STRICT', 'strict');
$$input =~ m/\Gcomment/gc and return('COMMENT', 'comment');
$$input =~ m/\Gdate/gc and return('DATE', 'date');
$$input =~ m/\Gauthor/gc and return('AUTHOR', 'author');
$$input =~ m/\Gstate/gc and return('STATE', 'state');
$$input =~ m/\Gnext/gc and return('NEXT', 'next');
$$input =~ m/\Glog/gc and return('LOG', 'log');
$$input =~ m/\Gtext/gc and return('TEXT', 'text');
$$input =~ m/\Gdesc/gc and return('DESC', 'desc');
$$input =~ m/\G;/gc and return(';', ';');
$$input =~ m/\G:/gc and return(':', ';');
# num
$$input =~ m/\G([\d\.]+)/gc and return('num', [$1]);
# id
$$input =~ m/\G
((?:[\d\.]+)?) # {num}
([^\$,\.:;@\x00-\x1F]) # idchar
([^\$,\.:;@\x00-\x1F]|(?:[\d\.]+))* # {idchar | num}*
/xgc
and return('id', [$1,$2,$3] );
# simple string
$$input =~ m/\G
@
((?:[^@]|@@)*)
@
/xgcs
and return('string', [$1] );
};
#
# ids
#
$state eq 'ids' and do {
$state = 'norm';
$$input =~ m{\G
(?:
(\d?)
([^\$,\.:;@\x00-\x1F])
([^\$,\.:;@\x00-\x1F]*)
)*
}xgc
and return('ids', [$1,$2,$3]);
};
#
# symnums
#
$state eq 'symnums' and do {
$state = 'norm';
$$input =~ m{\G
(?:
(\d*) # {digit}*
([^\$,\.:;@\x00-\x1F]) # idchar
([^\$,\.:;@\x00-\x1F]*) # {idchar | digit}*
: # :
([\d\.]+)[\s\n\r]* # num
)*
}xgcs
and return('symnums', [$1,$2,$3,$4]);
};
#
# idnums
#
$state eq 'idnums' and do {
$state = 'norm';
$$input =~ m{\G
(?:
((?:[\d\.]+)?) # {num}
([^\$,\.:;@\x00-\x1F]) # idchar
([^\$,\.:;@\x00-\x1F]|(?:[\d\.]+))* # {idchar | num}*
: # :
([\d\.]+) # num
)*
}xgc
and return('idnums', [$1,$2,$3,$4]);
};
#
# ido
#
$state eq 'ido' and do {
$state = 'norm';
$$input =~ m{\G
(?:
((?:[\d\.]+)?) # {num}
([^\$,\.:;@\x00-\x1F]) # idchar
([^\$,\.:;@\x00-\x1F]|(?:[\d\.]+))* # {idchar | num}*
)?
}xgc
and return('ido', [$1,$2,$3]);
};
#
# nums
#
$state eq 'nums' and do {
$state = 'norm';
$$input =~ m/\G([\d\.]*)/gc and return('nums', [$1]);
};
#
# NO EXPECTED TOKEN! ERROR
#
return('',[ undef, -1 ]);
}
sub Run {
my $self = shift;
$input = shift;
$revs_to_co = shift;
$dates_to_co = shift;
$dt = undef;
$dt = new VCS::Rcs::Deltatext();
$state = 'norm';
$ft = 1;
# $init_rev_no = undef;
$self->YYParse( yylex => \&_Lexer, yyerror => \&_Error, yydebug => 0x00 );
$dt
}