# Copyright (c) 1997-2006
# Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
# http://www.math.tu-berlin.de/polymake, mailto:polymake@math.tu-berlin.de
#
# This program 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, or (at your option) any
# later version: http://www.gnu.org/licenses/gpl.txt.
#
# This program 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.
#----------------------------------------------------------------------------
# $Project: polymake $$Id: Preference.pm 7188 2006-03-10 11:51:32Z gawrilow $
use strict;
use namespaces;
use integer;
####################################################################################
package Poly::Preference::Label;
use Struct (
[ new => '$;$$$$$' ],
[ '$name' => '#1' ],
[ '$parent' => '#3' ], # Label higher in the hierarchy
[ '$wildcard_name' => '#4 || "*"' ],
'%children', # Labels lower in the hierarchy
'%controls', # control list -> number of items in this list
[ '$clock' => '#5' ], # sequential number of the last 'prefer' command
[ '$rank' => '#6' ], # rank in this command
[ '$id' => '#2' ], # from perModule object which has defined this label
);
# Structure of a control list:
# for i=0..#{involved Labels}-1
# [i*2] -> stored item
# [i*2+1] -> Label
# [-1] -> order count: number of leading items which are known to be ordered due to
# the active preferences. The trailing items are in arbitrary order.
# Thus, a control list without any active preferences applied has
# the order count == 0.
####################################################################################
sub child {
my ($self, $name, $id)=@_;
$self->children->{$name} ||=
new Label( $name, $id, weak($self), $self->wildcard_name.".$name", $self->clock, $self->rank );
}
####################################################################################
sub add_control {
my ($self, $list, $item)=@_;
++$self->controls->{$list};
if (@$list) {
my $pos=-1;
if (defined($self->clock)) {
if ($list->[-1]==0 or
(my $clock_diff=$list->[1]->clock - $self->clock) < 0) {
$pos=0;
$list->[-1]=2;
} elsif ($clock_diff==0) {
for ($pos=0;
$pos<$list->[-1] && $list->[$pos+1]->rank <= $self->rank;
$pos+=2) { }
$list->[-1]+=2;
}
}
splice @$list, $pos, 0, $item, $self;
} else {
@$list=($item, $self, defined($self->clock)*2);
}
}
####################################################################################
sub register_copy {
my ($new, $old)=@_;
for (my $i=1; $i<$#$old; $i+=2) {
++($old->[$i]->controls->{$new});
}
}
####################################################################################
sub dup_control {
my ($list)=@_;
my @new_list=@$list;
register_copy(\@new_list, $list);
\@new_list;
}
####################################################################################
sub copy_control {
my ($new, $old)=@_;
@$new=@$old;
register_copy($new, $old);
$new;
}
####################################################################################
sub merge_controls {
my ($dst, $src)=@_;
register_copy($dst, $src);
if (!$src->[-1] ||
$dst->[-1] && $dst->[1]->clock > $src->[1]->clock) {
# src unordered - attach to the tail
splice @$dst, -1, 0, @$src[0..$#$src-1];
} elsif (!$dst->[-1] ||
$src->[-1] && $dst->[1]->clock < $src->[1]->clock) {
# dst unordered - push the new items to the front
splice @$dst, 0, 0, @$src[0..$#$src-1];
$dst->[-1]=$src->[-1];
} else {
# both ordered: merge carefully
my $dord=$dst->[-1];
my ($s, $d);
for (($s,$d)=(1,1); $s<$src->[-1] && $d<$dord; $d+=2) {
if ($dst->[$d]->rank > $src->[$s]->rank) {
splice @$dst, $d-1, 0, @$src[$s-1,$s];
$s+=2;
$dord+=2;
}
}
$dst->[-1]+=$src->[-1];
# insert the unordered rest
splice @$dst, $dord, 0, @$src[$s-1..$#$src-1];
}
}
####################################################################################
sub forget_control {
my $list=shift;
for (my $i=1; $i<$#$list; $i+=2) {
delete $list->[$i]->controls->{$list};
}
}
####################################################################################
sub describe_control_item {
my $item=shift;
if (is_code($item)) {
$item=$item->() if sub_file($item) =~ m|Poly/Overload\.pm$|;
(is_method($item) ? "method " : "sub ").method_owner($item)."::".method_name($item)."(".prototype($item).")"
} else {
"rule of ".method_owner($item->code)->prototype->name." ".$item->header." from ".sub_file($item->code)." line ".sub_firstline($item->code);
}
}
####################################################################################
# return all items from a control list, removing duplicates
sub get_items {
my $list=shift;
my (%seen, @items);
for (my $i=0; $i<$#$list; $i+=2) {
push @items, $list->[$i] unless $seen{$list->[$i]}++;
}
@items;
}
####################################################################################
# return the items from a control list, sorted by rank
# each bag starts with the rank value
# the last bag always contains unordered items (and rank is undef)
sub get_items_by_rank {
my $list=shift;
my (%seen, @bags);
my $i;
for ($i=0; $i<$list->[-1]; $i+=2) {
my $cur_rank=$list->[$i+1]->rank;
if (!@bags) {
push @bags, [ $cur_rank ];
} elsif (@{$bags[-1]}==0) {
$bags[-1]->[0]=$cur_rank;
} elsif ($bags[-1]->[0]<$cur_rank) {
push @bags, [ $cur_rank ];
}
push @{$bags[-1]}, $list->[$i] unless $seen{$list->[$i]}++;
}
if ($i<$#$list) {
if (!@bags || @{$bags[-1]}>1) {
push @bags, [ undef ];
} else {
undef $bags[-1]->[0];
}
for (; $i<$#$list; $i+=2) {
push @{$bags[-1]}, $list->[$i] unless $seen{$list->[$i]}++;
}
}
@bags;
}
####################################################################################
# clock, rank =>
sub set_preferred {
my $self=shift;
my @out_of_effect;
if (defined $self->clock) {
if ($self->clock==$_[0]) {
die $self->full_name, " occurs in the preference list at positions ", $self->rank, " and $_[1]\n";
}
push @out_of_effect, $self->clock;
}
($self->clock, $self->rank)=@_;
CONTROLS:
while (my ($list, $cnt)=each %{$self->controls}) {
if ($list->[-1]) {
my $clock_cmp=$list->[1]->clock <=> $self->clock;
if ($clock_cmp<0) {
# obsolete
push @out_of_effect, $list->[1]->clock;
$list->[-1]=0;
} elsif ($clock_cmp>0) {
push @out_of_effect, $self->clock;
next CONTROLS;
} elsif ($list->[1]==$self) {
# kept his position
$list->[-1]=2*$cnt;
next CONTROLS;
}
}
my $new_pos=$list->[-1]+1;
$list->[-1]+=2*$cnt;
for (my $pos=$new_pos; $pos < $#$list; $pos+=2) {
if ($list->[$pos] == $self) {
if ($pos != $new_pos) {
splice @$list, $new_pos-1, 0, splice @$list, $pos-1, 2;
}
next CONTROLS unless --$cnt;
$new_pos+=2;
}
}
confess( "corrupted control list for label ", $self->full_name );
}
(@out_of_effect, map { $_->set_preferred(@_) } values %{$self->children});
}
####################################################################################
sub neutralize_controls {
my ($self, $deep)=@_;
my %warned;
foreach my $list (keys %{$self->controls}) {
if ($list->[-1]>0 && $list->[1]==$self) {
if (!$warned{$list->[0]}++) {
warn_print( describe_control_item($list->[0]), " is still the default choice" );
}
$list->[-1]=0;
}
}
if ($deep) {
foreach my $c (values %{$self->children}) {
neutralize_controls($c, $deep);
}
}
}
####################################################################################
sub set_temp_preferred {
my ($self, $scope)=@_;
while (my ($list, $cnt)=each %{$self->controls}) {
next if $#$list == $cnt*2; # no competitors
my @temp_list=@$list;
$temp_list[-1]=0;
for (my $i=1; $i<$#temp_list; $i+=2) {
if ($list->[$i] == $self) {
if ($i-1 != $temp_list[-1]) {
# put the controlled item in the first position
splice @temp_list, $temp_list[-1], 0, splice @temp_list, $i-1, 2;
}
$temp_list[-1]+=2;
last unless --$cnt;
}
}
if ($Switches::v>=2) {
dbg_print( $self->full_name, " temporarily preferred over ",
join(", ", map { $temp_list[$_*2+1]->full_name } $self->controls->{$list}..($#temp_list/2-1)) );
}
confess( "corrupted control list for label ", $self->full_name ) if $cnt;
$scope->begin_locals;
local_array($list, \@temp_list);
local_scalar($self->rank, 0);
$scope->end_locals;
}
foreach my $c (values %{$self->children}) {
$c->set_temp_preferred($scope);
}
}
####################################################################################
sub full_name {
my $self=shift;
my $n=$self->name;
while (defined($self=$self->parent)) {
$n=$self->name.".$n";
}
$n
}
sub parent_name {
my $self=shift;
$self=$self->parent while defined($self->parent);
$self->name
}
####################################################################################
#
# Subtraction of preference lists
# => 1 - nothing more in effect
# => 0 - partially (not all controls or not all children)
# => 2 - fully
sub status {
my ($self)=@_;
my $status=3;
foreach my $list (keys %{$self->controls}) {
$status &= ($list->[-1]>0 && $list->[1]->clock==$self->clock) ? 2 : 1
or return 0;
}
foreach my $c (values %{$self->children}) {
$status &= status($c)
or last;
}
$status
}
####################################################################################
sub add_to_pref_tree {
my ($self, $list)=@_;
if (is_ARRAY($list)) {
push @$list, $self;
} else {
while (my ($name, $c)=each %{$self->children}) {
if (!exists $list->{$name} || is_ARRAY($list->{$name})) {
push @{$list->{$name}}, $c;
} elsif ($list->{$name}) {
add_to_pref_tree($c, $list->{$name});
}
}
}
}
####################################################################################
sub subtract {
my ($self, $clock, $new_wildcard, $wildcard_cmp, $tree)=@_;
if ($self->clock != $clock) {
# already involved in the new pref list - nothing to do
return;
}
if (defined (my $subtree=$tree->{$self->name})) {
if ($subtree) {
# positive result already known
add_to_pref_tree($self, $subtree);
} else {
# negative result already known
neutralize_controls($self, 1);
}
return;
}
if ($wildcard_cmp<=0 and
($wildcard_cmp=prefix_cmp($self->wildcard_name, $new_wildcard)) == 2) {
# no intersection with new pref list - remains in effect
$tree->{$self->name}=[ $self ];
return;
}
my $status=status($self);
if ($status & 1) {
# completely out of control
$tree->{$self->name}=0;
neutralize_controls($self, 1);
} elsif ($status) {
if ($wildcard_cmp>0) {
# this branch has survived
$tree->{$self->name}=[ $self ];
}
} else {
# injured - handle children individually
my $subtree=$tree->{$self->name}={ };
neutralize_controls($self);
subtract($_, $clock, $new_wildcard, $wildcard_cmp, $subtree) for values %{$self->children};
}
}
####################################################################################
package Poly::Preference::List;
use Struct (
[ new => '$$' ],
[ '$clock' => '#1' ],
[ '$mask' => '0' ],
[ '@labels' => '#2' ],
);
sub new {
my $self=&_new;
$self->mask |= $_->id for @{$self->labels};
$self;
}
sub activate {
my $self=shift;
my $rank=0;
map { $_->set_preferred($self->clock, $rank++) } @{$self->labels};
}
####################################################################################
sub compare {
my ($p1, $p2)=@_;
my $l=$#{$p1->labels};
return 2 if $l != $#{$p2->labels};
my $result=0;
for (my $i=0; $i<=$l; ++$i) {
if ($p1->labels->[$i] != $p2->labels->[$i]) {
my $cmp=prefix_cmp($p1->labels->[$i]->full_name, $p2->labels->[$i]->full_name);
return 2 if $cmp==2 or $result && $result != $cmp;
$result=$cmp;
}
}
$result;
}
####################################################################################
sub subtract {
my ($self, $new_wildcard)=@_;
my (@result, %tree);
$_->subtract($self->clock, $new_wildcard, -1, \%tree) for @{$self->labels};
my @sublists=values %tree;
for (my $i=0; $i<=$#sublists; ++$i) {
my $list=$sublists[$i];
if (is_ARRAY($list)) {
push @result, new List($self->clock, $list);
} elsif ($list) {
push @sublists, values %$list;
}
}
@result;
}
####################################################################################
sub toString {
my $self=shift;
if (@{$self->labels}==1) {
'"'.$self->labels->[0]->full_name.'"'
} else {
'"' . $self->labels->[0]->wildcard_name . " " . join(", ", map { $_->parent_name } @{$self->labels}) . '"'
}
}
####################################################################################
package Poly::Preference::perModule;
my $id_cnt=0;
my $clock=100000;
my $compile_clock=0;
use Struct (
'$id',
'$mask',
'$handler',
'%labels',
'@super',
'@default_prefs',
);
sub new {
my $self=&_new;
$self->id=$self->mask=1 << $id_cnt++;
$self;
}
####################################################################################
sub add_label {
my ($self, $name)=@_;
( $self->labels->{$name} &&=
croak( "multiple definition of label $name" ) ) ||=
new Label($name, $self->id);
}
####################################################################################
sub find_label {
my ($self, $name, $create)=@_;
my @name=split /\./, $name;
$name=shift @name;
my $label=$self->labels->{$name};
if (!$label) {
foreach my $super (@{$self->super}) {
$label=$super->labels->{$name} and last;
}
return undef unless $label;
}
foreach $name (@name) {
$label= $create ? $label->child($name, $self->id) : $label->children->{$name}
or return undef;
}
$label;
}
####################################################################################
# $compile_mode & 1 => allow to create new sublevels
# $compile_mode & 2 => 'prefer' command comes from the rules
# $compile_mode & 4 => 'prefer' command comes from the preference file
sub add_preference {
my ($self, $expr, $compile_mode)=@_;
my (@err, @l);
# parse the labels
if ($expr =~ /^ $hier_id_re $/xo) {
if (defined (my $label=$self->find_label($expr, $compile_mode & 1))) {
@l=($label);
} else {
push @err, $expr;
}
} elsif (my ($sublevel, $list)= $expr =~ /^ \*\.($hier_id_re) \s+ ($hier_ids_re) $/xo) {
@l=map { $self->find_label("$_.$sublevel", $compile_mode & 1) or
push @err, "$_.$sublevel"
} split /\s*,\s*/, $list;
} else {
croak( "syntax error in preference list" );
}
if (@err) {
if ($compile_mode & 4 and $main::Arch) {
warn_print( "stored preference statements for label", @err>1 && "s", " @err\n",
"are not in effect - probably excluded by auto-configuration" ) if $Switches::v;
} else {
croak( "unknown label", @err>1 && "s", " @err" );
}
}
my $pref=new List($compile_mode & 2 ? ++$compile_clock : ++$clock, \@l);
if ($compile_mode & 2) {
push @{$self->default_prefs}, $pref;
return;
}
if ($compile_mode & 4) {
push @{$self->handler->active_prefs}, $pref;
$pref->activate;
} else {
if (!$compile_mode) {
foreach my $p2 (@{$self->handler->active_prefs}) {
my $cmp=$p2->compare($pref);
if ($cmp <= 0) {
warn_print( "preference list ", $pref->toString, " ignored since another list ", $p2->toString, " is already in effect" );
return;
} elsif ($cmp==1) {
# has absorbed some existing preference list - can't have duplicates
last;
}
}
}
$self->handler->activate(0,$pref);
}
}
####################################################################################
sub set_temp_preference {
my ($self, $scope, $expr)=@_;
if ($expr =~ /^ $hier_ids_re $/xo) {
if (defined (my $label=$self->find_label($expr, 0))) {
$label->set_temp_preferred($scope);
} else {
croak( "unknown label $expr" );
}
} else {
croak( "syntax error in label name" );
}
}
####################################################################################
sub matching_default_prefs {
my ($self, $expr)=@_;
my @matched;
if ($expr =~ /^ $hier_id_re $/xo) {
if (defined (my $label=$self->find_label($expr, 0))) {
foreach my $pm (@{$self->super}, $self) {
if ($label->id & $pm->mask) {
foreach my $pref (@{$pm->default_prefs}) {
if ($pref->labels->[0] == $label) {
return $pref;
} elsif ((my $cmp=prefix_cmp($expr, $pref->labels->[0]->full_name))==-1) {
push @matched, $pref;
} elsif ($cmp==1) {
return new List(++$clock, [ $label ]);
}
}
}
}
} else {
croak( "unknown label $expr" );
}
} elsif ($expr =~ /^ \*\.$hier_id_re $/xo) {
foreach my $pm (@{$self->super}, $self) {
foreach my $pref (@{$pm->default_prefs}) {
my $cmp=prefix_cmp($expr, $pref->labels->[0]->wildcard_name);
if ($cmp==0) {
return $pref;
} elsif ($cmp==-1) {
push @matched, $pref;
} elsif ($cmp==1) {
my @sublevel=split /\./, substr($expr, length($pref->labels->[0]->wildcard_name)+1);
my @sublabels=map {
my $l=$_;
foreach my $s (@sublevel) {
$l=$l->children->{$s} or last;
}
defined($l) ? $l : ();
} @{$pref->labels};
if (@sublabels) {
return new List(++$clock, \@sublabels);
}
}
}
}
} else {
croak( "syntax error in label name" );
}
@matched;
}
sub reset {
if (my @prefs=&matching_default_prefs) {
$_[0]->handler->activate(1,@prefs);
} else {
croak( "no default preferences matching $_[1]" );
}
}
####################################################################################
sub end_compile_mode {
my ($self, $module)=@_;
my $key=do { ref($module) =~ /([^:]+)$/; lc($1) } . " " . $module->name;
if (my $ph=$module->can("prefs_handler")) {
$ph=$ph->();
if (!$self->handler) {
$self->handler=weak($ph);
push @{$ph->modules}, $module;
}
my $text=delete $ph->orphans->{$key};
my @stored_prefs;
push @stored_prefs, $2 while ($text =~ s/^[ \t]* prefer \s+ (['"])?(.*?)(?(1)\1) [ \t]* ;? (?= \s*$ )//xm);
if ($ph->version_bumped) {
$ph->activate(0,@{$self->default_prefs});
foreach my $pref (@stored_prefs) {
add_preference($self, $pref, 1);
}
} elsif (@stored_prefs) {
foreach my $pref (@stored_prefs) {
add_preference($self, $pref, 5);
}
} elsif (!defined($text)) {
# prefer.pl was probably deleted
foreach my $pref (@{$self->default_prefs}) {
push @{$ph->active_prefs}, $pref;
$pref->activate;
$ph->need_save=1;
}
}
if ($text =~ $significant_line_re) {
local $Poly::User::application=$module;
Poly::Shell::eval_expr($text);
if ($@) {
die $@;
} else {
$ph->user_commands->{$key}=$text;
}
}
}
$self;
}
####################################################################################
sub inherit {
my $self=shift;
my %seen;
foreach my $s (@_) {
++$seen{$s};
++$seen{$_} for (@{$s->super});
$self->mask |= $s->mask;
}
push @{$self->super}, grep { --$seen{$_}==0 } @_, map { @{$_->super} } @_;
}
####################################################################################
package Poly::Preference;
use Struct (
[ new => '$' ],
[ '$file' => '#1' ], # where to save preference lists
'@modules', # Module or Application
'%orphans', # package => file fragment
'%user_commands', # package => perl text
'$version_bumped', # boolean
'$need_save', # boolean
'@active_prefs',
);
my $sep_line="\n#########################################\n";
my $preface=<<'.';
#########################################################################
#
# This file contains preference settings that were in effect
# as you closed your last polymake session.
#
# Initially it contains copies of "prefer" commands scattered over the
# rule files. They are commented out, since they come into action
# as soon as the rule files are loaded.
#
# Later on, each interactive "prefer" command you type in the polymake
# shell is also recorded here, in the chronological order.
# Prior commands having lost any effect are wiped out from the file
# automatically.
#
# You can also edit this file manually, including or deleting "prefer"
# commands, or even other commands recognized by the interactive shell.
# But never edit it while polymake processes are running, otherwise
# you risk to do it in vain, all your changes may be overwritten.
#
# To revert to the default preferences later, comment out or delete
# your changes, or execute the interactive command 'reset_preference'.
#
# Please be aware that this file is interpreted by polymake after all
# rule files, unlike "customize.pl".
#
# **********************************************************************
# If you have written your own rule files and want them be included
# each time you start polymake, put commands like this:
# include 'my.rules';
# or
# include qw( my.rules other.rules );
# in the appropriate section of this file - after the declaration of
# the application these rules belong to.
#
# Specify the rule files either as absolute paths or relatively to one
# of the directories stored in the variable @lookup_rules below.
#########################################################################
.
if (defined $main::Version) {
$preface .= <<".";
#
# The rule files are rescanned for new preference lists as soon as you
# run a polymake version newer than recorded here, or use an application
# for the first time.
# If you have inserted new "prefer" commands in the rules and want them
# to appear here right now, comment out the following line and rerun polymake.
\$version=v$main::Version;
.
}
sub import {
if (@_!=2) {
Carp::croak( "usage: use Preference \"filename\"" );
}
my $pkg=caller;
if (exists &{get_pkg($pkg)->{prefs_handler}}) {
Carp::croak( "attempt to install multiple preference handlers in package \"$pkg\"" );
}
my $handler=&_new;
define_function($pkg, "prefs_handler", sub { $handler });
eval "package $pkg; END { \$handler->save if \$handler->need_save }";
if (-f $handler->file) {
$handler->read_file;
} else {
$handler->need_save=1;
}
}
#################################################################################
sub read_file {
my ($self, $filename)=@_;
$filename ||= $self->file;
open my $pf, $filename
or die "can't read preferences file \"$filename\": $!\n";
local $_;
my ($key, $body, $version)=("BEGIN", <<".");
package Poly::User;
#line 1 \"$filename\"
.
while (<$pf>) {
if (/^\s* (application|module) \s+ ($id_re); \s*$/xo) {
$self->orphans->{$key}=$body;
$key="$1 $2";
my $l=$.+1;
$body="#line $l \"$filename\"\n";
next;
}
$body.=$_;
}
$self->orphans->{$key}=$body;
eval $self->orphans->{BEGIN};
if ($@) {
err_print( beautify_error() );
return;
}
$self->need_save=$self->version_bumped=
defined $main::Version && (!defined($version) || $version lt $main::VersionNumber);
}
####################################################################################
sub activate {
my ($self, $incr_clock)=splice @_, 0, 2;
foreach my $pref (@_) {
push @{$self->active_prefs}, $pref;
$pref->clock=++$clock if $incr_clock;
if (my %old_clocks=map { $_=>1 } $pref->activate) {
my $new_wildcard=$pref->labels->[0]->wildcard_name;
for (my $i=$#{$self->active_prefs}; $i>=0; --$i) {
my $old_pref=$self->active_prefs->[$i];
if ($old_clocks{$old_pref->clock}) {
splice @{$self->active_prefs}, $i, 1, $old_pref->subtract($new_wildcard);
}
}
}
}
$self->need_save=1;
}
####################################################################################
sub reset_all {
my ($self)=@_;
foreach my $module (@{$self->modules}) {
activate($self, 1, @{$module->prefs->default_prefs});
}
}
#################################################################################
sub clean_borders {
local $_=shift;
if (defined($_)) {
s/\A (?: $empty_or_separator_line )+ //xom;
s/(?: $empty_or_separator_line )+ \Z//xom;
}
$_;
}
sub save {
my ($self)=@_;
my $tempfile=new OverwriteFile($self->file);
open my $pf, ">", $tempfile
or die "can't create temporary file \"$tempfile\" for user preferences: $!\n";
(my $text=$self->orphans->{BEGIN}) =~ s/\A(?s:.*?) ^[ \t\#]*\$version\b .*\n//xom;
print $pf $preface, $sep_line, clean_borders($text), $sep_line;
my @active_prefs=@{$self->active_prefs};
foreach my $module (@{$self->modules}) {
ref($module) =~ /([^:]+)$/;
my $key=lc($1)." ".$module->name;
print $pf "$key;\n";
my $pm=$module->prefs;
for (my $i=0; $i<=$#active_prefs; ) {
my $pref=$active_prefs[$i];
if ($pref->mask & $pm->id and ($pref->mask & $pm->mask)==$pref->mask) {
print $pf "\nprefer ", $pref->toString, ";\n";
splice @active_prefs, $i, 1;
} else {
++$i;
}
}
if (defined ($text=clean_borders($self->user_commands->{$key}))) {
print $pf "\n", $text;
}
print $pf $sep_line;
}
while ((my $key, $text)=each %{$self->orphans}) {
next if $key eq "BEGIN";
$text =~ s/^\#line.*\n//mg;
print $pf "$key;\n$text";
}
close $pf;
$self->need_save=0;
}
1
# Local Variables:
# c-basic-offset:3
# End:
syntax highlighted by Code2HTML, v. 0.9.1