<%message%>
< <%endif%> --- > <%if error%> ><%error%>
> <%else%> 34a35 > <%endif%> 41,44c42,46 < Name: < < Email: < --- > > <%ifnot Username%> >You have been successfully subscribed to our newsletter
< <%endif%> < <%if action eq 'unsubscribe'%> <You have been successfully removed from our newsletter
--- > <%if error%> ><%error%>
> <%else%> > <%if action eq 'subscribe'%> >You have been successfully subscribed to the list.
> <%endif%> > <%if action eq 'unsubscribe'%> >You have been successfully removed from the list.
> <%endif%> Index: cgi/admin/templates/help/help_guide_plugins_install.html =================================================================== RCS file: /usr/local/gossamer/lsqldev/cgi/admin/templates/help/help_guide_plugins_install.html,v retrieving revision 1.1 retrieving revision 1.2 diff -r1.1 -r1.2 66,67c66,68 < Table To do this we will need a GT::SQL::Editor < object. --- > Table to do this we will need a GT::SQL::Editor > object. However, we should first check to make sure the column doesn't > already exist (as they may be upgrading the plugin): 69,72c70,75 <my $editor = $DB->table ('Links');
< unless ($editor->add_col ( 'Review', { type => 'TEXT' }) {
< $Plugins::Pluginname::error = "Unable to add column to Links: $GT::SQL::error";
< return;
---
> unless (exists $DB->table('Links')->cols->{'Review'}) {
> my $editor = $DB->table ('Links');
> unless ($editor->add_col ( 'Review', { type => 'TEXT' }) {
> $Plugins::Pluginname::error = "Unable to add column to Links: $GT::SQL::error";
> return;
> }
Index: cgi/admin/templates/snap/email.html
===================================================================
RCS file: /usr/local/gossamer/lsqldev/cgi/admin/templates/snap/email.html,v
retrieving revision 1.2
retrieving revision 1.4
diff -r1.2 -r1.4
43,44c43,51
< <%if message%>
< <%message%>
---
> <%if error%>
> <%error%>
> <%else%>
> <%if action eq 'subscribe'%>
> You have been successfully subscribed to the list.
> <%endif%>
> <%if action eq 'unsubscribe'%>
> You have been successfully removed from the list.
> <%endif%>
45a53
>
49c57,61
< Name: Email:
---
> <%ifnot Username%>
>
> Name: Email:
> <%endif%>
>
Index: cgi/admin/templates/yahoo/email.html
===================================================================
RCS file: /usr/local/gossamer/lsqldev/cgi/admin/templates/yahoo/email.html,v
retrieving revision 1.2
retrieving revision 1.4
diff -r1.2 -r1.4
47,49c47,55
<
< <%if message%>
< <%message%>
---
> <%if error%>
> <%error%>
> <%else%>
> <%if action eq 'subscribe'%>
> You have been successfully subscribed to the list.
> <%endif%>
> <%if action eq 'unsubscribe'%>
> You have been successfully removed from the list.
> <%endif%>
54c60,64
< Name: Email:
---
> <%ifnot Username%>
>
> Name: Email:
> <%endif%>
>
Index: Base.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Base.pm,v
retrieving revision 1.62
retrieving revision 1.65
diff -r1.62 -r1.65
6c6
< # $Id: Base.pm,v 1.62 2001/02/14 06:57:09 alex Exp $
---
> # $Id: Base.pm,v 1.65 2001/02/28 04:49:09 alex Exp $
24c24
< $VERSION = sprintf "%d.%03d", q$Revision: 1.62 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.65 $ =~ /(\d+)\.(\d+)/;
226c226,227
< defined $level or ($level = 1);
---
> (defined($level) and $level =~ /^\d+$/) or ($level = 1);
>
463c464
< my $stack = stack_track('GT::Base', 1);
---
> my $stack = stack_trace('GT::Base', 1);
515c516
< my ($ls, $fh);
---
> my ($ls, $spc, $fh);
521a523
> $spc = ' ';
525a528
> $spc = ' ';
534,536c537,547
< if ($] > 5.00503) {
< eval { $args = (@DB::args) ? ("with arguments
(" . join (", " => map { defined $_ ? $_ : '' } @DB::args) . ")") : "with no arguments"; };
< if ($@) { $args = "strange arguments: $@"; }
---
> my @args;
> for (@DB::args) {
> eval { my $a = $_ }; # workaround for a reference that doesn't think it's a reference
> my $print = $@ ? \$_ : $_;
> push @args, defined $print ? $print : '[undef]';
> }
> if (@args) {
> my $args = join ", ", @args;
> $args =~ s/\n\s*\n/\n/g;
> $args =~ s/\n/\n$spc$spc$spc$spc/g;
> $out .= qq!$pkg ($$): $sub called at $file line $line with arguments $ls$spc$spc ($args).$ls!;
539c550
< $args = (@DB::args) ? ("with arguments
(" . join (", " => map { defined $_ ? $_ : '' } @DB::args) . ")") : "with no arguments";
---
> $out .= qq!$pkg ($$): $sub called at $file line $line with no arguments.$ls!;
541,543d551
< $args =~ s/\n\s*\n/\n/g;
< $args =~ s/\n/\n\t/g;
< $out .= qq!$pkg ($$): $sub called at $file line $line $args.$ls!;
783c791
< Revision: $Id: Base.pm,v 1.62 2001/02/14 06:57:09 alex Exp $
---
> Revision: $Id: Base.pm,v 1.65 2001/02/28 04:49:09 alex Exp $
Index: CGI.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/CGI.pm,v
retrieving revision 1.48
retrieving revision 1.52
diff -r1.48 -r1.52
6c6
< # $Id: CGI.pm,v 1.48 2001/02/14 06:55:16 alex Exp $
---
> # $Id: CGI.pm,v 1.52 2001/03/02 04:54:23 alex Exp $
20c20
< $FORM_PARSED $POST_MAX $CRLF %PARAMS %COOKIES/;
---
> $INPUT_SEPARATOR $FORM_PARSED $POST_MAX $CRLF %PARAMS %COOKIES/;
24c24
< $VERSION = sprintf "%d.%03d", q$Revision: 1.48 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.52 $ =~ /(\d+)\.(\d+)/;
36a37
> $INPUT_SEPARATOR = chr(35);
135c136
< # with a \0.
---
> # with $INPUT_SEPARATOR.
143c144
< map { $_ => ref $PARAMS{$_}->[0] ? $PARAMS{$_}->[0] : join("\0", @{$PARAMS{$_}}) }
---
> map { $_ => ref $PARAMS{$_}->[0] ? $PARAMS{$_}->[0] : join($INPUT_SEPARATOR, @{$PARAMS{$_}}) }
373,376c374,385
< $toencode =~ s/&/&/g;
< $toencode =~ s//>/g;
< $toencode =~ s/"/"/g;
---
> if (ref($toencode) eq 'SCALAR') {
> $$toencode =~ s/&/&/g;
> $$toencode =~ s/ $$toencode =~ s/>/>/g;
> $$toencode =~ s/"/"/g;
> }
> else {
> $toencode =~ s/&/&/g;
> $toencode =~ s/ $toencode =~ s/>/>/g;
> $toencode =~ s/"/"/g;
> }
468,469c477,486
< for ( split /&/, shift ) {
< /([^=]+)=(.*)/ and push @{$PARAMS{unescape($1)}}, unescape($2)
---
> for ( split /&/, shift ) {
> /([^=]+)=(.*)/ or next;
> my ($key, $val) = (unescape($1), unescape($2));
>
> # Need to remove cr's on windows.
> if ($^O eq 'MSWin32') {
> $key =~ s/\r\n/\n/g;
> $val =~ s/\r\n/\n/g;
> }
> push @{$PARAMS{$key}}, $val;
972c989
< the same key or joined as a string with \0.
---
> the same key or joined as a string with $INPUT_SEPARATOR.
996c1013
< L.
---
> L.
1005c1022
< Revision: $Id: CGI.pm,v 1.48 2001/02/14 06:55:16 alex Exp $
---
> Revision: $Id: CGI.pm,v 1.52 2001/03/02 04:54:23 alex Exp $
Index: Date.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Date.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -r1.33 -r1.34
6c6
< # $Id: Date.pm,v 1.33 2001/02/09 02:38:11 alex Exp $
---
> # $Id: Date.pm,v 1.34 2001/02/28 04:49:27 alex Exp $
54c54
< $VERSION = sprintf "%d.%03d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/;
523c523,526
< die "Can't handle date: $date" if ($count++ > 255);
---
> if ($count++ > 255) {
> warn "GT::Date - can't handle date: $date\n";
> return 0;
> }
718c721
< Revision: $Id: Date.pm,v 1.33 2001/02/09 02:38:11 alex Exp $
---
> Revision: $Id: Date.pm,v 1.34 2001/02/28 04:49:27 alex Exp $
Index: Dumper.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Dumper.pm,v
retrieving revision 1.15
retrieving revision 1.17
diff -r1.15 -r1.17
6c6
< # $Id: Dumper.pm,v 1.15 2001/02/12 22:07:13 jagerman Exp $
---
> # $Id: Dumper.pm,v 1.17 2001/03/01 16:50:16 jagerman Exp $
24c24
< $VERSION = sprintf "%d.%03d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/;
71c71
< return $self;
---
> return $self;
248c248
< $val =~ s/(['\\])/\\$1/g;
---
> $val =~ s/('|\\(?=['\\]|$))/\\$1/g;
301c301
< Revision: $Id: Dumper.pm,v 1.15 2001/02/12 22:07:13 jagerman Exp $
---
> Revision: $Id: Dumper.pm,v 1.17 2001/03/01 16:50:16 jagerman Exp $
Index: HTML.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/HTML.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -r1.7 -r1.8
6c6
< # $Id: HTML.pm,v 1.7 2001/02/11 01:11:24 aki Exp $
---
> # $Id: HTML.pm,v 1.8 2001/02/28 21:17:20 aki Exp $
19d18
< use GT::URI::HTTP;
24c23
< @ISA = qw| GT::Base Exporter |;
---
> @ISA = qw| Exporter GT::Base |;
754c753
< Revision: $Id: HTML.pm,v 1.7 2001/02/11 01:11:24 aki Exp $
---
> Revision: $Id: HTML.pm,v 1.8 2001/02/28 21:17:20 aki Exp $
Index: MD5.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/MD5.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -r1.9 -r1.10
6c6
< # $Id: MD5.pm,v 1.9 2001/01/16 20:33:37 jagerman Exp $
---
> # $Id: MD5.pm,v 1.10 2001/03/01 00:36:44 jagerman Exp $
27c27
< $VERSION = sprintf "%d.%03d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
46a47,48
> use integer;
>
Index: Mail.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Mail.pm,v
retrieving revision 1.26
retrieving revision 1.28
diff -r1.26 -r1.28
6c6
< # $Id: Mail.pm,v 1.26 2001/02/14 01:50:53 sbeck Exp $
---
> # $Id: Mail.pm,v 1.28 2001/02/19 23:43:14 alex Exp $
31c31
< $VERSION = sprintf "%d.%03d", q$Revision: 1.26 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.28 $ =~ /(\d+)\.(\d+)/;
43c43,44
< NOIO => "No input to parse!"
---
> NOIO => "No input to parse!",
> NOEMAIL => "No message head was specified",
180d180
< $self->{mail_attach} ||= [];
275c275
<
---
>
421a422,423
>
> my $attach;
427c429,434
< my $attach = $self->new_part (@_);
---
> elsif (ref $_[0] eq 'GT::Mail::Parts') {
> $attach = $_[0];
> }
> else {
> $attach = $self->new_part (@_);
> }
471c478
< if ((@{$self->{head}->{parts}} > 0) or (@{$self->{mail_attach}} > 0)) {
---
> if (@{$self->{head}->{parts}} > 0) {
492c499
< if (($num_parts == $num) and (@{$self->{mail_attach}} <= 0)) {
---
> if ($num_parts == $num) {
503,509d509
< # If we have email objects to attach, attach them.
< if (@{$self->{mail_attach}} > 0) {
< $self->_build_attach_email ($code);
< $self->debug ("Boundary\n\t--$bound--") if ($self->{_debug});
< $code->($CRLF . '--' . $bound . '--' . $CRLF);
< }
<
511c511
< if ((@{$self->{head}->{parts}} > 0) or (@{$self->{mail_attach}} > 0)) {
---
> if (@{$self->{head}->{parts}} > 0) {
518c518
< return 1;
---
> return $self->{head};
537c537
< if (ref($file) and (ref($file) eq 'GLOB')) {
---
> if (ref($file) and (ref($file) eq 'GLOB') and fileno($file)) {
686,687c686,698
< $self->debug ("Setting multipart boundary to ($bound).") if ($self->{_debug});
< $self->{head}->set ("Content-Type" => qq!multipart/mixed; boundary="$bound"!);
---
>
> # Set the content boundary unless it has already been set
> my $c = $self->{head}->get('Content-Type');
> if ($c) {
> $self->debug(qq|Setting content type to ($c; boundary="$bound")|) if $self->{_debug};
> $self->{head}->set('Content-Type' => $c . qq|; boundary="$bound"|);
> }
> else {
> $self->debug ("Setting multipart boundary to ($bound).") if ($self->{_debug});
> $self->{head}->set ('Content-Type' => qq!multipart/mixed; boundary="$bound"!)
> }
>
>
721,745d731
< sub _build_attach_email {
< # --------------------------------------------------------------------------
< # Private method that handles attaching the rfc/822 emails.
< #
< my ($self, $code) = @_;
< my $num_attach = $#{$self->{mail_attach}};
< my $bound = $self->{head}->multipart_boundary;
< for my $num (0 .. $num_attach) {
< next unless $self->{mail_attach}->[$num];
< $self->debug ("Attaching rfc/822 email with name msg.$num") if ($self->{_debug});
< my $new_part = $self->new_part (
< type => 'message/rfc822',
< encoding => '7bit',
< 'Content-Disposition' => qq!inline; filename="msg.$num"!,
< );
< (my $head = $new_part->header_as_string) =~ s/\015?\012/$CRLF/g;
< $code->($head . $CRLF);
< $self->{mail_attach}->[$num]->build_email ($code) or return;
< if ($num != $num_attach) {
< $self->debug ("Boundary\n\t--$bound") if ($self->{_debug});
< $code->($CRLF . '--' . $bound . $CRLF);
< }
< }
< }
<
782,784c768,779
< $part->set (
< "Content-Type" => qq!multipart/mixed; boundary="$bound"!
< );
---
>
> # Set the content boundary unless it has already been set
> my $c = $part->get('Content-Type');
> if ($c) {
> $self->debug(qq|Setting content type to ($c; boundary="$bound")|) if $self->{_debug};
> $part->set('Content-Type' => $c . qq|; boundary="$bound"|);
> }
> else {
> $self->debug ("Setting multipart boundary to ($bound).") if ($self->{_debug});
> $part->set ('Content-Type' => qq!multipart/mixed; boundary="$bound"!)
> }
>
841,875d835
< sub read {
< # my ($self, $io, $out, $bytes) = @_;
< # Assume it's a filehandle
< if (ref $_[1]) {
< if ($_[3]) {
< return read($_[1], $_[2], $_[3]);
< }
< else {
< $_[2] = <$_[1]>;
< return $_[2];
< }
< }
<
< # The fun part, a string
< else {
< defined($_[1]) and length($_[1]) or return;
< $_[1] =~ tr/\r//d;
< if ($_[3]) {
< $_[2] = substr($_[1], 0, $_[3]);
< substr($_[1], 0, $_[3]) = '';
< return length($_[2]) || undef;
< }
< else {
< if (index($_[1], "\n") == -1 and length($_[1])) {
< $_[2] = $_[1];
< $_[1] = undef;
< return $_[2];
< }
< $_[2] = substr($_[1], 0, index($_[1], "\n") + 1);
< substr($_[1], 0, index($_[1], "\n") + 1) = '';
< return $_[2];
< }
< }
< }
<
1090c1050
< Revision: $Id: Mail.pm,v 1.26 2001/02/14 01:50:53 sbeck Exp $
---
> Revision: $Id: Mail.pm,v 1.28 2001/02/19 23:43:14 alex Exp $
Index: Robot.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Robot.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -r1.11 -r1.12
6c6
< # $Id: Robot.pm,v 1.11 2001/02/12 17:20:01 aki Exp $
---
> # $Id: Robot.pm,v 1.12 2001/02/28 21:18:11 aki Exp $
32c32
< 'hits_interval' => 0,
---
> 'hits_interval' => 1,
67c67,68
< 'log_file' => undef
---
> 'log_file' => undef,
> 'log_format' => '%p %t: %m'
347a349
> $self->debug( "Checking $uri..." ) if ($self->{_debug});
360c362
< $self->_log_message( "Queuing $validated_uri" ) if ( $self->{log_file} );
---
> $self->_log_message( "Queuing $validated_uri" ) if ($self->{log_file});
872a875
> $self->debug( "Checking $uri..." ) if ($self->{_debug});
878c881
< $self->_log_message( "Ignoring $uri as it moves to another host." ) if ( $self->{log_file} );
---
> $self->_log_message( "Ignoring $uri as it moves to another host." ) if ($self->{log_file});
953c956
< my $self = shift;
---
> my $self = shift;
955,956c958,966
< my $file = $self->{log_file};
< print $file "$message\n";
---
> my $file = $self->{log_file};
> my $str = $self->{log_format};
> my %replace = (
> 't' => scalar(localtime()),
> 'p' => $$,
> 'm' => $message
> );
> $str =~ s/\%(.)/$replace{$1}||$1/ge;
> print $file "$str\n";
1117c1127
< Revision: $Id: Robot.pm,v 1.11 2001/02/12 17:20:01 aki Exp $
---
> Revision: $Id: Robot.pm,v 1.12 2001/02/28 21:18:11 aki Exp $
Index: SQL.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/SQL.pm,v
retrieving revision 1.70
retrieving revision 1.71
diff -r1.70 -r1.71
6c6
< # $Id: SQL.pm,v 1.70 2001/02/13 20:19:40 jagerman Exp $
---
> # $Id: SQL.pm,v 1.71 2001/03/01 18:48:26 jagerman Exp $
29c29
< $VERSION = sprintf "%d.%03d", q$Revision: 1.70 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.71 $ =~ /(\d+)\.(\d+)/;
58c58
< 'FKRELATION' => "%s breaks foreign key relation with the %s table.",
---
> 'FKRELATION' => "Column %s breaks foreign key relation with the %s table.",
790c790
< Revision: $Id: SQL.pm,v 1.70 2001/02/13 20:19:40 jagerman Exp $
---
> Revision: $Id: SQL.pm,v 1.71 2001/03/01 18:48:26 jagerman Exp $
Index: Socket.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Socket.pm,v
retrieving revision 1.28
retrieving revision 1.32
diff -r1.28 -r1.32
6c6
< # $Id: Socket.pm,v 1.28 2001/01/24 19:23:52 aki Exp $
---
> # $Id: Socket.pm,v 1.32 2001/03/02 04:07:31 alex Exp $
28c28
< $VERSION = sprintf "%d.%03d", q$Revision: 1.28 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.32 $ =~ /(\d+)\.(\d+)/;
117c117
< my ( $self, $sock, $options );
---
> my ( $self, $options );
120c120
< if (! ref ($self) and (ref ( $self ) ne 'GT::Socket') ) {
---
> if (! ref ($_[0]) and (ref ( $_[0] ) ne 'GT::Socket') ) {
122a123,125
> else {
> $self = shift;
> }
129d131
< shift;
182,191c184,201
< eval {
< local $SIG{ALRM} = sub { $fh = undef; $self->error( 'TIMEOUT', 'WARN', $host ); alarm(0); die 'TIMEOUT' };
< alarm($self->{timeout});
< my $err = connect($fh, $paddr);
< alarm(0) if ($self->{timeout});
< $err or die $self->error( 'TIMEOUT', 'WARN', $host );
< };
< $@ and return undef;
< } else {
< connect($fh, $paddr) or return $self->error( 'TIMEOUT', 'WARN', $host );
---
> {
> local $SIG{__DIE__};
> eval {
> local $SIG{ALRM} = sub { $fh = undef; $self->error( 'TIMEOUT', 'WARN', $host ); alarm(0); die 'TIMEOUT\n' };
> alarm($self->{timeout});
> connect($fh, $paddr) or die 'CONNECT';
> };
> }
> alarm(0) if ($self->{timeout});
> if ($@ and $@ =~ /^TIMEOUT/) {
> return $self->error ('TIMEOUT', 'WARN', $host);
> }
> elsif ($@) {
> return $self->error ('CONNECT', 'WARN', $host);
> }
> }
> else {
> connect($fh, $paddr) or return $self->error( 'CONNECT', 'WARN', $host );
818c828
< Revision: $Id: Socket.pm,v 1.28 2001/01/24 19:23:52 aki Exp $
---
> Revision: $Id: Socket.pm,v 1.32 2001/03/02 04:07:31 alex Exp $
Index: TempFile.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/TempFile.pm,v
retrieving revision 1.18
retrieving revision 1.20
diff -r1.18 -r1.20
6c6
< # $Id: TempFile.pm,v 1.18 2001/02/09 02:26:17 alex Exp $
---
> # $Id: TempFile.pm,v 1.20 2001/03/01 20:51:32 alex Exp $
45c45
< if (-d $dir and -w _) {
---
> if (-d $dir and -w _ and -x _) {
70c70
< if ($filename !~ m#^([a-zA-Z0-9_ '":/\\\.]+)$#) { die "$class: Invalid filename: $filename"; }
---
> ($filename =~ /^(.+)$/) and ($filename = $1); # Detaint.
72d71
< $filename = $1;
154c153
< Revision: $Id: TempFile.pm,v 1.18 2001/02/09 02:26:17 alex Exp $
---
> Revision: $Id: TempFile.pm,v 1.20 2001/03/01 20:51:32 alex Exp $
Index: Template.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Template.pm,v
retrieving revision 1.61
retrieving revision 1.72
diff -r1.61 -r1.72
6c6
< # $Id: Template.pm,v 1.61 2001/02/14 06:24:34 alex Exp $
---
> # $Id: Template.pm,v 1.72 2001/03/01 21:37:08 alex Exp $
20c20
< use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS $TEMPLATE_OBJ $error);
---
> use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS $error);
22c22
< $VERSION = sprintf "%d.%03d", q$Revision: 1.61 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.72 $ =~ /(\d+)\.(\d+)/;
37c37,38
< 'UNKNOWNTAG' => "Unknown Tag: '%s'"
---
> 'COMPILE' => "Error: Unable to compile function: %s. Reason: %s",
> 'UNKNOWNTAG' => "Unknown Tag: '%s'",
49,59c50
< my ($self);
< if (ref $_[0]) {
< $self = shift;
< }
< else {
< $TEMPLATE_OBJ ||= new GT::Template;
< $self = $TEMPLATE_OBJ;
< $self->clear_vars; # Remove existing vars if called as class method.
< shift;
< }
<
---
> my $self = ref $_[0] ? shift : (shift, new GT::Template);
73a65
> $self->{root} = $opt->{root} if (defined $opt->{root});
161a154,155
> $self->{opt}->{package} = exists $opt->{package} ? $opt->{package} : caller(1) || 'main';
>
218d211
<
242a236,246
> elsif ($tag eq 'lastloop') {
> substr($$txt, $last_pos - $tag_len) = '';
> $self->{lastloop} = 1;
> return $print ? 1 : \$return;
> }
> elsif ($tag eq 'nextloop') {
> substr($$txt, $last_pos - $tag_len) = '';
> $self->{nextloop} = 1;
> return $print ? 1 : \$return;
> }
>
268c272,277
< my ($var, $comp, $val) = split(/\s*\b\s*/, $tag, 3);
---
> $tag =~ s/([\:\w]+)\b\s*//;
> my $var = $1;
> my ($comp, $val);
> if (length($tag)) {
> ($comp, $val) = $tag =~ /^(\S+?)\s*(?=(?:[^"']["'])|(?:[^\$]\$)|\b)\s*(.+)$/;
> }
270d278
<
355c363
< my $err = sprintf ($ERRORS->{BADINC}, $errfile, $! ? $! : 'File does not exist');
---
> my $err = $self->{opt}->{escape} ? \sprintf($ERRORS->{BADINC}, $errfile, $! ? $! : 'File does not exist') : sprintf($ERRORS->{BADINC}, $errfile, $! ? $! : 'File does not exist');
430c438,443
< my ($var, $comp, $val) = split(/\s+/, $tag, 3);
---
> $tag =~ s/([\:\w]+)\b\s*//;
> my $var = $1;
> my ($comp, $val);
> if (length($tag)) {
> ($comp, $val) = $tag =~ /^(\S+?)\s*(?=(?:[^"']["'])|(?:[^\$]\$)|\b)\s*(.+)$/;
> }
492,493d504
< my %vars = %{$self->{VARS}};
< local $self->{VARS} = \%vars;
496c507
< my $err = sprintf ($ERRORS->{LOOPNOTHASH}, $next);
---
> my $err = $self->{opt}->{escape} ? \sprintf ($ERRORS->{LOOPNOTHASH}, $next) : sprintf ($ERRORS->{LOOPNOTHASH}, $next);
508c519,527
< $print ? $self->_parse_tags($loop_tpl) : ($return .= ${$self->_parse_tags($loop_tpl)});
---
> $print ? $self->_parse_tags(\$loop_tpl) : ($return .= ${$self->_parse_tags($loop_tpl)});
> if ($self->{lastloop}) {
> $self->{lastloop} = 0;
> last;
> }
> elsif ($self->{nextloop}) {
> $self->{nextloop} = 0;
> next;
> }
520c539
< $print ? $self->_parse_tags($loop_tpl) : ($return .= ${$self->_parse_tags($loop_tpl)});
---
> $print ? $self->_parse_tags(\$loop_tpl) : ($return .= ${$self->_parse_tags($loop_tpl)});
525,526d543
< my %vars = %{$self->{VARS}};
< local $self->{VARS} = \%vars;
530c547
< my $err = sprintf ($ERRORS->{LOOPNOTHASH}, $vars);
---
> my $err = $self->{opt}->{escape} ? \sprintf ($ERRORS->{LOOPNOTHASH}, $vars) : sprintf ($ERRORS->{LOOPNOTHASH}, $vars);
543a561,568
> if ($self->{lastloop}) {
> $self->{lastloop} = 0;
> last;
> }
> elsif ($self->{nextloop}) {
> $self->{nextloop} = 0;
> next;
> }
631c656
< exists $self->{VARS}->{$1} or return sprintf ($ERRORS->{BADVAR}, $1, $package, $func);
---
> exists $self->{VARS}->{$1} or return $self->{opt}->{escape} ? \sprintf($ERRORS->{BADVAR}, $1, $package, $func) : sprintf($ERRORS->{BADVAR}, $1, $package, $func);
644c669
< $ret = $self->{opt}->{strict} ? sprintf ($ERRORS->{CANTLOAD}, $package, join(",
\n" => @err)) : '';
---
> $ret = $self->{opt}->{strict} ? $self->{opt}->{escape} ? \sprintf($ERRORS->{CANTLOAD}, $package, join(",
\n" => @err)) : sprintf($ERRORS->{CANTLOAD}, $package, join(",
\n" => @err)) : '';
766a792,793
> # If a tag starts with sub { then we assume it's a code ref, compile it, run it and
> # return it.
768a796,805
> if (index ($ret, 'sub {') == 0) {
> $self->{VARS}{$str} = eval "package $self->{opt}->{package}; $ret";
> if (ref $self->{VARS}{$str} eq 'CODE') {
> $ret = &{$self->{VARS}{$str}}($self->{VARS});
> $ret = defined($ret) ? $ret : '';
> }
> else {
> $self->{VARS}{$str} = $ret = sprintf($ERRORS->{COMPILE}, $str, $@);
> }
> }
773c810
< return $strict ? sprintf($ERRORS->{UNKNOWNTAG}, $str) : '';
---
> return $strict ? $self->{opt}->{escape} ? \sprintf($ERRORS->{UNKNOWNTAG}, $str) : sprintf($ERRORS->{UNKNOWNTAG}, $str) : '';
1030c1067
< Revision: $Id: Template.pm,v 1.61 2001/02/14 06:24:34 alex Exp $
---
> Revision: $Id: Template.pm,v 1.72 2001/03/01 21:37:08 alex Exp $
1032a1070,1071
>
>
Index: URI.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/URI.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -r1.17 -r1.18
6c6
< # $Id: URI.pm,v 1.17 2001/02/12 18:55:40 alex Exp $
---
> # $Id: URI.pm,v 1.18 2001/02/28 21:16:07 aki Exp $
353c353
< GT::URI Makes requests and reterives resources internet servers.
---
> GT::URI Makes requests and retrieves resources from internet servers.
545c545
< Revision: $Id: URI.pm,v 1.17 2001/02/12 18:55:40 alex Exp $
---
> Revision: $Id: URI.pm,v 1.18 2001/02/28 21:16:07 aki Exp $
Index: MD5/Crypt.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/MD5/Crypt.pm,v
retrieving revision 1.1
retrieving revision 1.3
diff -r1.1 -r1.3
2c2,3
< # Gossamer Thread module library.
---
> # Gossamer Thread module library. gt_md5_crypt was added which uses
> # "$GT$" as the magic string instead of the unix "$1$" or apache "$apr1$"
32c33
< @EXPORT = qw(unix_md5_crypt apache_md5_crypt);
---
> @EXPORT = qw(unix_md5_crypt apache_md5_crypt gt_md5_crypt);
65a67,68
> local $^W;
>
79,82c82,92
< # change the Magic string to match the one used by Apache
< local $Magic = '$apr1$';
<
< unix_md5_crypt(@_);
---
> # change the Magic string to match the one used by Apache
> local $Magic = '$apr1$';
>
> unix_md5_crypt(@_);
> }
>
> sub gt_md5_crypt {
> # change the Magic string to put our signature in the password
> local $Magic = '$GT$';
>
> unix_md5_crypt(@_);
Index: Mail/Encoder.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Mail/Encoder.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -r1.14 -r1.15
6c6
< # $Id: Encoder.pm,v 1.14 2001/02/13 05:54:16 sbeck Exp $
---
> # $Id: Encoder.pm,v 1.15 2001/02/19 21:19:04 sbeck Exp $
98d97
< print "Not a ref!\n";
113d111
< print "Got a file handle!!\n";
128c126
< if (ref $in) {
---
> if (not ref $in) {
192a191
> unless ($ref) { $in =~ s/\015?\012/\n/g }
199c198
< $in =~ s/\A([^\r\n]*?\r?\n)//m;
---
> $in =~ s/^(.*?\r?\n)//m;
201c200
< length($_) or last;
---
> (defined and length) or last;
224a224
> s/\015?\012/$CRLF/g;
225a226,228
> unless ($ref) {
> (defined($in) and length($in)) or last;
> }
316c319
< Revision: $Id: Encoder.pm,v 1.14 2001/02/13 05:54:16 sbeck Exp $
---
> Revision: $Id: Encoder.pm,v 1.15 2001/02/19 21:19:04 sbeck Exp $
Index: Mail/POP3.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Mail/POP3.pm,v
retrieving revision 1.13
retrieving revision 1.15
diff -r1.13 -r1.15
6c6
< # $Id: POP3.pm,v 1.13 2001/02/13 05:55:07 sbeck Exp $
---
> # $Id: POP3.pm,v 1.15 2001/02/27 13:12:43 sbeck Exp $
29a30
> use GT::MD5 qw/md5_hex/;
162a164
> $_[0]->debug('--- Attempting to read') if ($_[0]->{_debug});
163a166
> $_[0]->debug('--- Read ' . length($line) . ' bytes') if ($_[0]->{_debug});
186a190,192
>
> $self->debug('Connected to ' . $self->{host} . ' on port ' . $self->{port}) if ($self->{_debug});
>
188c194
< select((select($self->{sock}) , $| = 1)[0]);
---
> select((select($self->{sock}), $| = 1)[0]);
196c202
< $self->debug ("Connected to ($self->{host})") if ($self->{_debug});
---
> $self->debug ("Going to login") if ($self->{_debug});
216,222c222
<
< eval {
< require MD5;
< 1;
< }
< or return $self->error ("NOMD5", "WARN", $@);
< $hash = MD5->hexhash ($self->{msg_id} . $self->{pass});
---
> $hash = md5_hex($self->{msg_id} . $self->{pass});
224,225c224,230
< $_ = $self->send ("APOP " . $self->{user} . " " . $hash); /^\+/ or return $self->error ("LOGIN", "WARN", "APOP Login failed: $_");
< /^\+OK \S+ has (\d+) /i and ($self->{count} = $1);
---
> local ($_) = $self->send ("APOP " . $self->{user} . " " . $hash); /^\+/ or return $self->error ("LOGIN", "WARN", "APOP Login failed: $_");
> if (/^\+OK \S+ has (\d+) /i) {
> $self->{count} = $1;
> }
> elsif (!/^\+OK/i) {
> return $self->error('LOGIN', 'WARN', $_);
> }
243c248
< $_ = $self->send ("USER " . $self->{user}); /^\+/ or return $self->error ("LOGIN", "WARN", "USER POP Login failed: $_");
---
> local($_) = $self->send ("USER " . $self->{user}); /^\+/ or return $self->error ("LOGIN", "WARN", "USER POP Login failed: $_");
249c254,259
< /^\+OK \S+ has (\d+) /i and ($self->{count} = $1);
---
> if (/^\+OK \S+ has (\d+) /i) {
> $self->{count} = $1;
> }
> elsif (!/^\+OK/i) {
> return $self->error('LOGIN', 'WARN', $_);
> }
261,262c271,272
< $num or return $self->error ("BADARGS", "FATAL", '$obj->head ($msg_num);. No message number passed to head.');
< $self->debug ("Getting head of message @_ ... ") if ($self->{_debug});
---
> $num or return $self->error ("BADARGS", "FATAL", '$obj->head ($msg_num);. No message number passed to head.'); #'
> $self->debug ("Getting head of message @_ ... ") if ($self->{_debug});
264c274
< $_ = $self->send ("TOP $num 0"); /^\+OK/ or return $self->error ("ACTION", "WARN", "TOP $num 0", $_);
---
> local($_) = $self->send ("TOP $num 0"); /^\+OK/ or return $self->error ("ACTION", "WARN", "TOP $num 0", "($_)");
268c278
< (index($_, '.') == 0) and last;
---
> (index($_, '.') == 0) and CORE::last; #'
271c281
< if (index($header, '>' == 0)) {
---
> if (index($header, '>') == 0) {
290c300
< defined($num) or return $self->error ("BADARGS", "FATAL", '$obj->retr ($msg_numm, $code);');
---
> defined($num) or return $self->error ("BADARGS", "FATAL", '$obj->retr ($msg_numm, $code);'); #'
292c302,310
< $self->debug ("Getting message $num ... ") if ($self->{_debug});
---
> $self->debug ("Getting message $num ... ") if ($self->{_debug}); #'
>
> # Get the size of the message
> my $size;
> my $l = $self->list($num) or return;
> (undef, $size) = split /\s+/ => $l;
>
> local ($_) = $self->send ("RETR $num"); /^\+OK/ or return $self->error ("ACTION", "WARN", "RETR $num", $_); #'
> my $s = $self->{sock};
295,299c313,319
< local ($_) = $self->send ("RETR $num"); /^\+OK (\d+)/ or return $self->error ("ACTION", "WARN", "RETR $num", $_);
< my $size = $1;
< my $s = $self->{sock};
< read($s, my $body, $size);
< my $dot = <$s>;
---
> my $body = ' ' x $size; $body = '';
> while(<$s>) {
> /^\.\015\012/ and CORE::last;
> $body .= $_;
> }
> # CORE::read($s, my $body, $size);
> # my $dot = <$s>;
314a335,342
> sub last {
> my ($self) = @_;
>
> local($_) = $self->send ("LAST"); /^\+OK/ or return $self->error ("ACTION", "WARN", "LAST", $_);
> s/^\+OK\s*//i;
> return $_;
> }
>
347c375
< $_ = $self->send ("STAT"); /^\+OK/ or return $self->error ("ACTION", "WARN", "STAT", $_);
---
> local($_) = $self->send ("STAT"); /^\+OK/ or return $self->error ("ACTION", "WARN", "STAT", $_);
367,368c395,399
< $_ = $self->send ("LIST $num"); /^\+OK/ or return $self->error ("ACTION", "WARN", "LIST $num", $_);
< ($num) and return $_;
---
> local($_) = $self->send ("LIST $num"); /^\+OK/ or return $self->error ("ACTION", "WARN", "LIST $num", $_);
> if ($num) {
> s/^\+OK\s*//i;
> return $_;
> }
372c403
< (index($_, '.') == 0) and last;
---
> (index($_, '.') == 0) and CORE::last;
386c417
< $_ = $self->send ("RSET"); /^\+OK/ and return $self->error ("ACTION", "WARN", "RSET", $_);
---
> local($_) = $self->send ("RSET"); /^\+OK/ and return $self->error ("ACTION", "WARN", "RSET", $_);
397c428
< $_ = $self->send ("DELE $num"); /^\+OK/ or return $self->error ("ACTION", "WARN", "DELE $num", $_);
---
> local($_) = $self->send ("DELE $num"); /^\+OK/ or return $self->error ("ACTION", "WARN", "DELE $num", $_);
412a444
> local $_;
418d449
< $num ||= sub { $_[0] =~ /(\d+) (.+)/ and $ret->{$1} = $2 };
422,423c453,459
< last if /^\./;
< $num->($_);
---
> CORE::last if /^\./;
> if ($num and ref($num) eq 'CODE') {
> $num->($_);
> }
> else {
> /^(\d+) (.+)/ and $ret->{$1} = $2;
> }
720c756
< Revision: $Id: POP3.pm,v 1.13 2001/02/13 05:55:07 sbeck Exp $
---
> Revision: $Id: POP3.pm,v 1.15 2001/02/27 13:12:43 sbeck Exp $
Index: Mail/Parse.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Mail/Parse.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -r1.24 -r1.25
6c6
< # $Id: Parse.pm,v 1.24 2001/02/13 22:06:29 sbeck Exp $
---
> # $Id: Parse.pm,v 1.25 2001/02/27 13:14:12 sbeck Exp $
33c33
< $VERSION = substr q$Revision: 1.24 $, 10;
---
> $VERSION = substr q$Revision: 1.25 $, 10;
260,267c260
< my @header_lines;
< while ($$in =~ /^(.*?$CRLF)/g) {
< if ($1 eq $CRLF) {
< last;
< }
< push @header_lines, $1;
< }
< $part->extract(\@header_lines) or return $self->error($GT::Mail::Parts::error, 'WARN');
---
> $part->extract ([map { $_ . $CRLF } split($CRLF => $$in)]) or return $self->error($GT::Mail::Parts::error, 'WARN');
410c403
< my ($delim, $close) = ("$CRLF--$bound$CRLF", "$CRLF--$bound--$CRLF");
---
> my ($delim, $close) = ("--$bound", "--$bound--");
413,416c406,408
< $loc = index($$in, $delim);
< if ($loc != -1) {
< $_[3] = \do{substr($$in, 0, $loc)};
< substr($$in, 0, $loc + length($delim)) = '';
---
> if ($$in =~ s/(.*?)(?:\A|$CRLF)\Q$delim\E$CRLF//sm) {
> my $data = $1;
> $_[3] = \$data;
420,423c412,414
< $loc = index($$in, $close);
< if ($loc != -1) {
< $_[3] = \do{substr($$in, 0, $loc)};
< substr($$in, 0, $loc + length($close)) = '';
---
> elsif ($$in =~ s/(.*)(?:\A|$CRLF)\Q$close\E(?:\Z|$CRLF)//sm) {
> my $data = $1;
> $_[3] = \$data;
427d417
<
433a424
> my $F;
443c434
< my ($delim, $close) = ("$CRLF--$inner_bound$CRLF", "$CRLF--$inner_bound--$CRLF");
---
> my ($delim, $close) = ("--$inner_bound", "--$inner_bound--");
448,451c439,441
< $loc = index($$in, $delim);
< if ($loc != -1) {
< push(@saved, split($CRLF => substr($$in, 0, $loc)));
< substr($$in, 0, $loc + length($delim)) = '';
---
> if ($$in =~ s/(.*?)(?:\A|$CRLF)\Q$delim\E$CRLF//s) {
> push(@saved, split($CRLF => $1));
> $self->debug("Found delim($delim)") if $self->{_debug};
454,455c444
< $loc = index($$in, $close);
< if ($loc != -1) {
---
> elsif ($$in =~ s/(.*)(?:\A|$CRLF)\Q$close\E(?:\Z|$CRLF)//s) {
457a447
>
480,483c470,472
< $loc = index($$in, $delim);
< if ($loc != -1) {
< push(@saved, split($CRLF => substr($$in, 0, $loc)));
< substr($$in, 0, $loc + length($delim)) = '';
---
> if ($$in =~ s/(.*?)(?:\A|$CRLF)\Q$delim\E$CRLF//s) {
> push(@saved, split($CRLF => $1));
> $self->debug("Found delim($delim)") if $self->{_debug};
486,487c475
< $loc = index($$in, $close);
< if ($loc != -1) {
---
> elsif ($$in =~ s/(.*)(?:\A|$CRLF)\Q$close\E(?:\Z|$CRLF)//s) {
489c477
< substr($$in, 0, $loc + length($close)) = '';
---
> $self->debug("Found close($close)") if $self->{_debug};
545,546c533,534
< $$out =~ s/[ \t]+?\n/\n/g; # rule #3 (trailing space must be deleted)
< $$out =~ s/=\n//g; # rule #5 (soft line breaks)
---
> $$out =~ s/[ \t]+?\015?\012/\012/g; # rule #3 (trailing space must be deleted)
> $$out =~ s/=\015?\012//g; # rule #5 (soft line breaks)
704c692
< Revision: $Id: Parse.pm,v 1.24 2001/02/13 22:06:29 sbeck Exp $
---
> Revision: $Id: Parse.pm,v 1.25 2001/02/27 13:14:12 sbeck Exp $
Index: Mail/Parts.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/Mail/Parts.pm,v
retrieving revision 1.28
retrieving revision 1.30
diff -r1.28 -r1.30
5c5
< # $Id: Parts.pm,v 1.28 2001/02/13 05:56:29 sbeck Exp $
---
> # $Id: Parts.pm,v 1.30 2001/02/27 13:15:22 sbeck Exp $
21c21
< $CRLF = "\r\n";
---
> $CRLF = "\015\012";
295a296,297
> $type ||= 'text';
> $subtype ||= 'plain';
311c313
< $self->multipart_boundary ("---------=_" . scalar (time) . "-$$-" . scalar (@{$self->{parts}}));
---
> $self->multipart_boundary ("---------=_" . scalar (time) . "-$$-" . int(rand(time)/2));
448c450,452
< $ret .= $tag . ': ' . $self->get ($key) . $CRLF;
---
> my $val = $self->get ($key);
> $val =~ s/[\r\n]//g;
> $ret .= $tag . ': ' . $val . $CRLF;
451c455,457
< $ret .= $tag . ': ' . $self->mime_type . $CRLF;
---
> my $val = $self->mime_type;
> $val =~ s/[\r\n]//g;
> $ret .= $tag . ': ' . $val . $CRLF;
562a569
> $self->{body_in} ||= '';
Index: SQL/Admin.pm
===================================================================
RCS file: /usr/local/gossamer/library/GT/SQL/Admin.pm,v
retrieving revision 1.61
retrieving revision 1.65
diff -r1.61 -r1.65
6c6
< # $Id: Admin.pm,v 1.61 2001/02/10 22:59:18 aki Exp $
---
> # $Id: Admin.pm,v 1.65 2001/03/01 03:07:03 jagerman Exp $
48c48
< $VERSION = sprintf "%d.%03d", q$Revision: 1.61 $ =~ /(\d+)\.(\d+)/;
---
> $VERSION = sprintf "%d.%03d", q$Revision: 1.65 $ =~ /(\d+)\.(\d+)/;
118d117
<
1184c1183
< print "(" . join (", " => @{$attribs{values}}) . ")" if ($attribs{values} and ($attribs{values} !~ /^\s*$/sm));
---
> print "(" . join (", " => @{$attribs{values}}) . ")" if ($attribs{values} and (ref $attribs{values}));
1229c1228
< $attribs{form_size} ||= 20;
---
> $attribs{form_size} ||= $attribs{form_type} eq 'SELECT' ? 0 : 20;
1242a1242,1244
>
> my $values = join (", " => @{$attribs{values}}) if ($attribs{values});
> $values = GT::CGI->html_escape($values);
1248,1250c1250,1254
< Column Type $attribs{type} Column Value " . join (", " => @{$attribs{values}}) . " Column Type $attribs{type} Column Value