33 | | |
| 33 | == Inline Perl Script == |
| 34 | |
| 35 | perl script posted here due to wiki being busted |
| 36 | |
| 37 | {{{ |
| 38 | #################################################################### |
| 39 | # The code below is the same as the code used to define |
| 40 | # the default style in barnowl. |
| 41 | # You can make a new, different-looking style by tweaking it. |
| 42 | # I'd recommend copying this and putting the file at |
| 43 | # ~/.owl/styletemplate.pl |
| 44 | # To use the new style in barnowl, use the following commands: |
| 45 | # |
| 46 | #perl do "/full/explicit/path/to/this/file/comma/namely/styletemplate.pl" |
| 47 | #view -s mystyle |
| 48 | # |
| 49 | |
| 50 | package BarnOwl::Style::MyStyle; |
| 51 | use List::Util qw[min max]; |
| 52 | ############################################################################### |
| 53 | # Branching point for various formatting functions in this style. |
| 54 | ############################################################################### |
| 55 | sub format_message($) |
| 56 | { |
| 57 | my $m = shift; |
| 58 | |
| 59 | if ( $m->is_loginout) { |
| 60 | return format_login($m); |
| 61 | } elsif($m->is_ping) { |
| 62 | return ( "\@b(PING) from \@b(" . $m->pretty_sender . ")\n" ); |
| 63 | } elsif($m->is_admin) { |
| 64 | return "\@bold(OWL ADMIN)\n" . indentBody($m); |
| 65 | } else { |
| 66 | return format_chat($m); |
| 67 | } |
| 68 | } |
| 69 | |
| 70 | |
| 71 | |
| 72 | ################################################################################ |
| 73 | |
| 74 | sub time_hhmm { |
| 75 | my $m = shift; |
| 76 | my ($time) = $m->time =~ /(\d\d:\d\d)/; |
| 77 | return $time; |
| 78 | } |
| 79 | |
| 80 | sub format_login($) { |
| 81 | my $m = shift; |
| 82 | return sprintf( |
| 83 | '@b<%s%s> for @b(%s) (%s) %s', |
| 84 | uc( $m->login ), |
| 85 | $m->login_type, |
| 86 | $m->pretty_sender, |
| 87 | $m->login_extra, |
| 88 | time_hhmm($m) |
| 89 | ); |
| 90 | } |
| 91 | |
| 92 | sub format_chat($) { |
| 93 | my $m = shift; |
| 94 | |
| 95 | my $head; |
| 96 | my $message; |
| 97 | |
| 98 | my $instance; |
| 99 | |
| 100 | my %short_classes = getShortClasses(); |
| 101 | if(defined $m->subcontext && (lc $m->subcontext ne "personal")) { |
| 102 | $instance = $m->subcontext; |
| 103 | } |
| 104 | |
| 105 | $head = substr($m->pretty_sender,0,9) . (" " x max(10 - (length $m->pretty_sender),1)); |
| 106 | my $midline; |
| 107 | |
| 108 | if($m->is_personal) { |
| 109 | if($m->direction eq "out") { |
| 110 | $midline = "->" . $m->pretty_recipient; |
| 111 | } else { |
| 112 | #no midline |
| 113 | } |
| 114 | } else { |
| 115 | if(defined($short_classes{lc $m->context})) { |
| 116 | $midline = (length($short_classes{$m->context}) > 0 ? '-' : '') . $short_classes{$m->context} . "." . $instance; |
| 117 | } else { |
| 118 | $midline = '-' . $m->context; |
| 119 | } |
| 120 | } |
| 121 | |
| 122 | if(defined $midline) { |
| 123 | $head .= substr($midline,0,8) . (" " x max(9 - (length $midline),0)) . " "; |
| 124 | } |
| 125 | |
| 126 | my $footer = ""; |
| 127 | if(defined $instance && !defined($short_classes{$m->context})) { |
| 128 | $footer .= '[' . $m->subcontext . ']'; |
| 129 | } |
| 130 | $footer .= ' ' . time_hhmm($m); |
| 131 | |
| 132 | $message = $head . $m->body . $footer; |
| 133 | $message = format_full_msg($head,$m,$footer); |
| 134 | if($m->is_personal) { |
| 135 | $message = BarnOwl::Style::boldify($message); |
| 136 | } |
| 137 | return $message; |
| 138 | |
| 139 | } |
| 140 | # my $m = shift; |
| 141 | # my $header; |
| 142 | # if ( $m->is_personal ) { |
| 143 | # if ( $m->direction eq "out" ) { |
| 144 | # $header = ucfirst $m->type . " sent to " . $m->pretty_recipient; |
| 145 | # } else { |
| 146 | # $header = ucfirst $m->type . " from " . $m->pretty_sender; |
| 147 | # } |
| 148 | # } else { |
| 149 | # $header = $m->context; |
| 150 | # if(defined $m->subcontext) { |
| 151 | # $header .= ' / ' . $m->subcontext; |
| 152 | # } |
| 153 | # $header .= ' / @b{' . $m->pretty_sender . '}'; |
| 154 | # } |
| 155 | # |
| 156 | # $header .= " " . time_hhmm($m); |
| 157 | # my $sender = $m->long_sender; |
| 158 | # $sender =~ s/\n.*$//s; |
| 159 | # $header .= " " x (4 - ((length $header) % 4)); |
| 160 | # $header .= "(" . $sender . ")"; |
| 161 | # my $message = $header . "\n". indentBody($m); |
| 162 | # if($m->is_personal && $m->direction eq "in") { |
| 163 | # $message = BarnOwl::Style::boldify($message); |
| 164 | # } |
| 165 | # return $message; |
| 166 | #} |
| 167 | |
| 168 | sub getShortClasses{ |
| 169 | |
| 170 | my %classes = ( |
| 171 | help => 'h', |
| 172 | sipb => 's', |
| 173 | message => '' |
| 174 | ); |
| 175 | } |
| 176 | |
| 177 | sub format_full_msg |
| 178 | { |
| 179 | my $h = shift; |
| 180 | my $m = shift; |
| 181 | my $f = shift; |
| 182 | |
| 183 | #output message |
| 184 | my $message = ""; |
| 185 | |
| 186 | # first, cleanup (de-rasterize) the body. |
| 187 | my $cleanbody = $m->body; |
| 188 | $cleanbody =~ s/\s/ /g; |
| 189 | |
| 190 | # now add the header right on there |
| 191 | $cleanbody = $h . $cleanbody; |
| 192 | |
| 193 | # now we want to re-rasterize |
| 194 | |
| 195 | my $cols = BarnOwl::getnumcols() - 5; |
| 196 | |
| 197 | #temporary until the feeding is done by a seperate subprocess; |
| 198 | my $indent = 0; |
| 199 | while (length($cleanbody) > 0 ) { |
| 200 | |
| 201 | my $line = (" " x $indent) . substr($cleanbody,0,$cols - $indent); |
| 202 | $cleanbody = substr($cleanbody,$cols - $indent); |
| 203 | |
| 204 | if (length($cleanbody) > 0 ) { |
| 205 | #normal run of the mill line. |
| 206 | $message .= $line . "\n"; |
| 207 | } |
| 208 | else { |
| 209 | #last line. Attempt clean footer insertion |
| 210 | if(length($line) + length($f) < $cols) { |
| 211 | $message .= $line . fillWhiteSpace($cols,length($line) + length($f),$m) . $f . "\n"; |
| 212 | } else { |
| 213 | # The header adds too much space here to fit on one line. We want to |
| 214 | # print out the full line, and then add the header on the next line. |
| 215 | $message .= $line . "\n" . fillWhiteSpace($cols, length($f),$m) . $f . "\n"; |
| 216 | } |
| 217 | } |
| 218 | $indent = 2; |
| 219 | } |
| 220 | return $message; |
| 221 | } |
| 222 | |
| 223 | sub indentBody($) |
| 224 | { |
| 225 | my $m = shift; |
| 226 | |
| 227 | my $body = $m->body; |
| 228 | # replace newline followed by anything with |
| 229 | # newline plus four spaces and that thing. |
| 230 | $body =~ s/\n(.)/\n $1/g; |
| 231 | |
| 232 | return $body; |
| 233 | } |
| 234 | |
| 235 | sub fillWhiteSpace |
| 236 | { |
| 237 | my $cols = shift; |
| 238 | my $empty = shift; |
| 239 | my $m = shift; |
| 240 | |
| 241 | my $output = ""; |
| 242 | my $length = $cols - $empty; |
| 243 | |
| 244 | if($m->long_sender eq "") { |
| 245 | return $output = (" " x $length); |
| 246 | } |
| 247 | |
| 248 | my $sig = $m->long_sender; |
| 249 | $sig =~ s/\s/ /g; |
| 250 | |
| 251 | my $filler = " --" . $sig; |
| 252 | |
| 253 | $filler = (" " x max($length - (length $filler)-1,0)) . substr($filler,0,$length -1) . " "; |
| 254 | |
| 255 | $output = (" " x $length); |
| 256 | if((length $filler) == (length $output)) { |
| 257 | $output = $filler; |
| 258 | } |
| 259 | return $output; |
| 260 | } |
| 261 | |
| 262 | BarnOwl::command("style mystyle perl BarnOwl::Style::MyStyle::format_message"); |
| 263 | |
| 264 | 1; |
| 265 | |
| 266 | }}} |
| 267 | |
| 268 | |