wApua-0.06.2/0000755000175000017500000000000012701574641010723 5ustar abeabewApua-0.06.2/Makefile.PL0000644000175000017500000000171112701570736012676 0ustar abeabe# This -*- perl -*- script writes the Makefile for wApua require 5.004; use strict; use ExtUtils::MakeMaker; sub MY::postamble { ' emacs: emacs Makefile.PL MANIFEST README CHANGES INSTALL wApua.rc wApua/*.pm bin/wApua bin/*.pl & '; } WriteMakefile( NAME => 'wApua', VERSION_FROM => 'bin/wApua', EXE_FILES => [ "bin/wApua", "bin/wbmp2xbm" ], PREREQ_PM => { 'URI' => "1.03", 'URI::Escape' => undef, 'URI::file' => undef, 'URI::Heuristic' => undef, 'LWP' => "5.47", 'LWP::UserAgent' => undef, 'HTML::Parser' => "2.99_06", 'HTML::TokeParser' => undef, 'Tk' => "800.000", 'Tk::ROText' => undef }, dist => { COMPRESS => 'gzip -9f', SUFFIX => '.gz' } ); wApua-0.06.2/META.yml0000644000175000017500000000124512701574641012176 0ustar abeabe--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150005' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: wApua no_index: directory: - t - inc requires: HTML::Parser: 2.99_06 HTML::TokeParser: '0' LWP: '5.47' LWP::UserAgent: '0' Tk: '800.000' Tk::ROText: '0' URI: '1.03' URI::Escape: '0' URI::Heuristic: '0' URI::file: '0' version: v0.06.2 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' wApua-0.06.2/wApua/0000755000175000017500000000000012701574641012000 5ustar abeabewApua-0.06.2/wApua/Config.pm0000644000175000017500000002124312701571575013550 0ustar abeabepackage wApua::Config; # Copyright (C) 2000, 2006, 2009, 2016 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland use strict; # This is the standard configuration of wApua, a WAP User Agent, # mainly developed for debugging WML pages... # Edit the values in the function readConfig to change the wApua # default configuration. sub new { # Builds and returns a configuration hash, based on the values # given in this file, the configfile and the command line options. my $self = {}; shift; $self->{config} = 0; $self->{configfile} = 0; bless($self); return $self; } sub readConfig { # Builds and returns a configuration hash, based on the values # given in this file, the configfile and the command line options. my $self = shift; my $configfile = $self->getConfigFile; my %CONFIG; # Initial configuration # Proxy configuration only via environment variables at the # moment. From the LWP::UserAgent man page: # $ua->env_proxy() # Load proxy settings from *_proxy environment variables. # You might specify proxies like this (sh-syntax): # gopher_proxy=http://proxy.my.place/ # wais_proxy=http://proxy.my.place/ # no_proxy="localhost,my.domain" # export gopher_proxy wais_proxy no_proxy # Csh or tcsh users should use the setenv command to # define these environment variables. # If you have warnings about some KP keysym (seems to appear under MS # win and is probably some perl/Tk or Tk problem), set this to 1. $CONFIG{NoKPKeySyms} = 0; # If you like the old text buttons more than the new bitmap ones, say # here 1 instead of 0. $CONFIG{TextButtons} = 0; # Keys $CONFIG{ModKeys} = "Alt Meta Control"; $CONFIG{ModKeys} = "Alt Control" if ($^O eq "MSWin32"); $CONFIG{ModKeys} = "Command" if ($^O eq "MacOS"); $CONFIG{DefaultModKey} = "Meta"; $CONFIG{DefaultModKey} = "Control" if ($^O eq "MSWin32"); $CONFIG{DefaultModKey} = "Command" if ($^O eq "MacOS"); $CONFIG{HelpKey} = "Help"; $CONFIG{HelpKey} = "F1" if ($^O eq "MSWin32"); $CONFIG{HelpKey} = "F1" if ($^O eq "MacOS"); # Anyone knows what keysym some key for help on Macs has? # Fonts $CONFIG{FontFamily} = "helvetica"; $CONFIG{TTFontFamily} = "courier"; $CONFIG{SoftButtonFont} = "font=-1=normal"; # Font sizes $CONFIG{'FontSize-2'} = 6; $CONFIG{'FontSize-1'} = 8; $CONFIG{'FontSize0'} = 10; $CONFIG{'FontSize+1'} = 12; $CONFIG{'FontSize+2'} = 14; # Cursors $CONFIG{TextCursor} = "xterm"; #xterm (or pencil) $CONFIG{WaitCursor} = "watch"; #watch (or trek) $CONFIG{NormalCursor} = "top_left_arrow"; #top_left_arrow $CONFIG{LinkCursor} = "center_ptr"; #hand2 # All possibilities of X11: # # X_cursor, arrow, based_arrow_down, based_arrow_up, boat, bogosity, # bottom_left_corner, bottom_right_corner, bottom_side, bottom_tee, # box_spiral, center_ptr, circle, clock, coffee_mug, cross, # cross_reverse, crosshair, diamond_cross, dot, dotbox, double_arrow, # draft_large, draft_small, draped_box, exchange, fleur, gobbler, # gumby, hand1, hand2, heart, icon, iron_cross, left_ptr, left_side, # left_tee, leftbutton, ll_angle, lr_angle, man, middlebutton, mouse, # pencil, pirate, plus, question_arrow, right_ptr, right_side, # right_tee, rightbutton, rtl_logo, sailboat, sb_down_arrow, # sb_h_double_arrow, sb_left_arrow, sb_right_arrow, sb_up_arrow, # sb_v_double_arrow, shuttle, sizing, spider, spraycan, star, target, # tcross, top_left_arrow, top_left_corner, top_right_corner, top_side, # top_tee, trek, ul_angle, umbrella, ur_angle, watch, xterm # Buttons $CONFIG{BackButton} = "back.wbmp"; $CONFIG{ForwardButton} = "forward.wbmp"; $CONFIG{ReloadButton} = "reload.wbmp"; $CONFIG{HomeButton} = "home.wbmp"; $CONFIG{StopButton} = "stop.wbmp"; $CONFIG{LogoButton} = "wApua.wbmp"; $CONFIG{LogoURL} = "http://fsinfo.noone.org/~abe/wApua/index.wml"; $CONFIG{ButtonDirectory} = "wApua/images"; # Use absolute for paths outside @INC; # Colors, program $CONFIG{Background} = '#808080'; $CONFIG{Foreground} = '#FFFFFF'; $CONFIG{BorderWidth} = 2; # Colors, WAP pages $CONFIG{WAPBackground} = '#A6C6A6'; $CONFIG{WAPForeground} = '#000000'; # Colors, links $CONFIG{LinkBackground} = '#A6C6A6'; $CONFIG{LinkForeground} = '#FFFFFF'; $CONFIG{LinkBorderWidth} = 2; $CONFIG{LinkBorderType} = "flat"; # Colors, hover links $CONFIG{HoverBackground} = $CONFIG{LinkBackground}; $CONFIG{HoverForeground} = $CONFIG{LinkForeground}; $CONFIG{HoverBorderWidth} = 2; $CONFIG{HoverBorderType} = "raised"; # Colors, errors $CONFIG{ErrorBackground} = '#A6C6A6'; $CONFIG{ErrorForeground} = '#FF0000'; # Colors, selections $CONFIG{ActiveBackground} = '#B0B0B0'; $CONFIG{ActiveForeground} = '#FFFFFF'; $CONFIG{ActiveBorderWidth} = 2; # Start URL and HTTP headers $CONFIG{HomeURL} = "http://fsinfo.noone.org/~abe/wApua/index.wml"; $CONFIG{HTTP_Accept} = "text/vnd.wap.wml; q=1.0, text/plain; q=0.5, image/vnd.wap.wbmp; level=0"; $CONFIG{HTTP_Accept_Image} = "image/vnd.wap.wbmp; level=0"; # Debugging my $debug = $CONFIG{Debug} = $self->{debug} || 0; # Time Out $CONFIG{TimeOut} = 15; # Carriage return after link? $CONFIG{CarriageReturnAfterLink} = 0; # Reading configuration file if ($configfile) { print STDERR "Reading configuration from $configfile...\n" if $debug >= 1; open(CF,$configfile) or die "Can't open $configfile"; while () { next if /^\s*($|\#)/; chomp; my ($key,$value) = split(/:\s+/,$_,2); $key =~ s/(\s+$|^\s+)//g; $value =~ s/(\s+$|^\s+)//g; $value = 0 if $value =~ /^(No|False)$/i; $value = 1 if $value =~ /^(Yes|True)$/i; if ($key =~ /\s/) { warn "Wrong syntax, ignoring line $. of $configfile:\n$_\n"; } else { $CONFIG{$key} = $value; } } close CF; } else { print STDERR "No configuration file found. Using default configuration...\n" if $debug >= 1; } if ($debug >= 1) { print STDERR "Using the following configuration:\n"; foreach (sort keys %CONFIG) { print STDERR " $_: $CONFIG{$_}\n"; } } $self->{config} = %CONFIG; return %CONFIG; } sub getConfig { # Builds and returns a configuration hash, based on the values # given in this file, the configfile and the command line options. my $self = shift; $self->readConfig unless $self->{config}; return $self->{config}; } sub getConfigFile { # Builds and returns a configuration hash, based on the values # given in this file, the configfile and the command line options. my $self = shift; my @commandline = (); while (@ARGV) { $_ = shift(@ARGV); if ($_ eq "-f") { $self->{configfile} = shift(@ARGV); } elsif ($_ eq "-d") { $self->{debug} = shift(@ARGV); } elsif (/^--debug=(\d+)$/) { $self->{debug} = $1; } elsif (/^(-h|--(help|usage))$/) { print <{configfile}) { my @configfiles = ($^O =~ /^(MSWin32|MacOS)$/ ? ($ENV{"HOME"}."/.wApua.rc", $ENV{"HOME"}."/.wApuarc", $ENV{"HOME"}."/.wapua.rc", $ENV{"HOME"}."/.wapuarc", $ENV{"HOME"}."/wApua.rc", $ENV{"HOME"}."/wapua.rc", $ENV{"HOME"}."/wApua.ini", $ENV{"HOME"}."/wapua.ini") : ($ENV{"HOME"}."/.wApua.rc", $ENV{"HOME"}."/.wApuarc", $ENV{"HOME"}."/.wapua.rc", $ENV{"HOME"}."/.wapuarc")); foreach my $configfile (@configfiles) { #print STDERR "Testing $configfile... "; if (-e $configfile) { $self->{configfile} = $configfile; #print STDERR "That's it!\n"; last; } #print STDERR "No, not the right one...\n"; } } return $self->{configfile}; } 1; wApua-0.06.2/wApua/Helpers.pm0000644000175000017500000001040712701570736013743 0ustar abeabepackage wApua::Helpers; # Copyright (C) 2000, 2006, 2009 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland #use strict; # In here are some helpers, needed by wApua (and some of its modules), # a WAP User Agent, mainly developed for debugging WML pages... use Exporter (); @ISA = qw(Exporter); @EXPORT = qw(&transformEntities &parsecdata &parseentities &parsespaces &telURL &internalURL &noglobalbind &findINC &preparser &syntaxwarn &syntaxignore &showSource); use Data::Dumper; # Idea from Tk::findINC sub findINC { my $file = shift; if ($file =~ m(^/)) { return $file if (-e $file); return undef; } foreach my $dir (@INC) { return "$dir/$file" if (-e "$dir/$file"); } return undef; } sub noglobalbind { # Keine globalen Key-Bindings fr Eingabefelder my $f = shift; $f->bindtags([$f,ref($f)]); $f->bind('','focusNext'); $f->bind('<>','focusPrev'); $f->bind('','focusPrev'); } # Is it an internal URL? sub internalURL { return (shift =~ /^(wapua|about):/i); } # Is it an telephone URL? sub telURL { return (shift =~ /^(wtai|tel|fax|modem):/i); } sub parsespaces { my $seite = shift; $seite =~ s/\s+/ /gs; $seite =~ s/ //gs; $seite =~ s=\s*(]*)?/?>)((<[^<>]+>)*)\s*=$1$4=gi; return $seite; } sub parseentities { my $seite = shift; $seite =~ s/&\#(34|x22);/\"/gi; $seite =~ s/&\#(38|x26);/\&/gi; $seite =~ s/&\#(39|x27);/\'/gi; $seite =~ s/&\#(60|x40);/\</gi; $seite =~ s/&\#(62|x42);/\>/gi; $seite =~ s/&\#(160|xA0);/\ /gi; $seite =~ s/&\#(173|xAD);/\­/gi; $seite =~ s/&\#(\d+);/pack("C", $1)/eg; $seite =~ s/&\#x([a-fA-F0-9]+);/pack("C", hex($1))/eg; return $seite; } sub parsecdata { my $seite = shift; $seite =~ s/&(.*?);/&!$1;/g; $seite =~ s/&/&/g; $seite =~ s//>/g; $seite =~ s/\"/"/g; $seite =~ s/\'/'/g; $seite =~ s/\\\]\\\]/\]\]/g; return $seite; } sub transformEntities { my $seite = shift; $seite =~ s/"/\"/g; $seite =~ s/&/\&/g; $seite =~ s/'/\'/g; $seite =~ s/<//g; $seite =~ s/ / /g; $seite =~ s/­/-/g; $seite =~ s/&!(.*?);/&$1;/g; return $seite; } sub preparser { my $seite = shift; # Delete redundant white spaces my $newseite = ""; while ($seite =~ m=]+)?>(.*)|=s) { my $before = $`; my $between; if (defined $3) { $between = $3; } my $match = $&; $seite = "$'"; if ($& =~ /^
" .
			  &parsecdata($between) .
			  "
"); } } $newseite .= &parsespaces(&parseentities($seite)); return $newseite; } sub syntaxwarn { my $expected = shift; my $found = shift; warn < + Found closing tag: EOF } sub syntaxignore { my $tag = shift; if (0 < scalar @_) { $tag = shift; warn "Ignored unknown tag: <$tag>"; my %hash = %{shift()}; foreach (keys %hash) { #warn " $_: $hash{$_}"; } } else { warn "Ignored unknown tag: <$tag>"; } } sub showSource { print shift; } 1; wApua-0.06.2/wApua/images/0000755000175000017500000000000012701574641013245 5ustar abeabewApua-0.06.2/wApua/images/wApua.wbmp0000644000175000017500000000037612701570736015220 0ustar abeabeKÁ  8 !À`x Àx C <`8````? 0?|8 `wApua-0.06.2/wApua/images/forward.wbmp0000644000175000017500000000004212701570736015575 0ustar abeabe~>>~wApua-0.06.2/wApua/images/home.wbmp0000644000175000017500000000004212701570736015061 0ustar abeabe~>wApua-0.06.2/wApua/images/reload.wbmp0000644000175000017500000000004212701570736015377 0ustar abeabe>G `>wApua-0.06.2/wApua/images/back.wbmp0000644000175000017500000000004212701570736015031 0ustar abeabewApua-0.06.2/wApua/images/stop.wbmp0000644000175000017500000000004212701570736015116 0ustar abeabe?@ ZZJjjJ,?wApua-0.06.2/wApua/Cache.pm0000644000175000017500000001017512701570736013346 0ustar abeabepackage wApua::Cache; # Copyright (C) 2000, 2006, 2009 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland use strict; # This is the RAM cache object for wApua, a WAP User Agent, mainly # developed for debugging WML pages... use HTTP::Response; use HTTP::Request; # constructor sub new { shift; my $self = {}; $self->{response} = {}; $self->{ua} = shift; $self->{ua_headers} = shift; bless($self); return $self; } # cache functions sub addResponse { # add page to cache, needs response object as parameter my $self = shift; my $response = shift; $self->{response}{$response->base} = $response; return 1; # successfully saved } sub getCachedContent { # retrieve page from cache my $self = shift; my $url = shift; return (exists $self->{response}{$url} ? $self->{response}{$url}->content : 0); } sub getCachedResponse { # retrieve cached response object from cache my $self = shift; my $url = shift; if (exists $self->{response}{$url}) { return $self->{response}{$url}; } else { warn "Asking for response for $url although it is not stored in cache!"; return 0; } } sub getLastModified { # get last modification date of cached object my $self = shift; my $url = shift; if (exists $self->{response}{$url}) { return $self->{response}{$url}->last_modified; } else { warn "Asking for the last-modified-date of $url although it is not stored in cache!"; return 0; } } sub getContentLength { # get last modification date of cached object my $self = shift; my $url = shift; if (exists $self->{response}{$url}) { return $self->{response}{$url}->content_length; } else { warn "Asking for the content length of $url although it is not stored in cache!"; return 0; } } sub inCache { # is the page already cached? my $self = shift; my $url = shift; return exists $self->{response}{$url}; } sub getURLs { # get the URLs of all pages in the cache my $self = shift; return keys %{$self->{response}}; } sub expired { # is it necessary to retrieve the page (again)? my $self = shift; my $url = shift; my $headers = $self->{ua_headers}; if (@_) { $headers = shift; } return 0; # if (exists $self->{response}{$url}) { # my $request = new HTTP::Request('HEAD', $url, $headers); # print $request->as_string; # my $response = $self->{ua}->request($request); # print $response->as_string; # print "HEAD: ".($response->last_modified)."\n"; # print "Cache: ".($self->{response}{$url}->last_modified)."\n"; # if ($response->last_modified > $self->{response}{$url}->last_modified) { # return 1; # } else { # return 0; # } # } else { # warn "Asking if $url is expired in cache although it is not stored in cache!"; # return 1; # } } sub getContent { # retrieve page my $self = shift; my $url = shift; return $self->getResponse()->content; } sub getResponse { # retrieve response my $self = shift; my $url = shift; if ($self->inCache($url) && $self->expired($url)) { return getCachedResponse($url); } else { my $request = new HTTP::Request('GET', $url, $self->{ua_headers}); print $request->as_string; my $response = $self->{ua}->request($request); print $response->as_string; return $response; } } return 1; wApua-0.06.2/wApua/Phone.pm0000644000175000017500000000412412701570736013411 0ustar abeabepackage wApua::Phone; # Copyright (C) 2000, 2006, 2009 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland use strict; # This is the Phone URL decoder object for wApua, a WAP User Agent, # mainly developed for debugging WML pages... use URI::Escape; sub new { my $self = {}; shift; my $url = uri_unescape(shift); $url =~ s/\#.*$//; $self->{page} = <

wApua Phone URL Decoder

EOF if ($url =~ m%^(wtai://wp/mc;|tel:)(.*)$%) { $self->{page} .= "Dialing $2 with virtual phone...\n"; } elsif ($url =~ m%^wtai://wp/ap;(.*);(.*)$%) { $self->{page} .= "Added '$2' with number '$1' to virtual phone book...\n"; } elsif ($url =~ /^fax:(.*)$/) { $self->{page} .= "Sending some virtual fax to $1...\n"; } elsif ($url =~ /^modem:(.*)$/) { $self->{page} .= "Trying to establish a virtual modem connection to $1...\n"; } else { $self->{page} .= "Unsupported phone URL: $url...\n"; } $self->{page} .= < EOF bless($self); return $self; } sub as_string { my $self = shift; return $self->{page}; } 1; wApua-0.06.2/wApua/UserAgent.pm0000644000175000017500000000360712701571443014236 0ustar abeabepackage wApua::UserAgent; # Copyright (C) 2000, 2006, 2009, 2016 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland @ISA = qw(LWP::UserAgent); use strict; # This is just a specialization of LWP::UserAgent for wApua, a WAP # User Agent, mainly developed for debugging WML pages... use LWP::UserAgent; use LWP::MediaTypes qw(add_type); use Tk::DialogBox; sub new { my $self = new LWP::UserAgent; shift; # I hate OS names written all in lower case... *g* my$os=($^O=~/[A-Z]/?$^O:"\u$^O"); $os="SunOS" if $os=~/^sunos$/i; $os=~s/^(.*)bsd$/\u$ {1}BSD/i; $self->agent(shift()." (PERL/$]; lwp/".$LWP::VERSION."; ". "pTk/".$Tk::VERSION."; $os)"); $self->parse_head(0); $self->env_proxy(); add_type("text/vnd.wap.wml" => qw(wml)); bless($self); return $self; } # In the style of lwp-request sub get_basic_credentials { my($self, $realm, $url) = @_; my $host = $url->host_port; my($user, $password) = &wApua::PasswordDialog($realm, $host); return (undef, undef) unless length $user; return ($user, $password); } 1; wApua-0.06.2/wApua/History.pm0000644000175000017500000001405312701570736014003 0ustar abeabepackage wApua::History; # Copyright (C) 2000, 2006, 2009 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland use strict; # This is the history object for wApua, a WAP User Agent, mainly # developed for debugging WML pages... # constructor sub new { shift; my $self = {}; $self->{point} = -1; $self->{url} = []; $self->{getabs} = 0; $self->{fetch} = shift; $self->{state} = shift; $self->{fwd} = shift; $self->{menu} = shift; $self->{mark} = shift; $self->{oldm} = ${$self->{menucolors}}{-background}; $self->{title} = {}; %{$self->{menucolors}} = @_; bless($self); return $self; } # history functions sub push { # pushes URL on history stack. forward stack gets lost. my $self = shift; while (($self->{point}+1) != scalar @{$self->{url}}) { pop @{$self->{url}}; } my $URL = shift; my $title = ""; $title = shift if @_; push @{$self->{url}},$URL; ${$self->{title}}{$URL}=$title; $self->{point} += 1; $self->update_menu; return $URL; } sub size { # get the size of the history my $self = shift; return scalar @{$self->{url}}; } sub last { # returns the URL, back would go to, without changing any data # returns 0, if the end of history is reached my $self = shift; my $id = $self->{point}-1; return ($id < 0 ? 0 : $ {$self->{url}}[$id]); } sub next { # returns the URL, forward would go to, without changing any data # returns 0, if the end of history is reached my $self = shift; my $id = $self->{point}+1; return ($id >= scalar @{$self->{url}} ? 0 : $ {$self->{url}}[$id]); } sub top { # returns the top-most URL, without changing any data # returns 0, if the history is empty my $self = shift; return ($self->{point} < 0 ? 0 : $ {$self->{url}}[$self->{point}]); } sub title { # returns the top-most URL, without changing any data # returns 0, if the history is empty my $self = shift; my $url = shift; return ${$self->{title}}{$url} if defined ${$self->{title}}{$url}; } sub back { # goes backward in history and returns the last URL used. my $self = shift; my $id = $self->{point}-1; if ($id < 0) { return 0; } else { $self->{point} = $id; $self->update_menu; return ${$self->{url}}[$id]; } } sub forward { # goes forward my $self = shift; my $id = $self->{point}+1; if ($id >= scalar @{$self->{url}}) { return 0; } else { $self->{point} = $id; $self->update_menu; return ${$self->{url}}[$id]; } } sub backwardHistory { # returns all visited pages until the actual my $self = shift; my $id = 0; my @bH = (); while ($id < $self->{point}) { push @bH,${$self->{url}}[$id++]; } return @bH; } sub forwardHistory { # returns all visited pages from the actual my $self = shift; my $id = $self->{point}+1; my @fH = (); while ($id < scalar @{$self->{url}}) { push @fH,${$self->{url}}[$id++]; } return @fH; } sub allHistory { # returns all pages in history my $self = shift; return @{$self->{url}}; } sub get { # get the history entry (absolute or relative to the actual), # it returns 0, if the parameter is out of the scope of history my $self = shift; my $id = ($self->{getabs}?shift:$self->{point}+shift); return (($id < 0) || ($id >= scalar @{$self->{url}}) ? 0 : $ {$self->{url}}[$id]); } sub set { # changes the actual URL (e.g. after some redirect), returns # old URL my $self = shift; my $old = ${$self->{url}}[$self->{point}]; ${$self->{url}}[$self->{point}] = shift; ${$self->{title}}[$self->{point}] = shift if @_; $self->update_menu; return $old; } sub settitle { # changes the actual title and returns old one my $self = shift; my $old = ${$self->{title}}{$self->top}; ${$self->{title}}{$self->top} = shift; $self->update_menu; return $old; } sub absolute { # get or set if get interprets parameters relative # (default) or absolute. my $self = shift; if (@_) { $self->{getabs} = shift; } return $self->{getabs}; } sub update_menu { my $self = shift; $self->{menu}->delete(0,"end"); my $i = 0; my %url; foreach ($self->allHistory) { my $foo = $_; my $bar = $i; $ {$self->{menucolors}}{-background} = ($bar == $self->{point} ? $self->{mark} : $self->{oldm}); $url{$bar+1} = $_; $self->{menu}->command(-label => ($self->title($_) ? $self->title($_) : $_), %{$self->{menucolors}}, -accelerator => $bar+1, -command => sub { $self->pos($bar); $self->{fwd}->configure(-state => "normal") if $self->next; &{$self->{fetch}}($foo,0); } ); $i++; } $self->{menu}->bind('<>' => sub { my $w = $Tk::event->W; if ($self->{menu}->type('active') eq "command") { &{$self->{state}}("Goto ". $url{$w->entrycget('active', -accelerator)}); } elsif ($self->{menu}->type('active') eq "tearoff") { &{$self->{state}}("Click here to get a tear-off menu"); } else { &{$self->{state}}(""); } $self->{menu}->idletasks; }); } sub pos { # get or set the actual page id in history my $self = shift; if (@_) { $self->{point} = shift; } return $self->{point}; } 1; wApua-0.06.2/wApua/WBMP2XBM.pm0000644000175000017500000001160512701570736013540 0ustar abeabepackage wApua::WBMP2XBM; # Copyright (C) 2000, 2006, 2009 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland # This is a perl module, which converts some wireless bitmap (wbmp) # into some X11 bitmap (xbm). It is mainly designed for use in the # perl/Tk WAP browser wApua. See wbmp2xbm.pl for some simple example, # how to use this module. use strict; ### constructor sub new { shift; my $self = {}; $self->{wbmp_string} = shift; $self->{image_name} = (@_ ? shift : "WBMPtoXBM"); $self->{width} = 0; $self->{height} = 0; $self->{length} = length($self->{wbmp_string}); $self->{xbm_string} = 0; $self->{config} ||= {}; $self->{config}{debug} = shift || 0; bless($self); return $self; } ### Methods sub xbm { # get the xbm equivalent of the given wbmp image my $self = shift; $self->convert unless $self->{xbm_string}; return $self->{xbm_string}; } sub width { # get the width of the given image my $self = shift; $self->convert unless $self->{xbm_string}; return $self->{width}; } sub height { # get the height of the given image my $self = shift; $self->convert unless $self->{xbm_string}; return $self->{height}; } sub dimension { # get the width of the given image my $self = shift; $self->convert unless $self->{xbm_string}; return $self->{width}."".$self->{height}; } sub convert { # the converter itself, returns 0 if an error occured my $self = shift; my $debug = $self->{config}{debug}; my $wbmp = $self->{wbmp_string}; if (length $wbmp) { my ($data, $rest) = &nextdata($wbmp); $wbmp = $rest; print STDERR "WBMP Type: $data" if $debug >= 1; if ($data != 0) { warn "\nUnsupported WBMP type"; return 0; } print STDERR " -- OK.\n" if $debug >= 1; ($data, $rest) = &nextdata($wbmp); $wbmp = $rest; print STDERR "WBMP FixHeader: $data" if $debug >= 1; if ($data != 0) { warn "\nUnsupported or wrong WBMP type (Extended headers are unsupported.)"; return 0; } print STDERR " -- OK.\n" if $debug >= 1; ($data, $rest) = &nextdata($wbmp); $wbmp = $rest; my $width = $data; ($data, $rest) = &nextdata($wbmp); $wbmp = $rest; my $height = $data; $self->{width} = $width; $self->{height} = $height; my $woctets = ($width >> 3) + (($width % 8)?1:0); my $octetrest = $width%8; $octetrest = ($octetrest==0?8:$octetrest); print STDERR "Image dimension: ${width}x$height ($woctets octets per row)\n" if $debug >= 1; $self->{xbm_string} = ("#define ".$self->{image_name}."_width $width\n". "#define ".$self->{image_name}."_height $height\n". "static char ".$self->{image_name}."_bits[] = {\n "); my $xbmcol = 0; my $col = 0; while (length($wbmp) > 0) { $xbmcol++; $col++; $data = ord(substr($wbmp,0,1)); $wbmp = substr($wbmp,1); $self->{xbm_string} .= sprintf(" 0x%.2x,",&little_big($data)^0xff); if ($xbmcol > 11) { $self->{xbm_string} .= " \n "; $xbmcol = 0; } } $self->{xbm_string} .= " };\n"; return $self->{xbm_string}; } else { return 0; } } ### Subroutines sub little_big { # converts little endian 8bit integers into big # endian ones (and vice versa of course ;-) my $in = shift; my $out = 0; my $i; foreach $i (0..7) { if (($in & (1<<(7-$i))) == (1<<(7-$i))) { $out += (1<<$i) ; #print "|"; } else { #print "-"; } } #print "\n"; return $out; } sub header { # reads one byte of some multibyte integer according to WAE my $char = shift; die "Not very well programmed" if length($char) != 1; my ($value,$cont); $value = (ord($char) & 127);# << 1; $cont = ((ord($char) & 128) == 128)?1:0; return ($value,$cont); } sub nextdata { # returns the next multibyte integer of the given # string and the rest of the string my $string = shift; my $cont = 1; my $value; my $data = 0; while ($cont) { my $char = substr($string,0,1); $string = substr($string,1); ($value,$cont) = &header($char); $data += $value; #print "Value: $value; Cont: $cont\n"; } return ($data, $string) } 1; wApua-0.06.2/wApua/About.pm0000644000175000017500000002356212701574535013422 0ustar abeabepackage wApua::About; # Copyright (C) 2000, 2006, 2009, 2016 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland use strict; # This is the About-Pages object for wApua, a WAP User Agent, mainly # developed for debugging WML pages... use wApua::Helpers; sub new { my $self = {}; shift; my $version = shift; my $cache = shift; my $helpkey = (shift).", ?"; $helpkey .= ", F1" if $helpkey ne "F1"; my @modkeylist = @_; my $LWPversion = $LWP::VERSION; my $URIversion = $URI::VERSION; my $TokeParserVersion = $HTML::TokeParser::VERSION; my $ParserVersion = $HTML::Parser::VERSION; my $TkVersion = $Tk::VERSION; my $date = localtime($^T); my $imgloc = "file://".&findINC('wApua/images/wApua.wbmp'); $self->{about} = <

$version

$version is a web browser for WML (version 1.1 and 1.2) pages. It is primarily designed for debugging WML pages in comparsion to only browsing the WML pages on the web.

+ Key Bindings
+ About wApua and PERL
+ About the name wApua
+ Author of wApua
+ Copyright -eh- left
+ Download the latest version
+ Program Environment
+ System Environment
+ Loaded Perl Libraries
+ Cache Contents

$version Key Bindings

General Key Bindings

EOF my $helpwml = "\n\n"; $helpwml .= < EOF my $commandwml = ""; foreach my $modkey (@modkeylist) { $commandwml .= "[$modkey".'-$1]'; } $commandwml =~ s/\]\[/, /g; $commandwml =~ s/[][]//g; $commandwml = '"'.$commandwml.'"'; $helpwml =~ s/\[%-([^][]*)\]/eval($commandwml)/egs; $self->{about} .= $helpwml; $self->{about} .= "\n" unless ($^O eq "MSWin32" or $^O eq "MacOS"); $self->{about} .= <

Additional Key Bindings for the Location Field

Tab focus next object/window
LeftTab, Shift-Tabfocus previous object/window
j, Return, CursorDown, Control-N scroll one line down
k, Minus, CursorDown, Control-P scroll one line up
PageDown, Space Scroll one page down
PageUp, BackSpace Scroll one page up
$helpkeyOpens this page (about:\#keys)
"; $helpwml .= "Alt-F4, Meta-F4, " unless $^O eq "MacOS"; $helpwml .= "[%-Q]Exit $version
"; $helpwml .= "Again, L2, " unless $^O eq "MSWin32" or $^O eq "MacOS"; $helpwml .= "[%-R]Reload actual page
h, [%-Left], [%-B] Back in history
l, [%-Right], [%-F]Forward in history
[%-H] Go to home page
[%-U] Show source code of actual document
Props, L3Opens the program environment page (about:\#info)
ReturnOpen URL in location field
Control-UClear location field

$version and PERL

$version requires the following PERL modules, which are not included in the $version distribution:
+ LWP::UserAgent (at least libwww-perl Version 5.47)
+ URI
+ HTML::TokeParser

The GUI is implemented in perl/Tk.

The Name of the Game: wApua

The name "wApua" has two meanings:

WAP UA stands for WAP UserAgent, although - at the moment - it\'s just an WML browser fetching pages by HTTP.

Apua is Finnish and means 'Help' and this browser initially was and probably still is nothing else but some help for debugging WML pages on the web...

Copyright -eh- left

Copyright © 2000, 2006, 2009 by Axel Beckert <wapua\@deuxchevaux.org>

This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA.

You can reach the author by snail-mail and e-mail.

Author of $version

Axel Beckert
Mail: Krbergstrasse 20
8049 Zrich, Switzerland
E-Mail: <wapua\@deuxchevaux.org>
WWW: http://abe.home.pages.de/english.html
WAP: http://fsinfo.noone.org/~abe/index.wml

Downloading $version

You can download the actual version of wApua at the wApua Home Page.
WML version http://fsinfo.noone.org/~abe/wApua/index.wml
HTML version http://fsinfo.noone.org/~abe/wApua/index.html

Actual Environment

Program name:$0
Running PERL version:$] ($^X)
Running libwww-perl version:$LWPversion
Running HTML::Parser version:$ParserVersion
Running HTML::TokeParser version:$TokeParserVersion
Running URI version:$URIversion
Running perl/Tk version:$TkVersion
Process id:$$
OS type:$^O
Program start:$date
User id:$< ($>)
Group ids:$( ($))

System Environment

EOF foreach (sort keys %ENV) { $self->{about} .= "\n"; } $self->{about} .= <

Loaded Perl Libraries

$_$ENV{$_}
EOF foreach my $m (sort keys %INC) { $self->{about} .= "\n" unless $m =~ m(^/); } $self->{about} .= <

Cache contents

$m $INC{$m}
EOF foreach my $url (sort $cache->getURLs()) { my $timestring = ($cache->getLastModified($url) ? localtime($cache->getLastModified($url)) : "[Unknown]"); #print STDERR "CACHE($url): ".$cache->getCachedContent($url)."\n"; my $sizestring = length($cache->getCachedContent($url)); $self->{about} .= ("". "". "\n"); } $self->{about} .= <

EOF bless($self); return $self; } sub as_string { my $self = shift; return $self->{about}; } 1; wApua-0.06.2/CHANGES0000644000175000017500000001336512701571635011726 0ustar abeabe---------------------------------------------------------------------- wApua ChangeLog ---------------------------------------------------------------------- 0.06.1 to 0.06.2: + Fixed deprecation warnings with Perl 5.22 about using literal control characters in variable names. 0.06 to 0.06.1: + Fixed POD errors in wApua and wbmp2xpm + Minor cosmetic changes to unify comments, e-mail addresss and copyright statements + Removed trailing and leading whitespaces + Updated homepage and other URLs to new location 0.05.1 to 0.06: + Slight overhaul over nearly all files + Removed a lot of debug output which was printed anyway, added debug flags -d and --debug. Use -d 1 for previous default behaviour. + wApua now is more pedantic about command line options and shows a short help if called with -h, --help or --usage. Same for wbmp2xbm.pl. + wApua now optionally (see example config) inserts a line break after each link, like the Nokia 6210 does. + Small modifications to Makefile.PL including 'make emacs' support ;-) + Small cosmetic modifications to README and INSTALL + DOCTYPE string parsing now knows more valid variations. + Ability to show loaded perl libraries + Bugfix: "view source" works again + Renaming wbmp2xbm.pl to wbmp2xbm + Clean initialisation of debug flag in wApua::WBMP2XBM + Input sanitizing, --debug and --verbose flag for wbmp2xbm + POD documentation 0.05dev to 0.05.1: + Compatibiliy with newer Tk versions, especially 804.027 and above + Documentation bugfix for how to install it locally + Address change in the license 0.04dev to 0.05dev: + wApua now reads config files on startup and has much more configuration possibilities. For this reason also some default values have changed (Home page, HTTP Accept-Languages header, etc.). + Added a simple authentication dialog. + Added a simple phone URL decoder. + Added a right-click popup menu, which needs no further mouse movement to activate the history back function + Added a stop button. + Added (WBMP based) bitmap navigation buttons. (The old text navigation buttons are still available, just say "TextButtons: true" in your ~/.wApua.rc + If appropriate, the status bar shows number of cards in the actual deck or image dimensions. + Different HTTP Accept headers for images and other files. + wApua now uses the xml_mode feature of HTML::Parser. So since now at least HTML::Parser 3.00 (more precisely 2.99_06 :-) is necessary. + Added again more informations (mostly used module versions) to the internal page "about:#info" + Added the wApua logo to the main "about:#index" page. + The User-Agent header now conatins more information: - wApua version (now with "/" instead of " " as delimiter) - PERL version - libwww-perl version - perl/Tk version - Value of $^O + wApua::UserAgent now is a specialization of LWP::UserAgent + Added the wApua logo in the lower right corner of the browser window. A click on the logo gets you to the wApua home page. + Fixed some minor bugs: - Local images (URLs with file:/) are no more cached. - Fixed compilation problems under PERL versions lesser than 5.006. - Several bugs concerning history and/or forward/back buttons. - Links in tables now set the cursor right. + Improved "busy state". + Improved (re-)initialising of the "do buttons". + History-Back and -Forward functions now ring a bell, if they're invoked (e.g. via key bindings) and a history movement in that direction isn't possible. + Main and history menu now write something into the state line. + Some code clean up/improvements. + MainWindow is coming up much earlier now. + Fixed again some more bugs in key bindings. + Updated a lot in the README file. 0.03dev to 0.04dev: + Changed the name from "wApua.pl" to "wApua". + Added a RAM cache. + Added the internal page "about:#cache", which shows which pages are cached. It is also accessible via menu. + Comfortable installation via MakeMaker + Added a key bindings help page called "about:#keys", which replaced "about:#index" in the menu. + Fixed again some more bugs in key bindings. + Improved WBMP support: - Error messages are shown in the browser if some image file doesn't exist or isn't a supported WBMP file. - The image dimension is shown, when the mouse is over some WBMP image. + Several minor bug fixes: - When loading some WML page with inline WBMPs, now the deck size (shown in the status line) is really the deck size and not the size of the last image loaded, as before. - Entities in labels of do-buttons are no more ignored. - Removed wrong data description in about:#info - The text cursor doesn't appear anymore in the text window. - The cursor in text window now displays the right cursor, also if some link was highlighted in the meantime. It also has now the $textcursor initially instead of $normalcursor. - After hitting enter in the location field, the focus goes back to the text window. + Changed the default size from 420x260 to 420x360 + Improved internal pages "about:#info" and "about:#env" (now using tables) + Some performance improvements + Added an INSTALL file 0.02dev to 0.03dev: + Some minor bugfixes on doctype string parsing and menus + Added WBMP (Type 0) support and an WBMP to XBM converter for command line use + Added timer support + Added "Show source" function. + Fixed some more bugs in key bindings 0.01dev to 0.02dev: + Added proxy support via environment variables + Fixed bug in MS-Windows and MacOS key bindings + Added a README file :-) 0.01dev: + Initial release. # Local Variables: # mode: text # End: wApua-0.06.2/COPYING0000644000175000017500000004313012701570736011760 0ustar abeabe GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02111-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. wApua-0.06.2/INSTALL0000644000175000017500000000543312701570736011762 0ustar abeabe---------------------------------------------------------------------- wApua Installation ---------------------------------------------------------------------- ========================================== Short installation instructions for wApua: ========================================== Install libwww-perl (at least 5.47 or newer should work) and perl/Tk (at least 800.019 or newer should work; version 400.xxx does not work). Get wApua (e.g. at http://fsinfo.noone.org/~abe/wApua/) and do > tar xzf wApua-latest.tar.gz > cd wApua-x.yz Then configure wApua's system wide defaults by editing wApua/Config.pm (you can always configure them in you .wApua.rc, too) and do > perl Makefile.PL > make > su # make install Copy wApua.rc to ~/.wApua.rc and change it according to your preferences. ================================================== More detailed installation instructions for wApua: ================================================== Get libwww-perl (aka LWP, at least version 5.47) from http://www.linpro.no/lwp/ For installing libwww-perl, you'll usually also need the following PERL modules, you'll get them from the shown URLs: - URI (http://www.perl.com/cgi-bin/cpan_mod?module=URI) - HTML::Parser (http://www.perl.com/cgi-bin/cpan_mod?module=HTML::Parser) - MIME::Base64 (http://www.perl.com/cgi-bin/cpan_mod?module=MIME::Base64) - Net::FTP (from libnet, http://www.perl.com/cgi-bin/cpan_mod?module=Net::FTP) Then get perl/Tk 800 (aka pTk, perl/Tk 400 will not work! Version 800.019 should be fine...). You'll get the most actual version at http://www.perl.com/cgi-bin/cpan_mod?module=Tk. Install them all according to their installation instructions. It should be a good idea to install libwww-perl as the last of them. Maybe they're already installed or are available as package of your favourite package manager. Get the latest wApua from http://fsinfo.noone.org/~abe/wApua/ and unpack the tar ball with > tar xzf wApua-latest.tar.gz or, if no GNU tar is available, with > zcat wApua-latest.tar.gz | tar -xf - Then > cd wApua-x.yz where x.yz should be the version number. You may want to configure system wide default settings for wApua by editing wApua/Config.pm now. Then create a 'Makefile' with > perl Makefile.PL and run > make After that, you probably want to make some > su to gain root access and then install wApua by running # make install If you don't have root access and want to install wApua locally, the last four steps should be replaced by something like this: > perl Makefile.PL PREFIX=~ LIB=~/lib > make install [Due to wApua not yet being at CPAN (because of lack of documentation), an installation using the CPAN module is not yet possible.] Hope, you'll find wApua useful. Have fun! Axel. # Local Variables: # mode: text # End: wApua-0.06.2/bin/0000755000175000017500000000000012701574641011473 5ustar abeabewApua-0.06.2/bin/wbmp2xbm0000755000175000017500000000771012701570736013165 0ustar abeabe#!/usr/bin/perl -w my $VERSION = '0.06.1'; my $COPYRIGHT = '(C) 2000, 2006, 2009 by Axel Beckert '; # Copyright (C) 2000, 2006, 2009 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Krbergstrasse 20 # 8049 Zrich, Switzerland use wApua::WBMP2XBM; my $verbose = 0; my $debug = 0; $0 =~ m([^/]+$); my $basename = $&; sub usage { &version(); print <] .wbmp $basename (-h|--help|--usage) $basename (-V|--version) Will generate an X Bitmap file called .xbm EOT } sub version { print "$basename $VERSION $COPYRIGHT\n"; } unless (@ARGV) { &usage(); exit 1; } foreach (@ARGV) { if (/^(-h|--help|--usage)$/) { &usage(); exit 0; } if (/^(-V|--version)$/) { print "$0 $VERSION $COPYRIGHT\n"; exit 0; } if (/^(-v|--verbose)$/) { $verbose = 1; next; } if (/^--debug=(\d+)$/) { $debug = $1; next; } my $wbmpfile = $_; my $filebasename = $_; $filebasename =~ s/\.wbmp$//i; my $xbmfile = $filebasename.".xbm"; open(WBMP, '<', $wbmpfile) or die "Can't open $_ for reading"; my $wbmp = ""; while () { $wbmp .= $_; } my $wbmpObj = new wApua::WBMP2XBM($wbmp,$filebasename,$debug); die "An error occured during conversion" unless $wbmpObj->xbm; print STDERR "Image dimension: ".$wbmpObj->dimension."\n" if $verbose; open(XBM, '>', $xbmfile) or die "Can't write to $xbmfile"; print XBM $wbmpObj->xbm; close XBM; close WBMP; } __END__ =head1 NAME wbmp2xbm - converts WBMP to XBM =head1 SYNOPSIS =over 1 =item wbmp2xbm [-v|--verbose] [--debug=I] F F<...> =item wbmp2xbm (-h|--help|--usage) =item wbmp2xbm (-V|--version) =back =head1 DESCRIPTION wbmp2xbm is a converter from WAP Wireless Bitmaps (WBMP) to X Bitmaps (XBM) written in Perl. It uses the same converting library as the WAP WML browser wApua. wbmp2xbm needs at least one WBMP file as argument and will save it as XBM file with the same basename but a .xbm suffix. =head1 OPTIONS =over 22 =item -h, --help, --usage Shows a summary of options. =item -V, --version Shows the version of wbmp2xbm. =item -d I, --debug=I Sets the level of debug output to I. =back =head1 SEE ALSO L, L, L. The wApua FAQ at L =head1 COPYRIGHT Copyright (C) 2000, 2006, 2009 by Axel Beckert This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. On Debian systems, the complete text of the GNU General Public License can be found in /usr/share/common-licenses/GPL. It also came with wApua in the file F. =head1 AUTHOR wbmp2xbm was written by Axel Beckert wApua-0.06.2/bin/wApua0000755000175000017500000015072612701572644012512 0ustar abeabe#!/usr/bin/perl package wApua; my # splitted line for MakeMaker $VERSION = "0.06.2"; # Copyright (C) 2000, 2006, 2009, 2016 by Axel Beckert # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. # # You can reach the author by snail-mail at the following address: # # Axel Beckert # Kuerbergstrasse 20 # 8049 Zurich, Switzerland use strict; use wApua::UserAgent; use wApua::History; use wApua::Cache; use wApua::WBMP2XBM; use wApua::About; use wApua::Phone; use wApua::Config; use wApua::Helpers; use Tk; use Tk::ROText; use HTML::TokeParser; use URI; use URI::Escape; use URI::Heuristic; use URI::file; ### Initialation my $config = new wApua::Config; my %CONFIG = $config->readConfig; my $debug = $CONFIG{Debug}; $| = $debug; my @co = (-background => $CONFIG{Background}, -foreground => $CONFIG{Foreground}); my @ci = (-background => $CONFIG{WAPBackground}, -foreground => $CONFIG{WAPForeground}); my $cib = $CONFIG{WAPBackground}; my @cl = (-background => $CONFIG{LinkBackground}, -foreground => $CONFIG{LinkForeground}); my @ca = (-background => $CONFIG{HoverBackground}, -foreground => $CONFIG{HoverForeground}); my @ce = (-background => $CONFIG{ErrorBackground}, -foreground => $CONFIG{ErrorForeground}); my $lbw = $CONFIG{LinkBorderWidth}; my $lhbw = $CONFIG{HoverBorderWidth}; my $lbt = $CONFIG{LinkBorderType}; my $lhbt = $CONFIG{HoverBorderType}; my @modkeylist = split(" ",$CONFIG{ModKeys}); my $default_modkey = $CONFIG{DefaultModKey}; my $helpkey = $CONFIG{HelpKey}; my $noKPkeysyms = $CONFIG{NoKPKeySyms}; my $homeurl = $CONFIG{HomeURL}; my @activecolors = (-activeforeground => $CONFIG{ActiveForeground}, -activebackground => $CONFIG{ActiveBackground}); my @menucolors = (@activecolors, @co); my @padding = (-highlightbackground => $CONFIG{Background}, -highlightcolor => $CONFIG{Foreground}, -highlightthickness => 1, -borderwidth => $CONFIG{BorderWidth}); my @buttonpadding = (-padx => 3, -pady => 3, @activecolors, @padding); my @textpadding = (-selectforeground => $CONFIG{ActiveForeground}, -selectbackground => $CONFIG{ActiveBackground}, -selectborderwidth => $CONFIG{ActiveBorderWidth}); my @fieldpadding = (@textpadding, @padding); my $starturl = scalar @ARGV ? $ARGV[0] : $CONFIG{HomeURL}; my ($acturl,$url) = ($starturl,$starturl); my %fontsizes = (-2 => $CONFIG{'FontSize-2'}, -1 => $CONFIG{'FontSize-1'}, 0 => $CONFIG{'FontSize0'}, 1 => $CONFIG{'FontSize+1'}, 2 => $CONFIG{'FontSize+2'}); my $fontfamily = $CONFIG{FontFamily}; my $ttfontfamily = $CONFIG{TTFontFamily}; my $softbuttonfont = $CONFIG{SoftButtonFont}; my $textcursor = $CONFIG{TextCursor}; my $waitcursor = $CONFIG{WaitCursor}; my $normalcursor = $CONFIG{NormalCursor}; my $linkcursor = $CONFIG{LinkCursor}; my $textbuttons = $CONFIG{TextButtons}; my $version = "wApua $VERSION"; my $uaversion = "wApua/$VERSION"; my %state=(); my $card; my $cardcounter = 0; my $content; my $wait = 0; my $stop = 0; my $source = ""; my $timer_url = 0; my $timer_info = ""; my $timer_id = 0; # Tk window my $window = MainWindow->new(@co, -takefocus => 0, -width => 420, -height => 360, -borderwidth => 2, -relief => "flat", -title => "$version - A WAP User Agent") ; $window->packPropagate(0); $window->update; # LWP UserAgent configuration partly moved to my $wapua = new wApua::UserAgent($uaversion); $wapua->timeout($CONFIG{TimeOut}); my %HTTP_Headers; my %HTTP_Image_Headers; foreach my $key (keys %CONFIG) { if ($key =~ /^HTTP_/) { $HTTP_Headers{$'} = $CONFIG{$key} unless $key eq "HTTP_Accept_Image"; $HTTP_Image_Headers{$'} = $CONFIG{$key} unless $key =~ /^HTTP_Accept(_Image)?$/; $HTTP_Image_Headers{Accept} = $CONFIG{$key} if $key eq "HTTP_Accept_Image"; } } my $wapua_headers = new HTTP::Headers %HTTP_Headers; my $wapua_image_headers = new HTTP::Headers %HTTP_Image_Headers; # Generate font names my ($fsize,$bold,$uline,$fname,$ttname); foreach $fsize (keys %fontsizes) { foreach $bold ("bold", "normal") { $fname = "font=$fsize=$bold"; $ttname = "tt=$fsize=$bold"; $window->fontCreate($fname, -family => $fontfamily, -weight => $bold, -size => $fontsizes{$fsize}); $window->fontCreate($ttname, -family => $ttfontfamily, -weight => $bold, -size => $fontsizes{$fsize}); } } $window->fontCreate("error-normal", -family => $fontfamily, -weight => "normal", -size => $fontsizes{0}); $window->fontCreate("error-bold", -family => $fontfamily, -weight => "bold", -size => $fontsizes{0}); $window->fontCreate("error-small", -family => $fontfamily, -weight => "bold", -size => $fontsizes{-1}); # Navigation bar my $navbar = $window->Frame(@co, -borderwidth => 0, -takefocus => 0); my $locbar = $window->Frame(@co, -borderwidth => 0, -takefocus => 0); $navbar->pack(-side => "top", -fill => "x", -padx => 2, -pady => 2); $locbar->pack(-side => "top", -fill => "x", -padx => 2, -pady => 2); # Buttons of the navigation bar my ($backbutton, $backxbm); unless ($textbuttons) { # Find the back button image open(WBMP,&findINC("$CONFIG{ButtonDirectory}/$CONFIG{BackButton}")) or warn "Can't find $CONFIG{ButtonDirectory}/$CONFIG{BackButton} in \@INC"; my $wbmp = ""; while () { $wbmp .= $_; } close(WBMP); $backxbm = new wApua::WBMP2XBM($wbmp); } if ((!$textbuttons) && $backxbm->xbm) { my $backImage = $navbar->Bitmap('back', @co, -data => $backxbm->xbm, -maskdata => $backxbm->xbm); $backbutton = $navbar->Button(-image => $backImage, -width => 19, -command => \&back, @buttonpadding, @co); } else { $backbutton = $navbar->Button(-text => ' Back', @co, @buttonpadding, -command => \&back); } $backbutton->pack(-side => 'left', -fill => "y"); $backbutton->bind('' => \&blankState); $backbutton->bind('' => \&backState); my ($reloadbutton, $reloadxbm); unless ($textbuttons) { # Find the reload button image open(WBMP,&findINC("$CONFIG{ButtonDirectory}/$CONFIG{ReloadButton}")) or warn "Can't find $CONFIG{ButtonDirectory}/$CONFIG{ReloadButton} in \@INC"; my $wbmp = ""; while () { $wbmp .= $_; } close(WBMP); $reloadxbm = new wApua::WBMP2XBM($wbmp); } if ((!$textbuttons) && $reloadxbm->xbm) { my $reloadImage = $navbar->Bitmap('reload', @co, -data => $reloadxbm->xbm, -maskdata => $reloadxbm->xbm); $reloadbutton = $navbar->Button(-image => $reloadImage, -width => 19, -command => \&reload, @buttonpadding, @co); } else { $reloadbutton = $navbar->Button(-text => 'Reload', @co, @buttonpadding, -command => \&reload); } $reloadbutton->pack(-side => 'left', -fill => "y"); $reloadbutton->bind('' => \&blankState); $reloadbutton->bind('' => \&reloadState); my ($forwardbutton, $forwardxbm); unless ($textbuttons) { # Find the forward button image open(WBMP,&findINC("$CONFIG{ButtonDirectory}/$CONFIG{ForwardButton}")) or warn "Can't find $CONFIG{ButtonDirectory}/$CONFIG{ForwardButton} in \@INC"; my $wbmp = ""; while () { $wbmp .= $_; } close(WBMP); $forwardxbm = new wApua::WBMP2XBM($wbmp); } if ((!$textbuttons) && $forwardxbm->xbm) { my $forwardImage = $navbar->Bitmap('forward', @co, -data => $forwardxbm->xbm, -maskdata => $forwardxbm->xbm); $forwardbutton = $navbar->Button(-image => $forwardImage, -width => 19, -command => \&forward, @buttonpadding, @co); } else { $forwardbutton = $navbar->Button(-text => 'Forward ', @co, @buttonpadding, -command => \&forward); } $forwardbutton->pack(-side => 'left', -fill => "y"); $forwardbutton->bind('' => \&blankState); $forwardbutton->bind('' => \&forwardState); my ($stopbutton, $stopxbm); unless ($textbuttons) { # Find the stop button image open(WBMP,&findINC("$CONFIG{ButtonDirectory}/$CONFIG{StopButton}")) or warn "Can't find $CONFIG{ButtonDirectory}/$CONFIG{StopButton} in \@INC"; my $wbmp = ""; while () { $wbmp .= $_; } close(WBMP); $stopxbm = new wApua::WBMP2XBM($wbmp); } if ((!$textbuttons) && ($stopxbm->xbm)) { my $stopImage = $navbar->Bitmap('stop', @co, -data => $stopxbm->xbm, -maskdata => $stopxbm->xbm); $stopbutton = $navbar->Button(-image => $stopImage, -width => 19, -command => \&stop, @buttonpadding, @co); } else { $stopbutton = $navbar->Button(-text => 'Stop', @co, @buttonpadding, -command => \&stop ); } $stopbutton->pack(-side => 'left', -fill => "y"); $stopbutton->bind('' => \&blankState); $stopbutton->bind('' => sub { &textState("Interrupt current transfer!") if $stopbutton->cget(-state) eq "normal"; }); sub stop { $stop = 1; } sub stopfree { $stopbutton->configure(-state => 'normal'); $stopbutton->update; $stop = 0; } sub stopclosed { $stopbutton->configure(-state => 'disabled'); $stopbutton->update; $stop = 0; } my ($homebutton, $homexbm); unless ($textbuttons) { # Find the home button image open(WBMP,&findINC("$CONFIG{ButtonDirectory}/$CONFIG{HomeButton}")) or warn "Can't find $CONFIG{ButtonDirectory}/$CONFIG{HomeButton} in \@INC"; my $wbmp = ""; while () { $wbmp .= $_; } close(WBMP); $homexbm = new wApua::WBMP2XBM($wbmp); } if ((!$textbuttons) && $homexbm->xbm) { my $homeImage = $navbar->Bitmap('home', @co, -data => $homexbm->xbm, -maskdata => $homexbm->xbm); $homebutton = $navbar->Button(-image => $homeImage, -width => 19, -command => \&home, @co, @buttonpadding); } else { $homebutton = $navbar->Button(-text => 'Home', @co, @buttonpadding, -command => \&home); } $homebutton->pack(-side => 'left', -fill => "y"); $homebutton->bind('' => \&blankState); $homebutton->bind('' => sub { &textState("Go home ($homeurl)"); }); my $exitbutton = $navbar->Button(-text => 'Quit', @co, @buttonpadding, -command => sub { exit; }); $exitbutton->pack(-side => 'right', -fill => "y"); $exitbutton->bind('' => \&blankState); $exitbutton->bind('' => sub { &textState("Quit $version"); }); my $aboutbutton = $navbar->Button(-text => 'About', @co, @buttonpadding, -command => sub { &fetchAddToHistory("about:"); }); $aboutbutton->pack(-side => 'right', -fill => "y"); $aboutbutton->bind('' => \&blankState); $aboutbutton->bind('' => sub { &textState("About $version"); }); $window->update; ### Menu my $menubutton = $locbar->Menubutton(-text => "Menu", @buttonpadding, @menucolors); my $menu = $menubutton->menu(-tearoff => 0, @menucolors); $menubutton->pack(-side => 'left'); $menu->command(-label => 'Help', -command => sub { &blankState; &fetchAddToHistory("about:#keys"); }, ($helpkey?(-accelerator => $helpkey):()), @menucolors); $menu->command(-label => 'Show source', -command => sub { &blankState; &showSource($source); }, -accelerator => "$default_modkey-U", @menucolors); $menu->command(-label => 'Cache contents', -command => sub { &blankState; &fetchAddToHistory("about:#cache"); }, @menucolors); $menu->command(-label => 'Quit', -command => sub { exit; }, -accelerator => "$default_modkey-Q", @menucolors); my $hisbutton = $locbar->Menubutton(-text => "History", @buttonpadding, @menucolors); my $hismenu = $hisbutton->menu(-tearoff => 1, @menucolors); $hisbutton->pack(-side => 'left'); my $history = new wApua::History(\&fetchUsingCache, \&textState, $forwardbutton, $hismenu, $cib, @menucolors, -font => $softbuttonfont); my $cache = new wApua::Cache($wapua,$wapua_headers); $menu->bind('<>' => sub { my $w = $Tk::event->W; &textState("Get help on keybindings (about:#keys)") if ($w->entrycget('active', -label) eq "Help"); &textState("Show actual contents of the RAM cache (about:#cache)") if ($w->entrycget('active', -label) eq "Cache contents"); &textState("Show source code of $acturl") if ($w->entrycget('active', -label) eq "Show source"); &textState("Quit $version") if ($w->entrycget('active', -label) eq "Quit"); $window->idletasks; }); $locbar->Label(-text => 'URL: ', @co, -takefocus => 0)->pack(-side => 'left'); my $urlfield = $locbar->Entry(-width => 40, @co, @fieldpadding, -exportselection => 1, -highlightthickness => 1, -takefocus => 1, -textvariable => \$url); $urlfield->pack(-side => 'left', -expand => 1, -fill => "x"); $urlfield->bind('' => \&blankState); $urlfield->bind('' => sub { &textState("Insert some text and hit ... ;-)"); }); my $statusline = $window->Frame(-relief => "sunken", -takefocus => 0, -borderwidth => 1, @co); my $status = $statusline->Label(-text => ' ', @co, -takefocus => 0, -width => -1, -font => "font=-1=normal", -relief => "flat", -justify => "left"); my $filesize = $statusline->Label(-text => ' ', @co, -takefocus => 0, -font => "font=-1=normal", -relief => "flat", -justify => "right"); $filesize->pack(-side => 'right', -anchor => "e"); $status->pack(-side => 'left', -anchor => "w"); #$statusline->packPropagate(0); $statusline->pack(-side => 'bottom', -fill => "x", -padx => 2, -pady => 2); ### WAP-Page := Browser + Do-Tag-Button-Leiste my $wappage = $window->Frame(-borderwidth => 1, -takefocus => 0, -relief => "sunken", # ridge, groove, flat, raised, sunken @ci); $wappage->pack(-side => 'bottom', -fill => "both", -padx => 2, -pady => 2, -expand => 1); ### Browser := Textfenster + Scrollbar my $browser = $wappage->Scrolled("ROText", -scrollbars => "osoe"); $browser->ConfigSpecs(-relief => ["SELF"], -takefocus => ["SELF"], -borderwidth => ["SELF"], -background => [("SELF", "CHILDREN")], -foreground => ["SELF"]); $browser->configure(-relief => "flat", -cursor => $textcursor, -takefocus => 0, -borderwidth => "2", -background => $cib); $browser->pack(-side => 'top', -fill => "both", -padx => 4, -padx => 4, -expand => 1); ### Scrollbar my $scrollbar = $browser->Subwidget("xscrollbar"); $scrollbar->configure(-activebackground => $cib, -highlightbackground => $cib, -highlightcolor => $cib, -troughcolor => $cib, -background => $cib, -activerelief => "ridge", -relief => "flat", -width => 3, -borderwidth => 0, -takefocus => 1, -elementborderwidth => 0); ### Textfenster my $scrolled = $browser->Subwidget("scrolled"); $scrolled->configure(@textpadding, -exportselection => 1, -takefocus => 0, -insertofftime => 1, -insertontime => 0, -highlightthickness => 0, -relief => "flat", # ridge, groove, flat, raised, sunken -width => 0, -height => 0, -highlightbackground => $cib, -wrap => "word", -borderwidth => 0, -padx => 0, -padx => 0, @ci); # Place, where the do buttons and the wApua logo reside my $dobar = $wappage->Frame(-borderwidth => 1, -takefocus => 0, -relief => "flat", @ci); $dobar->pack(-side => 'bottom', -fill => "x", -padx => 0, -pady => 0); # Find the wApua Logo open(WAPUAWBMP,&findINC("$CONFIG{ButtonDirectory}/$CONFIG{LogoButton}")) or warn "Can't find $CONFIG{ButtonDirectory}/$CONFIG{LogoButton} in \@INC"; my $wapuawbmp = ""; while () { $wapuawbmp .= $_; } close(WAPUAWBMP); my ($wapualabel, $wapuaimage); my $wapuaxbm = new wApua::WBMP2XBM($wapuawbmp); if ($wapuaxbm->xbm) { $wapuaimage = $dobar->Bitmap('wApua', @cl, -data => $wapuaxbm->xbm, -maskdata => $wapuaxbm->xbm); $wapualabel = $dobar->Label(-image => $wapuaimage, @cl); $wapualabel->bind('<1>' => sub { &fetchAddToHistory($CONFIG{LogoURL});}); $wapualabel->pack(-side => 'right', -padx => 4, -pady => 0); $wapualabel->bind('' => \&blankState); $wapualabel->bind('' => sub { &textState("$version (PERL $], pTk $Tk::VERSION, lwp $LWP::VERSION)");}); } $window->update; ### Do-Tag-Button-Leiste my $dotags; sub dotagsInitialize { $dotags=$dobar->Frame(-borderwidth => 1, -takefocus => 0, -relief => "flat", @ci); $dotags->pack(-side => 'left', -fill => "x", -padx => 4, -pady => 4, (defined($wapualabel) ? (-before => $wapualabel) : ())); } &dotagsInitialize; # Generate Browser Font Tags sub generateFontTags { foreach $fsize (keys %fontsizes) { foreach $bold ("bold", "normal") { $fname = "font=$fsize=$bold"; foreach $uline ("ul", "nl") { my $ul = ($uline eq "ul"?1:0); $browser->tag("configure" => "$fname=$uline=none", -font => $fname, @ci, -underline => $ul); $browser->tag("configure" => "$fname=$uline=link", -font => $fname, @cl, -borderwidth => $CONFIG{LinkBorderWidth},, -relief => $CONFIG{LinkBorderType}, -underline => $ul); $browser->tag("configure" => "$fname=$uline=active", -font => $fname, @ca, -underline => $ul); } } } $browser->tag("configure" => "error-normal", -font => "error-normal", @ce, -underline => 0); $browser->tag("configure" => "error-bold", -font => "error-bold", @ce, -underline => 0); $browser->tag("configure" => "error-small", -font => "error-small", @ce, -underline => 0); } &generateFontTags; sub blankState { $status->configure(-text => ''); } sub textState { $status->configure(-text => uri_unescape(shift)); } sub sizeState { $filesize->configure(-text => shift); } sub backState { my $text = $history->last; $status->configure(-text => "Go back ($text) in history") if $text; } sub reloadState { $status->configure(-text => "Reload the current document ($acturl)"); } sub forwardState { my $text = $history->next; $status->configure(-text => "Go forward ($text) in history") if $text; } sub scrolldown { $scrolled->yview(scroll => 1, "units"); } sub scrollup { $scrolled->yview(scroll => -1, "units"); } sub pagedown { $scrolled->yview(scroll => 1, "pages"); } sub pageup { $scrolled->yview(scroll => -1, "pages"); } ### Key Bindings my $modkey; $window->bind('all','','focusNext'); $window->bind('all','<>','focusPrev'); $window->bind('all','','focusPrev'); # vi $window->bind('all',"" => \&scrolldown); $window->bind('all',"" => \&scrollup); $window->bind('all',"" => \&back); $window->bind('all',"" => \&forward); # Netscape $window->bind('all',"" => \&pagedown); $window->bind('all',"" => \&pageup); $window->bind('all',"" => \&scrolldown); $window->bind('all',"" => \&scrollup); # Emacs / Netscape unless ($noKPkeysyms) { $window->bind('all',"" => \&pagedown); $window->bind('all',"" => \&pageup); $window->bind('all',"" => \&scrolldown); $window->bind('all',"" => \&scrollup); } $window->bind('all',"" => \&pagedown); $window->bind('all',"" => \&pageup); $window->bind('all',"" => \&scrolldown); $window->bind('all',"" => \&scrollup); $window->bind('all',"" => \&scrolldown); $window->bind('all',"" => \&scrollup); $window->bind('all',"" => sub { &fetchAddToHistory("about:#keys"); }); $window->bind('all',"?" => sub { &fetchAddToHistory("about:#keys"); }); # Sun key bindings. (I'm developing on a Ultra 10 :-) unless ($^O eq "MSWin32" or $^O eq "MacOS") { $window->bind('all',"" => \&reload); $window->bind('all',"<$helpkey>" => sub { &fetchAddToHistory("about:#keys"); }); $window->bind('all',"" => sub { &fetchAddToHistory("about:#info"); }); $window->bind('all',"" => sub { &fetchAddToHistory("about:#info"); }); } unless ($^O eq "MacOS") { $window->bind('all',"" => sub { exit; }); $window->bind('all',"" => sub { exit; }); } foreach $modkey (@modkeylist) { # Emacs / Netscape $window->bind('all',"<$modkey-Left>" => \&back); $window->bind('all',"<$modkey-Right>" => \&forward); $window->bind('all',"<$modkey-b>" => \&back); $window->bind('all',"<$modkey-f>" => \&forward); unless ($noKPkeysyms) { $window->bind('all',"<$modkey-KP_Left>" => \&back); $window->bind('all',"<$modkey-KP_Right>" => \&forward); } $window->bind('all',"<$modkey-q>" => sub { exit; }); $window->bind('all',"<$modkey-r>" => \&reload); $window->bind('all',"<$modkey-h>" => \&home); $window->bind('all',"<$modkey-u>" => \&showSource); unless ($modkey eq "Control") { $window->bind('all',"<$modkey-n>" => \&pagedown); $window->bind('all',"<$modkey-p>" => \&pageup); } } # Special bindings for the location field $urlfield->bind('', sub{ &fetchHeuristic($url); $browser->focusForce; } ); $urlfield->bind('', sub{$urlfield->delete(0,"end")}); # Remove some class bindings from the browser's text window foreach (qw(Tab Shift-Tab Return h j k l space BackSpace 3 Return minus)) { $scrolled->bind(ref($scrolled), "", ''); $scrolled->bind($scrolled->toplevel, "", ''); $scrolled->bind($scrolled, "", ''); } $scrolled->bindtags(['all',$scrolled->toplevel,$scrolled,ref($scrolled)]); &noglobalbind($urlfield); ### PopUp-Menu my $popup = $window->Menu(-type => "tearoff", -tearoff => 0, -popover => 'cursor', -font => $softbuttonfont, @menucolors); my $backpopup = $popup->command(-label => '~Back', -command => sub { &blankState; &back; }, -state => ($history->last?"normal":"disabled"), @menucolors); my $fwdpopup = $popup->command(-label => '~Forward', -command => sub { &blankState; &forward; }, -state => ($history->next?"normal":"disabled"), @menucolors); #$popup->separator(@menucolors); $popup->command(-label => '~Reload', -command => sub { &blankState; &reload; }, @menucolors); $popup->command(-label => '~Show source', -command => sub { &blankState; &showSource($source); }, @menucolors); $popup->command(-label => '~Home', -command => sub { &blankState; &home; }, @menucolors); $popup->toplevel->overrideredirect(1); # This is the magic line, which # makes the wm borders go away! # *smile* $popup->bind('<>' => sub { my $w = $Tk::event->W; &backState if ($w->entrycget('active', -label) eq "Back"); &forwardState if ($w->entrycget('active', -label) eq "Forward"); &reloadState if ($w->entrycget('active', -label) eq "Reload"); &textState("Go home ($homeurl)") if ($w->entrycget('active', -label) eq "Home"); &textState("Show source code of $acturl") if ($w->entrycget('active', -label) eq "Show source"); $window->idletasks; }); sub NavPopup { my ($w, $X, $Y) = @_; $popup->Post($X-10,$Y-10); } foreach my $w ($wappage, $scrolled, $wapualabel, $wapuaimage) { $w->bind($w, '', [\&NavPopup, Ev('X'), Ev('Y')] ) if defined $w; } # History function my %backbuttons = (); sub configBack { my $state = shift; $backbutton->configure(-state => $state); $backpopup->configure(-state => $state); foreach (values %backbuttons) { $_->configure(-state => $state); } } sub configForward { my $state = shift; $forwardbutton->configure(-state => $state); $fwdpopup->configure(-state => $state); } sub back { if ($history->last) { &fetchUsingCache($history->back); } else { $backbutton->bell; &configBack("disabled"); } &configForward("normal") if $history->next; } sub forward { if ($history->next) { &fetchUsingCache($history->forward); } else { $backbutton->bell; &configForward("disabled"); } &configBack("normal") if $history->last; } sub reload { &fetchDirect($acturl); } sub home { &fetchAddToHistory($homeurl); } # sub modifyGlobalCursor { # my $cursor = shift; # $window->configure(-cursor => $cursor); # $browser->configure(-cursor => $cursor); # $scrolled->configure(-cursor => $cursor); # $wappage->configure(-cursor => $cursor); # } sub GlobalBusy { foreach my $w ($browser, $wappage, $window) { $w->Busy(-recurse => 0, -cursor => $waitcursor); } $wait = 1; } sub GlobalUnbusy { foreach my $w ($window, $wappage, $browser) { $w->Unbusy; $wait = 0; } } ####################################################### ### Functions for getting and displaying new pages. ### ####################################################### # For command-line use; sub fetchFile { $url = shift; my $newurl = URI::file->new_abs($url); print STDERR "*** fetchFile: $url -> $newurl ***\n" if $debug >= 2; &textState("Resolving relative path $url to $newurl..."); return (-e $url ? &fetchAddToHistory($newurl) : &fetchHeuristic($url)); } # Guessing the right URL sub fetchHeuristic { $url = shift; my $newurl = URI::Heuristic::uf_uristr($url); print STDERR "*** fetchHeuristic: $url -> $newurl ***\n" if $debug >= 2; &textState("Interpolating $url to $newurl..."); return &fetchAddToHistory($newurl); } # Adding URL to history sub fetchAddToHistory { my $newurl = shift; my $fetchurl = &URLtoFetch($newurl); print STDERR "*** fetchAddToHistory: $fetchurl ***\n" if $debug >= 2; $history->push($fetchurl); &configBack("normal"); &configForward("disabled"); &fetchUsingCache($newurl); } # Looking up URL in cache and retrieving it from cache, if applicable sub fetchUsingCache { my $newurl = shift; my $fetchurl = &URLtoFetch($newurl); print STDERR "*** fetchUsingCache: $fetchurl ***\n" if $debug >= 2; &configBack($history->last?"normal":"disabled"); &configForward($history->next?"normal":"disabled"); (!&internalURL($fetchurl) && $cache->inCache($fetchurl) && !$cache->expired($fetchurl) ? &fetchCache($newurl): &fetchDirect($newurl)); } # Fetching URL directly from cache sub fetchCache { my $newurl = shift; my $fetchurl = &URLtoFetch($newurl); print STDERR "*** fetchCache: $fetchurl ***\n" if $debug >= 2; &textState("Getting $fetchurl from RAM cache..."); &sizeState(""); $content = $cache->getCachedContent($fetchurl); print "From Cache: $fetchurl\n" if $debug >= 1; &useFetched($cache->getCachedResponse($fetchurl),$newurl); } # Fetching URL directly without looking it up in the cache sub fetchDirect { my $newurl = shift; my $fetchurl = &URLtoFetch($newurl); print STDERR "*** fetchDirect: $fetchurl ***\n" if $debug >= 2; &textState("Fetching $fetchurl..."); &sizeState(""); $content = ""; # SCNR if ($url =~ m/^about:42$/i) { textState("Don't panic!"); &fetchAddToHistory("http://wap.h2g2.com/"); textState("Don't panic!"); print STDERR "\n\nDon't panic! ;-)\n\n"; return 0; } my $response = 0; # Preserving internal pages and telephone URLs coming in contact # with lwp unless (&internalURL($url) or &telURL($url)) { &stopfree; my $request = new HTTP::Request('GET', $fetchurl, $wapua_headers); print $request->as_string if $debug >= 1; $response = $wapua->request($request,\&reqcallback); print $response->as_string if $debug >= 1; $response->content($content); } &useFetched($response,$url); } # Calculating the URL to fetch and updating title and location field. sub URLtoFetch { my $fetchurl = URI->new_abs(shift,$acturl)->as_string; print STDERR "*** URLtoFetch: $fetchurl ***\n" if $debug >= 2; $url = $fetchurl; $window->configure(-title => "$version: $fetchurl"); return &URLtoFetchNoURLfield($fetchurl); } sub URLtoFetchNoURLfield { my $fetchurl = URI->new_abs(shift,$acturl)->as_string; print STDERR "*** URLtoFetchNoURLfield: $fetchurl ***\n" if $debug >= 2; #&modifyGlobalCursor($waitcursor); &GlobalBusy; #$wait = 1; # Needs 3 to 10 seconds after cache access!!! Very strange... #$window->update; $fetchurl =~ s/\#.*$//; return $fetchurl; } # Doing something with the fetched document sub useFetched { # First parameter is response object my $response = shift; # Second parameter is relative URL $url = shift; # Extracting the card id print STDERR "*** useFetched $url...\n" if $debug >= 2; $card = ($url =~ m/\#(.*)$/ ? uri_unescape($1) : ""); $acturl = ($response ? $url = $response->base() : $url); #print STDERR "*** $acturl | $url ***\n"; $history->set($url); # Initializing the do-buttons and other things %backbuttons = (); $dotags->destroy; &dotagsInitialize; $cardcounter = 0; my $imagedimension = 0; if (&internalURL($url)) { &textState("Showing internal page $url..."); $source = new wApua::About($version,$cache,$helpkey, @modkeylist)->as_string; $content = $source; &display(preparser($source)); } elsif (&telURL($url)) { &textState("Showing telephone book: $url..."); $source = new wApua::Phone($url)->as_string; $content = $source; &display(preparser($source)); } elsif ($response->is_success) { $source = $content; my $seite=preparser($content); $cache->addResponse($response) unless (($url =~ m(^file:/)i) or $stop); if ($response->header('Content-Type') eq "text/plain") { $browser->configure(-wrap => "none"); $browser->delete("0.0","end"); $browser->insert("end", $content); # $browser->configure(-cursor => $textcursor); #$wait = 0; } elsif (($response->header('Content-Type') eq "image/vnd.wap.wbmp") or ($url =~ m/\.wbmp$/i)) { $browser->configure(-wrap => "none"); $browser->delete("0.0","end"); $imagedimension = &insertImage($content,$url,$browser); # $browser->configure(-cursor => $textcursor); #$wait = 0; } elsif ($seite !~ m(^\s*(<.*>)?\s*\"]*)[\"\']\s*>\s*<)is) { $browser->configure(-wrap => "none"); $browser->delete("0.0","end"); $browser->insert("end", "No WML page:\n" => "error-bold", $content => ("ttfont=0=normal=nl=none")); $browser->insert("end", "\nError: " => "error-bold", "Transfer interrupted!" => "error-normal") if $stop; # $browser->configure(-cursor => $textcursor); #$wait = 0; } else { $timer_url = 0; $scrolled->afterCancel($timer_id) if ($timer_id != 0); $timer_id = 0; $timer_info = 0; my $xml = $1; my $dtd = $3; warn "Incorrect DTD: $dtd" if $dtd !~ m"http://www\.wapforum\.org/DTD/wml(_.*)?\.xml"; if ($xml =~ /^\s*$/) { warn "Missing XML version tag!"; } elsif ($xml !~ m|<\?xml\sversion=[\"\']\d+\.\d+[\"\'](\s[^<>]*)?\?>|) { warn "Wrong XML version tag: $xml"; } $seite =~ s(^(<.*>)? ?\"]*[\"\']\s*> ?<)(<)is; if ($stop) { $browser->delete("0.0","end"); $browser->configure(-wrap => "none"); $browser->insert("end", "Error: " => "error-bold", "Transfer interrupted!" => "error-normal"); } else { &display($seite); } } } else { # Error! $browser->configure(-wrap => "none"); $browser->delete("0.0","end"); $browser->insert("end", "Error: " => "error-bold", $response->status_line => "error-normal"); &sizeState(""); # $browser->configure(-cursor => $textcursor); #$wait = 0; } $window->{source} = $source; # Write some appropriate string into the right part of the status # line... if ($imagedimension) { &sizeState("$imagedimension WBMP: ".length($source)." Bytes"); } elsif ($cardcounter == 1) { &sizeState("Deck size: ".length($source)." Bytes, 1 Card"); } elsif ($cardcounter) { &sizeState("Deck size: ".length($source)." Bytes, $cardcounter Cards"); } else { &sizeState("Content length: ".length($source)." Bytes"); } # Update left part of status line... &textState("Done."); &textState($timer_info) if $timer_id; &GlobalUnbusy; #$browser->configure(-cursor => $textcursor); &stopclosed; #$window->configure(-cursor => $normalcursor); #$wait = 0; } sub reqcallback { my($data, $response, $protocol) = @_; $content .= $data; #print $response->header('Content-Length')."\n"; if ($response->header('Content-Length')) { my $contleng = $response->header('Content-Length'); &textState("Received ".length($content)." of $contleng Bytes (". int(100*length($content)/$contleng)."%)..."); # Tk::ProgressBar } else { &textState("Received ".length($content)." Bytes..."); } &sizeState("Content length: ".length($content)." Bytes"); die "Transfer interrupted" if $stop; $status->update; $window->idletasks; } sub display { # Content as parameter my $seite = shift; my $foobar; # temporary data my @tagstack = (); my $font = "font=0=normal=nl=none"; my $fontsize; my @fontstack = ($font); my $end = 0; my $link = 0; my $token; my $cardstate=0; my $dostate=0; my $doid=0; my %dobuttons=(); my $doname; my $dolabel; my $anchorstate = 0; my $ul = 0; my %tabledata=(); my $table=0; my $topbrowser=$browser; # clear browser window $browser->configure(-wrap => "word"); $browser->delete("0.0","end"); # initialize parser. my $parser = HTML::TokeParser->new(\$seite); $parser->xml_mode(1); $parser->strict_names(1); $parser->marked_sections(1); while (($token = $parser->get_token) || !$end) { my @tokendata = @{$token}; # Debugging #foreach (@tagstack) { # print "$_ "; #} #print "\n"; if ($tokendata[0] eq "T") { # plain text $tokendata[1] = &transformEntities($tokendata[1]); $browser->insert("end", $tokendata[1], $font) if $cardstate; #print "$font: $tokendata[1]\n" if $cardstate; } elsif ($tokendata[0] eq "S") { push(@tagstack,$tokendata[1]); if ($tokendata[1] eq "br") { # line break $browser->insert("end", "\n", $font) if $cardstate; } elsif ($tokendata[1] eq "p") { # paragraph start $browser->insert("end", "\n", $font) if $cardstate; } elsif ($tokendata[1] eq "card") { # card begin $cardcounter++; my $id = $ {$tokendata[2]}{"id"}; if ($card eq "") { $card = "$id"; $cardstate = 1; } else { $cardstate = 1 if $card eq $id; } if ($cardstate) { $acturl =~ s/\#.*$//; $history->set($url=$acturl .= "#$card"); my $title = ""; if (defined $ {$tokendata[2]}{"title"}) { $title = $ {$tokendata[2]}{"title"}; #print "$id -> $title\n"; $window->configure(-title => "$version: $title"); $history->settitle($title); } if (defined $ {$tokendata[2]}{"ontimer"}) { $timer_url = $ {$tokendata[2]}{"ontimer"}; } } #print "wanted: $card, card-id: $id, card-state: $cardstate\n"; } elsif ($tokendata[1] eq "do") { # do start $dostate=1; $doname = (defined($ {$tokendata[2]}{"name"}) ? $ {$tokendata[2]}{"name"} : $doid++); $dolabel = &transformEntities($ {$tokendata[2]}{"label"}) if defined $ {$tokendata[2]}{"label"}; #print "do: name: $doname, label: $dolabel\n"; } elsif ($tokendata[1] eq "template") { # template start $cardstate=2; } elsif ($tokendata[1] eq "go") { # paragraph start &linktype($tokendata[1], $ {$tokendata[2]}{"href"}, $font, $cardstate, $dostate, $anchorstate, \%dobuttons, $doname, $dolabel); } elsif ($tokendata[1] eq "noop") { # no operation if ($dostate && ($cardstate == 1)) { $dobuttons{$doname}->destroy if defined $dobuttons{$doname}; delete $backbuttons{$doname}; #print "Deleting $doname\n"; } if ($anchorstate && $cardstate) { my $localfont = $font; $browser->tag('bind', $localfont, '' => ''); $browser->tag('bind', $localfont, '<1>' => ''); } } elsif ($tokendata[1] =~ m%^(prev|refresh)$%) { # back & reload &linktype($tokendata[1], 0, $font, $cardstate, $dostate, $anchorstate, \%dobuttons, $doname, $dolabel); } elsif ($tokendata[1] =~ m/^(b|strong)$/) { # bold, strong emph. #print "tag <$tokendata[1]>: switch from $font to "; push(@fontstack,$font); $font =~ s/^([^=]+)=([^=]+)=([^=]+)=([^=]+)=([^=]+)$/$1=$2=bold=$4=$5/; #print "$font.\n"; } elsif ($tokendata[1] eq "pre") { # tt #print "tag <$tokendata[1]>: switch from $font to "; push(@fontstack,$font); $font =~ s/^([^=]+)=([^=]+)=([^=]+)=([^=]+)=([^=]+)$/ttfont=$2=$3=$4=$5/; #print "$font.\n"; } elsif ($tokendata[1] eq "table") { # tables my $columns = (defined($ {$tokendata[2]}{"columns"}) ? $ {$tokendata[2]}{"columns"} : 0); if ($cardstate) { $table++; $tabledata{$table}{widget} = $scrolled->Frame(-takefocus => 0, -highlightthickness => 0, -relief => "flat", # raised -highlightbackground => $cib, @ci, -borderwidth => 1); $tabledata{$table}{row} = -1; $tabledata{$table}{col} = -1; $scrolled->window('create', "end", -window => $tabledata{$table}{widget}, -align => "baseline"); } } elsif ($tokendata[1] eq "tr") { # table rows if ($cardstate) { $tabledata{$table}{col} = -1; $tabledata{$table}{row}++; } } elsif ($tokendata[1] eq "td") { # table data if ($cardstate) { $tabledata{$table}{col}++; #print STDERR "$tabledata{$table}{row} $tabledata{$table}{col}\n"; $browser = $tabledata{$table}{widget}-> ROText(@textpadding, -exportselection => 1, -takefocus => 0, -highlightthickness => 0, -relief => "flat", # sunken -highlightbackground => $cib, -wrap => "word", -borderwidth => 0, -insertofftime => 1, -insertontime => 0, -width => 0, -height => 2, -padx => 2, -pady => 0, @ci); &generateFontTags; $browser->grid(-row => $tabledata{$table}{row}, -column => $tabledata{$table}{col}, -sticky => "nsew"); } } elsif ($tokendata[1] eq "big") { # big #print "tag <$tokendata[1]>: switch from $font to "; push(@fontstack,$font); $fontsize = (scalar grep(($_ eq "big"),@tagstack)) ? 2 : 1; $font =~ s/^([^=]+)=([^=]+)=([^=]+)=([^=]+)=([^=]+)$/$1=$fontsize=$3=$4=$5/; #print "$font.\n"; } elsif ($tokendata[1] eq "u") { # underline #print "tag <$tokendata[1]>: switch from $font to "; push(@fontstack,$font); $font =~ s/^([^=]+)=([^=]+)=([^=]+)=([^=]+)=([^=]+)$/$1=$2=$3=ul=$5/; #print "$font.\n"; } elsif ($tokendata[1] eq "small") { # big #print "tag <$tokendata[1]>: switch from $font to "; push(@fontstack,$font); $fontsize = (scalar grep(($_ eq "small"),@tagstack)) ? -2 : -1; $font =~ s/^([^=]+)=([^=]+)=([^=]+)=([^=]+)=([^=]+)$/$1=$fontsize=$3=$4=$5/; #print "$font.\n"; } elsif ($tokendata[1] eq "anchor") { # link $link++; push(@fontstack,$font); $font =~ s/^([^=]+)=([^=]+)=([^=]+)=([^=]+)=([^=]+)$/$1=$2=$3=$4=link$link/; #print "$localfont/$foobar.\n"; $anchorstate = 1; } elsif ($tokendata[1] eq "timer") { # timer if ($cardstate and $timer_url) { my $value = $ {$tokendata[2]}{"value"}; my $time = $value/10; $timer_info = "Timer redirect in ".($value/10)."sec to ". URI->new_abs($timer_url, $acturl)->as_string; $timer_id = $scrolled->after($value*100,\&timer); } } elsif ($tokendata[1] eq "img") { # image if ($cardstate) { &insertImageURL($ {$tokendata[2]}{"src"},$browser); } } elsif ($tokendata[1] eq "a") { # link $link++; #print "tag <$tokendata[1] href='$linkurl'>: switch from $font to "; push(@fontstack,$font); $font =~ s/^([^=]+)=([^=]+)=([^=]+)=([^=]+)=([^=]+)$/$1=$2=$3=$4=link$link/; &linktype("go", $ {$tokendata[2]}{"href"}, $font, $cardstate, 0, 1, 0, 0, 0); } elsif ($tokendata[1] eq "wml") { # deck start # do nothing } else { # any other start tag &syntaxignore(@tokendata); } } elsif ($tokendata[0] eq "E") { $foobar = pop(@tagstack); if ($foobar eq $tokendata[1]) { if ($tokendata[1] eq "p") { # paragraph end $browser->insert("end", "\n", $font) if $cardstate; } elsif ($tokendata[1] =~ m/^(b|pre|strong|big|small|u)$/) { # font modifiers #print "tag : switch from $font to "; $font = pop(@fontstack); #print "$font.\n"; } elsif ($tokendata[1] eq "a") { # font modifiers #print "tag : switch from $font to "; $font = pop(@fontstack); $browser->insert("end", "\n", $font) if $cardstate && $CONFIG{CarriageReturnAfterLink}; #print "$font.\n"; } elsif ($tokendata[1] eq "anchor") { # font modifiers #print "tag : switch from $font to "; $font = pop(@fontstack); $anchorstate = 0; #print "$font.\n"; } elsif ($tokendata[1] =~ /^(card|template)$/) { # card and template end $cardstate = 0; } elsif ($tokendata[1] eq "do") { # do end undef $doname; undef $dolabel; $dostate = 0; } elsif ($tokendata[1] eq "template") { # template end $cardstate = 0; } elsif ($tokendata[1] eq "table") { # table end if ($cardstate) { $browser = $topbrowser; $browser->insert("end", "\n", $font); } } elsif ($tokendata[1] eq "td") { # table cell end if ($cardstate) { my $endline = $browser->index("end"); $endline =~ s/\..*$//; my $i = 0; my $max = 0; while ($i++ < $endline) { my $l = length($browser->get("$i.0","$i.0 lineend")); $max = $l if $l > $max; } $browser->configure(-width => $max, -height => $endline -1); $browser = $topbrowser; } } elsif ($tokendata[1] eq "tr") { # table row end $browser = $topbrowser if $cardstate; } elsif ($tokendata[1] eq "wml") { # deck end $end = 1; foreach (@tagstack) { warn "Closing tag not found: "; } } elsif ($tokendata[1] =~ /^(br|prev|noop|refresh|img|go)$/) { # do nothing } else { &syntaxignore("/$tokendata[1]"); } } else { &syntaxwarn($foobar,$tokendata[1]); } } } # $browser->configure(-cursor => $textcursor); } sub insertImageURL { $content = ""; my $imgurl = &URLtoFetchNoURLfield(shift); print STDERR "*** insertImageURL: $imgurl ***\n" if $debug >= 2; my $browser = shift; if ($cache->inCache($imgurl) && !$cache->expired($imgurl)) { &insertImage($cache->getCachedContent($imgurl),$imgurl,$browser); print STDERR "IMAGE from cache: $imgurl\n" if $debug >= 1; } else { &stopfree; my $request = new HTTP::Request('GET', $imgurl, $wapua_image_headers); print STDERR "IMAGE: ".$request->as_string if $debug >= 1; my $response = $wapua->request($request,\&reqcallback); print STDERR "IMAGE: ".$response->as_string if $debug >= 1; $response->content($content); if ($response->is_error) { $browser->insert("end", ("[Image $imgurl: ". $response->status_line."]"), "error-small"); return 0; } else { $cache->addResponse($response) unless (($imgurl =~ m(^file:/)i) or $stop); return &insertImage($content,$imgurl,$browser); } &stopclosed; } } sub insertImage { my $wbmp = new wApua::WBMP2XBM(shift); my $imgurl = shift; # $browser->insert("end", # "[$tokendata[1] " . $wbmp->dimension . # "]", # $font); my $browser = shift; my $imglabel; if ($wbmp->xbm) { my $tkimage= $browser->Bitmap($imgurl, @ci, -data => $wbmp->xbm, -maskdata => $wbmp->xbm); $imglabel = $browser->Label(@ci, -image => $tkimage, -padx => 0, -pady => 0, -borderwidth => 0); $browser->window('create', "end", -window => $imglabel, -align => "baseline"); return &imageinfo($imglabel,$wbmp) } else { $browser->insert("end", "[Image $imgurl is of no supported WBMP type.]", "error-small"); return 0; } } sub imageinfo { # Parameter: cardstate, imgname my $imglabel = shift; my $imgdim = shift->dimension; $imglabel->bind('' => sub { &textState("$imgdim WBMP") } ); $imglabel->bind('' => \&blankState); return $imgdim; } sub linktype { # Parameter: tag, href, font, cardstate, dostate, anchorstate my $tag = shift; my $href = shift; my $font = shift; my $cardstate = shift; my $dostate = shift; my $anchorstate = shift; my $dobuttonsadr = shift; my $doname = shift; my $dolabel = shift; if ($dostate && $cardstate) { if ($tag eq "go") { $ {$dobuttonsadr}{$doname} = $dotags->Button(-text => $dolabel, -font => $softbuttonfont, @ci, @buttonpadding, -command => sub{&fetchAddToHistory($href)}); $ {$dobuttonsadr}{$doname}->pack(-side => 'left'); $ {$dobuttonsadr}{$doname}->bind('' => sub { &textState(URI->new_abs($href,$acturl)->as_string);}); } elsif ($tag eq "prev") { $dolabel = " Back" if !defined $dolabel or ($dolabel eq ""); $ {$dobuttonsadr}{$doname} = $dotags->Button(-text => $dolabel, -font => $softbuttonfont, @ci, @buttonpadding, -command => \&back); $ {$dobuttonsadr}{$doname}->bind('' => \&backState); $ {$dobuttonsadr}{$doname}->configure(-state => "disabled") unless $history->last; $backbuttons{$doname} = $ {$dobuttonsadr}{$doname}; } elsif ($tag eq "refresh") { $dolabel = "-Refresh-" if ($dolabel eq "") or !defined $dolabel; $ {$dobuttonsadr}{$doname}=$dotags->Button(-text => $dolabel, -font => $softbuttonfont, @ci, @buttonpadding, -command => \&reload); $ {$dobuttonsadr}{$doname}->bind('' => \&reloadState); } $ {$dobuttonsadr}{$doname}->bind('' => \&blankState);; $ {$dobuttonsadr}{$doname}->pack(-side => 'left'); } elsif ($anchorstate && $cardstate) { my $localfont = $font; my $foobar = $font; $foobar =~ s/=[un]l=link\d+$//; $browser->tag('bind', $localfont, '' => sub { my $browser = shift; $browser->tag('configure', $localfont, -font => $foobar, @cl, -borderwidth => $lbw, -relief => $lbt); $browser->configure(-cursor => ($wait ? $waitcursor : $textcursor)); &blankState; }); if ($tag eq "go") { $browser->tag('bind', $localfont, '' => sub { my $browser = shift; $browser->tag('configure', $localfont, -font => $foobar, @ca, -relief => $lhbt, -borderwidth => $lhbw); $browser->configure(-cursor => $linkcursor); &textState(URI->new_abs($href,$acturl)->as_string); }); $browser->tag('bind', $localfont, '<1>' => sub { &fetchAddToHistory($href); }); } elsif ($tag eq "prev") { $browser->tag('bind', $localfont, '' => sub { if ($history->last) { my $browser = shift; $browser->tag('configure', $localfont, -font => $foobar, @ca, -relief => $lhbt, -borderwidth => $lhbw); $browser->configure(-cursor => $linkcursor); &backState; }}); $browser->tag('bind', $localfont, '<1>' => \&back); } elsif ($tag eq "refresh/") { $browser->tag('bind', $localfont, '' => sub { my $browser = shift; $browser->tag('configure', $localfont, -font => $foobar, @ca, -relief => $lhbt, -borderwidth => $lhbw); $browser->configure(-cursor => $linkcursor); &reloadState; }); $browser->tag('bind', $localfont, '<1>' => \&reload); } $browser->tag('configure', $localfont, -font => $foobar, @cl, -relief => $lbt, -borderwidth => $lbw); } } sub timer { $timer_id = 0; &fetchAddToHistory($timer_url); } sub PasswordDialog { my($realm, $host) = @_; my($user, $password); my $dialog = $window->DialogBox(-title => "Protected area: $realm on $host", -buttons => ["OK", "Abort"], -default_button => "OK", @co, @padding); my $label = $dialog->add('Label', -text => "Protected Area: $realm on $host", @co); $label->grid(-row => 1, -column => 1, -sticky => "nsew", -columnspan => 3); my $imglabel = $dialog->add('Label', -bitmap => "warning", @co); $imglabel->grid(-row => 2, -column => 1, -sticky => "nsew", -rowspan => 2); my $userlabel = $dialog->add('Label', -text => "User:", @co); $userlabel->grid(-row => 2, -column => 2, -sticky => "nse"); my $userfield = $dialog->add('Entry', -width => 8, @co, @fieldpadding, -exportselection => 1, -highlightthickness => 1, -takefocus => 1, -textvariable => \$user); $userfield->grid(-row => 2, -column => 3, -sticky => "nsw"); my $pwdlabel = $dialog->add('Label', -text => "Password:", @co); $pwdlabel->grid(-row => 3, -column => 2, -sticky => "nse"); my $pwdfield = $dialog->add('Entry', -width => 8, @co, @fieldpadding, -exportselection => 1, -highlightthickness => 1, -takefocus => 1, -show => '.', -textvariable => \$password); $pwdfield->grid(-row => 3, -column => 3, -sticky => "nsw"); #$dialog->toplevel->overrideredirect(1); $dialog->toplevel->configure(@co, @padding); $userfield->focus; my $button = $dialog->Show; if ($button eq "Abort") { return (undef,undef); } else { return ($user, $password); } } $window->update; &fetchFile($url); &configBack("disabled"); MainLoop; __END__ =head1 NAME wApua - web browser for WAP WML pages =head1 SYNOPSIS =over 1 =item wApua [-f I] [-d I] [I] =item wApua (-h|--help|--usage) =back =head1 DESCRIPTION wApua is a browser for WAP (Wireless Application Protocol) pages written in the Wireless Markup Language (WML). It supports WML 1.1 and 1.2 except forms. It is written in Perl and uses the Perl/Tk library for its GUI and libwww-perl for the network parts. So it supports all transport protocols, libwww-perl (LWP) supports. =head1 OPTIONS =over 25 =item -h, --help, --usage Shows a summary of options. =item -v, --version Shows the version of wApua. =item -d I, --debug=I Sets the level of debug output to I. =back =head1 CONFIGURATION The system-wide default configuration can be changed in wApua::Config Per-user configuration can be done by creating a F<.wApuarc> file on Linux and other UNIX derivatives or clones or a F file on Windows and MacOS 9 in your home directory. See the example configuration F which comes with wApua. =head1 SEE ALSO L, L. The wApua FAQ at L =head1 KNOWN BUGS =over 4 =item Under some not yet exactly known circumstances, fetching a document from the internal cache takes very long. =back =head1 TODO =over 4 =item Supporting WML forms =item Global configuration file =back =head1 COPYRIGHT Copyright (C) 2000, 2006, 2009 by Axel Beckert This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1301, USA. On Debian systems, the complete text of the GNU General Public License can be found in /usr/share/common-licenses/GPL. It also came with wApua in the file F. =head1 AUTHOR wApua was written by Axel Beckert =head1 THANKS Thanks to Jindra Vavruska for many bug reports and suggestions. wApua-0.06.2/META.json0000644000175000017500000000224412701574641012346 0ustar abeabe{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150005", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "wApua", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "HTML::Parser" : "2.99_06", "HTML::TokeParser" : "0", "LWP" : "5.47", "LWP::UserAgent" : "0", "Tk" : "800.000", "Tk::ROText" : "0", "URI" : "1.03", "URI::Escape" : "0", "URI::Heuristic" : "0", "URI::file" : "0" } } }, "release_status" : "stable", "version" : "v0.06.2", "x_serialization_backend" : "JSON::PP version 2.27300" } wApua-0.06.2/wApua.rc0000644000175000017500000000130712701570736012330 0ustar abeabe# wApua Configuration file # # Copy this file to your home directory, rename it into .wApua.rc and # edit it according to your preferences HTTP_Accept_Charset: iso-8859-1; q=1, unicode-1-1; q=0.8 HTTP_Accept_Language: de; q=1.0, en-gb; q=0.9, en; q=0.8, en-us; q=0.7, nl; q=0.2, fr; q=0.1 HomeURL: http://fsinfo.noone.org/~abe/Links/index.wml Debug: No TextButtons: No Foreground: #000000 Background: #FFFFFF WAPForeground: #000000 WAPBackground: #FFFFFF LinkForeground: #FF0000 LinkBackground: #FFFFFF HoverForeground: #FFFFFF HoverBackground: #FF0000 HoverBorderType: flat ActiveForeground: #000000 ActiveBackground: #FF0000 ErrorBackground: #FF0000 ErrorForeground: #FFFFFF CarriageReturnAfterLink: Yes wApua-0.06.2/MANIFEST0000644000175000017500000000101312701574606012050 0ustar abeabebin/wApua bin/wbmp2xbm wApua/About.pm wApua/Phone.pm wApua/Cache.pm wApua/Config.pm wApua/History.pm wApua/Helpers.pm wApua/WBMP2XBM.pm wApua/UserAgent.pm wApua/images/wApua.wbmp wApua/images/home.wbmp wApua/images/back.wbmp wApua/images/forward.wbmp wApua/images/reload.wbmp wApua/images/stop.wbmp COPYING README CHANGES MANIFEST Makefile.PL INSTALL wApua.rc META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) wApua-0.06.2/README0000644000175000017500000000754612701570736011620 0ustar abeabe---------------------------------------------------------------------- wApua README ---------------------------------------------------------------------- wApua is PERL written WAP WML browser based on libwww-perl and perl/Tk. For installation see the file INSTALL. wApua was developed because of frustration about commercial WML browsers (WinWAP et al), that didn't fit my requirements. In addition to that, none of them was able to run under diverse Unices, especially SunOS and Solaris, which we have here on our work-stations. And those online WML to HTML converters are slow and not very useful for debugging WML pages. So on some day in spring 2000 I thought about writing a WML in Tcl/Tk, because some of my colleagues used that for simple-to-write graphical user interfaces. But I haven't seen any Tcl code before, because I wrote most of those simple-to-write things in PERL. Then I discovered Perl/Tk and only a few days later the first usable verison of wApua was ready for debugging http://wap.dagstuhl.de/, which is part of my job :-). I worked with wApua for about three or four months. Then someone asked at the Heise WAP Forum [1] for WAP WML browser for Linux and I set up a little page [2] with some informations and download possiblities and announced it on Freshmeat [3]. It doesn't interpret all WML tags yet (e.g. no forms support yet), but especially it interprets some tags that WinWAP 2.2/2.3 interprets very rudimentary or even wrong, e.g. tables and the tag. Newest additions are configuration via configuration file ~/.wApua.rc, a RAM cache and navigation buttons with images instead of text. There are still new wApua features in my mind, so watch out for new versions, which probably come out in quite irregular intervals, which currently ranged from a few days to five years. ;-) Hmmm, if there ever will be a final version of wApua? ;-) See the source code of wApua/Config.pm for configuration possibilities (colors, fonts, home page, paths, etc.). Every hash-key used there, can also be used in you configuration file ~/.wApua.rc. In addition to that, every key (in the configuration file and Config.pm) beginning with "HTTP_" is treated as HTTP header, which will be added to every request, that wApua makes. (There is one exception: HTTP_Accept_Images is the HTTP Accept header for retrieving images). See the file wApua.rc for examples and an alternative coloring scheme. Starting wApua: + If you start wApua without any options, wApua will start with the home page configured in Config.pm or .wApua.rc. + Starting wApua with "wApua -f " will start wApua and read the configuration from . If you want to suppress the reading of .wApua.rc, start wApua with "wApua -f /dev/null". You may also start wApua with "wApua -f -" and it will read the configuration from STDIN. + Any other command line parameter will be regarded as (more or less) complete URL. If it's the name of an existing file, it will be loaded, otherwise wApua will look up if it's a hostname and after that being unsuccessful it will try to add some "www." in front and some ".com" at the end... (Most heuristics done by URI::Heuristics.) The latest versions and much more information about wApua can be found at the wApua Home Page [2] and at Freshmeat [3]. You may also try http://fsinfo.noone.org/~abe/wApua/index.wml with some WAP browser... :-) You can reach the author of wApua (Axel Beckert, that's me :-) via e-mail at wapua@deuxchevaux.org. Bug reports and suggestions are welcome. Hope, you find it useful. Have fun! Axel. ---------------------------------------------------------------------- References: [1] http://www.heise.de/ix/forum/go.shtml?list=1&g=952686372_61 (German only) [2] http://fsinfo.noone.org/~abe/wApua/ [3] http://freshmeat.net/projects/wapua/ # Local Variables: # mode: text # End:
URLLast modificationSize
$url$timestring$sizestring Bytes