gavin/devops
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

first commit

Browse Source
This commit is contained in:
douboer
2025-09-17 16:08:16 +08:00
parent 9395faa6b2
commit 3ff47c11d5
1318 changed files with 117477 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
perl/Examples/Chap2/AST-to-string Normal file
View File

@@ -0,0 +1,19 @@
###
### AST_to_string
###
## Chapter 2 section 2
sub AST_to_string {
my ($tree) = @_;
if (ref $tree) {
my ($op, $a1, $a2) = @$tree;
my ($s1, $s2) = (AST_to_string($a1),
AST_to_string($a2));
"($s1 $op $s2)";
} else {
$tree;
}
}

26
perl/Examples/Chap2/def-cdir-tablearg Normal file
View File

@@ -0,0 +1,26 @@
###
### define_config_directive_tablearg
###
## Chapter 2 section 1.2
sub define_config_directive {
my ($rest, $dispatch_table) = @_;
$rest =~ s/^\s+//;
my ($new_directive, $def_txt) = split /\s+/, $rest, 2;
if (exists $dispatch_table->{$new_directive}) {
warn "$new_directive already defined; skipping.\n";
return;
}
my $def = eval "sub { $def_txt }";
if (not defined $def) {
warn "Could not compile definition for `$new_directive': $@; skipping.\n";
return;
}
$dispatch_table->{$new_directive} = $def;
}

26
perl/Examples/Chap2/def-conf-dir Normal file
View File

@@ -0,0 +1,26 @@
###
### define_config_directive
###
## Chapter 2 section 1.2
sub define_config_directive {
my $rest = shift;
$rest =~ s/^\s+//;
my ($new_directive, $def_txt) = split /\s+/, $rest, 2;
if (exists $CONFIG_DIRECTIVE_TABLE{$new_directive}) {
warn "$new_directive already defined; skipping.\n";
return;
}
my $def = eval "sub { $def_txt }";
if (not defined $def) {
warn "Could not compile definition for `$new_directive': $@; skipping.\n";
return;
}
$CONFIG_DIRECTIVE_TABLE{$new_directive} = $def;
}

23
perl/Examples/Chap2/rdconfig-default Normal file
View File

@@ -0,0 +1,23 @@
###
### read_config_default
###
## Chapter 2 section 1.4
sub read_config {
my ($filename, $actions, $userparam) = @_;
open my($CF), $filename or return; # Failure
while (<$CF>) {
chomp;
my ($directive, $rest) = split /\s+/, $_, 2;
my $action = $actions->{$directive} || $actions->{_DEFAULT_};
if ($action) {
$action->($directive, $rest, $actions, $userparam);
} else {
die "Unrecognized directive $directive on line $. of $filename; aborting";
}
}
return 1; # Success
}

22
perl/Examples/Chap2/rdconfig-tablearg Normal file
View File

@@ -0,0 +1,22 @@
###
### read_config_tablearg
###
## Chapter 2 section 1.2
sub read_config {
my ($filename, $actions) = @_;
open my($CF), $filename or return; # Failure
while (<$CF>) {
chomp;
my ($directive, $rest) = split /\s+/, $_, 2;
if (exists $actions->{$directive}) {
$actions->{$directive}->($rest, $actions);
} else {
die "Unrecognized directive $directive on line $. of $filename; aborting";
}
}
return 1; # Success
}

22
perl/Examples/Chap2/rdconfig-tabular Normal file
View File

@@ -0,0 +1,22 @@
###
### read_config_tabular
###
## Chapter 2 section 1.1
sub read_config {
my ($filename, $actions) = @_;
open my($CF), $filename or return; # Failure
while (<$CF>) {
chomp;
my ($directive, $rest) = split /\s+/, $_, 2;
if (exists $actions->{$directive}) {
$actions->{$directive}->($rest);
} else {
die "Unrecognized directive $directive on line $. of $filename; aborting";
}
}
return 1; # Success
}

21
perl/Examples/Chap2/rdconfig-tagarg Normal file
View File

@@ -0,0 +1,21 @@
###
### read_config_tagarg
###
## Chapter 2 section 1.3
sub read_config {
my ($filename, $actions, $userparam) = @_;
open my($CF), $filename or return; # Failure
while (<$CF>) {
my ($directive, $rest) = split /\s+/, $_, 2;
if (exists $actions->{$directive}) {
$actions->{$directive}->($directive, $rest, $actions, $userparam);
} else {
die "Unrecognized directive $directive on line $. of $filename; aborting";
}
}
return 1; # Success
}

21
perl/Examples/Chap2/rdconfig-uparam Normal file
View File

@@ -0,0 +1,21 @@
###
### read_config_userparam
###
## Chapter 2 section 1.3
sub read_config {
my ($filename, $actions, $user_param) = @_;
open my($CF), $filename or return; # Failure
while (<$CF>) {
my ($directive, $rest) = split /\s+/, $_, 2;
if (exists $actions->{$directive}) {
$actions->{$directive}->($rest, $userparam, $actions);
} else {
die "Unrecognized directive $directive on line $. of $filename; aborting";
}
}
return 1; # Success
}

34
perl/Examples/Chap2/rpn-ifelse Normal file
View File

@@ -0,0 +1,34 @@
###
### rpn_ifelse
###
## Chapter 2 section 2
my $result = evaluate($ARGV[0]);
print "Result: $result\n";
sub evaluate {
my @stack;
my ($expr) = @_;
my @tokens = split /\s+/, $expr;
for my $token (@tokens) {
if ($token =~ /^\d+$/) { # It's a number
push @stack, $token;
} elsif ($token eq '+') {
push @stack, pop(@stack) + pop(@stack);
} elsif ($token eq '-') {
my $s = pop(@stack);
push @stack, pop(@stack) - $s
} elsif ($token eq '*') {
push @stack, pop(@stack) * pop(@stack);
} elsif ($token eq '/') {
my $s = pop(@stack);
push @stack, pop(@stack) / $s
} else {
die "Unrecognized token `$token'; aborting";
}
}
return pop(@stack);
}

37
perl/Examples/Chap2/rpn-table Normal file
View File

@@ -0,0 +1,37 @@
###
### rpn_table
###
## Chapter 2 section 2
my @stack;
my $actions = {
'+' => sub { push @stack, pop(@stack) + pop(@stack) },
'*' => sub { push @stack, pop(@stack) * pop(@stack) },
'-' => sub { my $s = pop(@stack); push @stack, pop(@stack) - $s },
'/' => sub { my $s = pop(@stack); push @stack, pop(@stack) / $s },
'NUMBER' => sub { push @stack, $_[0] },
'_DEFAULT_' => sub { die "Unrecognized token `$_[0]'; aborting" }
};
my $result = evaluate($ARGV[0], $actions);
print "Result: $result\n";
sub evaluate {
my ($expr, $actions) = @_;
my @tokens = split /\s+/, $expr;
for my $token (@tokens) {
my $type;
if ($token =~ /^\d+$/) { # It's a number
$type = 'NUMBER';
}
my $action = $actions->{$type}
|| $actions->{$token}
|| $actions->{_DEFAULT_};
$action->($token, $type, $actions);
}
return pop(@stack);
}

22
perl/Examples/Chap2/walk-html-disp Normal file
View File

@@ -0,0 +1,22 @@
###
### walk_html_dispatch
###
## Chapter 2 section 2.1
sub walk_html {
my ($html, $textfunc, $elementfunc_table) = @_;
return $textfunc->($html) unless ref $html; # It's a plain string
my ($item, @results);
for $item (@{$html->{_content}}) {
push @results, walk_html($item, $textfunc, $elementfunc_table);
}
my $tag = $html->{_tag};
my $elementfunc = $elementfunc_table->{$tag}
|| $elementfunc_table->{_DEFAULT_}
|| die "No function defined for tag `$tag'";
return $elementfunc->($html, @results);
}

18
perl/Examples/Chap2/walk-html-uparam Normal file
View File

@@ -0,0 +1,18 @@
###
### walk_html_userparam
###
## Chapter 2 section 2.1
sub walk_html {
my ($html, $textfunc, $elementfunc, $userparam) = @_;
return $textfunc->($html, $userparam) unless ref $html;
my ($item, @results);
for $item (@{$html->{_content}}) {
push @results, walk_html($item, $textfunc, $elementfunc, $userparam);
}
return $elementfunc->($html, $userparam, @results);
}