%s
" . join(",\n" => @err) : ''; 655d683 < $ret = defined($ret) ? $ret : ''; 660d687 < $ret = defined($ret) ? $ret : ''; 666,705d692 < sub _parse_args { < # -------------------------------------------------------- < # Splits up arguments on commas outside of quotes. < # < my($delimiter, $line) = @_; < my($quote, $quoted, $unquoted, $delim, $word, @pieces); < local $^W; < while (length($line)) { < ($quote, $quoted, undef, $unquoted, $delim, undef) = < $line =~ m/^(["']) # a $quote < ((?:\\.|(?!\1)[^\\])*) # and $quoted text < \1 # followed by the same quote < ([\000-\377]*) # and the rest < | # --OR-- < ^((?:\\.|[^\\"'])*?) # an $unquoted text < (\Z(?!\n)|(?:$delimiter)|(?!^)(?=["'])) < # plus EOL, delimiter, or quote < ([\000-\377]*) # the rest < /x; # extended layout < return() unless( $quote || length($unquoted) || length($delim)); < < $line = $+; < < $unquoted =~ s/\\(.)/$1/g; < if (defined $quote) { < $quoted =~ s/\\(.)/$1/g if ($quote eq '"'); < $quoted =~ s/\\([\\'])/$1/g if ( $quote eq "'"); < } < $word .= defined $quote ? $quoted : $unquoted; < if (length($delim)) { < push(@pieces, $word); < undef $word; < } < if (!length($line)) { < push(@pieces, $word); < } < } < return(@pieces); < } < 759c746 < my ($self, $str, $strict) = @_; --- > my ($self, $str, $strict, $escape) = @_; 761,762c748 < local $self->{opt}->{string} = $strict; < if (ref($str) eq 'HASH') { --- > if (ref $str eq 'HASH') { 765c751 < elsif (defined ($ret = $self->_check_func($str, 0))) { --- > elsif (defined ($ret = $self->_check_func($str, $strict, $escape, 0))) { 772d757 < $ret = defined($ret) ? $ret : ''; 777d761 < $ret = defined($ret) ? $ret : ''; 782c766 < return $strict ? sprintf($ERRORS->{UNKNOWNTAG}, $str) : ''; --- > return $strict ? "Unknown Tag: '$str'" : ''; 1039c1023 < Revision: $Id: Template.pm,v 1.64 2001/02/20 00:43:27 alex Exp $ --- > Revision: $Id: Template.pm,v 1.51 2001/02/06 04:25:27 alex Exp $ 1042,1043d1025 < < Index: GT/URI.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/URI.pm,v retrieving revision 1.17 retrieving revision 1.15 diff -r1.17 -r1.15 6c6 < # $Id: URI.pm,v 1.17 2001/02/12 18:55:40 alex Exp $ --- > # $Id: URI.pm,v 1.15 2001/01/26 03:48:52 alex Exp $ 59c59 < my $requests= scalar(keys %{$self->{downloading}}); # + scalar(@{$self->{racked_uri}}); --- > my $requests= scalar(keys %{$self->{downloading}}) + scalar(@{$self->{racked_uri}}); 165d164 < delete $URI->{request}->{resource_attribs}; 167d165 < 294c292 < $self->debug( "$uri is peculiar because it does not have a request object associated" ) if ($self->{_debug}); --- > $self->debug( "$uri is peculiar because it does no have a request object associated" ) if ($self->{_debug}); 323,327c321,323 < my ( $completed, $tmp ); < while ( < ( %{$tmp = $URI->do_iteration()} ) or < ( $URI->requests( -1 ) ) < ) { --- > my $completed; > while ( $URI->requests( -1 ) ) { > my $tmp = $URI->do_iteration(); 545c541 < Revision: $Id: URI.pm,v 1.17 2001/02/12 18:55:40 alex Exp $ --- > Revision: $Id: URI.pm,v 1.15 2001/01/26 03:48:52 alex Exp $ Index: GT/MD5/Crypt.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/MD5/Crypt.pm,v retrieving revision 1.2 retrieving revision 1.1 diff -r1.2 -r1.1 66,67d65 < local $^W; < Index: GT/Mail/BulkMail.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/Mail/BulkMail.pm,v retrieving revision 1.23 retrieving revision 1.22 diff -r1.23 -r1.22 6c6 < # $Id: BulkMail.pm,v 1.23 2001/02/16 10:05:14 jagerman Exp $ --- > # $Id: BulkMail.pm,v 1.22 2001/01/03 17:16:08 jagerman Exp $ 58c58 < $CVS = sprintf "%s", q$Revision: 1.23 $ =~ /(\d+\.\d+)/; --- > $CVS = sprintf "%s", q$Revision: 1.22 $ =~ /(\d+\.\d+)/; 485,486c485 < my ($executable, $tags) = split ' ', $sendmail, 2; < if (-x $executable) { --- > if (-x $sendmail) { 488,496c487,488 < if ($tags) { < $self->{sendmail_with_tags} = $self->{sendmail} = $sendmail; < # Using tags assumes that a method equivelant to -t is being used < $self->{no_sendmail_bs} = 1; < } < else { < $self->{sendmail} = $sendmail; < delete $self->{no_sendmail_bs}; < } --- > $self->{sendmail} = $sendmail; > delete $self->{noSendmailBS}; 503c495 < return $self->{sendmail_with_tags} || $self->{sendmail}; --- > return $self->{sendmail}; 633c625 < if ($noIPCOpen2 || $self->{no_sendmail_bs} and $self->{method} eq 'sendmail') { --- > if ($noIPCOpen2 || $self->{noSendmailBS} and $self->{method} eq 'sendmail') { 863c855 < # sendmail can be run, but apparently it doesn't like the -bs option --- > # sendmail can be run, but apparently it doesn't like bs 868c860 < $self->{no_sendmail_bs}++; --- > $self->{noSendmailBS}++; 910,911c902 < my $to_open = $self->{sendmail_with_tags} || "$self->{sendmail} -t -oi -odq"; < unless (open(SENDMAIL, "| $to_open")) --- > unless (open(SENDMAIL, "| $self->{sendmail} -t -oi -odq")) 913c904 < $self->_cause_error("Can't run sendmail ($to_open): $!"); --- > $self->_cause_error("Can't run sendmail ($self->{sendmail} -t -oi -odq): $!"); Index: GT/Mail/Encoder.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/Mail/Encoder.pm,v retrieving revision 1.15 retrieving revision 1.11 diff -r1.15 -r1.11 6c6 < # $Id: Encoder.pm,v 1.15 2001/02/19 21:19:04 sbeck Exp $ --- > # $Id: Encoder.pm,v 1.11 2001/01/17 01:25:13 alex Exp $ 97,103c97,98 < if (not ref $in) { < while (1) { < last unless length $in; < $buf = substr($in, 0, 45); < substr($in, 0, 45) = ''; < < $encoded = encode_base64($buf); --- > while ($nread = read($in, $buf, 4096)) { > $encoded = encode_base64($buf); 106,117c101,103 < $encoded =~ s/\015?\012/$CRLF/g; < $encoded .= $CRLF unless ($encoded =~ /$CRLF\Z/); # ensure newline! < $out->($encoded); < } < } < else { < while ($nread = read($in, $buf, 45)) { < $encoded = encode_base64($buf); < $encoded =~ s/\015?\012/$CRLF/g; < $encoded .= $CRLF unless ($encoded =~ /$CRLF\Z/); # ensure newline! < $out->($encoded); < } --- > $encoded =~ s/\015?\012/$CRLF/g; > $encoded .= $CRLF unless ($encoded =~ /$CRLF\Z/); # ensure newline! > $out->($encoded); 126,136c112,115 < if (not ref $in) { < $in =~ s/\015?\012/$CRLF/g; < $out->($in); < } < else { < my ($buf, $nread) = ('', 0); < while ($nread = read($in, $buf, 4096)) { < $buf =~ s/\015?\012/$CRLF/g; < $out->($buf); < } < defined ($nread) or return; # check for error --- > my ($buf, $nread) = ('', 0); > while ($nread = read($in, $buf, 4096)) { > $buf =~ s/\015?\012/$CRLF/g; > $out->($buf); 137a117 > defined ($nread) or return; # check for error 144d123 < 145a125 > 148,160c128,130 < if (not ref $in) { < while (1) { < last unless length $in; < $buf = substr($in, 0, 45); < substr($in, 0, 45) = ''; < $out->(pack('u', $buf)); < } < } < else { < while (read($in, $buf, 45)) { < $buf =~ s/\015?\012/$CRLF/g; < $out->(pack('u', $buf)) < } --- > while (read($in, $buf, 45)) { > $buf =~ s/\015?\012/$CRLF/g; > $out->(pack('u', $buf)) 169,180c139,142 < < if (not ref $in) { < $in =~ tr[\200-\377][\000-\177]; < $in =~ s/\015?\012/$CRLF/g; < $out->($in); < } < else { < while (<$in>) { < tr[\200-\377][\000-\177]; < s/\015?\012/$CRLF/g; < $out->($_); < } --- > while (<$in>) { > if (/[\200-\377]/) { tr[\200-\377][\000-\177] } > s/\015?\012/$CRLF/g; > $out->($_); 188,201c150,151 < < local $_; < my $ref = ref $in; < unless ($ref) { $in =~ s/\015?\012/\n/g } < while (1) { < if ($ref) { < $_ = <$in>; < defined($_) or last; < } < else { < $in =~ s/^(.*?\r?\n)//m; < $_ = $1; < (defined and length) or last; < } --- > > while (<$in>) { 224d173 < s/\015?\012/$CRLF/g; 226,228d174 < unless ($ref) { < (defined($in) and length($in)) or last; < } 319c265 < Revision: $Id: Encoder.pm,v 1.15 2001/02/19 21:19:04 sbeck Exp $ --- > Revision: $Id: Encoder.pm,v 1.11 2001/01/17 01:25:13 alex Exp $ Index: GT/Mail/POP3.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/Mail/POP3.pm,v retrieving revision 1.13 retrieving revision 1.11 diff -r1.13 -r1.11 6c6 < # $Id: POP3.pm,v 1.13 2001/02/13 05:55:07 sbeck Exp $ --- > # $Id: POP3.pm,v 1.11 2001/01/30 09:39:19 sbeck Exp $ 21,23d20 < # Constants < sub BLOCK () { 4096 } < 36c33 < $CRLF = "\r\n"; --- > $CRLF = "\015\012"; 70,72c67,70 < my $io = ''; < $self->top ($num, sub { $io .= $_[0] }) or return; < return GT::Mail::Parse->new(debug => $self->{_debug}, in_string => $io, crlf => $CRLF)->parse_head; --- > my $io = GT::TempFile->tmpopen or return; > $self->top ($num, sub { print $io $_[0] }) or return; > seek ($io, 0, 0); > return GT::Mail::Parse->new (debug => $self->{_debug}, handle => $io)->parse_head; 87c85,86 < my $part = $self->head_part($_) or return; --- > my $part = $self->head_part or return; > 1 while (<$s>); 105,108c104,120 < my $io = $self->retr($num) or return; < my $parser = new GT::Mail::Parse(debug => $self->{_debug}, in_string => $io, crlf => $CRLF); < $parser->parse or return $self->error("PARSE", "WARN", $GT::Mail::Parse::error); < return $parser; --- > my $io = GT::TempFile->tmpopen or return; > $self->retr ($num, sub { print $io $_[0] }) or return; > seek ($io, 0, 0); > $self->{mail} ||= GT::Mail->new(debug => $self->{_debug}); > $self->{mail}->parse($io) or return; > return delete $self->{mail}; > } > > sub naming { > # -------------------------------------------------------- > # $obj->naming($coderef); > # ----------------------- > # This method just wraps to the GT::Mail naming routine. > # > my $self = shift; > $self->{mail} ||= GT::Mail->new(debug => $self->{_debug}); > return $self->{mail}->naming(@_); 183,185c195,196 < port => $self->{port}, < host => $self->{host}, < max_down => 0, --- > port => $self->{port}, > host => $self->{host} 187,188c198 < $self->{sock} = $self->{sock_obj}->fh or return $self->error ("CANTCONNECT", "WARN", $GT::Socket::error); < select((select($self->{sock}) , $| = 1)[0]); --- > $self->{sock} = $self->{sock_obj}->fh or return $self->error ("CANTCONNECT", "WARN", $GT::Socket::error); 260,261c270,272 < my ($self, $num, $code) = @_; < $num or return $self->error ("BADARGS", "FATAL", '$obj->head ($msg_num);. No message number passed to head.'); --- > my $self = shift; > my ($num, $lines, $header, $line, $buflen, $s, $code); > 264,269c275,277 < $_ = $self->send ("TOP $num 0"); /^\+OK/ or return $self->error ("ACTION", "WARN", "TOP $num 0", $_); < my $s = $self->{sock}; < my ($tp, $header); < while (<$s>) { < (index($_, '.') == 0) and last; < $header .= $_; --- > $num = shift || return $self->error ("BADARGS", "FATAL", '$obj->head ($msg_num);. No message number passed to head.'); > unless ($code = shift) { > $code = sub { $header .= $_[0] }; 271,272c279,289 < if (index($header, '>' == 0)) { < substr($header, 0, index($header, "\r\n") + 2) = ''; --- > $lines = 0; > > $_ = $self->send ("TOP $num $lines"); /^\+OK/ or return $self->error ("ACTION", "WARN", "TOP $num $lines", $_); > > $s = $self->{sock}; > my $tp; > while (<$s>) { > $tp = 1 if (/^\r?\n$/); # Out of the header. > next if (!$tp and /^>/); # Qmails nice screwed up header > /^\./ and last; > $code->($_); 273a291 > 275,278c293,294 < if ($code and ref $code eq 'CODE') { < $code->($header); < } < else { --- > > if ($header) { 281d296 < 289,290c304,305 < my ($self, $num, $code) = @_; < defined($num) or return $self->error ("BADARGS", "FATAL", '$obj->retr ($msg_numm, $code);'); --- > my $self = shift; > my $num = shift || return $self->error ("BADARGS", "FATAL", '$obj->message ($msg_numm, $code);'); 294,303c309,312 < # Retrieve the entire email < 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>; < < # Qmail puts this wierd header as the first line < if (index($body, '>') == 0) { < substr($body, 0, index($body, "\r\n") + 2) = ''; --- > $_ = $self->send ("RETR $num"); /^\+OK/ or return $self->error ("ACTION", "WARN", "RETR $num", $_); > my ($body, $code); > unless ($code = shift) { > $code = sub { $body .= $_[0] }; 305,307c314,322 < $self->debug ("Message $num retrieved.") if ($self->{_debug}); < if ($code and ref $code eq 'CODE') { < $code->($body); --- > my $s = $self->{sock}; > > # Get the entire message body. > my $tp; > while (<$s>) { > $tp = 1 if (/^\r?\n$/); # Out of the header. > next if (!$tp and /^>/); # Qmails nice screwed up header > /^\./ and last; > $code->($_); 309,310c324,327 < else { < return \$body; --- > $self->debug ("Message $num retrieved.") if ($self->{_debug}); > > if ($body) { > return wantarray ? split(/\r?\n/, $body) : $body; 365c382 < my @messages; --- > my ($line, $message, @messages); 369,373c386,388 < my $s = $self->{sock}; < while (<$s>) { < tr/\r\n//d; < (index($_, '.') == 0) and last; < push (@messages, $_); --- > while (defined ($line = $self->read())) { > $line =~ /^\./ and last; > push (@messages, $line); 375c390 < $self->debug ("", (scalar @messages), " messages listed.") if ($self->{_debug}); --- > $self->debug ("", ($#messages+1), " messages listed.") if ($self->{_debug}); 487c502 < my @to = $top->split_field; --- > my @to = $top->emails; 720c735 < Revision: $Id: POP3.pm,v 1.13 2001/02/13 05:55:07 sbeck Exp $ --- > Revision: $Id: POP3.pm,v 1.11 2001/01/30 09:39:19 sbeck Exp $ Index: GT/Mail/Parse.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/Mail/Parse.pm,v retrieving revision 1.24 retrieving revision 1.21 diff -r1.24 -r1.21 6c6 < # $Id: Parse.pm,v 1.24 2001/02/13 22:06:29 sbeck Exp $ --- > # $Id: Parse.pm,v 1.21 2001/01/30 09:41:33 sbeck Exp $ 16c16 < use vars qw($VERSION $DEBUG $ERRORS $CRLF $CR_LN @ISA); --- > use vars qw($VERSION $DEBUG $ERRORS $CRLF @ISA); 22a23 > use GT::Mail::Decoder; 33c34 < $VERSION = substr q$Revision: 1.24 $, 10; --- > $VERSION = substr q$Revision: 1.21 $, 10; 36,39c37 < $CRLF = "\n"; < < # The length of a crlf < $CR_LN = 2; --- > $CRLF = "\015\012"; 49d46 < DEEPPARTS => "Deep recursion dected, email appears to have more than 50 parts!", 52,72d48 < my %DecoderFor = ( < # Standard... < '7bit' => 'NBit', < '8bit' => 'NBit', < 'base64' => 'Base64', < 'binary' => 'Binary', < 'none' => 'Binary', < 'quoted-printable' => 'QuotedPrint', < < # Non-standard... < 'x-uu' => 'UU', < 'x-uuencode' => 'UU', < ); < # If MIME::Base64 is installed use it < eval { < local $SIG{__DIE__}; < require MIME::Base64; < import MIME::Base64; < 1; < } or *decode_base64 = \>_old_decode_base64; < 111c87 < for my $m (qw(in_file in_handle in_string crlf)) { --- > for my $m (qw(naming in_file handle)) { 116,123d91 < sub crlf { < $CRLF = pop || return $CRLF; < $CR_LN = length($CRLF); < my $c = $CRLF; < $c =~ s/\r/\\r/g; < $c =~ s/\n/\\n/g; < } < 132c100 < my ($self) = @_; --- > my $self = shift; 135c103 < $self->init(@_) if (@_ > 1); --- > $self->init(@_) if (@_ > 0); 137,138c105,106 < ($self->{string} and ref($self->{string}) eq 'SCALAR') < or return $self->error('BADARGS', 'FATAL', "No input was given to parse before parse() was called"); --- > # Must have an input handle to parse > my $in = $self->{file_handle} or return; 141c109 < $self->_parse_part(undef, $self->{string}); # parse! --- > $self->_parse_part (undef, $in); # parse! 155c123 < my ($self, $in) = @_; --- > my $self = shift; 158c126,129 < # $self->init (@_) if (@_ > 2); --- > $self->init (@_) if (@_ > 0); > > # Must have an input handle to parse > my $in = $self->{file_handle} or return; 169c140 < sub in_handle { --- > sub handle { 171c142 < # $obj->in_handle (\*FH); --- > # $obj->handle (\*FH); 176,183c147,148 < if (@_ > 1 and ref $value and fileno $value) { < my $tmp = ''; < local $_; < while (<$value>) { < ${$self->{string}} .= $_; < } < } < return $self->{string}; --- > (@_ > 1) and $self->{file_handle} = $value; > return $self->{file_handle}; 199,210d163 < sub in_string { < my ($self, $string) = @_; < return $self->{string} unless (@_ > 1); < if (ref($string) eq 'SCALAR') { < $self->{string} = $string; < } < else { < $self->{string} = \$string; < } < return $self->{string}; < } < 237,238c190,213 < sub top_part { < return ${shift()->{parts}}[0]; --- > sub naming { > # -------------------------------------------------------------------------- > # $obj->naming ( sub { do somthing }, @args ); > # ------------------------------------- > # This is the naming scheme for the parts of the email that are > # parsed and added as attachments. > # You should pass in a code ref and a list of arguments. > # Te code ref will be passed in the part object for that part > # and the rest of the arguments you passed in here. > # In addition to the arguments you pass here the first argument > # to your callback will be the part object. > # > my $self = shift; > my $code = shift; > > if (defined ($code) and ref ($code) eq 'CODE') { > $self->{naming} = $code; > if (@_) { > $self->{args} = [@_]; > } > return 1; > } > $self->{naming} or $self->{naming} = \&_naming; > return $self->{naming}; 240a216 > 257c233 < $part->extract($in) or return $self->error ("PARSE", "WARN", "Couldn't parse head!"); --- > $part->extract ($in) or return $self->error ("PARSE", "WARN", "Couldn't parse head!"); 260,265c236,242 < my @header_lines; < while ($$in =~ /^(.*?$CRLF)/g) { < if ($1 eq $CRLF) { < last; < } < push @header_lines, $1; --- > > seek($in, 0, 0); > my @headlines; > while (<$in>) { > s/\r?\n$/\n/; > /^\n/ and last; > push @headlines, $_; 267c244,245 < $part->extract(\@header_lines) or return $self->error($GT::Mail::Parts::error, 'WARN'); --- > $part->extract (\@headlines) or return; > seek ($in, 0, 0); 281,284d258 < if (ref $in eq 'GLOB' or ref $in eq 'FileHandle') { < return $self->_parse_stream($outer_bound, $in, $part); < } < 293,296c267,271 < my $indx = index($$in, $CRLF . $CRLF); < if ($indx == -1) { < $self->debug('Message has no body.'); < $indx = length($$in); --- > my @headlines; > while (<$in>) { > s/\r?\n$/\n/; > /^\n/ and last; > push @headlines, $_; 298,299c273 < $part->extract ([map { $_ . $CRLF } split($CRLF => substr($$in, 0, $indx))]) or return $self->error($GT::Mail::Parts::error, 'WARN'); < substr($$in, 0, $indx + ($CR_LN * 2)) = ''; --- > $part->extract (\@headlines) or return; 302c276 < my ($type, $subtype) = split('/', $part->mime_type); --- > my ($type, $subtype) = split ('/', $part->mime_type); 314,315c288,289 < defined ($inner_bound) or return $self->error ("PARSE", "WARN", "No multipart boundary in multipart message."); < (index($inner_bound, $CRLF) == -1) or return $self->error ("PARSE", "WARN", "CR or LF in multipart boundary."); --- > defined ($inner_bound) or return $self->error ("PARSE", "WARN", "No multipart boundary in multipart message."); > ($inner_bound =~ /[\r\n]/) and return $self->error ("PARSE", "WARN", "CR or LF in multipart boundary."); 318c292 < $self->debug ("Parsing preamble.") if ($self->{_debug}); --- > $self->debug ("Parsing preamble."); 326c300 < ++$partno < 50 or return $self->error('DEEPPARTS', 'WARN'); --- > ++$partno; 329,330c303,304 < ($parts, $state) = $self->_parse_part($inner_bound, $in, new GT::Mail::Parts) or return; < ($state eq 'EOF') and return $self->error('PARSE', 'WARN', 'Unexpected EOF before close.'); --- > ($parts, $state) = $self->_parse_part ($inner_bound, $in, new GT::Mail::Parts) or return; > ($state eq 'EOF') and return $self->error ("PARSE", "WARN", "Unexpected EOF before close."); 332,333c306 < $parts->mime_type($retype) if $retype; < push(@{$part->{parts}}, $parts); --- > $parts->mime_type ($retype) if $retype; 335c308,310 < last if ($state eq 'CLOSE'); --- > push (@{$self->{parts}}, $parts); > push (@{$part->{parts}}, $parts); > last if ($state eq 'CLOSE'); 340c315 < ($state = $self->_parse_epilogue($outer_bound, $in, $part)) or return; --- > ($state = $self->_parse_epilogue ($outer_bound, $in, $part)) or return; 351c326 < if (!exists($DecoderFor{lc($encoding)})) { --- > if (!GT::Mail::Decoder->supported ($encoding)) { 359a335 > my $rawlength = undef; 364a341,342 > $ENCODED = GT::TempFile->tmpopen or return; > binmode ($ENCODED); 365a344,347 > > select ((select ($ENCODED), $| = 1)[0]); > $rawlength = tell ($ENCODED); > seek ($ENCODED, 0, 0); 374a357 > 379,383c362,376 < $part->{body_in} = 'MEMORY'; < < my $decoder = $DecoderFor{lc($encoding)}; < $self->debug("Decoding " . lc($encoding)) if $self->{_debug}; < $self->$decoder($ENCODED, \$part->{data}) or return; --- > > my $body = $self->_new_body_for ($part) or return $self->error ("PARSE", "WARN", "Message has no body."); > $part->binmode (1) unless $part->mime_type =~ m{^(text|message)(/|\Z)}i; #/ > > (my $out = $part->open ("w")) or return; > > $self->debug ("Decoding $encoding.") if ($self->{_debug}); > GT::Mail::Decoder->gt_decode ( > debug => $self->{_debug}, > encoding => $encoding, > in => $ENCODED, > out => sub { print $out $_[0] } > ) or return $self->error ("DECODE", "WARN", $GT::Mail::Decoder::error); > close ($out); > 385c378 < else { --- > else { 388,389c381,395 < $self->debug("Reparsing enclosed message.") if ($self->{_debug}); < my $out = ''; --- > $self->debug ("Reparsing enclosed message.") if ($self->{_debug}); > > my $out = GT::TempFile->tmpopen or return; > > $self->debug ("Decoding $encoding.") if ($self->{_debug}); > GT::Mail::Decoder->gt_decode ( > debug => $self->{_debug}, > encoding => $encoding, > in => $ENCODED, > out => sub { print $out $_[0] } > ) or return $self->error ("DECODE", "WARN", $GT::Mail::Decoder::error); > seek ($out, 0,0); > > my $top = new GT::Mail::Parts; > push (@{$part->{parts}}, $top); 391,394c397 < my $decoder = $DecoderFor{lc($encoding)}; < $self->debug("Decoding " . lc($encoding)) if $self->{_debug}; < $self->$decoder($ENCODED, \$out) or return; < $self->_parse_part(undef, \$out, new GT::Mail::Parts) or return; --- > $self->_parse_part (undef, $out, $top) or return; 406,407c409 < my ($self, $bound, $in) = @_; < my $loc; --- > my ($self, $bound, $in, $out) = @_; 410c412 < my ($delim, $close) = ("$CRLF--$bound$CRLF", "$CRLF--$bound--$CRLF"); --- > my ($delim, $close) = ("--$bound", "--$bound--"); 412,425c414,426 < < $loc = index($$in, $delim); < if ($loc != -1) { < $_[3] = \do{substr($$in, 0, $loc)}; < substr($$in, 0, $loc + length($delim)) = ''; < $self->debug("Found delim($delim)") if $self->{_debug}; < return 'DELIM' < } < $loc = index($$in, $close); < if ($loc != -1) { < $_[3] = \do{substr($$in, 0, $loc)}; < substr($$in, 0, $loc + length($close)) = ''; < $self->debug("Found close($close)") if $self->{_debug}; < return 'CLOSE' --- > > # Read: > my $eol; > my $held_eol = ''; > while (<$in>) { > > ($_, $eol) = m/^(.*?)($CRLF|\n)?\Z/o; > > # Now, look at what we've got: > ($_ eq $delim) and return 'DELIM'; > ($_ eq $close) and return 'CLOSE'; > print $out $held_eol, $_; > $held_eol = $eol; 428c429 < return $self->error ("PARSE", "FATAL", "Unexpected EOF.\n". --- > return $self->error ("PARSE", "WARN", "Unexpected EOF.\n". 442,443c443 < my $loc; < my ($delim, $close) = ("$CRLF--$inner_bound$CRLF", "$CRLF--$inner_bound--$CRLF"); --- > my ($delim, $close) = ("--$inner_bound", "--$inner_bound--"); 448,456c448,453 < $loc = index($$in, $delim); < if ($loc != -1) { < push(@saved, split($CRLF => substr($$in, 0, $loc))); < substr($$in, 0, $loc + length($delim)) = ''; < return 'DELIM' < } < $loc = index($$in, $close); < if ($loc != -1) { < return $self->error ("Found ($close) before finding the start of the boundary. Message malformed"); --- > while (<$in>) { > s/\r?\n$//o; > ($_ eq $delim) and return 'DELIM'; > ($_ eq $close) and return $self->error ("Found ($close) before finding the start of the boundary. Message malformed"); > > push @saved, "$_\n"; 471d467 < my $loc; 473c469 < my ($delim, $close) = ("$CRLF--$outer_bound$CRLF", "$CRLF--$outer_bound--$CRLF") --- > my ($delim, $close) = ("--$outer_bound", "--$outer_bound--") 479,498c475,476 < if (defined $outer_bound) { < $loc = index($$in, $delim); < if ($loc != -1) { < push(@saved, split($CRLF => substr($$in, 0, $loc))); < substr($$in, 0, $loc + length($delim)) = ''; < return 'DELIM' < } < $loc = index($$in, $close); < if ($loc != -1) { < push(@saved, split($CRLF => substr($$in, 0, $loc))); < substr($$in, 0, $loc + length($close)) = ''; < return 'CLOSE' < } < } < push(@saved, split($CRLF => $$in)); < $$in = ''; < $self->debug ("EOF: epilogue is ", length(join '', @saved), " bytes") if ($self->{_debug}); < return 'EOF'; < } < --- > while (<$in>) { > s/\r?\n$//o; 500,518c478,481 < sub Base64 { < # -------------------------------------------------------------------------- < my ($self, $in, $out) = @_; < < ### Extract substring with highest multiple of 4 bytes: < ### 0 means not enough to work with... get more data! < my $len_4xN = length($$in) & ~3; < < ### Partition into largest-multiple-of-4 (which we decode), < ### and the remainder (which gets handled next time around): < $$out .= decode_base64(substr($$in, 0, $len_4xN)); < my $buffer = substr($$in, $len_4xN); < < ### No more input remains. Dispose of anything left in buffer: < if (length($buffer)) { < < ### Pad to 4-byte multiple, and decode: < $buffer .= "==="; ### need no more than 3 pad chars < $len_4xN = length($buffer) & ~3; --- > if (defined($outer_bound)) { > ($_ eq $delim) and return 'DELIM'; > ($_ eq $close) and return 'CLOSE'; > } 520,521c483 < ### Decode it! < $$out .= decode_base64(substr($buffer, 0, $len_4xN)); --- > push @saved, "$_\n"; 523,548c485,486 < < return 1; < } < < sub Binary { < # -------------------------------------------------------------------------- < my ($self, $in, $out) = @_; < $$out = $$in; < return 1; < } < < sub NBit { < # -------------------------------------------------------------------------- < my ($self, $in, $out) = @_; < $$out = $$in; < return 1; < } < < sub QuotedPrint { < # -------------------------------------------------------------------------- < my ($self, $in, $out) = @_; < $$out = $$in; < $$out =~ s/[ \t]+?\n/\n/g; # rule #3 (trailing space must be deleted) < $$out =~ s/=\n//g; # rule #5 (soft line breaks) < $$out =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; < return 1; --- > $self->debug ("EOF: epilogue is ", length(join '', @saved), " bytes"); > return 'EOF'; 551c489 < sub UU { --- > sub _naming { 553,571c491,499 < my ($self, $in, $out) = @_; < my ($mode, $file); < < # Find beginning... < while ($$in =~ s/^(.+$CRLF)//o) { < local $_ = $1; < last if ($mode, $file) = /^begin\s*(\d*)\s*(\S*)/; < } < return GT::Mail::Decoder->error("uu decoding: no begin found", 'WARN') if (!defined($_)); < < # Decode: < while ($$in =~ s/^(.+$CRLF)//o) { < local $_ = $1; < last if /^end/; < next if /[a-z]/; < next unless int((((ord() - 32) & 077) + 2) / 3) == int(length() / 4); < $$out .= unpack('u', $_); < } < return 1; --- > # Private naming function that is used if you do not specify the > # naming code ref. > # > my ($self, $part) = @_; > my $name = $part->recommended_filename; > $self->debug ('Recommended name is ('.$name.')') if ($self->{_debug} and $name); > $self->{Ext} ||= 'txt'; > my $file = $name ? $name : $self->{name}++ . '.' . $self->{Ext}; > return './' . $file; 574c502 < sub gt_old_decode_base64 ($) { --- > sub _new_body_for { 576,591c504,514 < local($^W) = 0; < < my $str = shift; < my $res = ""; < < $str =~ tr|A-Za-z0-9+=/||cd; < if (length($str) % 4) { < carp ("Length of base64 data not a multiple of 4"); < } < $str =~ s/=+$//; < $str =~ tr|A-Za-z0-9+/| -_|; < while ($str =~ /(.{1,60})/gs) { < my $len = chr(32 + length($1)*3/4); < $res .= unpack("u", $len . $1 ); < } < return $res; --- > # Internal Method > # --------------- > # Sets the path to the body and returns it. > # Uses the naming scheme defined. > # > my ($self, $part) = @_; > my @args = exists $self->{args} ? @{$self->{args}} : (); > unshift(@args, $self, $part); > my $path = ($self->{naming} and ref ($self->{naming}) eq 'CODE') ? $self->{naming}->(@args) : $self->_naming ($part); > $self->debug("Setting Path to: ($path) for ($part)") if ($self->{_debug}); > return $part->body_path ($path); 704c627 < Revision: $Id: Parse.pm,v 1.24 2001/02/13 22:06:29 sbeck Exp $ --- > Revision: $Id: Parse.pm,v 1.21 2001/01/30 09:41:33 sbeck Exp $ Index: GT/Mail/Parts.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/Mail/Parts.pm,v retrieving revision 1.29 retrieving revision 1.25 diff -r1.29 -r1.25 2c2,3 < # Gossamer Threads Module Library - http://gossamer-threads.com/ # --- > # Gossamer Threads Module Library - http://gossamer-threads.com/ > # 5c6 < # $Id: Parts.pm,v 1.29 2001/02/19 21:19:57 sbeck Exp $ --- > # $Id: Parts.pm,v 1.25 2001/01/30 09:43:01 sbeck Exp $ 16a18 > use GT::Mail::Decoder; 21c23 < $CRLF = "\015\012"; --- > $CRLF = "\r\n"; 41c43,44 < # token = 1* # --- > # token = 1* > # 76d78 < 83c85,86 < ($tag, $lines) = $self->_fmt_line ($tag, $lines) or return; --- > ($tag, $lines) = $self->_fmt_line ($tag, $lines); > 103c106 < $raw =~ tr/\n//d; --- > $raw =~ s/\n//g; 153c156 < $tag = lc($tag); --- > $tag = $self->_tag_case($tag); 171c174 < $tag = lc($tag); --- > $tag = $self->_tag_case ($tag); 200c203 < my $tag = lc($_[0]); --- > my $tag = $self->_tag_case($_[0]); 311c314 < $self->multipart_boundary ("---------=_" . scalar (time) . "-$$-" . int(rand(time)/2)); --- > $self->multipart_boundary ("---------=_" . scalar (time) . "-$$-" . scalar (@{$self->{parts}})); 365c368 < $tag = lc($tag); --- > $tag = $self->_tag_case($tag); 444,445d446 < my $key = lc $tag; < $tag = $self->_tag_case($tag); 448c449 < $ret .= $tag . ': ' . $self->get ($key) . $CRLF; --- > $ret .= $tag . ': ' . $self->get ($tag) . $CRLF; 456c457 < delete $head{$key}; --- > delete $head{$tag}; 459,460c460,461 < next unless exists $self->{header_lines}->{$key}; < foreach (@{$self->{header_lines}->{$key}}) { --- > next unless exists $self->{header_lines}->{$tag}; > foreach (@{$self->{header_lines}->{$tag}}) { 465c466 < delete $head{$key}; --- > delete $head{$tag}; 469c470 < foreach (@{$self->{header_lines}->{lc($tag)}}) { --- > foreach (@{$self->{header_lines}->{$tag}}) { 472d472 < $tag = $self->_tag_case($tag); 490c490 < $tag = lc($tag); --- > $tag = $self->_tag_case ($tag); 563d562 < $self->{body_in} ||= ''; 759a759,762 > if (defined $tag) { > $tag = $self->_tag_case($tag); > $tag =~ s/\A([^ :]+)/$1/o; > } 761,763c764 < (defined ($tag) && $tag =~ /\A($FIELD_NAME|From )/oi) or return $self->error ("BADTAG", "WARN", $tag); < $tag =~ s/^([^ :]+):/$1/; < $tag = lc($tag); --- > (defined ($tag) && $tag =~ /\A($FIELD_NAME|From )/oi) and return $self->error ("BADTAG", "WARN", $tag); 767c768 < $line =~ s/\n*\Z//; --- > $line =~ s/\n*\Z//s; 774c775,776 < my ($self, $tag) = @_; --- > my $self = shift; > my $tag = shift; 777,780c779,780 < $tag =~ s/:\Z//; < $tag =~ s/\A\s*//; < $tag =~ s/\s*\Z//; < $tag = lc $tag; --- > $tag =~ s/:\Z//o; > $tag =~ s/\A\s*|\s*\Z//g; 784,785c784,785 < $tag =~ s/\b([a-z]+)/\L\u$1/g; < $tag =~ s/\b([b-df-hj-np-tv-z]+)\b/\U$1/g if (index($tag, '-') != -1); --- > $tag =~ s/\b([a-z]+)/\L\u$1/gio; > $tag =~ s/\b([b-df-hj-np-tv-z]+)\b/\U$1/gio if $tag =~ /-/; 793,795c793 < my $out = ''; < GT::Mail::Parse->decode_base64 (\$str, \$out); < return $out; --- > >::Mail::Decoder::decode_base64 ($str); 846,847c844,845 < my @to = $top_part->split_field ('to'); < my @from = $top_part->split_field ('from'); --- > my @to = $top_part->emails ('to'); > my @from = $top_part->emails ('from'); 1088c1086,1089 < http://www.gossamer-threads.com/ =head1 VERSION --- > http://www.gossamer-threads.com/ > > =head1 VERSION > Index: GT/Mail/Send.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/Mail/Send.pm,v retrieving revision 1.9 retrieving revision 1.8 diff -r1.9 -r1.8 6c6 < # $Id: Send.pm,v 1.9 2001/02/07 03:29:30 alex Exp $ --- > # $Id: Send.pm,v 1.8 2000/12/15 18:13:44 alex Exp $ 22c22 < $VERSION = sprintf "%d.%03d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/; 99c99 < foreach ($self->{mail}->{head}->split_field ('to')) { --- > foreach ($self->{mail}->{head}->emails ('to')) { 218c218 < Revision: $Id: Send.pm,v 1.9 2001/02/07 03:29:30 alex Exp $ --- > Revision: $Id: Send.pm,v 1.8 2000/12/15 18:13:44 alex Exp $ Index: GT/SQL/Admin.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Admin.pm,v retrieving revision 1.63 retrieving revision 1.60 diff -r1.63 -r1.60 6c6 < # $Id: Admin.pm,v 1.63 2001/02/18 19:41:32 alex Exp $ --- > # $Id: Admin.pm,v 1.60 2001/02/06 04:47:55 alex Exp $ 28d27 < $ROW_COLOR1 $ROW_COLOR2 48c47 < $VERSION = sprintf "%d.%03d", q$Revision: 1.63 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.60 $ =~ /(\d+)\.(\d+)/; 57,58d55 < $ROW_COLOR1 = 'bgcolor="#dddddd"'; < $ROW_COLOR2 = 'bgcolor="#eeeeee"'; 117a115 > 255,269c253,254 < < if ( $self->{in}->param('dr') eq 'rows' ) { < print qq!!; < print "", $self->{html}->display_row_cols({ mode => 'search_results' }), ""; < my $i = 0; < while (my $result = $sth->fetchrow_hashref) { < print "", $self->{html}->display_row ( { mode => 'search_results', values => $result }), ""; < } < print ""; < } < < else { < while (my $result = $sth->fetchrow_hashref) { < print "", $self->{html}->display ( { mode => 'search_results', values => $result }); < } --- > while (my $result = $sth->fetchrow_hashref) { > print "", $self->{html}->display ( { mode => 'search_results', values => $result }); 271d255 < 448,487c432,437 < < if ( $self->{in}->param('dr') eq 'rows' ) { < < print qq!!; < print "Delete", $self->{html}->display_row_cols({ mode => 'search_results' }), ""; < < while (my $result = $sth->fetchrow_hashref) { < foreach my $key (@pk) { < if ($self->{db}->can ('_complete_name')) { < my $new = {}; < for (keys %{$result}) { < $new->{$self->{db}->_complete_name ($_)} = $result->{$_}; < } < $result = $new; < } < my $val = $result->{$key}; < $self->{html}->escape(\$val); < print qq~~; < } < print ""; < print qq~~; < print $self->{html}->display_row ( { mode => 'search_results', values => $result }), ""; < print qq~~; < $i++; < } < < print "\n"; < < } < < else { < < while (my $result = $sth->fetchrow_hashref) { < foreach my $key (@pk) { < if ($self->{db}->can ('_complete_name')) { < my $new = {}; < for (keys %{$result}) { < $new->{$self->{db}->_complete_name ($_)} = $result->{$_}; < } < $result = $new; --- > while (my $result = $sth->fetchrow_hashref) { > foreach my $key (@pk) { > if ($self->{db}->can ('_complete_name')) { > my $new = {}; > for (keys %{$result}) { > $new->{$self->{db}->_complete_name ($_)} = $result->{$_}; 489,491c439 < my $val = $result->{$key}; < $self->{html}->escape(\$val); < print qq~~; --- > $result = $new; 493,496c441,443 < print qq~~; < print $self->{html}->display ( { mode => 'delete_search_results', values => $result } ); < print "\n"; < $i++; --- > my $val = $result->{$key}; > $self->{html}->escape(\$val); > print qq~~; 498c445,448 < --- > print qq~~; > print $self->{html}->display ( { mode => 'delete_search_results', values => $result } ); > print "\n"; > $i++; 500,501d449 < < 658,671c606,611 < < if ( $self->{in}->param('dr') eq 'rows' ) { < < print qq!!; < print "Modify", $self->{html}->display_row_cols({ mode => 'search_results' }), ""; < < while (my $result = $sth->fetchrow_hashref) { < foreach my $key (@pk) { < if ($self->{db}->can ('_complete_name')) { < my $new = {}; < for (keys %{$result}) { < $new->{$self->{db}->_complete_name ($_)} = $result->{$_}; < } < $result = $new; --- > while (my $result = $sth->fetchrow_hashref) { > foreach my $key (@pk) { > if ($self->{db}->can ('_complete_name')) { > my $new = {}; > for (keys %{$result}) { > $new->{$self->{db}->_complete_name ($_)} = $result->{$_}; 673,675c613 < my $val = $result->{$key}; < $self->{html}->escape(\$val); < print qq~~; --- > $result = $new; 677,681c615,617 < print ""; < print qq~~; < print $self->{html}->display_row ( { mode => 'modify_search_results', values => $result } ); < print "\n"; < $i++; --- > my $val = $result->{$key}; > $self->{html}->escape(\$val); > print qq~~; 683,686c619,622 < < print "\n"; < < --- > print qq~~; > print $self->{html}->display ( { mode => 'modify_search_results', values => $result } ); > print "\n"; > $i++; 688,712d623 < < else { < < while (my $result = $sth->fetchrow_hashref) { < foreach my $key (@pk) { < if ($self->{db}->can ('_complete_name')) { < my $new = {}; < for (keys %{$result}) { < $new->{$self->{db}->_complete_name ($_)} = $result->{$_}; < } < $result = $new; < } < my $val = $result->{$key}; < $self->{html}->escape(\$val); < print qq~~; < } < print qq~~; < print $self->{html}->display ( { mode => 'modify_search_results', values => $result } ); < print "\n"; < $i++; < } < < }; < < 1183c1094 < print "(" . join (", " => @{$attribs{values}}) . ")" if ($attribs{values} and (ref $attribs{values})); --- > print "(" . join (", " => @{$attribs{values}}) . ")" if ($attribs{values} and ($attribs{values} !~ /^\s*$/sm)); 1228c1139 < $attribs{form_size} ||= $attribs{form_type} eq 'SELECT' ? 0 : 20; --- > $attribs{form_size} ||= 20; 1242,1244d1152 < < my $values = join (", " => @{$attribs{values}}) if ($attribs{values}); < $values = GT::CGI->html_escape($values); 1250,1254c1158,1160 < Column Type$attribs{type} < Column Value < ~; < my @pk = $self->{db}->pk; < if (! grep { $column eq $_ } @pk) { --- > Column Type$attribs{type}\n~; > print " Column Value" . join (", " => @{$attribs{values}}) . "\n" if ($attribs{values}); > unless ($self->{db}->pk ($column)) { 1261,1271c1167 < < ~; < } < else { < print qq~ < < Not Null < < Yes (Can't change primary key) < < ~; --- > ~; 1287,1288c1183,1184 < Form Names(Stored in Database)Only for checkbox, multi-select or radio forms.~ . join ("\n" => @{$attribs{form_names}}) . qq~ < Form Values(Displayed on Form)Only for checkbox, multi-select or radio forms.~ . join ("\n" => @{$attribs{form_values}}) . qq~ --- > Form Names(Stored in Database)~ . join ("\n" => @{$attribs{form_names}}) . qq~ > Form Values(Displayed on Form)~ . join ("\n" => @{$attribs{form_values}}) . qq~ 1609c1505 < $attribs{form_size} = $self->{cgi}->{form_size} || ($attribs{form_type} eq 'SELECT') ? 0 : 20; --- > $attribs{form_size} = $self->{cgi}->{form_size} || 20; 1650,1651c1546,1547 < Form Names(Stored in Database)Only for checkbox, multi-select or radio forms.$attribs{form_names} < Form Values(Displayed on Form)Only for checkbox, multi-select or radio forms.$attribs{form_values} --- > Form Names(Stored in Database)$attribs{form_names} > Form Values(Displayed on Form)$attribs{form_values} 1888a1785 > 1892a1790,1795 > if (not $attribs{form_names}) { > $errors .= "You must specify the names for the enum in the 'Form Names' text area. One per line.\n"; > } > if (not $attribs{form_values}) { > $errors .= "You must specify the values for the enum field in the 'Form Values' text area. One per line.\n"; > } 1894,1895c1797,1798 < else { < delete $attribs{values}; --- > elsif (@{$attribs{values}}) { > $errors .= "You should not enter anything in the 'Column Value' unless you are creating an enum field: '@{$attribs{values}}'\n"; 1902,1906d1804 < else { < delete $attribs{form_names}; < delete $attribs{form_values}; < } < 1907a1806 > 1958d1856 < $attribs{values} = [split /\s*,\s*/, $self->{cgi}->{values}]; 1966,1967c1864,1865 < if (not @{$attribs{values}}) { < $errors .= "You must specify the values for the enum field in the Values text area.\n"; --- > if (not @{$attribs{form_names}}) { > $errors .= "You must specify the names for the enum in the 'Form Names' text area. One per line.\n"; 1969,1975c1867,1868 < } < else { < delete $attribs{values}; < } < if ($attribs{form_type} =~ /^CHECKBOX|MULTIPLE|RADIO$/) { < if (! (@{$attribs{form_names}} or @{$attribs{form_values}}) ) { < $errors .= "For checkbox and select fields, you must specify in form names and form values what you want displayed, one entry per line."; --- > if (not @{$attribs{form_values}}) { > $errors .= "You must specify the values for the enum field in the 'Form Values' text area. One per line.\n"; 1979,1980c1872,1876 < delete $attribs{form_names}; < delete $attribs{form_values}; --- > if ($attribs{form_type} =~ /^CHECKBOX|SELECT|RADIO$/) { > if (! (@{$attribs{form_names}} or @{$attribs{form_values}}) ) { > $errors .= "For checkbox and select fields, you must specify in form names and form values what you want displayed, one entry per line."; > } > } 2185d2080 < 2198,2209d2092 < my $dr = $self->{html}->select ( < { < name => "dr", < values => { < '' => 'As Elements', < 'rows' => 'As Rows' < }, < default => $self->{cgi}->{dr}, < blank => 1 < } < ); < 2235c2118 < $sb --- > $sb 2237,2244c2120 < $so < ~; < < if ( ( () = $self->{in}->param('db') ) == 1 ) { < $out .= qq~ < < Display Records: < $dr --- > $so 2246,2248c2122 < ~; < } < --- > ~; 2559c2433 < Revision: $Id: Admin.pm,v 1.63 2001/02/18 19:41:32 alex Exp $ --- > Revision: $Id: Admin.pm,v 1.60 2001/02/06 04:47:55 alex Exp $ Index: GT/SQL/Base.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Base.pm,v retrieving revision 1.7 retrieving revision 1.4 diff -r1.7 -r1.4 6c6 < # $Id: Base.pm,v 1.7 2001/02/17 08:01:21 alex Exp $ --- > # $Id: Base.pm,v 1.4 2001/02/06 04:25:44 alex Exp $ 28c28 < $VERSION = sprintf "%d.%03d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; 311a312 > next if (defined $opts->{$field} and ($opts->{$field} eq '*')); 325c326 < if (exists $opts->{"$field-gt"} and ($opts->{"$field-gt"} ne "")) { --- > if (exists $opts->{"$field-gt"}) { 328c329 < elsif (exists $opts->{"$field-lt"} and ($opts->{"$field-gt"} ne "")) { --- > elsif (exists $opts->{"$field-lt"}) { 331,357c332,333 < else { < if (exists $opts->{$field} and ($opts->{$field} ne "")) { < if ($opts->{$field} =~ /^(>|<)(.*)/) { < push @ins, ($field, $1, $2); < } < elsif ($opts->{$field} eq '+') { < push @ins, ($field, "<>", ''); < } < elsif ($opts->{$field} eq '-') { < push @ins, ($field, "=", ''); < } < elsif ($opts->{$field} eq '*') { < if ($opts->{"$field-opt"} and ($opts->{"$field-opt"} eq '<>')) { < push @ins, ($field, '=', ''); < } < else { < next; < } < } < else { < (index ($opts->{$field}, "\\") == 0) and (substr ($opts->{$field}, 0, 1) = ""); < push @ins, ($field, $comp, "$s$opts->{$field}$s"); < } < } < else { < next; < } --- > elsif (exists $opts->{$field} and $opts->{$field} =~ /^(>|<)/) { > push @ins, ($field, $1, $opts->{$field}); 358a335,338 > elsif (exists $opts->{$field}) { > push @ins, ($field, $comp, "$s$opts->{$field}$s"); > } > next if (!defined $ins[2] or ($ins[2] =~ /^\s*$/)); 378c358,360 < return 1 if (UNIVERSAL::can($class, 'new')); --- > return 1 if (defined %{$class . '::'}); > > local ($@, $SIG{__DIE__}); 384d365 < local ($@, $SIG{__DIE__}); 387,389c368 < push @err, $@; < # In case the module had compile errors, %class:: will be defined, but not complete. < undef %{$class . '::'} if defined %{$class . '::'}; --- > push @err, $@; 398,399c377,378 < if (! $ok or ! UNIVERSAL::can($class, 'new')) { < return $self->error ('BADSUBCLASS', 'FATAL', $class, join(", ", @err)); --- > if (! $ok or ! defined %{$class . '::'}) { > return $self->error ('BADSUBCLASS', 'FATAL', $class, join ", ", @err); 404a384 > Index: GT/SQL/Condition.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Condition.pm,v retrieving revision 1.16 retrieving revision 1.15 diff -r1.16 -r1.15 6c6 < # $Id: Condition.pm,v 1.16 2001/02/07 01:35:15 alex Exp $ --- > # $Id: Condition.pm,v 1.15 2001/02/05 00:44:29 alex Exp $ 23c23 < $VERSION = sprintf "%d.%03d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/; 31c31,32 < # that object ("AND" is the default), the conditions for this object. --- > # that object ("AND" is the default), the conditions for this object, > # and the values. 37a39 > $self->{values} = []; 160a163,213 > # $obj->prepare_sql; > # ------------------ > # Does the same thing as $obj->sql except that > # it replaces the values by question marks which > # make caching prepare statements a lot easier. > # > # The values corresponding to the question marks > # are stored into $self->{values}. > ## > sub prepare_sql { > my $self = shift; > my @cond = @{$self->{cond}}; > my $bool = $self->boolean; > my @vals = (); > my (@tmp, $sql_str); > > # for each sub-condition of our GT::SQL::Condition object > foreach my $cond (@cond) > { > # if the sub-condition is an array, then we construct > # out prepared statement > if (ref $cond eq 'ARRAY') > { > my ($col, $op, $val) = @{$cond}; > if (ref $val eq 'SCALAR') { > $sql_str = "$col $op " . $$val; > } > elsif (ref $val) { > return $self->error ('BADARGS', 'FATAL', "Invalid value '@$val', must be scalar or scalar ref."); > } > else { > defined $val or $val = 'NULL'; > push @vals, $val; > $sql_str = "$col $op ?"; > } > } > # if it is a condition, then we prepare it's statement > # and include it in our current statement. > elsif (ref $cond eq ref $self) > { > $sql_str = "(" . $cond->prepare_sql . ")"; > push @vals, $cond->store_values; > } > push (@tmp, $sql_str); > } > $self->store_values (@vals); > return join " $bool ", @tmp; > } > > > ## 176a230,250 > > ## > # $obj->store_values; > # ------------------- > # Returns the values which have been stored for replacement > # in a prepared statement. > # > # $obj->store_values (LIST); > # -------------------------- > # Store LIST into the current GT::SQL::Condition object for > # further retrieval. > # > # Scott: do we want to push onto here? why not set it '=' > ## > sub store_values { > my ($self, @args) = @_; > map {quote($_)} @args; > @{$self->{values}} = @args if (@args); > return wantarray ? @{$self->{values}} : $self->{values} > } > 281c355 < Revision: $Id: Condition.pm,v 1.16 2001/02/07 01:35:15 alex Exp $ --- > Revision: $Id: Condition.pm,v 1.15 2001/02/05 00:44:29 alex Exp $ Index: GT/SQL/Driver.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Driver.pm,v retrieving revision 1.47 retrieving revision 1.45 diff -r1.47 -r1.45 6c6 < # $Id: Driver.pm,v 1.47 2001/02/14 18:49:31 alex Exp $ --- > # $Id: Driver.pm,v 1.45 2001/02/05 00:03:50 sbeck Exp $ 30c30 < $VERSION = sprintf "%d.%03d", q$Revision: 1.47 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.45 $ =~ /(\d+)\.(\d+)/; 170,173d169 < @GT::SQL::Driver::debug::QUERY_STACK = (); < return if ($INC{'Apache::DBI'}); # Apache::DBI is loaded and handling persistant connections. < < # Otherwise remove connections that aren't valid. 175d170 < next if ($CONN{$dsn} and $CONN{$dsn}->ping); 177,178c172,174 < delete $CONN{$dsn}; < } --- > } > %CONN = (); > @GT::SQL::Driver::debug::QUERY_STACK = (); 581c577 < require GT::Dumper; --- > require Data::Dumper; 590c586 < my $dump = >::Dumper::Dumper($arg); --- > my $dump = &Data::Dumper::Dumper($arg); Index: GT/SQL/Editor.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Editor.pm,v retrieving revision 1.20 retrieving revision 1.18 diff -r1.20 -r1.18 6c6 < # $Id: Editor.pm,v 1.20 2001/02/18 19:15:10 alex Exp $ --- > # $Id: Editor.pm,v 1.18 2001/01/30 23:00:10 alex Exp $ 22c22 < $VERSION = sprintf "%d.%03d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/; 39c39 < $self->{table} = $opts->{table}; --- > $self->{schema} = $opts->{table}; 44c44 < $self->{table}->connect; --- > $self->{schema}->connect; 70c70 < my $c = $self->{table}->cols; --- > my $c = $self->{schema}->cols; 73,74c73,74 < my $defs = $self->{table}->{driver}->_column_sql ($col); < my $table = $self->{table}->name; --- > my $defs = $self->{schema}->{driver}->_column_sql ($col); > my $table = $self->{schema}->name; 76,77c76,79 < # Auto add a new position number. < $col->{pos} = keys (%$c) + 1; --- > # Auto add a new position number if not specified. > if (! exists $col->{pos}) { > $col->{pos} = keys (%$c) + 1; > } 81,84c83,86 < unless ($self->{table}->check_schema) { < my $name = $self->{table}->name; < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$name.def"); < return; --- > unless ($self->{schema}->check_schema) { > my $name = $self->{schema}->name; > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$name.def"); > return undef; 90c92 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 111c113 < my $table = $self->{table}->name; --- > my $table = $self->{schema}->name; 124c126 < delete $self->{table}->cols->{$name}; --- > delete $self->{schema}->cols->{$name}; 127c129 < @{$self->{table}->pk} = grep !/^\Q$name\E$/, @{$self->{table}->pk}; --- > @{$self->{schema}->pk} = grep !/^\Q$name\E$/, @{$self->{schema}->pk}; 130,132c132,134 < for (keys %{$self->{table}->fk}) { < for my $col (keys %{$self->{table}->fk->{$_}}) { < if ($col eq $name) { delete $self->{table}->fk->{$_}->{$col} } --- > for (keys %{$self->{schema}->fk}) { > for my $col (keys %{$self->{schema}->fk->{$_}}) { > if ($col eq $name) { delete $self->{schema}->fk->{$_}->{$col} } 138,140c140,142 < for (keys %{$self->{table}->$index()}) { < @{$self->{table}->$index()->{$_}} = grep !/^\Q$name\E$/, @{$self->{table}->$index()->{$_}}; < if (not @{$self->{table}->$index()->{$_}}) { delete $self->{table}->$index()->{$_} } --- > for (keys %{$self->{schema}->$index()}) { > @{$self->{schema}->$index()->{$_}} = grep !/^\Q$name\E$/, @{$self->{schema}->$index()->{$_}}; > if (not @{$self->{schema}->$index()->{$_}}) { delete $self->{schema}->$index()->{$_} } 145,146c147,148 < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def"); --- > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def"); 153c155 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 167c169 < exists $self->{table}->{schema}->{cols}->{$col} or return $self->error ("NOCOL", "WARN", $col); --- > exists $self->{schema}->cols->{$col} or return $self->error ("NOCOL", "WARN", $col); 170,173c172 < my $orig = $self->{table}->{schema}->{cols}->{$col}; < < # Set the position, can't be changed. < $defs->{pos} = $orig->{pos}; --- > $defs->{pos} = $self->{schema}->{cols}->{$col}->{pos}; 176,179c175,178 < my $table = $self->{table}->name; < if (exists $defs->{type} and ($defs->{type} ne $orig->{type}) or < exists $defs->{size} and ($defs->{size} ne $orig->{size}) or < exists $defs->{not_null} and ($defs->{not_null} ne $orig->{not_null})) --- > my $table = $self->{schema}->name; > if ($defs->{type} ne $self->{schema}->cols->{$col}->{type} or > $defs->{size} ne $self->{schema}->cols->{$col}->{size} > ) 182,190d180 < } < if (ref $defs->{values} and ref $orig->{values}) { < my $orig_list = join ("", @{$defs->{values}}); < my $new_list = join ("", @{$orig->{values}}); < if ($new_list ne $orig_list) { < $change = 1; < } < } < if ($change) { 194c184 < if (exists $self->{table}->fk->{$col}) { --- > if (exists $self->{schema}->fk->{$col}) { 200,203c190,193 < $self->{table}->{schema}->{cols}->{$col} = $defs; < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def"); < return; --- > $self->{schema}->cols->{$col} = $defs; > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def"); > return undef; 207c197 < my $def = $self->{table}->{driver}->_column_sql ($defs); --- > my $def = $self->{schema}->{driver}->_column_sql ($defs); 211c201 < $self->{table}->do ($query) or return; --- > $self->{schema}->{driver}->do ($query) or return; 214,215c204 < $self->save_state or return; < --- > $self->save_state or return undef; 232,233c221,222 < map { exists $self->{table}->cols->{$_} or return $self->error ("NOCOL", "WARN", $_) } @{$indexes}; < exists $self->{table}->unique->{$index_name} and return $self->error ("INDXEXISTS", "WARN", $index_name); --- > map { exists $self->{schema}->cols->{$_} or return $self->error ("NOCOL", "WARN", $_) } @{$indexes}; > exists $self->{schema}->unique->{$index_name} and return $self->error ("INDXEXISTS", "WARN", $index_name); 235c224 < $table = $self->{table}->name; --- > $table = $self->{schema}->name; 241c230 < my $sth = $self->{table}->{driver}->do ($query) or return undef; --- > my $sth = $self->{schema}->{driver}->do ($query) or return undef; 245,247c234,236 < $self->{table}->unique->{$index_name} = $indexes; < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def") or return undef; --- > $self->{schema}->unique->{$index_name} = $indexes; > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def") or return undef; 254c243 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 270c259 < exists $self->{table}->unique->{$index_name} or return $self->error ("NOUNIQUE", "WARN", $index_name); --- > exists $self->{schema}->unique->{$index_name} or return $self->error ("NOUNIQUE", "WARN", $index_name); 272c261 < $table = $self->{table}->name; --- > $table = $self->{schema}->name; 275,277c264,266 < delete $self->{table}->unique->{$index_name}; < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def"); --- > delete $self->{schema}->unique->{$index_name}; > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def"); 284c273 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 302,304c291,293 < map { exists $self->{table}->cols->{$_} or return $self->error ("NOCOL", "WARN", $_) } @{$indexes}; < exists $self->{table}->index->{$index_name} and return $self->error ("INDXEXISTS", "WARN", $index_name); < my $table = $self->{table}->name; --- > map { exists $self->{schema}->cols->{$_} or return $self->error ("NOCOL", "WARN", $_) } @{$indexes}; > exists $self->{schema}->index->{$index_name} and return $self->error ("INDXEXISTS", "WARN", $index_name); > my $table = $self->{schema}->name; 307,309c296,298 < $self->{table}->index->{$index_name} = $indexes; < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def"); --- > $self->{schema}->index->{$index_name} = $indexes; > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def"); 318c307 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 333c322 < exists $self->{table}->index->{$index_name} or return $self->error ("NOINDEX", "WARN", $index_name); --- > exists $self->{schema}->index->{$index_name} or return $self->error ("NOINDEX", "WARN", $index_name); 336,338c325,327 < delete $self->{table}->index->{$index_name}; < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def"); --- > delete $self->{schema}->index->{$index_name}; > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def"); 343c332 < my $table = $self->{table}->name; --- > my $table = $self->{schema}->name; 346c335 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 365c354 < map { exists $self->{table}->cols->{$_} or return $self->error ("NOCOL", "WARN", $_) } @fields; --- > map { exists $self->{schema}->cols->{$_} or return $self->error ("NOCOL", "WARN", $_) } @fields; 367,368c356,357 < my ($table, %add) = ($self->{table}->name); < if ($self->{table}->pk) { --- > my ($table, %add) = ($self->{schema}->name); > if ($self->{schema}->pk) { 371,372c360,361 < $self->{table}->{driver}->do ($query) or return undef; < %add = map { $_ => 1 } @{delete $self->{table}->{schema}->{pk}}; --- > $self->{schema}->{driver}->do ($query) or return undef; > %add = map { $_ => 1 } @{delete $self->{schema}->{pk}}; 377,379c366,368 < $self->{table}->{schema}->{pk} = [keys %add]; < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def"); --- > $self->{schema}->{pk} = [keys %add]; > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def"); 387c376 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 400c389 < $self->{table}->pk || return $self->error ("NOPK", "WARN"); --- > $self->{schema}->pk || return $self->error ("NOPK", "WARN"); 403,405c392,394 < $self->{table}->{schema}->{pk} = []; < unless ($self->{table}->check_schema) { < $self->{table}->load_state ("$GT::SQL::DEF_PATH/$self->{table}->{name}.def"); --- > $self->{schema}->{pk} = []; > unless ($self->{schema}->check_schema) { > $self->{schema}->load_state ("$GT::SQL::DEF_PATH/$self->{schema}->{name}.def"); 410c399 < my $table = $self->{table}->name; --- > my $table = $self->{schema}->name; 413c402 < $self->{table}->{driver}->do ($query) or return undef; --- > $self->{schema}->{driver}->do ($query) or return undef; 428c417 < $self->{table}->fk (@_) or return undef; --- > $self->{schema}->fk (@_) or return undef; 435c424 < delete $self->{table}->{schema}->{fk}->{$table} or return $self->error ("FKNOEXISTS", "WARN", $table); --- > delete $self->{schema}->{fk}->{$table} or return $self->error ("FKNOEXISTS", "WARN", $table); 540c529 < my $table = $self->{table}->name; --- > my $table = $self->{schema}->name; 542c531 < my $tmp = $self->{table}->fk_tables() || []; --- > my $tmp = $self->{schema}->fk_tables() || []; 546c535 < $self->{table}->{driver}->do (qq!DROP TABLE $table!) or return; --- > $self->{schema}->{driver}->do (qq!DROP TABLE $table!) or return; 560c549 < if ( keys %{$self->{table}->weight()} ) { --- > if ( keys %{$self->{schema}->weight()} ) { 566c555 < 'schema' => $self->{table}, --- > 'schema' => $self->{schema}, 581,582c570,571 < my $fk = $self->{table}->fk() or return; < my $prefix = $DB->prefix(); --- > > my $fk = $self->{schema}->fk() or return; 584d572 < $related_name =~ s/^$prefix//g; # not 'o' because it may cause mod_perl problems 612c600 < schema => $self->{table}, --- > schema => $self->{schema}, 625c613 < foreach my $table (@{$self->{table}->fk_tables}) { --- > foreach my $table (@{$self->{schema}->fk_tables}) { 640c628 < foreach my $table (@{$self->{table}->fk_tables}) { --- > foreach my $table (@{$self->{schema}->fk_tables}) { 660c648 < foreach my $table (keys %{$self->{table}->fk}) { --- > foreach my $table (keys %{$self->{schema}->fk}) { 662,663c650,651 < if ($fc = $self->{table}->fk->{$table}->{$mycol}) { < delete $self->{table}->fk->{$table}->{$mycol}; --- > if ($fc = $self->{schema}->fk->{$table}->{$mycol}) { > delete $self->{schema}->fk->{$table}->{$mycol}; 665c653 < next if keys %{$self->{table}->fk->{$table}}; --- > next if keys %{$self->{schema}->fk->{$table}}; 893c881 < Revision: $Id: Editor.pm,v 1.20 2001/02/18 19:15:10 alex Exp $ --- > Revision: $Id: Editor.pm,v 1.18 2001/01/30 23:00:10 alex Exp $ Index: GT/SQL/Relation.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Relation.pm,v retrieving revision 1.42 retrieving revision 1.39 diff -r1.42 -r1.39 6c6 < # $Id: Relation.pm,v 1.42 2001/02/12 01:01:01 alex Exp $ --- > # $Id: Relation.pm,v 1.39 2001/01/31 04:10:48 alex Exp $ 29c29 < $VERSION = sprintf "%d.%03d", q$Revision: 1.42 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.39 $ =~ /(\d+)\.(\d+)/; 577c577 < return sort { my $ret = $self->_col_cmp($a, $b); $ret } keys %cols; --- > return sort { my $ret = $self->_col_cmp ($a, $b); $ret } keys %cols; 669c669 < return sort { my $ret = $self->_col_cmp($a, $b); $ret; } @result; --- > return sort { my $ret = $self->_col_cmp ($a, $b); $ret } @result; 929c929 < return 0; --- > return; 1615c1615 < Revision: $Id: Relation.pm,v 1.42 2001/02/12 01:01:01 alex Exp $ --- > Revision: $Id: Relation.pm,v 1.39 2001/01/31 04:10:48 alex Exp $ Index: GT/SQL/Table.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Table.pm,v retrieving revision 1.104 retrieving revision 1.100 diff -r1.104 -r1.100 6c6 < # $Id: Table.pm,v 1.104 2001/02/19 22:07:58 alex Exp $ --- > # $Id: Table.pm,v 1.100 2001/02/05 00:18:15 alex Exp $ 28c28 < $VERSION = sprintf "%d.%03d", q$Revision: 1.104 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.100 $ =~ /(\d+)\.(\d+)/; 62d61 < $self->{_index} = 1; 235c234 < $self->_index_record($self->{last_insert}, $sth) unless ($opts->{GT_SQL_SKIP_INDEX}); --- > $self->_index_record($self->{last_insert}, $sth); 285c284 < # $obj->update ($hash_ref, $condition, $opts); --- > # $obj->update ($hash_ref, $condition); 290c289 < # $obj->update ($hash_ref_1, $hash_ref_2, $opts); --- > # $obj->update ($hash_ref_1, $hash_ref_2); 305,306d303 < $opts ||= {}; < $where ||= {}; # Update all. 350c347 < $self->_update_index ($sth) unless ($opts->{GT_SQL_SKIP_INDEX}); --- > $self->_update_index ($sth); 2319,2321d2315 < Passing in GT_SQL_SKIP_INDEX => 1 will not index the fields. You can < also use the C method to do this. < 2398,2399c2392,2393 < C returns undef on failure and the a L statement < handle on success. The error message will be available in $GT::SQL::error. --- > C returns undef on failure, 1 on success. The error message > will be available in $GT::SQL::error. 2404,2406d2397 < Passing in GT_SQL_SKIP_INDEX => 1 will not index the fields. You can < also use the C method to do this. < 2552c2543 < Revision: $Id: Table.pm,v 1.104 2001/02/19 22:07:58 alex Exp $ --- > Revision: $Id: Table.pm,v 1.100 2001/02/05 00:18:15 alex Exp $ Index: GT/SQL/Display/HTML.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Display/HTML.pm,v retrieving revision 1.48 retrieving revision 1.44 diff -r1.48 -r1.44 6c6 < # $Id: HTML.pm,v 1.48 2001/02/18 19:41:15 alex Exp $ --- > # $Id: HTML.pm,v 1.44 2001/01/29 14:46:43 sbeck Exp $ 24c24 < $VERSION = sprintf "%d.%03d", q$Revision: 1.48 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.44 $ =~ /(\d+)\.(\d+)/; 218,224c218 < # sort => coderef called to sort the list. Keep in mind that you < # will need to do this (this example is a reverse numerical sort): < # sub { no strict "refs"; ${${caller() . "::"}{b}} <=> ${${caller() . "::"}{a}} } < # because $a and $b are package globals and are not the < # same '$a' and '$b' that are available in your function. < # sort_order => takes a list of the fields in the order they should be displayed. < --- > # 240c234 < my $sort_f = exists $opts->{sort} ? $opts->{sort} : ''; --- > my $sort_f = exists $opts->{sort} ? $opts->{sort} : sub { lc $hash{$a} cmp lc $hash{$b} }; 265,266c259,260 < elsif ($sort_f and ref $sort_f) { @keys = sort { $sort_f->($a, $b) } keys %hash; } < else { @keys = @$names; } --- > elsif ($sort_f and ref $sort_f) { @keys = sort { $sort_f->() } keys %hash; } > else { @keys = keys %hash; } 451c445 < my $def = exists $opts->{def} ? $opts->{def} : return $self->error ("BADARGS", "FATAL", "No type hash passed to view creator display_text (" . (caller())[2] . ")" ); --- > my $def = exists $opts->{def} ? $self->{def} : return $self->error ("BADARGS", "FATAL", "No type hash passed to view creator display_text (" . (caller())[2] . ")" ); 453a448 > $val =~ s/\Q$INPUT_SEPARATOR\E|\n/\n/g; 455,468d449 < < # If they are using checkbox/radio/selects then we map form_names => form_values. < if (ref $def->{form_names} and ref $def->{form_values}) { < if (@{$def->{form_names}} and @{$def->{form_values}}) { < my %map = map { $def->{form_names}->[$_] => $def->{form_values}->[$_] } (0 .. $#{$def->{form_names}}); < my @keys = split /\Q$INPUT_SEPARATOR\E|\n/, $val; < $val = ''; < < foreach (@keys) { < $val .= $map{$_} ? $map{$_} : $_; < $val .= ""; < } < } < } 547,548c528,529 < and $hash = { 'LIKE' => 'Like', '=' => 'Exact Match', '<>' => 'Not Equal', '>' => 'Greater Than', '<' => 'Less Than'}, < $so = [ 'LIKE', '=', '<>', '>', '<' ], last CASE; --- > and $hash = { 'LIKE' => 'Like', '=' => 'Exact Match', '>' => 'Greater Than', '<' => 'Less Than'}, > $so = [ 'LIKE', '=', '>', '<' ], last CASE; 550,551c531,532 < and $hash = { 'LIKE' => 'Like', '=' => 'Exact Match', '<>' => 'Not Equal', }, < $so = [ 'LIKE', '=', '<>' ], last CASE; --- > and $hash = { 'LIKE' => 'Like', '=' => 'Exact Match' }, > $so = [ 'LIKE', '=' ], last CASE; 553,554c534,535 < and $hash = { '=' => 'Exact Match', '<>' => 'Not Equal', '>' => 'Greater Than', '<' => 'Less Than'}, < $so = [ '=', '>', '<', '<>' ], last CASE; --- > and $hash = { '=' => 'Exact Match', '>' => 'Greater Than', '<' => 'Less Than'}, > $so = [ '=', '>', '<' ], last CASE; Index: GT/SQL/Display/HTML/Relation.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Display/HTML/Relation.pm,v retrieving revision 1.12 retrieving revision 1.11 diff -r1.12 -r1.11 6c6 < # $Id: Relation.pm,v 1.12 2001/02/09 06:52:05 sbeck Exp $ --- > # $Id: Relation.pm,v 1.11 2001/01/25 00:47:08 alex Exp $ 24c24 < $VERSION = sprintf "%d.%03d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/; 239c239 < (defined $c->{$col}->{default} and $c->{$col}->{default} =~ /0000/) ? --- > ($c->{$col}->{default} =~ /0000/) ? Index: GT/SQL/Display/HTML/Table.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/SQL/Display/HTML/Table.pm,v retrieving revision 1.11 retrieving revision 1.9 diff -r1.11 -r1.9 6c6 < # $Id: Table.pm,v 1.11 2001/02/10 23:05:32 aki Exp $ --- > # $Id: Table.pm,v 1.9 2001/01/25 00:47:08 alex Exp $ 24c24 < $VERSION = sprintf "%d.%03d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/; --- > $VERSION = sprintf "%d.%03d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/; 54,158d53 < sub display_row { < # --------------------------------------------------------------- < # Display a record row as html. < # < my ($self, $opts) = @_; < $opts->{disp_form} = 0; < $opts->{disp_html} = 1; < return $self->_display_row ($opts || ()); < } < < sub display_row_cols { < # --------------------------------------------------------------- < # returns the for each of the title names for columns < # < my $self = shift; < < # Initiate if we are passed in any arguments as options. < if (@_) { $self->init (@_); } < < # Get the column hash and primary key < $self->{cols} = $self->{db}->cols unless exists $self->{cols}; < $self->{pk} = $self->{db}->pk unless exists $self->{pk}; < < # Output < my $out = ''; < < # Hide the primary keys. < $self->{view_key} and push (@{$self->{view}}, @{$self->{pk}}); < < # Calculate the form values. < my $values = $self->_get_defaults; < < # Now go through each column and print out a column row. < my @cols = $self->{db}->ordered_columns; < my $script = GT::CGI->url(); < $script =~ s/\&?sb=([^&]*)//g; < my $sb = $1; < $script =~ s/\&?so=(ASC|DESC)//g; < my $so = $1; < foreach my $col (@cols) { < < $out .= qq!\n\t{col_font}>!; < $out .= qq!!; < $out .= $col; < $out .= ( ( $col eq $sb ) ? ( ($so eq 'ASC') ? " ^" : " v" ) : '' ) . ""; < $out .= qq!\n!; < < } < < return $out; < } < < sub _display_row { < # --------------------------------------------------------------- < # Handles displaying of a form or a record. < # < my $self = shift; < < # Initiate if we are passed in any arguments as options. < if (@_) { $self->init (@_); } < < # Get the column hash and primary key < $self->{cols} = $self->{db}->cols unless exists $self->{cols}; < $self->{pk} = $self->{db}->pk unless exists $self->{pk}; < < # Output < my $out = ''; < < # Hide the primary keys. < $self->{view_key} and push (@{$self->{view}}, @{$self->{pk}}); < < # Calculate the form values. < my $values = $self->_get_defaults; < < # Now go through each column and print out a column row. < my @cols = $self->{db}->ordered_columns; < foreach my $col (@cols) { < < # Run any code refs that have been setup. < if (exists $self->{code}->{$col} and (ref $self->{code}->{$col} eq 'CODE')) { < $out .= $self->{code}->{$col}->($self, $self->{cols}->{$col}, $values); < next; < } < next if $self->_skip ($col); < < # Set the form name (using increment for multiple if requested) and also the display name. < my $field_name = $self->{multiple} ? "$self->{multiple}-$col" : $col; < my $display_name = exists $self->{cols}->{$col}->{form_display} ? $self->{cols}->{$col}->{form_display} : $col; < my $value = $values->{$col}; < my $disp = $self->{disp_form} ? $self->_get_form_display ($col) : $self->_get_html_display ($col); < < $disp eq 'hidden' and push (@{$self->{hide}}, $col) and next; < < $out .= qq!\n\t{col_font}>!; < < # Get the column display subroutine < $out .= $self->$disp( { name => $field_name, def => $self->{cols}->{$col}, value => $value }); < < $out .= qq!\n!; < < } < < return $out; < } < 195c90 < else { $cwidth = "30%"; $vwidth = "70%" } --- > else { $cwidth = "30%"; $vwidth = "70%" } Index: GT/Session/TempTable.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/Session/TempTable.pm,v retrieving revision 1.2 retrieving revision 1.1 diff -r1.2 -r1.1 8a9 > use GT::Session::SQL; 13c14 < @ISA = qw| GT::Base |; --- > @ISA = qw| GT::Session::SQL GT::Base |; 16,17c17,22 < id => undef, < tb => undef, --- > info => { > session_date => undef, > session_data => undef, > session_id => undef, > }, > tb => undef, 24d28 < seconds => 60*60, 33,36c37,40 < 'BADDATA' => "Invalid data in session: '%s'. Reason: '%s'", < 'CLASSFUNC' => "This is a class function only.", < 'INVALIDSESSION'=> "Invalid session id: '%s'.", < 'BADARGS' => "Invalid arguments: %s", --- > BADDATA => "Invalid data in session: '%s'. Reason: '%s'", > CLASSFUNC => "This is a class function only.", > INVALIDSESSION => "Invalid session id: '%s'.", > BADARGS => "Invalid arguments: %s", 40,42c44,48 < sub install { < #------------------------------------------------------------------------------- < # creates the controller table --- > sub new { > # --------------------------------------------------------------- > # Initilizes a session. Expects to find a session id to lookup, some > # data to save, or nothing. If no session is defined, then one will > # be generated. If an invalid session is specified, nothing is returned. 44,45c50,57 < my $self = shift; < my $DB = $self->_db(); --- > my $this = shift; > my $class = ref $this || $this; > my $self = bless {}, $class; > > # Set defaults. > foreach (keys %$ATTRIBS) { > $self->{$_} = $ATTRIBS->{$_}; > } 47c59,65 < my $c = $DB->creator( $self->{set_name} ); --- > # We got passed in a single session id. > if (@_ == 2) { > $self->{tb} = $_[1]; > $self->load ($_[0]) or return $self->error ('INVALIDSESSION', 'WARN', $_[0]); > $self->{save} = 0; > return $self; > } 49,60c67,88 < $c->cols( < ID => { pos => 1, type => 'INT', not_null => 1, unsigned => 1, regex => '^d+$' }, < SessID => { pos => 2, type => 'CHAR', size => 100, not_null => 1 }, < SessTable => { pos => 3, type => 'CHAR', size => 100, not_null => 1 }, < Timestmp => { pos => 4, type => 'TIMESTAMP', time_check => 1 } < ); < < $c->pk('ID'); < $c->ai('ID'); < $c->create('force'); < $c->set_defaults(); < $c->save_schema(); --- > # We got passed some options, possibly a session id. > if (@_ == 1 and ref $_[0] eq 'HASH') { > my $opts = $_[0]; > foreach (keys %{$opts}) { > if (exists $self->{$_}) { $self->{$_} = $opts->{$_}; next } > if (exists $self->{info}->{$_}) { $self->{info}->{$_} = $opts->{$_}; next } > } > } > > exists ($self->{tb}) or return $self->error ("BADARGS", "FATAL", "Must pass in a table object"); > > # If we have an id, load it or return. > if ($self->{info}->{session_id}) { > $self->load ($self->{info}->{session_id}) or return $self->error ('INVALIDSESSION', 'WARN', $self->{id}); > $self->{save} = 0; > } > else { > $self->{info}->{session_id} = generate_session_id(); > $self->{save} = 1; > } > > return $self; 63c91 < sub uninstall { --- > sub initial_create { 65c93 < # drops the controller table along with all the --- > # creates the controller table 67,83c95,96 < my $self = shift; < my $DB = $self->_db() or return; < my $err = 1; < < # drop all the associated temp tables..., < eval { < my $tb = $DB->table( $self->{set_name} ); < my $sth = $tb->select( [ 'SessTable' ] ); < while ( my $aref = $sth->fetchrow_arrayref() ) { < my $table_name = $aref->[0]; < eval { < my $e = $DB->editor( $table_name ); < $e->drop_table("remove") or die "Can't drop table"; < }; < $@ and $err = undef; < < } --- > my $self = shift; > my $DB = $self->_db(); 85,88c98 < # now drop the master control table < my $e = $DB->editor( $self->{set_name}); < $e->drop_table("remove") or die "Can't drop table"; < }; --- > my $c = $DB->creator( $self->{set_name} ); 90c100,111 < return $@ ? undef : 1; --- > $c->cols( > ID => { pos => 1, type => 'INT', not_null => 1, unsigned => 1, regex => '^d+$' }, > SessID => { pos => 2, type => 'CHAR', size => 100, not_null => 1 }, > SessTable => { pos => 3, type => 'CHAR', size => 100, not_null => 1 }, > Timestmp => { pos => 4, type => 'TIMESTAMP', time_check => 1 } > ); > > $c->pk('ID'); > $c->ai('ID'); > $c->create('force'); > $c->set_defaults(); > $c->save_schema(); 98c119,120 < my $create_session = ( ref $_[0] eq 'CODE' ? shift : $self->{create_session} ) or return $self->error( 'NOCS', 'WARN' ); --- > my $create_session = shift || $self->{create_session} or return $self->error( 'NOCS', 'WARN' ); > ref $create_session eq 'CODE' or return $self->error( 'CSNOTCODE', 'WARN' ); 100c122 < my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' ); --- > my $sid = $self->{info}->{session_id} or return $self->error( 'NOSID', 'WARN' ); 106c128 < my $newid = $Session->add({ SessTable => $table_name, SessID => $sid }) or return; --- > my $newid = $Session->add({ SessTable => $table_name, SessID => $sid, }) or return; 108,109c130,131 < # create the new table, extra parameters are passed into the create_session sub procedure < if ( my $result = &{$create_session}( $DB, $table_name, $newid, @_ ) ) { --- > # create the new table > if ( my $result = &{$create_session}( $DB, $table_name, $newid ) ) { 114c136 < $Session->delete($newid); --- > $Session->drop($newid); 126c148 < my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' ); --- > my $sid = $self->{info}->{session_id} or return $self->error( 'NOSID', 'WARN' ); 128,133c150,153 < my $DB = $self->_db(); < my $Session = $DB->table( $self->{set_name} ) or return; < my $sth = $Session->select({ ID => $set_id, SessID => $sid }) or return undef; < my $href = $sth->fetchrow_hashref() or return undef; < $href->{Timestmp} = \'NOW()'; < $Session->update( $href ); --- > my $DB = $self->_db(); > my $Session = $DB->table( $self->{set_name} ) or return; > my $sth = $Session->select({ ID => $set_id, SessID => $sid }, ['SessTable']) or return undef; > my $aref = $sth->fetchrow_arrayref() or return undef; 135c155 < if ( my $table_name = $href->{'SessTable'} ) { --- > if ( my $table_name = $aref->[0] ) { 151c171 < my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' ); --- > my $sid = $self->{info}->{session_id} or return $self->error( 'NOSID', 'WARN' ); 172c192 < my $sid = ( shift || $self->{id} ) or return $self->error( 'NOSID', 'WARN' ); --- > my $sid = ( shift || $self->{info}->{session_id} ) or return $self->error( 'NOSID', 'WARN' ); 175d194 < # delete all created temp tables 178,181c197,198 < eval { < my $e = $DB->editor($tbl_name); < $e->drop_table( "remove" ); < } --- > my $e = $DB->editor($tbl_name); > $e->drop_table( "remove" ); 199c216 < my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' ); --- > my $sid = $self->{info}->{session_id} or return $self->error( 'NOSID', 'WARN' ); 205c222 < $e->drop_table(); --- > $e->drop_table( "remove" ); 212,213c229 < my $self = shift; < my $seconds = shift || $self->{seconds}; --- > my ($self, $seconds) = @_; 220,222d235 < my $DB = $self->_db() or return; < my $tb = $DB->table( $self->{set_name} ); < 225c238 < my @time = localtime ($new_sec); --- > my @time = localtime ($new_sec); 230c243 < my $sth = $tb->select( GT::SQL::Condition->new('Timestmp', '<', $date_str), [ 'SessID' ] ) or return $self->error ($GT::SQL::error); --- > my $sth = $self->{tb}->select( GT::SQL::Condition->new('session_data', '<', $date_str), [ 'session_id' ] ) or return $self->error ($GT::SQL::error); 234c247 < $tb->delete (GT::SQL::Condition->new ('Timestmp', '<', $date_str)) or return $self->error ($GT::SQL::error); --- > $self->{tb}->delete (GT::SQL::Condition->new ('session_data', '<', $date_str)) or return $self->error ($GT::SQL::error); 249c262 < $db = GT::SQL->new( $def_path ); --- > my $db = GT::SQL->new( $def_path ); 262c275 < return md5_hex( time . $$ . rand (16000) ); --- > return md5_hex ( time . $$ . rand (16000) ); Index: GT/URI/HTTP.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/URI/HTTP.pm,v retrieving revision 1.21 retrieving revision 1.20 diff -r1.21 -r1.20 6c6 < # $Id: HTTP.pm,v 1.21 2001/02/11 01:11:24 aki Exp $ --- > # $Id: HTTP.pm,v 1.20 2000/12/11 18:28:47 aki Exp $ 168,169c168 < if ( $sock ) { < $fh = $sock->fh(); --- > if ( $fh = $sock->fh() ) { 880c879 < Revision: $Id: HTTP.pm,v 1.21 2001/02/11 01:11:24 aki Exp $ --- > Revision: $Id: HTTP.pm,v 1.20 2000/12/11 18:28:47 aki Exp $ Index: GT/URI/HTTPS.pm =================================================================== RCS file: /usr/local/gossamer/library/GT/URI/HTTPS.pm,v retrieving revision 1.5 retrieving revision 1.4 diff -r1.5 -r1.4 6c6 < # $Id: HTTPS.pm,v 1.5 2001/02/11 01:11:24 aki Exp $ --- > # $Id: HTTPS.pm,v 1.4 2001/01/02 16:57:49 aki Exp $ 169,170c169 < if ( $sock ) { < $fh = $sock->fh(); --- > if ( $fh = $sock->fh() ) { 614c613 < Revision: $Id: HTTPS.pm,v 1.5 2001/02/11 01:11:24 aki Exp $ --- > Revision: $Id: HTTPS.pm,v 1.4 2001/01/02 16:57:49 aki Exp $
", $self->{html}->display ( { mode => 'search_results', values => $result }); < } --- > while (my $result = $sth->fetchrow_hashref) { > print "
", $self->{html}->display ( { mode => 'search_results', values => $result }); 271d255 < 448,487c432,437 < < if ( $self->{in}->param('dr') eq 'rows' ) { < < print qq!