Changeset db0ac7e for perlwrap.pm
- Timestamp:
- May 3, 2008, 12:52:32 PM (16 years ago)
- Branches:
- master, barnowl_perlaim, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
- Children:
- feabce2
- Parents:
- d9337637 (diff), 811ad93 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent. - File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
perlwrap.pm
r9815e2e r811ad93 153 153 } 154 154 $configfile ||= $ENV{HOME}."/.owlconf"; 155 156 # populate global variable space for legacy owlconf files157 sub _format_msg_legacy_wrap {158 my ($m) = @_;159 $m->legacy_populate_global();160 return &BarnOwl::format_msg($m);161 }162 155 163 156 # populate global variable space for legacy owlconf files … … 692 685 # Internal startup/shutdown routines called by the C code 693 686 687 sub _load_perl_commands { 688 # Load builtin perl commands 689 BarnOwl::new_command(style => \&BarnOwl::Style::style_command, 690 { 691 summary => "creates a new style", 692 usage => "style <name> perl <function_name>", 693 description => 694 "A style named <name> will be created that will\n" . 695 "format messages using the perl function <function_name>.\n\n" . 696 "SEE ALSO: show styles, view -s, filter -s\n\n" . 697 "DEPRECATED in favor of BarnOwl::create_style(NAME, OBJECT)", 698 }); 699 } 700 694 701 sub _load_owlconf { 695 702 # load the config file … … 702 709 if(*BarnOwl::format_msg{CODE}) { 703 710 # if the config defines a legacy formatting function, add 'perl' as a style 704 BarnOwl::_create_style("perl", "BarnOwl::_format_msg_legacy_wrap", 705 "User-defined perl style that calls BarnOwl::format_msg" 706 . " with legacy global variable support"); 707 BarnOwl::set("-q default_style perl"); 711 BarnOwl::create_style("perl", BarnOwl::Style::Legacy->new( 712 "BarnOwl::format_msg", 713 "User-defined perl style that calls BarnOwl::format_msg" 714 . " with legacy global variable support", 715 1)); 716 BarnOwl::set("-q default_style perl"); 708 717 } 709 718 } … … 715 724 716 725 sub _startup { 726 _load_perl_commands(); 717 727 _load_owlconf(); 718 728 … … 763 773 sub format_message($) 764 774 { 765 my $m = shift; 775 my $self = shift; 776 my $m = shift; 777 my $fmt; 766 778 767 779 if ( $m->is_loginout) { 768 returnformat_login($m);780 $fmt = $self->format_login($m); 769 781 } elsif($m->is_ping && $m->is_personal) { 770 return ( "\@b(PING) from \@b(" . $m->pretty_sender . ")\n");782 $fmt = $self->format_ping($m); 771 783 } elsif($m->is_admin) { 772 return "\@bold(OWL ADMIN)\n" . indentBody($m);784 $fmt = $self->format_admin($m); 773 785 } else { 774 return format_chat($m); 775 } 776 } 777 778 BarnOwl::_create_style("default", "BarnOwl::Style::Default::format_message", "Default style"); 786 $fmt = $self->format_chat($m); 787 } 788 $fmt = BarnOwl::Style::boldify($fmt) if $self->should_bold($m); 789 return $fmt; 790 } 791 792 sub should_bold { 793 my $self = shift; 794 my $m = shift; 795 return $m->is_personal && $m->direction eq "in"; 796 } 797 798 sub description {"Default style";} 799 800 BarnOwl::create_style("default", "BarnOwl::Style::Default"); 779 801 780 802 ################################################################################ … … 787 809 788 810 sub format_login($) { 811 my $self = shift; 789 812 my $m = shift; 790 813 return sprintf( … … 798 821 } 799 822 823 sub format_ping { 824 my $self = shift; 825 my $m = shift; 826 return "\@b(PING) from \@b(" . $m->pretty_sender . ")\n"; 827 } 828 829 sub format_admin { 830 my $self = shift; 831 my $m = shift; 832 return "\@bold(OWL ADMIN)\n" . $self->indent_body($m); 833 } 834 800 835 sub format_chat($) { 836 my $self = shift; 837 my $m = shift; 838 my $header = $self->chat_header($m); 839 return $header . "\n". $self->indent_body($m); 840 } 841 842 sub chat_header { 843 my $self = shift; 801 844 my $m = shift; 802 845 my $header; … … 819 862 } 820 863 $header .= " " . time_hhmm($m); 864 $header .= $self->format_sender($m); 865 return $header; 866 } 867 868 sub format_sender { 869 my $self = shift; 870 my $m = shift; 821 871 my $sender = $m->long_sender; 822 872 $sender =~ s/\n.*$//s; 823 $header .= " " x (4 - ((length $header) % 4)); 824 $header .= "(" . $sender . '@color[default]' . ")"; 825 my $message = $header . "\n". indentBody($m); 826 if($m->is_personal && $m->direction eq "in") { 827 $message = BarnOwl::Style::boldify($message); 828 } 829 return $message; 830 } 831 832 sub indentBody($) 873 return " (" . $sender . '@color[default]' . ")"; 874 } 875 876 sub indent_body($) 833 877 { 878 my $self = shift; 834 879 my $m = shift; 835 880 … … 846 891 } 847 892 893 package BarnOwl::Style::Basic; 894 our @ISA=qw(BarnOwl::Style::Default); 895 896 sub description {"Compatability alias for the default style";} 897 898 BarnOwl::create_style("basic", "BarnOwl::Style::Basic"); 899 848 900 package BarnOwl::Style::OneLine; 901 # Inherit format_message to dispatch 902 our @ISA = qw(BarnOwl::Style::Default); 903 904 use constant BASE_FORMAT => '%s %-13.13s %-11.11s %-12.12s '; 905 906 sub description {"Formats for one-line-per-message"} 907 908 BarnOwl::create_style("oneline", "BarnOwl::Style::OneLine"); 909 849 910 ################################################################################ 850 # Branching point for various formatting functions in this style.851 ################################################################################852 use constant BASE_FORMAT => '%s %-13.13s %-11.11s %-12.12s ';853 sub format_message($) {854 my $m = shift;855 856 # if ( $m->is_zephyr ) {857 # return format_zephyr($m);858 # }859 if ( $m->is_loginout ) {860 return format_login($m);861 }862 elsif ( $m->is_ping) {863 return format_ping($m);864 }865 elsif ( $m->is_admin || $m->is_loopback) {866 return format_local($m);867 }868 else {869 return format_chat($m);870 }871 }872 873 BarnOwl::_create_style("oneline", "BarnOwl::Style::OneLine::format_message", "Formats for one-line-per-message");874 875 ################################################################################876 911 877 912 sub format_login($) { 913 my $self = shift; 878 914 my $m = shift; 879 915 return sprintf( … … 898 934 sub format_chat($) 899 935 { 936 my $self = shift; 900 937 my $m = shift; 901 938 my $dir = lc($m->{direction}); … … 911 948 if ($m->is_personal) { 912 949 $line= sprintf(BASE_FORMAT, 913 914 915 916 917 918 950 $dirsym, 951 $m->type, 952 '', 953 ($dir eq 'out' 954 ? $m->pretty_recipient 955 : $m->pretty_sender)); 919 956 } 920 957 else { 921 958 $line = sprintf(BASE_FORMAT, 922 923 924 925 926 927 959 $dirsym, 960 $m->context, 961 $m->subcontext, 962 ($dir eq 'out' 963 ? $m->pretty_recipient 964 : $m->pretty_sender)); 928 965 } 929 966 … … 931 968 $body =~ tr/\n/ /; 932 969 $line .= $body; 933 $line = BarnOwl::Style::boldify($line) if ($m->is_personal && lc($m->direction) eq 'in');934 970 return $line; 935 971 } 936 972 937 # Format locally generatedmessages938 sub format_ local($)973 # Format owl admin messages 974 sub format_admin($) 939 975 { 976 my $self = shift; 940 977 my $m = shift; 941 my $type = uc($m->{type}); 942 my $line = sprintf(BASE_FORMAT, '<', $type, '', ''); 978 my $line = sprintf(BASE_FORMAT, '<', 'ADMIN', '', ''); 943 979 my $body = $m->{body}; 944 980 $body =~ tr/\n/ /; … … 968 1004 } 969 1005 1006 sub style_command { 1007 my $command = shift; 1008 if(scalar @_ != 3 || $_[1] ne 'perl') { 1009 die("Usage: style <name> perl <function>\n"); 1010 } 1011 my $name = shift; 1012 my $perl = shift; 1013 my $fn = shift; 1014 { 1015 no strict 'refs'; 1016 unless(*{$fn}{CODE}) { 1017 die("Unable to create style '$name': no perl function '$fn'\n"); 1018 } 1019 } 1020 BarnOwl::create_style($name, BarnOwl::Style::Legacy->new($fn)); 1021 } 1022 1023 package BarnOwl::Style::Legacy; 1024 1025 sub new { 1026 my $class = shift; 1027 my $func = shift; 1028 my $desc = shift; 1029 my $useglobals = shift; 1030 $useglobals = 0 unless defined($useglobals); 1031 return bless {function => $func, 1032 description => $desc, 1033 useglobals => $useglobals}, $class; 1034 } 1035 1036 sub description { 1037 my $self = shift; 1038 return $self->{description} || 1039 ("User-defined perl style that calls " . $self->{function}); 1040 }; 1041 1042 sub format_message { 1043 my $self = shift; 1044 if($self->{useglobals}) { 1045 $_[0]->legacy_populate_global(); 1046 } 1047 no strict 'refs'; 1048 goto \&{$self->{function}}; 1049 } 1050 970 1051 971 1052 # switch to package main when we're done
Note: See TracChangeset
for help on using the changeset viewer.