[求助]几个模块cpan上找不到，google也找不到。。。急死人了！向各位求助

xhmaxhma

求助各位了。。。

Sledge:lugin::Mail
Sledge:lugin::Validation
Sledge::Exception::MapFileUndefined
Edge::Config
Edge::Mailer
Data:age::Googlish

Sledge像是开发框架的模块， 很多子模块cpan都下载到了！ 独独缺了这3个子模块   Sledge:lugin::Mailer 和 Sledge:lugin::Mail::Japanese到是找到了！ 唉  

上面6个模块在cpan和google上都找过了。。。还是找不到。。。有哪位用过上面模块的朋友知道下载地址给个也行啊， 在此先谢谢大家了！

alexru

这么多娃娃头？

gsging

1. 
   
2. Sledge::Plugin::Mail
   
3. Sledge::Plugin::Validation
   
4. Edge::Config
   
5. Edge::Mailer
   

复制代码

上面这4个我可以给你

Sledge::Exception::MapFileUndefined这个你是不是写错了,Sledge框架里面没有Exception这个目录
我估计你要找的是不是Sledge::Exceptions::MapFileUndefined这个?
如果是的话那么你可以在Sledge::Exceptions这个模块里面找找看是否有Sledge::Exceptions::MapFileUndefined这个package.

1. 
   
2. Data::Page::Googlish

复制代码

这个就不清楚了.

[ 本帖最后由 gsging 于 2006-11-2 14:02 编辑 ]

gsging

1. 
   
2. package Sledge::Plugin::Mail;
   
3. # $Id: Mail.pm,v 1.12 2002/04/24 18:11:28 miyagawa Exp $
   
4. #
   
5. # Tatsuhiko Miyagawa <miyagawa@edge.co.jp>
   
6. # Livin' On The EDGE, Limited.
   
7. #
   
8. 
   
9. use strict;
   
10. use vars qw($VERSION);
    
11. $VERSION = 0.06;
    
12. 
    
13. use base qw(Class::Accessor);
    
14. __PACKAGE__->mk_accessors(qw(to sender _tmpl filter));
    
15. 
    
16. use Edge::Mailer;
    
17. 
    
18. use vars qw($SendVia);
    
19. $SendVia = 'localhost';
    
20. 
    
21. sub import {
    
22.     my $class = shift;
    
23.     my $pkg = caller;
    
24. 
    
25.     no strict 'refs';
    
26.     *{"$pkg\::init_mail"} = sub {
    
27.         my($self, $name) = @_;
    
28.         # template load
    
29.         $self->{mail} = $self->create_mail($name);
    
30.     };
    
31.     *{"$pkg\::create_mail"} = sub {
    
32.         my($self, $name) = @_;
    
33.         return $class->new($name, $self);
    
34.     };
    
35.     *{"$pkg\::mail"} = sub {
    
36.         my $self = shift;
    
37.         $self->{mail};
    
38.     };
    
39. }
    
40. 
    
41. sub new {
    
42.     my($class, $name, $page) = @_;
    
43.     my $self = bless {}, $class;
    
44. 
    
45.     $name .= '.eml' if $name !~ /\./;
    
46. 
    
47.     my $file = $page->can('mail_tmpl_dirname')
    
48.         ? join("/", $page->create_config->tmpl_path, $page->mail_tmpl_dirname, $name)
    
49.             : $page->guess_filename($name);
    
50. 
    
51.     $self->_tmpl($page->create_template($file));
    
52.     return $self;
    
53. }
    
54. 
    
55. sub param {
    
56.     my $self = shift;
    
57.     $self->_tmpl->param(@_);
    
58. }
    
59. 
    
60. sub send {
    
61.     my $self = shift;
    
62. 
    
63.     # $SendVia = "smtp.example.com" || "| /usr/sbin/sendmail"
    
64.     my($host, $method, @send_args) = _choose_way($SendVia);
    
65.     my $mailer = Edge::Mailer->new(
    
66.         to       => $self->to,
    
67.         sender   => $self->sender,
    
68.         smtphost => $host,
    
69.         filter   => $self->filter,
    
70.         message  => $self->_tmpl->output,
    
71.     );
    
72. 
    
73.     $mailer->$method(@send_args);
    
74. }
    
75. 
    
76. sub _choose_way {
    
77.     my $via = shift;
    
78.     if ($via =~ s/^\|\s*//) {
    
79.         # | /path/to/sendmail
    
80.         return (undef, 'send_via_sendmail', $via);
    
81.     }
    
82.     return ($via, 'send');
    
83. }
    
84. 
    

复制代码

gsging

1. 
   
2. package Sledge::Plugin::Validation;
   
3. # $Id: Validation.pm,v 1.4 2002/08/22 10:43:44 miyagawa Exp $
   
4. #
   
5. # Tatsuhiko Miyagawa <miyagawa@edge.co.jp>
   
6. # Livin' On The EDGE, Limited.
   
7. #
   
8. 
   
9. use strict;
   
10. use vars qw($VERSION);
    
11. $VERSION = 0.02;
    
12. 
    
13. use Sledge::Constants;
    
14. use Sledge::Exceptions;
    
15. 
    
16. sub import {
    
17.     my $class = shift;
    
18.     return unless @_;
    
19. 
    
20.     my %args = @_;
    
21.     my $pkg = caller;
    
22.     no strict 'refs';
    
23.     while (my($page, $validator) = each %args) {
    
24.         *{"$pkg\::post_dispatch_$page"} = $class->make_post_closure($page, $validator);
    
25.     }
    
26. }
    
27. 
    
28. sub make_post_closure {
    
29.     my($class, $page, $val_class) = @_;
    
30.     my $val_method = 'validate'; # default
    
31.     if ($val_class =~ /^(.*)\->(.*)$/) {
    
32.         $val_class = $1;
    
33.         $val_method = $2;
    
34.     }
    
35.     eval qq{require $val_class};
    
36.     if ($@ && $@ !~ /locate/) {
    
37.         Sledge::Exception::ClassUndefined->throw($@);
    
38.     }
    
39.     return sub {
    
40.         my $self = shift;
    
41.         my $validator  = $val_class->new;
    
42.         my($status, $reason) = $validator->$val_method($self);
    
43.         my $method = ($status == SUCCESS) ? "succeed_$page" : "fail_$page";
    
44.         $self->$method($reason);
    
45.     };
    
46. }
    
47. 
    
48. 1;
    

复制代码

gsging

1. 
   
2. package Edge::Config;
   
3. 
   
4. use strict;
   
5. use vars qw($VERSION);
   
6. $VERSION = 0.12;
   
7. 
   
8. use Tie::Hash;
   
9. use base 'Tie::StdHash';
   
10. use Carp ();
    
11. 
    
12. sub safe_load {
    
13.     my $module = shift;
    
14.     $module =~ /^([A-Za-z0-9_\:]+)$/;
    
15.     $module = $1;
    
16.     eval qq{require $module};
    
17. }
    
18. 
    
19. # XXX 5.8.0 Tie::StdHash doesn't have new()
    
20. sub new {
    
21.     my $pkg = shift;
    
22.     $pkg->TIEHASH(@_);
    
23. }
    
24. 
    
25. sub TIEHASH {
    
26.     my($class, $configname) = @_;
    
27. 
    
28.     no strict 'refs';
    
29.     local $@;
    
30. 
    
31.     my $common_name = $ENV{EDGE_CONFIG_COMMON_NAME} || '_common';
    
32.     safe_load("${class}::${common_name}");
    
33.     die $@ if $@ && $@ !~ /Can\'t locate/;
    
34.     if ($configname) {
    
35.         safe_load("${class}::${configname}");
    
36.         die $@ if $@ && $@ !~ /Can\'t locate/;
    
37.     }
    
38.     my %config = %{join '::', $class, $common_name, 'Config'};
    
39.     %config = (%config, %{join '::', $class, $configname, 'Config'}) if $configname;
    
40. 
    
41.     # case sensitive hash
    
42.     %config = map { lc($_) => $config{$_} } keys %config
    
43.         unless $class->case_sensitive;
    
44.     bless \%config, $class;
    
45. }
    
46. 
    
47. sub FETCH {
    
48.     my($self, $key) = @_;
    
49.     unless (ref($self)) {
    
50.         require Carp;
    
51.         Carp::carp "Possibly misuse: $key called as a class method.";
    
52.     }
    
53.     $key = lc($key) unless $self->case_sensitive;
    
54.     Carp::croak "no such key: $key"
    
55.         if (! exists $self->{$key} && $self->strict_param);
    
56.     $self->{$key};
    
57. }
    
58. 
    
59. sub STORE {
    
60.     my($self, $key, $value) = @_;
    
61.     $key = lc($key) unless $self->case_sensitive;
    
62.     Carp::croak "can't modify param $key"
    
63.         unless $self->can_modify_param;
    
64.     $self->{$key} = $value;
    
65. }
    
66. 
    
67. sub param {
    
68.     my $self = shift;
    
69.     if (@_ == 0) {
    
70.         return keys %{$self};
    
71.     }
    
72.     elsif (@_ == 1) {
    
73.         my $value = $self->FETCH(@_);
    
74.         if (wantarray && ref($value)) {
    
75.             return @$value if ref($value) eq 'ARRAY';
    
76.             return %$value if ref($value) eq 'HASH';
    
77.         }
    
78.         return $value;
    
79.     }
    
80.     else {
    
81.         $self->STORE(@_);
    
82.     }
    
83. }
    
84. 
    
85. # default value
    
86. sub strict_param { 1; }
    
87. sub can_modify_param { 0; }
    
88. sub case_sensitive { 1; }
    
89. 
    
90. # nop for AUTOLOAD
    
91. sub DESTROY { }
    
92. 
    
93. use vars qw($AUTOLOAD);
    
94. sub AUTOLOAD {
    
95.     my $self = shift;
    
96.     $AUTOLOAD =~ s/.*:://;
    
97. 
    
98.     # cache accessor
    
99.     $self->_create_accessor($AUTOLOAD);
    
100. 
     
101.     $self->param($AUTOLOAD, @_);
     
102. }
     
103. 
     
104. sub _create_accessor {
     
105.     my($self, $accessor) = @_;
     
106. 
     
107.     no strict 'refs';
     
108.     my $class = ref $self;
     
109.     *{"$class\::$accessor"} = sub {
     
110.         my $self = shift;
     
111.         $self->param($accessor, @_);
     
112.     };
     
113. }
     
114. 
     
115. 1;
     
116. __END__
     
117. 
     
118. =head1 NAME
     
119. 
     
120. Edge::Config - Edge standard application configuration
     
121. 
     
122. =head1 SYNOPSIS
     
123. 
     
124.   package YourProject::Config;
     
125.   use base 'Edge::Config';
     
126. 
     
127.   package main;
     
128.   use YourProject::Config;
     
129. 
     
130.   # for OO-kids
     
131.   $config = YourProject::Config->new;
     
132.   $config = YourProject::Config->new($configname);
     
133. 
     
134.   # for hash lover
     
135.   tie %config, 'YourProject::Config';
     
136.   tie %config, 'YourProject::Config', $configname;
     
137. 
     
138. 
     
139. =head1 DESCRIPTION
     
140. 
     
141. see README.
     
142. 
     
143. =head1 AUTHOR
     
144. 
     
145. Tatsuhiko Miyagawa <miyagawa@edge.co.jp>
     
146. 
     
147. =head1 SEE ALSO
     
148. 
     
149. perl(1).
     
150. 
     
151. =cut
     

复制代码

gsging

1. 
   
2. # $Id: Mailer.pm,v 1.14 2005/01/07 06:36:54 taniguchi Exp $
   
3. package Edge::Mailer;
   
4. 
   
5. use strict;
   
6. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
   
7. 
   
8. require Exporter;
   
9. @ISA = qw(Exporter);
   
10. @EXPORT = qw(mailer);
    
11. $VERSION = '0.16';
    
12. 
    
13. use Carp;
    
14. use FileHandle;
    
15. use Jcode;
    
16. use Net::SMTP;
    
17. use Sys::Hostname;
    
18. 
    
19. use constant TIMEOUT_DEFAULT    => 30;
    
20. use constant SMTPHOST_DEFAULT   => 'localhost';
    
21. 
    
22. use constant RFC_COMPLIANT_VERSION => 0.64;
    
23. 
    
24. sub new {
    
25.     my $proto = shift;
    
26.     my $class = ref $proto || $proto;
    
27. 
    
28.     my $self = bless {
    
29.         timeout => TIMEOUT_DEFAULT,
    
30.         smtphost => SMTPHOST_DEFAULT,
    
31.     }, $class;
    
32.     $self->_init(@_);
    
33.     return $self;
    
34. }
    
35. 
    
36. sub mailer { __PACKAGE__->new(@_); }
    
37. 
    
38. sub _init {
    
39.     my $self = shift;
    
40.     while (my ($key, $val) = splice(@_, 0, 2)) {
    
41.         $self->{$key} = $val;
    
42.     }
    
43.     return $self;
    
44. }
    
45. 
    
46. sub _prepare_send {
    
47.     my $self = shift;
    
48. 
    
49.     # 必須フィールドがなければ warning and return
    
50.     foreach my $field (qw( to sender message )) {
    
51.         defined $self->{$field} or do {
    
52.             carp __PACKAGE__.":$field is required!";
    
53.             return;
    
54.         };
    
55.     }
    
56. 
    
57.     # RCPT 複数の場合は array reference
    
58.     my @rcpt = ref($self->{to}) eq 'ARRAY'
    
59.         ? @{$self->{to}} : ($self->{to});
    
60.     # 最初は EUC にしておく
    
61.     my $message = Jcode->new($self->{message})->h2z->euc;
    
62. 
    
63.     # Time-Zone diff
    
64.     my $date = rfc2822date(localtime());
    
65.     my $fqdn = $self->{smtphost} ne SMTPHOST_DEFAULT ?
    
66.         $self->{smtphost} : $ENV{SERVER_NAME} || Sys::Hostname::hostname;
    
67. 
    
68.     # smtphost で指定した時はIP-addrかもしれない
    
69.     # IP-addr の場合は ...@[11.11.11.11] のようにする
    
70.     $fqdn =~ s/^(\d+\.\d+\.\d+\.\d+)$/[$1]/;
    
71. 
    
72.     my $message_id = sprintf '<%s.%s.%s@%s>', time, $$, random_str(6), $fqdn;
    
73. 
    
74.     # デフォルトヘッダ作成
    
75.     my %header = (From => $self->{sender},
    
76.                   'X-Sender' => $self->{sender},
    
77.                   To => join(', ', @rcpt),
    
78.                   Subject => '(no-title)',
    
79.                   Date => $date,
    
80.                   'Message-Id' => $message_id,
    
81.                   'X-Mailer' => "Edge Mailer $VERSION",
    
82.                   'Content-Type' => 'text/plain; charset="ISO-2022-JP"',
    
83.                   'MIME-Version' => '1.0',
    
84.                   'Content-Transfer-Encoding' => '7bit');
    
85.     %header = map { lc($_) => $header{$_} } keys %header;
    
86. 
    
87.     # $message の最初の空行までをヘッダとみなす
    
88.     my ($header, $body) = split /\n\n/, $message, 2;
    
89. 
    
90.     # フォームの \r\n をカット
    
91.     $body =~ s/\r\n|\r/\n/g;
    
92. 
    
93.     # extract headers
    
94.     my %orig_hdr;
    
95.     my $current_hdr;
    
96.     for (split /\n/, $header) {
    
97.         if (/^(\S+?):\s+(.+)$/) {
    
98.             $current_hdr = lc($1);
    
99.             $orig_hdr{$current_hdr} = $2;
    
100.         } elsif (/^\s+(.+)$/) {
     
101.             $orig_hdr{$current_hdr} .= ' '. $1;
     
102.         }
     
103.     }
     
104. 
     
105.     # merge
     
106.     %orig_hdr = (%header, %orig_hdr);
     
107. 
     
108.     # MIME-Encode
     
109.     my $encoder = Jcode->VERSION >= RFC_COMPLIANT_VERSION
     
110.         ? sub { Jcode->new($_[0])->mime_encode() }
     
111.         : \&encode_mime;
     
112.     my %mime_header = map {
     
113.         $_ => _include_multibyte($orig_hdr{$_})
     
114.             ? $encoder->($orig_hdr{$_}) : $orig_hdr{$_};
     
115.     } keys %orig_hdr;
     
116. 
     
117.     $self->{_mail_header} = \%mime_header;
     
118.     $self->{_mail_body} = $body;
     
119.     $self->{_mail_to} = \@rcpt;
     
120. }
     
121. 
     
122. sub send {
     
123.     my $self = shift;
     
124.     $self->_prepare_send;
     
125. 
     
126.     my $smtp = Net::SMTP->new($self->{smtphost},
     
127.                               Timeout => $self->{timeout},
     
128.                               Hello => Sys::Hostname::hostname)
     
129.         or do {
     
130.             carp __PACKAGE__.":$self->{smtphost}: $!";
     
131.             return;
     
132.         };
     
133. 
     
134.     my($mailheader, $mailbody) = $self->_pretty_print;
     
135.     ($smtp->mail($self->{sender}) and
     
136.      $smtp->to(@{$self->{_mail_to}}) and
     
137.      $smtp->data() and
     
138.      $smtp->datasend($mailheader) and
     
139.      $smtp->datasend("\n") and
     
140.      $smtp->datasend($mailbody) and
     
141.      $smtp->dataend() and
     
142.      $smtp->quit) or do {
     
143.          carp __PACKAGE__.":SMTP communication failed: $!";
     
144.          return;
     
145.      };
     
146. 
     
147.     $self->_cleanup_send;
     
148.     return 1;
     
149. }
     
150. 
     
151. sub _pretty_print {
     
152.     my $self = shift;
     
153. 
     
154.     my $filtersub = $self->{filter} || sub { Jcode->new($_[0])->jis; };
     
155.     my $mailbody = $filtersub->($self->{_mail_body});
     
156. 
     
157.     my $mailheader = join '', map { uc_hiphen($_) . ': ' . $self->{_mail_header}->{$_} ."\n" } keys %{$self->{_mail_header}};
     
158.     return $mailheader, $mailbody;
     
159. }
     
160. 
     
161. sub _cleanup_send {
     
162.     my $self = shift;
     
163.     delete $self->{_mail_header};
     
164.     delete $self->{_mail_body};
     
165.     delete $self->{_mail_to};
     
166. }
     
167. 
     
168. sub send_via_sendmail {
     
169.     my($self, $sendmail) = @_;
     
170.     $self->_prepare_send;
     
171.     my($mailheader, $mailbody) = $self->_pretty_print;
     
172.     my $command = sprintf "%s -f %s %s",
     
173.         $sendmail, $self->{sender}, join(' ', @{$self->{_mail_to}});
     
174.     my $handle = FileHandle->new("| $command");
     
175.     $handle->print($mailheader);
     
176.     $handle->print("\n");
     
177.     $handle->print($mailbody);
     
178.     $handle->close;
     
179.     $self->_cleanup_send;
     
180. }
     
181. 
     
182. sub encode_mime {
     
183.     my @field = split /\s+/, shift;
     
184.     my @encoded = map { _include_multibyte($_)
     
185.                             ? _dirty_encode($_) : $_ } @field;
     
186.     return join ' ', @encoded;
     
187. }
     
188. 
     
189. sub _include_multibyte {
     
190.     my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
     
191.     my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
     
192. 
     
193.     return $_[0] =~ /$twoBytes|$threeBytes/;
     
194. }
     
195. 
     
196. sub _dirty_encode {
     
197.     require MIME::Base64;
     
198.     my $word = shift;
     
199.     return '=?ISO-2022-JP?B?' . MIME::Base64::encode_base64(Jcode->new($word)->iso_2022_jp, '') . '?=';
     
200. }
     
201. 
     
202. sub uc_hiphen {
     
203.     my $word = shift;
     
204.     return join '-', map { ucfirst } split /-/, $word;
     
205. }
     
206. 
     
207. 
     
208. sub random_str($) {
     
209.     my ($length) = @_;
     
210. 
     
211.     # from perldoc -f srand
     
212.     # This statement is something OS specific
     
213.     #srand (time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
     
214. 
     
215.     my @string = (0..9, 'A'..'Z', 'a'..'z');
     
216.     return join '', map { $string[rand $#string] } (0..$length-1);
     
217. }
     
218. 
     
219. sub rfc2822date {
     
220.     my @t = @_; # localtime.
     
221.     my $diff = calc_diff();
     
222.     my @days = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
     
223.     my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
     
224.                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
     
225.     my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @t;
     
226.     return sprintf("%s, %s %s %04d %02d:%02d:%02d $diff",
     
227.                    $days[$wday], $mday, $months[$mon], $year + 1900, $hour, $min, $sec);
     
228. }
     
229. 
     
230. # gmtime と localtime から time-zone を計算
     
231. # '+0900' のような文字列を返す
     
232. sub calc_diff {
     
233.     use Time::Local;
     
234.     my $diff_time = time - timelocal(gmtime(time));
     
235. 
     
236.     use integer;
     
237.     my $diff_hour = $diff_time / (60 * 60);
     
238.     my $diff_min =  abs(($diff_time % (60 * 60)) / 60);
     
239.     local $ENV{LANG}; # no LANG=ja
     
240.     return sprintf '%+03d%02d', $diff_hour, $diff_min;
     
241. }
     
242. 
     
243. 
     
244. 1;
     
245. __END__
     
246. 
     
247. =head1 NAME
     
248. 
     
249. Edge::Mailer - Standard Mailer of Livin' On The EDGE.
     
250. 
     
251. =head1 SYNOPSIS
     
252. 
     
253.   use Edge::Mailer;
     
254. 
     
255.   my $mailer = Edge::Mailer->new(to => $to,
     
256.                                  sender => $sender,
     
257.                                  message => $message);
     
258.   $mailer->send;
     
259. 
     
260.   # Same as above
     
261.   mailer(to => $to, sender => $sender, message => $message)->send;
     
262. 
     
263.   # specify SMTP server and Timeout
     
264.   my $mailer = Edge::Mailer->new(to => $to,
     
265.                                  sender => $sender,
     
266.                                  message => $message,
     
267.                                  smtphost => $smtphost,
     
268.                                  timeout => 30);
     
269. 
     
270.   # filters message-body before sending.
     
271.   # this is invalid for RFC, but sometimes required for i-mode
     
272.   my $mailer = Edge::Mailer->new(to => 'someone@docomo.ne.jp',
     
273.                                  sender => $sender,
     
274.                                  message => $message,
     
275.                                  filter => sub { Jcode->new($_[0])->z2h->sjis });
     
276. 
     
277. =head1 DESCRIPTION
     
278. 
     
279. This module provides easy way for sending mail. Required headers like '
     
280. Message-Id', 'Date'... are automatically assigned by this
     
281. module. Useful when MTA on your SMTP server is a strict qmail...
     
282. 
     
283. =head1 AUTHOR
     
284. 
     
285. Tatsuhiko Miyagwa <miyagawa@edge.co.jp>
     
286. Livin' On The Edge, Limited.
     
287. 
     
288. =head1 SEE ALSO
     
289. 
     
290. perl(1), Net::SMTP.
     
291. 
     
292. =cut
     
293. 
     

复制代码