--- /dev/null
+#! /usr/bin/perl
+
+#31.01.2017
+#14.10.2019
+
+use strict;
+
+my $inputfile;
+my $frame=-1;
+my $title;
+my $emptylines;
+my $content;
+my $addcolors;
+my $addfq;
+my $addfqn;
+my $color;
+my $mycolor;
+my $fq;
+my @colortab = ('', 'ni', 'br', 'po', 'zi', 'fi');
+
+if (open($inputfile,'<',$ARGV[0])) {
+ while (defined(my $line = <$inputfile>)) {
+ $line =~ s/[\r\n]//g;
+ if($line =~ /^([0-9]+)>(.*)$/) { #detected new frame and title
+
+ if($frame>=0) { #update curent frame
+ update($frame,$title,$content);
+ $frame = -1;
+ }
+ $frame = $1;
+ $title = $2;
+ $title =~ s/^[ \t]+//g;
+ $title =~ s/[ \t]+$//g;
+ $content='';
+ $emptylines='';
+
+ }
+ elsif($line =~ /^>/) { #detected new frame without number - ignored area starts here
+ if($frame>=0) {
+ update($frame,$title,$content);
+ $frame = -1; #updated current frame bun not go to next
+ }
+ }
+ elsif($frame>=0) { #otherwise - continue reading a non-ignored frame
+ if($line eq '') {
+ $emptylines = $emptylines."\n";
+ $color='';#color can't continue over an empty line.
+ }
+ else {
+ if($line =~ s/^\[(fq|tq)=([A-Za-z0-9]+)\]//){ #detected start of [fq] tag - coloring of text will start here
+ $addcolors=1;
+ $addfq=1;
+ $mycolor=$2;
+ $fq=$1;
+ # print $frame.'.'.$fq.'>'."\n";
+ }
+ if($addcolors ne '') {
+ if($line =~ s/\[\/(fq|tq)\]$//){ #end of [fq] tag
+ $addfqn=1;
+ # print $frame.'./'.$fq.'>'."\n";
+ }
+
+ if ($line =~ /^((\/([0-9]*))?)((([A-Za-z0-9]+):)?)/) { #start of someone's speech
+ # print"$line\n";
+ if($1 ne ''){ #line starts with custom color
+ $color = $colortab[int($3)];
+ $line =~ s/^\/[0-9]*//;
+ }
+ elsif($4 ne '') { #a name is defined
+ $color=$colortab[($6 eq $mycolor)?1:2];
+ }
+ elsif($fq eq 'fq') { #on tq color continues for next line. On tq it doesn't
+ $color='';
+ }
+ # print $frame.'.'.$color.'>'."\n";
+ }
+
+ # elsif($line eq ''){ #color can't continue over an empty line.
+ # $color='';
+ # print $frame.'./>'."\n";
+ # }
+
+ if($color ne ''){
+ $line= '['.$color.']'.$line.'[/'.$color.']';
+ }
+ if($addfq ne '') {
+ $addfq='';
+ $line = '['.$fq.']'.$line;
+ }
+ if($addfqn ne '') {
+ $addcolors='';
+ $addfqn='';
+ $line = $line.'[/'.$fq.']';
+ }
+ # print $frame.'>'.$line."\n";
+ }
+ else {
+ $color = '';
+ }
+
+
+ if ($content eq '') {
+ $content = $line."\n";
+ }
+ else {
+ $content = $content.$emptylines.$line."\n";
+ }
+ $emptylines='';
+ }
+ }
+ }
+ if($frame>=0) {
+ update($frame,$title,$content);
+ $frame = -1;
+ }
+ close($inputfile);
+}
+
+sub update {
+ (my $frame, my $title, my $content) = @_;
+ my %data = readdatafile($frame);
+ $data{'title'} = $title;
+ $data{'content'} = $content;
+ writedatafile($frame,%data);
+}
+
+# Function to read data from datafiles.
+# Very similar to http header file reading. (function readheaderfile() in proxy
+# library)
+#
+# Differences:
+#
+# 1. After field name and colon there must be exactly one whitespace (space or
+# tab). Any other leading or trailing whitespace (but not the newline character
+# at the end of the line) is treated as part of the field value.
+#
+# 2. Instead of colon an equal sign can be used. The number of whitespaces after
+# it is then zero and not one.
+#
+# 3. When header field is split into multiple lines the next lines must start
+# with exactly one whitespace (tab or space) Any other leading or trailing
+# whitespace (but not the newline character at the end of the line) is treated
+# as part of the field value. the lines will be joined with a newline between
+# them.
+#
+# 4. When the same field name appears it replaces the previous one.
+#
+# 5. Line separator is LF and not CR LF. The CR character is treated as part of
+# the field value.
+#
+# 6. After the end of header (double newline) all next lines are treated as the
+# value of the "content" field.
+#
+# Returns a hash containing the values.
+# Names are case sensitive and are converted to lowercase
+#
+# Argument can be a path or a file handle. In case of a file handle it will just
+# read the file. In case of path it opens the file before reading and closes
+# after. On failure (file not open) returns empty hash.
+#
+sub readdatafile {
+ (my $datapath) = @_;
+ my $datafile;
+ my %data;
+ my $eoh=0;
+
+ # check if $datapath is actually a path or maybe a filehandle
+ # filehandles are references.
+ if(ref($datapath)) {
+ $datafile=$datapath;
+ unless (seek($datafile, 0, 0)) {
+ return %data;
+ }
+ }
+ else {
+ unless (open ($datafile, "<", $datapath)) {
+ return %data;
+ }
+ }
+
+ # The name of header field in previous line. Required for header fields that
+ # occupy multiple lines.
+ my $lastname='';
+
+ while (defined(my $line = <$datafile>)) {
+ my $name='';
+ my $value='';
+
+ if ($eoh){
+ unless($line eq'') {
+ $data{'content'} = $data{'content'}.$line;
+ }
+ next;
+ }
+
+ $line =~ s/[\n]$//g;
+
+ # Empty line - end of header.
+ if ($line eq ''){
+ $eoh=1;
+ }
+ # Line starts with whitespace. It's a continuation of the previous line.
+ # Concatenate the field value, separated by newline.
+ elsif($line =~ /^[ \t](.*)$/){
+ if($lastname ne '') {
+ $data{$lastname}.="\n".$1;
+ }
+ }
+ # Line starts with a name followed by colon/equal sign. Save the value
+ elsif ($line =~ /^([^:=]+)((:[ \t])|=)(.*)$/) {
+ $name = lc($1);
+ $value = $4;
+
+ $data{$name}=$value;
+
+ $lastname = $name;
+ }
+ }
+
+ # If argument was a path the file must be closed.
+ unless (ref($datapath)) {
+ close ($datafile);
+ }
+
+ return %data;
+}
+
+# the function to write data to datafiles (see readdatafile() description)
+#
+# First argument can be a path or a file handle. In case of a file handle it
+# will just read the file. In case of path it opens the file before writing and
+# closes after.
+#
+# On failure (file not open) returns 0.
+# On success returns 1.
+#
+sub writedatafile {
+ (my $headerpath, my %header) = @_;
+ my $headerfile;
+
+ if(ref($headerpath)) {
+ $headerfile=$headerpath;
+ unless (seek($headerfile, 0, 0)) {
+ return 0;
+ }
+ }
+ else {
+ unless (open ($headerfile, ">", $headerpath)) {
+ return 0;
+ }
+ }
+
+ foreach my $ind (keys %header) {
+ unless($ind eq 'content') {
+ my $headname = $ind;
+ my $headval = $header{$ind};
+ $headval =~ s/\r//g;
+ $headval =~ s/\n/\n /g;
+ print $headerfile "$headname: $headval\n";
+ }
+ }
+ print $headerfile "\n".$header{'content'};
+
+ unless (ref($headerpath)) {
+ close ($headerfile);
+ }
+ else {
+ truncate ($headerfile , tell($headerfile));
+ }
+
+ return 1;
+}
bicyclesonthemoon.info / projects / ott / bsta-tools / commitdiff