Author: dylan
Date: 2004-09-11 20:57:29 -0400 (Sat, 11 Sep 2004)
New Revision: 359
Added:
trunk/clients/pirssi/
trunk/clients/pirssi/Build.PL
trunk/clients/pirssi/lib/
trunk/clients/pirssi/lib/Pirssi/
trunk/clients/pirssi/lib/Pirssi/Config/
trunk/clients/pirssi/lib/Pirssi/Config/Parser.yp
trunk/clients/pirssi/mylib/
trunk/clients/pirssi/mylib/Module/
trunk/clients/pirssi/mylib/Module/Build/
trunk/clients/pirssi/mylib/Module/Build/Yapp.pm
Log:
First commit of pirssi, a port of irssi to perl.
'cause segfaults are evil.
Added: trunk/clients/pirssi/Build.PL
===================================================================
--- trunk/clients/pirssi/Build.PL 2004-09-05 06:02:06 UTC (rev 358)
+++ trunk/clients/pirssi/Build.PL 2004-09-12 00:57:29 UTC (rev 359)
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use lib './mylib';
+use Module::Build::Yapp;
+my $build = Module::Build::Yapp->new(
+ module_name => 'Pirssi',
+ dist_version => '0.0.1',
+ dist_author => 'Dylan William Hardison <[EMAIL PROTECTED]>',
+ dist_abstract => 'Perl port of Irssi',
+ license => 'gpl',
+ requires => {
+ 'perl' => '5.8.0',
+ POE => 0.27,
+ },
+ create_makefile_pl => 'passthrough',
+ pants => 'hello',
+ #script_files => [glob('bin/*.pl')],
+ yapp_files => ['lib/Pirssi/Config/Parser.yp'],
+);
+
+$build->create_build_script;
Property changes on: trunk/clients/pirssi/Build.PL
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/clients/pirssi/lib/Pirssi/Config/Parser.yp
===================================================================
--- trunk/clients/pirssi/lib/Pirssi/Config/Parser.yp 2004-09-05 06:02:06 UTC
(rev 358)
+++ trunk/clients/pirssi/lib/Pirssi/Config/Parser.yp 2004-09-12 00:57:29 UTC
(rev 359)
@@ -0,0 +1,162 @@
+#
+# Calc.yp
+#
+# Parse::Yapp input grammar example.
+#
+# This file is PUBLIC DOMAIN
+#
+#
+%right ','
+%%
+input: #empty
+ | input line { push(@{$_[1]},$_[2]); $_[1] }
+;
+
+line: ';' { $_[1] }
+ | toplevel
+ | error ';' { $_[0]->YYErrok }
+;
+
+toplevel: assign_list {
+ my %hash = @{$_[1]};
+ $_[0]->YYData->{return} = \%hash;
+};
+
+array: '(' list ')' { $_[2] }
+ | '(' ')' { [] };
+hash: '{' assign_list '}' { my %hash = @{$_[2]}; \%hash }
+ | '{' '}' { my %hash; \%hash };
+
+assign: key '=' expr { [$_[1], $_[3]] };
+
+assign_list: assign { [ @{$_[1]} ] }
+ | assign ';' { [ @{$_[1]} ] }
+ | assign ';' assign_list { [ @{$_[1]}, @{$_[3]} ] }
+ | assign ';' assign_list ';' { [ @{$_[1]}, @{$_[3]} ] }
+;
+
+list: expr { [ $_[1] ] }
+ | expr ',' list {
+ [ $_[1], @{$_[3]} ];
+ }
+;
+
+key: SYMBOL | NUMBER | STRING;
+expr: STRING | NUMBER | array | hash;
+
+
+%%
+
+sub error {
+ exists $_[0]->YYData->{ERRMSG}
+ and do {
+ print $_[0]->YYData->{ERRMSG};
+ delete $_[0]->YYData->{ERRMSG};
+ return;
+ };
+ print "Syntax error: ", $_[0]->YYCurval, "\n";
+ print "Token: '", $_[0]->YYCurtok, "'\nWant:\t",
+ Dumper([$_[0]->YYExpect]), "\n";
+}
+
+sub lexer {
+ my ($me) = @_;
+ my ($tok, $val) = $me->_lexer;
+ if ($tok and $val) {
+ if ($tok ne $val) {
+ print "# $tok ($val)\n";
+ } else {
+ print "# $tok\n";
+ }
+ }
+ return ($tok, $val);
+}
+
+sub _lexer {
+ my ($parser) = shift;
+ local $/ = undef;
+
+
+ unless ($parser->YYData->{INPUT}) {
+ my $fh = $parser->YYData->{fh};
+ my $s = <$fh> or return ('', undef);
+ $s =~ s/^\s*#\s*.+?$//mg;
+ $parser->YYData->{INPUT} = $s;
+ }
+
+
+ for ($parser->YYData->{INPUT}) {
+ s/^[ \t\n]+//;
+ s/^([0-9]+(?:\.[0-9]+)?)//
+ and return('NUMBER',$1);
+ s/^([A-Za-z][A-Za-z0-9_]*)//
+ and return('SYMBOL',$1);
+
+ if (s/^(["'])((?:\\.|(?!\1)[^\\])*)\1//) {
+ my $s = $2;
+ my $q = $1;
+ $s =~ s/\\$q/$q/g;
+ return (STRING => $s);
+ }
+
+ s/^\s*(.)//s
+ and return($1,$1);
+ }
+}
+
+
+
+sub parse {
+ my ($self, $fh) = @_;
+
+ $self->YYData->{fh} = $fh;
+ $self->YYParse( yylex => \&lexer, yyerror => \&error );
+ $self->YYData->{return};
+}
+
+sub lex {
+ my ($self, $fh) = @_;
+
+ $self->YYData->{fh} = $fh;
+ while (my ($tok, $val) = $self->lexer) {
+ last if (not $tok and not defined $val);
+ print "# $tok";
+ if ($val ne $tok) {
+ print " ($val)";
+ }
+ print "\n";
+ }
+}
+
+__END__
+
+=head1 NAME
+
+Pirssi::Config::Parser - Parse irssi config files and themes.
+
+=head1 SYNOPSIS
+
+ use Pirssi::Config::Parser;
+ my $p = new Pirssi::Config::Parser;
+ my $data = $p->parse(\*STDIN);
+
+=head1 DESCRIPTION
+
+This module is a Parse::Yapp-based LALR parser for the config
+file used by irssi, and by extension, pirssi.
+
+=head1 METHODS
+
+=head2 new(Z<>)
+
+Returns a new Pirssi::Config::Parser object.
+
+=head2 parse($fh)
+
+Takes a file handle $fh and parses it,
+returning a hashref or undef on failure.
+
+=head2 lex($fh)
+
+This is for debugging the lexer, it will cause the file to be lexed
+and the tokens will be output to STDERR.
Added: trunk/clients/pirssi/mylib/Module/Build/Yapp.pm
===================================================================
--- trunk/clients/pirssi/mylib/Module/Build/Yapp.pm 2004-09-05 06:02:06 UTC
(rev 358)
+++ trunk/clients/pirssi/mylib/Module/Build/Yapp.pm 2004-09-12 00:57:29 UTC
(rev 359)
@@ -0,0 +1,76 @@
+# vim: set ft=perl ts=4 sw=4:
+# Module::Build::Yapp - Module::Build subclass for turning .yp files into .pm
modules.
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# This module is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This module is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package Module::Build::Yapp;
+use strict;
+use warnings;
+
+our $VERSION = '0.002';
+use base 'Module::Build';
+use File::Spec;
+
+
+sub ACTION_code {
+ my $me = shift;
+ my $p = $me->{properties};
+
+ if (exists $p->{yapp_files}) {
+ my @files = @{ $p->{yapp_files} };
+ foreach my $file (@files) {
+ $file = _sane_file($file);
+ my $modfile = _yp2pm($file);
+ my $modname = _file2mod($modfile);
+
+ if (not $me->up_to_date($file, $modfile)) {
+ $me->do_system('yapp',
+ '-m' => $modname,
+ '-o' => $modfile, $file);
+ }
+ }
+ }
+
+ $me->SUPER::ACTION_code(@_);
+}
+
+sub _sane_file {
+ my $file = shift;
+
+ $file = File::Spec->canonpath($file);
+ if (File::Spec->file_name_is_absolute($file)) {
+ $file = File::Spec->abs2rel($file);
+ }
+
+ return $file;
+}
+
+sub _yp2pm {
+ my $file = shift;
+ $file =~ s/yp$/pm/;
+ return $file;
+}
+
+sub _file2mod {
+ my $file = shift;
+ $file =~ s/^lib\///;
+ $file =~ s/\//::/g;
+ $file =~ s/\.pm$//;
+ return $file;
+}
+
+
+1;
