ReaScriptLib.pm
From CockosWiki
ReaScriptLib.pm
This would be nice but, unfortunately, won't work until ReaScript is implemented in the standard way. Left here in hope :)
# # ReaScriptLib.pm # # # Rev When Who What # --- ---------- ------------- ------------------------------------------------- # 001 24/11/2009 Mike Lacey Original version, # define and export extract_section() # package ReaScriptLib; use strict; use warnings; # Module initialisation code. On compile. BEGIN { use Exporter (); our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 0.01; @ISA = qw(Exporter); @EXPORT = qw(&extract_section); %EXPORT_TAGS = (); @EXPORT_OK = qw(); # exported globals and optionally exported functions } our @EXPORT_OK; # prototypes sub extract_section($$$); # extract_section($chunk, $name, $index) # params # chunk, chunk as returned from an RPR_GetSet*State function # name, section name <SEC_NAME or P_NAME, multi or single line # index the occurance of "name" to be extracted. So to pick up, say # the first ITEM in a track # -- name would be set to '<ITEM' # -- index would be set to 0, or to 1 for the second and so on. # # returns ( # before_section, the part of chunk before "section" # section, the section itself # after_section the part of chunk after "section" # ) # sub extract_section($$$){ my($chunk, $name, $index) = @_; my @chunk; # to hold $chunk split into lines my $cline; # individual lines from @chunk my $indent; # to keep track in a multiline section my ($before, $section, $after); # return values my $inner_state = 0; # 0=before section, 1=in section, 2=after my $multiline = 0; # boolean, single line sections have no < my $occurrence = 0; $multiline = 1 if $name =~ /^</; # a multiline section? $before = $section = $after = ''; # just in case @chunk = split(/\n/,$chunk); # populate @chunk foreach $cline (@chunk){ # and loop through it if($inner_state == 0){ # "before" section if($cline =~ /^\s+$name/){ # correct section name - correct occurrence? if($occurrence == $index){ # Yes $indent++; # keep track of indents $inner_state = 1; # might be multiline... $section .= "$cline\n"; # build up return variable $inner_state = 2 # done unless unless $multiline; # it's a multiline section } else { # No, wrong occurrence $occurrence++; # keep looking # (unless already past it) last if $occurrence > $index; } } else { # still before the section we're looking for $before .= "$cline\n"; # so build up return variable } } elsif($inner_state == 1){ # in a multiline section $section .= "$cline\n"; # so build up return variable $indent++ if $cline =~ /</; # keep track of indents $indent-- if $cline =~ />/; # keep track of indents $inner_state = 2 if $indent == 0; # and get out if we're done } elsif($inner_state == 2){ # "after" section $after .= "$cline\n"; # so build up return variable } } return($before, $section, $after); } END { } # module clean-up code # Initialisation code, on run 1; # return a TRUE value from the package initialisation