Dita-PCD
view release on metacpan or search on metacpan
lib/Dita/PCD.pm view on Meta::CPAN
ditaPcdBase(q(comment)), # Common row start
comment => q(), # Comment text
);
loadHash($h, %options)
}
sub newDitaPcdDescription(%) #P Create a new description
{my (%options) = @_; # Attributes
my $h =
genHash(q(DitaPcdDescription), # Description
ditaPcdBase(q(description)), # Common row start
description => q(), # Description text
);
loadHash($h, %options)
}
sub newDitaPcdMethod(%) #P Create a new Method
{my (%options) = @_; # Attributes
my $h =
genHash(q(DitaPcdMethod),
ditaPcdBase(q(method)), # Common row start
context => [], # Context for this method call
contextErrors => {}, # Errors in chosen context if entries present
methodError => q(), # Error in chosen method if true
method => q(), # Method name - a unitary method in Data::Edit::Xml
);
loadHash($h, %options)
}
sub newDitaPcdParseTree(%) #P Create a new Parse Tree
{my (%options) = @_; # Attributes
my $h =
genHash(q(DitaPCDParseTree),
inputFile => q(),
errors => [],
rows => [],
);
loadHash($h, %options)
}
sub parsePcdString($) #P Parse the specified L<pcd> directives B<$string> specifying changes to be made to L<dita> files.
{my ($string) = @_; # String of PCD directives
my $ditaTags = &pcdDitaTags; # Dita tag names
my @i = split /\n/, $string;
my @p; # Parse tree
for my $i(keys @i) # Each line==row of a pcd file
{my $l = $i[$i]; # Row to process
my $j = $i + 1; # Current row number
next unless $l =~ m(\S); # Ignore empty rows
if ($l =~ m(\A\s*#\s*(.*?)\s*\Z)) # Comment
{push @p, newDitaPcdComment(comment=>trim($1));
}
elsif ($l =~ m(\A\S)) # Description
{push @p, newDitaPcdDescription(description=>$l);
}
else # Method
{if (my ($method, @context) = split m/\s+/, trim($l)) # Parse command string invoking method
{push @p, newDitaPcdMethod(method=>$method, context=>[@context]);
}
}
}
newDitaPcdParseTree(rows => \@p) # Parse tree
} # parsePcdString
sub parsePcdFile($) #P Parse the specified L<pcd> directives B<$file> specifying changes to be made to L<dita> files.
{my ($if) = @_; # Input file
my $p = parsePcdString(readFile($if)); # Read and parse file
$p->inputFile = $if; # Add input file detail
$p # Return parse tree
} # parsePcdFile
sub editPcdParseTree($) #P Validate a B<$parseTree>
{my ($parseTree) = @_; # Parse tree
my $ditaTags = {map {$_=>1} &pcdDitaTags}; # Dita tag names
my $rowActions = {map {$_=>1} &pcdRowActions}; # Row actions
my $rowTypes = {map {$_=>1} &pcdRowTypes}; # Row types
my @l = @{$parseTree->rows}; # Rows in parse tree
my @errors;
my @delete;
my @repeat;
my @source;
my @target;
for my $l(@l) # Each line==row of a pcd file
{if (my $action = $l->action) # Validate action
{if ($action =~ m(\A(after|before)\Z)i)
{push @target, $l;
}
elsif ($action =~ m(\A(copy|move)\Z)i)
{push @source, $l;
}
elsif ($action =~ m(\Adelete\Z)i)
{push @delete, $l;
}
elsif ($action =~ m(\Arepeat\Z)i)
{push @repeat, $l;
}
elsif (!$$rowActions{$action})
{$l->actionError = "No such action";
# push @errors, $l;
}
}
if (my $rowType = $l->rowType) # Validate row type
{if (!$$rowTypes{$rowType})
{$l->methodError = q(No such row type);
# push @errors, $l;
}
}
if (ref($l) =~ m(method)i and my $method = $l->method) # Validate method
{if (!isSubInPackage(q(Data::Edit::Xml), $method))
{$l->methodError = q(No such method);
# push @errors, $l;
lib/Dita/PCD.pm view on Meta::CPAN
{my @action = $l->{action} ? (action => $l->{action}) : (); # Action specification
my $method = $l->{method}; # Method
if (my $rowType = $l->{rowType1}) # Comment
{if ($rowType =~ m(comment)i)
{push @p, newDitaPcdComment (@action, comment=>$method);
}
elsif ($rowType =~ m(description)i) # Description
{push @p, newDitaPcdDescription(@action, description=>$method);
}
elsif ($rowType =~ m(method)i) # Method
{my $context = join ' ', @{$l->{context}//[]}; # Join context string so it can be resplit
push @p, newDitaPcdMethod
(@action, method=>$method, context=>[split /\s+/, $context]);
}
else # Unknown row type
{confess "Unknown row type $rowType";
}
}
else # Missing row type
{confess "No row type";
}
}
newDitaPcdParseTree(rows=>\@p);
} # parseUrlRepresentationOfPcd
sub representPcdParseTreeAsText($) #P Print a parse tree as text
{my ($parseTree) = @_; # Parse tree
my @l = @{$parseTree->rows}; # Rows of parse tree
my @t;
for my $l(@l) # Each row
{if (my $rowType = ref($l)) # Type of row
{if ($rowType =~ m(comment)i) # Comment
{push @t, q(# ).$l->comment;
}
elsif ($rowType =~ m(description)i) # Description
{push @t, q(), $l->{description};
}
elsif ($rowType =~ m(method)i) # Method
{my $context = join ' ', @{$l->{context}//[]}; # Join context string so it can be resplit allowing the user to use a single field to enter several context entries
push @t, q( ).join ' ', $l->{method}, @{$l->{context}//[]}
}
else # Unknown row type
{confess "Unknown row type $rowType";
}
}
else # Missing row type
{confess "No row type";
}
}
join "\n", @t, '';
} # representPcdParseTreeAsText
sub compilePcdString($;$) #P Compile the specified L<pcd> directives in the supplied B<$string> optionally associated with B<$file>.
{my ($string, $file) = @_; # Input string, optional name of file associated with string
my $if = $file // q(); # Nominal file
my @l = split m/\n/, $string;
my @blocks;
for my $i(keys @l) # Each line==row a pcd file
{my $l = $l[$i];
my $j = $i + 1;
next if $l =~ m(\A\s*#|\A\s*\Z); # Comment
if ($l =~ m(\A\S)s) # Change description
{push @blocks, [[trim($l), $i+1, $if], []];
}
else # Change command block
{if (my ($cmd, @Keys) = split m/\s+/, trim($l)) # Parse command
{my @keys;
for my $key(@Keys) # Transforms keys into Perl strings
{if ($key =~ m(undef)) {push @keys, "undef"} # Undef for anything
elsif ($key =~ m/\Aqr(.*)\Z/s) {push @keys, $key} # Words wrapped with qr(.*) are regular expressions
elsif ($key =~ m(\|)s) {push @keys, "qr(\\A($key)\\Z)"} # Words separated by | are a regular expression indicating choice of tags
else {push @keys, "q($key)"}
}
if (isSubInPackage(q(Data::Edit::Xml), $cmd)) # Validate command
{my $p = join(', ', @keys); # Parameter list
my $e = qq(sub {Data::Edit::Xml::$cmd(\$_, $p)}); # Create matching Perl expression for command
my $r = eval $e; # Evaluate command
die "Error at $if line $j;\n$@\n" if $@; # Report any errors
push @blocks, [] unless @blocks; # Vivify blocks
push @{$blocks[-1][1]}, [$r, $j, $if]; # Save generated code
}
else # Report wrong command
{die "No such command: $cmd at $if line $j\n";
}
}
else # Request command
{die "Please specify a command at $if line $j\n";
}
}
}
\@blocks
} # compilePcdString
sub compilePcdFile($) #E Compile the specified L<pcd> directives B<$file> specifying changes to be made to L<dita> files.
{my ($if) = @_; # Input file
my $l = readFile($if);
compilePcdString($l, $if);
}
sub compilePcdFiles(@) #E Locate and compile the L<dita> files in the specified folder B<@in>.
{my (@in) = @_; # Input folders
my @blocks; # Blocks of changes
my @i = searchDirectoryTreesForMatchingFiles(@in, q(.pcd)); # Pcd source files
for my $f(@i) # Each pcd file
{push @blocks, @{compilePcdFile($f)};
}
\@blocks
}
sub transformDitaWithPcd($$$) #E Transform the contents of file B<$if> represented as a parse tree B<$x> by applying the specified L<pcd> directives in B<$blocks>.
{my ($if, $x, $blocks) = @_; # Input file, parse tree, change blocks
my %stats; # Statistics
for my $block(@$blocks) # Each block of commands
{my ($description, $commands) = @$block;
$x->by(sub # Traverse parse tree applying each block to each node
{my ($node) = @_;
sub # Execute the command block against the current node of the parse tree
{my ($d, $di, $df) = @$description;
%Data::Edit::Xml::savedNodes = @Data::Edit::Xml::saveLastCutOut = (); # Clear state from DEX expeditiously
( run in 0.996 second using v1.01-cache-2.11-cpan-71847e10f99 )