Tadashi Okoshi
slash****@users*****
2005年 10月 25日 (火) 04:20:55 JST
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/CGIError.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/CGIError.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/CGIError.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/CGIError.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/CGIError.pm Tue Oct 25 04:20:55 2005
@@ -1,55 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: CGIError.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-use strict;
-
-package Affelio::misc::CGIError;
-{
- use Exporter;
- @Affelio::misc::CGIError::ISA = "Exporter";
- @Affelio::misc::CGIError::EXPORT = qw (error);
- $Affelio::misc::CGIError::VERSION="0.01";
-
- use CGI;
- use CGI::Carp qw( fatalsToBrowser );
-
- BEGIN{
- sub carp_error{
- my $error_message = shift;
- my $q = new CGI;
-
- my $discard_this = $q->header("text/html");
- error ( $q, $error_message);
- }
- CGI::Carp::set_message( \&carp_error );
- }
-
- sub error{
- my ($q, $error_message) = @_;
-
- print $q->header("text/html"),
- $q->start_html("Affelio Error"),
- $q->h1("Affelio: We've got an error."),
- $q->p("Following error has occured."),
- $q->p('<PRE>' . $error_message),
- $q->end_html;
- exit;
- }
-
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/DBroutines.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/DBroutines.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/DBroutines.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/DBroutines.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/DBroutines.pm Tue Oct 25 04:20:55 2005
@@ -1,102 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: DBroutines.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::DBroutines;
-{
- use lib("../../../lib/");
- use DBI;
-
- use Exporter;
- @Affelio::misc::DBroutines::ISA = "Exporter";
- @Affelio::misc::DBroutines::EXPORT = qw (db_value_replace);
-
- sub db_value_replace{
- my $db = shift;
- my $dbname = shift;
- my $key_col = shift;
- my $target_col = shift;
- my $old = shift;
- my $new = shift;
-
- my $key_data;
- my $target_data;
- my $target_data_new;
- my %tmphash;
-
- Affelio::misc::Debug::debug_print("db_replace: start.");
- ######################################
- #Retrieve data
- ######################################
- my $q1 = "SELECT $key_col, $target_col FROM $dbname";
-
- Affelio::misc::Debug::debug_print("db_replace: [$q1]");
-
- my $s1 = $db->prepare($q1);
- if($@){
- Affelio::misc::Debug::debug_print("db_replace:".$db->errstr);
- die $db->errstr;
- }
-
- $s1->execute();
- if($@){
- Affelio::misc::Debug::debug_print("db_replace:".$db->errstr);
- die $db->errstr;
- }
-
- while( ($key_data, $target_data) = $s1->fetchrow_array){
- $tmphash{$key_data} = $target_data;
- }
- undef($q1);
- undef($s1);
-
- ######################################
- #Distill each line, replace, and store
- ######################################
- Affelio::misc::Debug::debug_print("db_replace: distilling...");
- while (($key_data, $target_data) = each(%tmphash)) {
-
- $target_data_new = $target_data;
- $old =~ s/\-/\\\-/g;
- $target_data_new =~ s/$old/$new/g;
-
- Affelio::misc::Debug::debug_print("db_replace: [$key_data] [$target_data]->[$target_data_new]");
-
- my $q2 = "update $dbname set $target_col = '$target_data_new' where $key_col = $key_data";
- Affelio::misc::Debug::debug_print("db_replace: [$q2]");
-
- my $s2 = $db->prepare($q2);
- if($@){
- Affelio::misc::Debug::debug_print("db_replace:".$db->errstr);
- die $db->errstr;
- }
-
- $s2->execute();
- if($@){
- Affelio::misc::Debug::debug_print("db_replace:".$db->errstr);
- die $db->errstr;
- }
-
- }
-
- Affelio::misc::Debug::debug_print("db_replace: end.");
- }
-
-
-
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Debug.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Debug.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Debug.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Debug.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Debug.pm Tue Oct 25 04:20:55 2005
@@ -1,53 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: Debug.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::Debug;
-{
- use Exporter;
- @Affelio::misc::Debug::ISA = "Exporter";
- @Affelio::misc::Debug::EXPORT = qw (debug_print);
-
- sub debug_print{
- my ($msg)= @_;
-####################
- return;
-####################
- chomp ($msg);
- $msg .= "\n";
- if($msg){
- my $filename="";
-
- #SECURITY |;"
- if(defined($ENV{'SCRIPT_NAME'})){
- $ENV{'SCRIPT_NAME'} =~ /([^\|\;\"]*)/;
- $filename = $1;
-
- $filename =~ s/\//\_/g;
- $filename =~ s/^\_//g;
- $filename =~ s/\~//g;
- $filename =~ s/\_bin\_.*//g;
- $filename =~ s/\_[a-zA-Z]*\.cgi$//g;
- open(OUT, ">> /tmp/af_$filename");
-
- print OUT "$$: ", $msg;
- close(OUT);
- }
- }
- }
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Encoding.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Encoding.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Encoding.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Encoding.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Encoding.pm Tue Oct 25 04:20:55 2005
@@ -1,48 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: Encoding.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::Encoding;
-{
- use lib "../../../extlib";
- use Crypt::RC5;
- use Jcode;
-
- use Exporter;
- @Affelio::misc::Encoding::ISA = "Exporter";
- @Affelio::misc::Encoding::EXPORT = qw (db_encode db_decode);
-
- ########################################################################
- sub db_encode{
- my $str = shift;
-
- $str = jcode($str)->mime_encode;
- $str =~ s/\n//g;
- $str =~ s/\r//g;
-
- return($str);
- }
-
- ########################################################################
- sub db_decode{
- my $str = shift;
-
- return(jcode($str)->mime_decode);
- }
-
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/InitAffelio.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/InitAffelio.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/InitAffelio.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/InitAffelio.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/InitAffelio.pm Tue Oct 25 04:20:55 2005
@@ -1,538 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: InitAffelio.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::InitAffelio;
-{
- use strict;
- use Exporter;
- @Affelio::misc::InitAffelio::ISA = "Exporter";
- @Affelio::misc::InitAffelio::EXPORT = qw (create_userdir get_userdir create_af_cfg create_db_cfg create_login_cfg copy_def_files init_db set_datadir_perm setup_affelio);
-
- use lib("../../../extlib/");
- use Cwd;
- use DBI;
- use Error qw(:try);
- use lib(".");
- use lib("../../../lib/");
- use Affelio;
- use Affelio::misc::CGIError;
- use Affelio::misc::Debug;
- use Affelio::misc::MyCrypt;
- use Affelio::App::Admin::EditTemplates;
- use Affelio::exception::Exception;
- use Affelio::exception::DBException;
- use Affelio::exception::IOException;
-
- #####################################################################
- sub create_userdir{
- my $topdir = shift;
-
- srand(time ^ ($$ + ($$ << 15)));
- #userdata
- my $dir1 = Affelio::misc::MyCrypt::generate_password();
- mkdir("$topdir/userdata/$dir1", 0777);
- my $dir2 = Affelio::misc::MyCrypt::generate_password();
- mkdir("$topdir/session/$dir2", 0777);
- }
-
- #####################################################################
- sub get_userdir{
- my $userdata_dir = shift;
-
- my $dir;
- my $ret;
- try{
- opendir(DIR, $userdata_dir);
-
- while (defined($dir = readdir(DIR))) {
- if(($dir ne '.') && ($dir ne '..')
- && ($dir ne 'default') && ($dir ne 'CVS')
- && ($dir ne 'index.html')){
- $ret = "$userdata_dir/$dir";
- }
- }
- }catch Error with{
- my $e=shift;
- throw($e);
- };
- return($ret);
- }
-
- #####################################################################
- sub create_af_cfg{
- my $affelio_cfg_path = shift;
- my $fs_root = shift;
- my $web_root = shift;
- my $char_set = shift;
- my $template = shift;
- my $sendmail_path = shift;
- my $additional_cfg = shift;
-
- eval{
- open(OUT, "> $affelio_cfg_path");
- print OUT "[site_config]\n";
- print OUT "fs_root=$fs_root\n";
- print OUT "web_root=$web_root\n";
- print OUT "char_set =$char_set\n";
- print OUT "template =$template\n";
- print OUT "\n";
- print OUT "[command]\n";
- print OUT "sendmail=$sendmail_path\n";
-
- if($additional_cfg){
- print OUT "[affelio_farm]\n";
- print OUT "$additional_cfg\n";
- }
-
- close OUT;
-
- chmod 0444, "$affelio_cfg_path";
- };
-
-
- }
-
- #####################################################################
- sub create_db_cfg{
- my $db_cfg_path = shift;
- my $db_type = shift;
- my $db_dbname=shift;
- my $db_username = shift;
- my $db_password = shift;
- my $db_hostname = shift;
- my $db_port = shift;
-
- eval{
- open(OUT, "> $db_cfg_path");
- print OUT "[db]\n";
- print OUT "type=$db_type\n";
- print OUT "dbname=$db_dbname\n";
- print OUT "username=$db_username\n";
- print OUT "password=$db_password\n";
- print OUT "hostname=$db_hostname\n";
- print OUT "port=$db_port\n";
- print OUT "[appdb]\n";
- print OUT "type=$db_type\n";
- print OUT "dbname=$db_dbname\n";
- print OUT "username=$db_username\n";
- print OUT "password=$db_password\n";
- print OUT "hostname=$db_hostname\n";
- print OUT "port=$db_port\n";
- close OUT;
- };
- }
-
- #####################################################################
- sub create_login_cfg{
- my $login_cfg_path = shift;
- my $username = shift;
- my $crypted_password = shift;
-
- eval{
- open(OUT, "> $login_cfg_path");
- print OUT "[auth]\n";
- print OUT "username=$username\n";
- print OUT "password=$crypted_password\n";
- close OUT;
- };
- }
-
- #####################################################################
- sub copy_def_files{
- my $top_dir=shift;
- my $user_dir=shift;
- my $locale = shift;
-
- #Copy default face JPEG file
- system("cp -f $top_dir/defaults/profile_face.jpg $user_dir/profile_face.jpg");
- system("chmod 666 $user_dir/profile_face.jpg");
-
- #Copy default preference file
- system("cp -f $top_dir/defaults/preference.cfg $user_dir/preference.cfg");
-
- system("cp -fr $top_dir/defaults/af_templates/$locale $user_dir/af_templates");
- }
-
- #####################################################################
- sub init_db{
- my $top_dir = shift;
- my $g_nickname = shift;
- my $g_email =shift;
- my $g_lh=shift;
-
- debug_print("init_db: [$top_dir] [$g_nickname] [$g_email]");
-
- ################################################################
- #Stage 0: load Affelio (init mode)
- ################################################################
- my $cfg_dir = "$top_dir/config/";
- my $af;
- my $dbh;
- try{
- $af = new Affelio(ConfigDir => $cfg_dir,
- Mode => "init");
- $dbh = $af->{db};
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("Could not load Affelio (init): $e");
- };
-
- ################################################################
- #Stage 1: DB creation
- ################################################################
-
- ################################
- #profile DB
- ################################
- my $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_CORE_prof(attribute TEXT, value TEXT)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating prof: $@");
- }
-
- $af->{user__nickname} = $g_nickname;
- $af->{user__email1} = $g_email;
- try{
- $af->{pm}->save_profile();
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("Cannot save_profile: $@");
- };
- debug_print("saved profile");
-
- ################################
- #profile attribute DB
- ################################
- $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_CORE_prof_attr(aid INTEGER, name TEXT, type INTEGER)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating attr: $@");
- }
-
- my $sth = "";
- eval{
- $sth = $dbh->prepare(q{insert into AFuser_CORE_prof_attr(aid, name, type) values (?,?,?)});
- };
- if($@){
- throw Affelio::exception::DBException("SQL prepare: $@");
- }
-
- try{
- open(FIN, "$top_dir/defaults/AFuser_CORE_prof_attr.csv");
-
- while(my $line=<FIN>){
- chomp($line);
- my ($aid, $name, $type) = split(',', $line);
- #print "$aid - $name - $type\n";
-
- $sth->execute($aid, $name, $type);
- }
- close(FIN);
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::IOException("prof_attr: $@");
- };
-
- ################################
- #friends DB
- ################################
- $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_CORE_friends(uid INTEGER PRIMARY KEY, af_id CHAR(255), nickname TEXT, timestamp TEXT, password TEXT, intro TEXT, option_pid INTEGER, lastupdated TEXT, f2list TEXT)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating friends tbl: $@");
- }
-
- ################################
- #erasedfriends DB
- ################################
- $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_CORE_erasedfriends(uid INTEGER PRIMARY KEY, af_id CHAR(255), timestamp TEXT)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating erased friends tbl: $@");
- }
-
- ################################
- #friendsfriends DB
- ################################
- $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_CORE_friendsfriends(uid INTEGER PRIMARY KEY, af_id CHAR(255), nickname TEXT, timestamp TEXT, f1list TEXT)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating F2 tbl: $@");
- }
-
- ################################
- #group DB
- ################################
- $create_tbl_cmd = "CREATE TABLE AFuser_CORE_group(gid INTEGER, group_name TEXT, members TEXT, option_pid INTEGER)";
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating grp tbl: $@");
- }
-
- ################################
- #Permission DB
- ################################
- $create_tbl_cmd = "CREATE TABLE AFuser_CORE_permission(pid INTEGER, type TEXT, target_id TEXT, ";
-
- for(my $i=0; $i<=63; $i++){
- $create_tbl_cmd .= " attr$i INT,";
- }
- chop($create_tbl_cmd);
- $create_tbl_cmd .= ")";
- debug_print("setup: create [$create_tbl_cmd]");
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating perm tbl: $@");
- }
-
- ################################
- #tmp_recvd_hs
- ################################
- $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_SNS_tmp_recvd_hs(sessionid TEXT, timestamp TEXT, af_id CHAR(255), nickname TEXT, DH_key_str TEXT)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating tmp_recved tbl: $@");
- }
-
- ################################
- #tmp_sent_hs
- ################################
- $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_SNS_tmp_sent_hs(sessionid TEXT, timestamp TEXT, af_id CHAR(255), nickname TEXT, DH_key_str TEXT)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating tmp_send tbl: $@");
- }
-
- ################################
- #message
- ################################
- $create_tbl_cmd = <<EOT;
-CREATE TABLE AFuser_CORE_message(mid INTEGER PRIMARY KEY, timestamp TEXT, msgtitle TEXT, msgtype TEXT, msgfrom TEXT, msgbody TEXT, readflag INTEGER)
-EOT
- if(!$dbh->do($create_tbl_cmd)){
- throw Affelio::exception::DBException("creating msg tbl: $@");
- }
-
- try{
- $dbh->disconnect;
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::DBException("DB disconnecting: $@");
- };
-
- ################################################################
- #Stage 2: Reload Affelio
- ################################################################
- try{
- undef($af);
- $af = new Affelio(ConfigDir => $cfg_dir);
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("Couldnot load Affelio: $e");
- };
-
- ################################
- #Set permission to F1
- ################################
- # n names b i intro email url im
- my @flag_array = (1,1,1,1, 1,1, 1,1, 0,0,0,0, 1,1,1,1, 0,0,0,0,0,0, 1);
- try{
- $af->{perm}->add_permission("f", "f1", \@flag_array);
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("adding F1 perm: $@");
- };
-
- ################################
- #Set permission to F2
- ################################
- # n names b i intro email url im
- my @flag_array = (1,0,0,0, 0,1, 1,1, 0,0,0,0, 1,1,1,1, 0,0,0,0,0,0, 1);
- try{
- $af->{perm}->add_permission("f", "f2", \@flag_array);
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("adding F2 perm: $@");
- };
-
- ################################
- #Set permission to PB
- ################################
- # n names b i intro email url im
- my @flag_array = (1,0,0,0, 0,0, 1,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0);
- try{
- $af->{perm}->add_permission("f", "pb", \@flag_array);
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("adding PB perm: $@");
- };
-
- ################################
- #Make a new group "dear_friend"
- ################################
- my $gid;
- try{
- $gid = $af->{gm}->add_group($af->{lh}->maketext("_SETUP_group_dear_friend"));
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("adding dear Grp: $@");
- };
-
- #####################################
- #Set permission to group "dear_friend"
- #####################################
- # n names b i intro email url im
- my @flag_array = (1,1,1,1, 1,1, 1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1,1,1, 1);
- try{
- $af->{perm}->add_permission("g", $gid, \@flag_array);
- }catch Error with{
- my $e = shift;
- throw Affelio::exception::Exception("adding perm to Grp: $@");
- };
- }
-
- #####################################################################
- sub set_datadir_perm{
- my $top_dir = shift;
- my $userdir = get_userdir("$top_dir/userdata");
-
- #hmmmmmm....
- system("chmod -R 777 $userdir");
- }
-
-
- #####################################################################
- #setup_affelio
- # all-in-one function to setup affelio
- #####################################################################
- sub setup_affelio{
- my $root_dir = shift;
- my $root_url = shift;
- my $locale = shift;
- my $lh = shift;
- my $template = shift;
- my $additional_cfg = shift;
- my $sendmail_path = shift;
- #
- my $db_type = shift;
- my $db_dbname = shift;
- my $db_username = shift;
- my $db_password = shift;
- my $db_hostname = shift;
- my $db_port = shift;
- #
- my $username = shift;
- my $password = shift;
- my $nickname =shift;
- my $email =shift;
-
- debug_print("InitAffelio:setup start.");
- debug_print("\t$root_dir ");
- debug_print("\t$root_url ");
- debug_print("\t$locale ");
- debug_print("\t$lh ");
- debug_print("\t$template ");
- debug_print("\t$additional_cfg");
- debug_print("\t$sendmail_path ");
- debug_print("\t$db_type ");
- debug_print("\t$db_dbname ");
- debug_print("\t$db_username ");
- debug_print("\t$db_password ");
- debug_print("\t$db_hostname ");
- debug_print("\t$db_port ");
- debug_print("\t$username ");
- debug_print("\t$password ");
- debug_print("\t$nickname ");
- debug_print("\t$email ");
-
- ################################
- #(1)Create user dir
- create_userdir($root_dir);
- debug_print("InitAffelio:setup (1) create dir done.");
-
- ################################
- #(2)Create af_cfg
- create_af_cfg("$root_dir/config/affelio.cfg",
- $root_dir,
- $root_url,
- $locale,
- $template,
- $sendmail_path,
- $additional_cfg);
- chmod 0700, "$root_dir/config";
- debug_print("InitAffelio:setup (2) create affelio.cfg done.");
-
- ################################
- #(3)Get userdata dir
- my $user_dir = "";
- $user_dir = get_userdir("$root_dir/userdata");
- debug_print("InitAffelio:setup (3) user dir = [$user_dir]");
-
- ################################
- #(4)create db.cfg
- create_db_cfg("$user_dir/db.cfg",
- $db_type,
- $db_dbname,
- $db_username,
- $db_password,
- $db_hostname,
- $db_port);
- debug_print("InitAffelio:setup (4) create db.cfg done");
-
- ################################
- #(5)create login.cfg
- my @salts = ( "A".."Z", "a".."z", "0".."9", ".", "/" );
- my $salt = $salts[int(rand(64))] . $salts[int(rand(64))];
- my $crypted_password = crypt($password, $salt);
- create_login_cfg("$user_dir/login.cfg",
- $username,
- $crypted_password);
- debug_print("InitAffelio:setup (5) create login.cfg [$crypted_password] done.");
-
- ################################
- #(6)Copy default files
- copy_def_files($root_dir , $user_dir, $locale);
- debug_print("InitAffelio:setup (6) copy default files. done.");
-
- ################################
- #(7)initialize DB
- init_db($root_dir , $nickname, $email, $lh);
- debug_print("InitAffelio:setup (7) Init DB done.");
-
- ################################
- #(8)Rebuild template
- my $af;
- $af = new Affelio(ConfigDir => "$root_dir/config/");
- Affelio::App::Admin::EditTemplates::rebuild($af);
- debug_print("InitAffelio:setup (8) Rebuild template done.");
-
- ################################
- #(9)Set permission
- set_datadir_perm($root_dir );
- debug_print("InitAffelio:setup (9) Set permission done.");
-
- debug_print("InitAffelio:setup ****ALL DONE****");
- }
-
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/L10N.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/L10N.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/L10N.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/L10N.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/L10N.pm Tue Oct 25 04:20:55 2005
@@ -1,34 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: L10N.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::L10N;
-{
- use strict;
- use lib("../../../extlib");
- use Locale::Maketext;
-
- use lib("../../../lib");
- use Affelio::misc::L10N;
-
- @Affelio::misc::L10N::ISA = qw(Locale::Maketext);
- @Affelio::misc::L10N::Lexicon = (_AUTO => 1,
- );
-
-
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/MyCrypt.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/MyCrypt.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/MyCrypt.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/MyCrypt.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/MyCrypt.pm Tue Oct 25 04:20:55 2005
@@ -1,88 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: MyCrypt.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::MyCrypt;
-{
- use lib "../../../extlib";
- use Crypt::RC5;
-
- use Exporter;
- @Affelio::misc::MyCrypt::ISA = "Exporter";
- @Affelio::misc::MyCrypt::EXPORT = qw (generate_password msg_encrypt msg_decrypt url_encode url_decode verify_password);
-
- ########################################################################
- sub generate_password{
- @chara=('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z','0','1','2','3','4','5','6','7','8','9');
- for($i=0; $i<9; $i++){
- $str .= $chara[int(rand($#chara+1))];
- }
- return $str;
- }
-
- ########################################################################
- sub msg_encrypt{
- my $plaintext = shift;
- my $key = shift;
- if ($key eq ""){
- die "msg_encrypt: Key is not defined!";
- }
-
- my $ref = Crypt::RC5->new($key, 12 );
- return( $ref->encrypt( $plaintext ) );
- }
-
- ########################################################################
- sub msg_decrypt{
- my $ciphertext = shift;
- my $key = shift;
- if ($key eq ""){
- die "msg_decrypt: Key is not defined!";
- }
-
- my $ref = Crypt::RC5->new($key, 12 );
- return($ref->decrypt( $ciphertext ));
- }
-
- ########################################################################
- sub url_encode{
- my $str = shift;
- $str =~ s/(\W)/sprintf("%%%02X", ord($1))/ego;
- return($str);
- }
-
- ########################################################################
- sub url_decode{
- my $str = shift;
- $str =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/ego;
- return($str);
- }
-
- ########################################################################
- sub verify_password{
- $passwd = shift;
- $epasswd = shift;
-
- if ($epasswd eq crypt($passwd, $epasswd)) {
- return(1);
- }else{
- return(-1);
- }
- }
-
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/NetMisc.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/NetMisc.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/NetMisc.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/NetMisc.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/NetMisc.pm Tue Oct 25 04:20:55 2005
@@ -1,125 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-# $Id: NetMisc.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::NetMisc;
-{
- use strict;
- use Exporter;
- @Affelio::misc::NetMisc::ISA = "Exporter";
- @Affelio::misc::NetMisc::EXPORT = qw (get_remote_domain get_remote_host URL2domain URL2path hostname2domain check_private_IP_addr);
-
- ########################################################################
- sub check_private_IP_addr{
- my $addr = shift;
-
- if($addr =~ /^192\.168\.([0-9]+)\.([0-9]+)/){
- return(1);
- }
- if($addr =~ /^192\.0\.2\.([0-9]+)/){
- return(1);
- }
- if($addr =~ /^10\.([0-9]+)\.([0-9]+)\.([0-9]+)/){
- return(1);
- }
- if($addr =~ /^172\.16\.([0-9]+)\.([0-9]+)/){
- return(1);
- }
- return(0);
- }
-
- ########################################################################
- sub get_remote_domain{
- my %env = shift;
- my $DomainName = !$ENV{'REMOTE_HOST'}||$ENV{'REMOTE_HOST'}eq$ENV{'REMOTE_ADDR'}?gethostbyaddr(pack('C4',split(/\./,$ENV{'REMOTE_ADDR'})),2)||$ENV{'REMOTE_ADDR'}:$ENV{'REMOTE_HOST'};
- $DomainName =~ s/^[\-+_0-9A-Za-z]+\.//;
-
- return $DomainName;
- }
-
- ########################################################################
- sub get_remote_host{
- my %env = shift;
- my $hostname = !$ENV{'REMOTE_HOST'}||$ENV{'REMOTE_HOST'}eq$ENV{'REMOTE_ADDR'}?gethostbyaddr(pack('C4',split(/\./,$ENV{'REMOTE_ADDR'})),2)||$ENV{'REMOTE_ADDR'}:$ENV{'REMOTE_HOST'};
-
- return $hostname;
- }
-
- ########################################################################
- sub hostname2domain{
- my $hostname = shift;
- my $domain="";
- my $host="";
-
- ($host, $domain) = split(/\./, $hostname);
- print "$domain\n";
-
-
- if($ENV{'REMOTE_HOST'} eq ""){
- $host = gethostbyaddr(pack("C4",split(/\./,$ENV{'REMOTE_ADDR'})),2);
- }else{
- $host = $ENV{'REMOTE_HOST'};
- }
-
- }
-
- ########################################################################
- sub URL2domain{
- my $url = shift;
-
- # $url="http://a.b.c.www-2.yahoo.com/cgi-bin/~a.cgi";
- # $url="http://1.2.3.4/cgi-bin/~a.cgi";
-
- my $ret=$url;
- if($url =~ /http\:\/\/([0-9.]*)\//){
- #IP address
- $ret =~ s|http://([0-9.]+)/.*|$1|;
- }else{
- #DNS hostname
- $ret =~ s|http://([A-Za-z0-9.-]+)/.*|$1|;
- }
-
- return($ret);
- }
-
-
- ########################################################################
- sub URL2path{
- my $url = shift;
- $url =~ s|[a-zA-Z]+://[^/]*||;
- return($url);
- }
-
-
-}#package
-1;
-
-sub a{
-print URL2domain("http://www.a.com/"); print "\n";
-print URL2domain("http://www.a.com/hogehoge"); print "\n";
-print URL2domain("http://www.a.com/hogehoge/"); print "\n";
-print URL2domain("http://www.a.com/hogehoge/aaa"); print "\n";
-print URL2domain("http://www.a.com/hogehoge/aaa/"); print "\n";
-
-print URL2path("http://www.a.com/"); print "\n";
-print URL2path("http://www.a.com:8000/a/b/"); print "\n";
-print URL2path("http://localhost:8000/a/b/"); print "\n";
-print URL2path("http://www.a.com/hogehoge"); print "\n";
-print URL2path("http://www.a.com/hogehoge/"); print "\n";
-print URL2path("http://www.a.com/hogehoge/aaa"); print "\n";
-print URL2path("http://www.a.com/hogehoge/aaa/"); print "\n";
-}
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Sanitizer.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Sanitizer.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Sanitizer.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Sanitizer.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Sanitizer.pm Tue Oct 25 04:20:55 2005
@@ -1,96 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: Sanitizer.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-use strict;
-
-package Affelio::misc::Sanitizer;
-
-use Exporter;
- ＠ Affelio::misc::Sanitizer::ISA = "Exporter";
- ＠ Affelio::misc::Sanitizer::EXPORT = qw (escape_filename sanitize_URL sanitize_HTML sanitize_number);
-
-#########################################################################
-
-sub escape_filename {
- my $forbedden = '\\\/\*\?\|"<>:,;% ';
- my ($filename) = @_;
- $filename =~ s/([$forbedden])/'%' . unpack('H2', $1)/eg;
- return $filename;
-}
-
-#########################################################################
-
-# Sanitize in HTML::Template template files.
-#
-# ESCAPE="HTML"
-# ESCAPE="URL"
-#
-
-#########################################################################
-
-sub sanitize_number {
- my $num = shift;
- $num =~ s/\D//g;
-
- return($num);
-}
-
-sub sanitize_URL {
- my $url = shift;
-
- # --- http://www.ietf.org/rfc/rfc2396.txt ---
- # uric = reserved | unreserved | escaped
- # reserved = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" | "$" | ","
- # unreserved = alphanum | mark
- # mark = "-" | "_" | "." | "!" | "~" | "*" | "'" | "(" | ")"
- # escaped = "%" hex hex
-
- return '' if($url =~ m|[^;/?:@&=+\$,A-Za-z0-9\-_.!~*'()%]|);
-
- # --- http://www.ietf.org/rfc/rfc2396.txt ---
- # scheme = alpha *( alpha | digit | "+" | "-" | "." )
-
- if($url =~ /^([A-Za-z][A-Za-z0-9+\-.]*):/) {
- my $scheme = lc($1);
- my $allowed = 0;
- $allowed = 1 if($scheme eq 'http');
- $allowed = 1 if($scheme eq 'https');
- $allowed = 1 if($scheme eq 'mailto');
- return '' if(not $allowed);
- }
-
- $url =~ s/&/&/g; # & -> &
- $url =~ s/'/'/g; # ' -> '
-
- return $url;
-}
-
-#########################################################################
-
-sub sanitize_HTML{
- my $str = shift;
-
- if( $$str ne "" ){
- $$str =~ s/&/&/g;
- $$str =~ s/</</g;
- $$str =~ s/>/>/g;
- $$str =~ s/"/"/g;
- }
-}
-
-#########################################################################
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Time.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Time.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Time.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Time.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/Time.pm Tue Oct 25 04:20:55 2005
@@ -1,114 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: Time.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-
-package Affelio::misc::Time;
-{
- use strict;
- use Exporter;
- @Affelio::misc::Time::ISA = "Exporter";
- @Affelio::misc::Time::EXPORT = qw (get_today get_timestamp get_past_timestamp get_expire_stamp timestamp2string timestamp2stringB);
-
- sub timestamp2string{
- my $timestamp = shift;
-
- my $year = substr ($timestamp, 0, 4);
- my $mon = substr ($timestamp, 4, 2);
- my $mday = substr ($timestamp, 6, 2);
- my $hour = substr ($timestamp, 8, 2);
- my $min = substr ($timestamp, 10, 2);
- my $sec = substr ($timestamp, 12, 2);
-
- return("$year/$mon/$mday $hour:$min");
- }
-
- sub timestamp2stringB{
- my $timestamp = shift;
-
- my $mon = substr ($timestamp, 4, 2);
- my $mday = substr ($timestamp, 6, 2);
- my $hour = substr ($timestamp, 8, 2);
- my $min = substr ($timestamp, 10, 2);
- my $sec = substr ($timestamp, 12, 2);
-
- return("$mon/$mday $hour:$min");
- }
-
-
-
- sub get_timestamp{
- my ($sec, $min, $hour, $mday, $mon, $year,
- $wday, $yday, $isdst) = localtime(time());
-
- return sprintf("%04d%02d%02d%02d%02d%02d",
- $year+1900, $mon+1, $mday,
- $hour, $min, $sec);
- }
-
-
- sub get_past_timestamp{
- my $past_sec = shift;
- my ($sec, $min, $hour, $mday, $mon, $year,
- $wday, $yday, $isdst) = localtime(time()-$past_sec);
-
- return sprintf("%04d%02d%02d%02d%02d%02d",
- $year+1900, $mon+1, $mday,
- $hour, $min, $sec);
- }
-
-
- sub get_today{
- my ($sec, $min, $hour, $mday, $mon, $year,
- $wday, $yday, $isdst) = localtime(time());
-
- return sprintf("%04d%02d%02d000000",
- $year+1900, $mon+1, $mday);
- }
-
-
- sub get_expire_stamp{
- my $p_mday = shift;
- my $p_hour = shift;
- my $p_min = shift;
-
- my ($sec, $min, $hour, $mday, $mon, $year,
- $wday, $yday, $isdst) = localtime(time());
-
- $year+= 1900;
- $mon += 1;
-# $mday += 1;
-
- $min += $p_min;
- if($min >= 60){
- $min -= 60;
- $hour+=1;
- }
- $hour += $p_hour;
- if($hour >= 24){
- $hour -= 24;
- $mday+= 1;
- }
- $mday += $p_mday;
-
- return sprintf("%04d%02d%02d%02d%02d%02d",
- $year, $mon, $mday,
- $hour, $min, $sec);
- }
-
-
-}
-1;
Index: affelio_farm/admin/skelton/affelio/lib/Affelio/misc/WebInput.pm
diff -u affelio_farm/admin/skelton/affelio/lib/Affelio/misc/WebInput.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/lib/Affelio/misc/WebInput.pm:removed
--- affelio_farm/admin/skelton/affelio/lib/Affelio/misc/WebInput.pm:1.1.1.1 Tue Oct 25 04:14:40 2005
+++ affelio_farm/admin/skelton/affelio/lib/Affelio/misc/WebInput.pm Tue Oct 25 04:20:55 2005
@@ -1,228 +0,0 @@
-# Copyright (C) 2005 FishGrove Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# $Id: WebInput.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 Exp $
-use strict;
-
-package Affelio::misc::WebInput;
-{
- use lib("../../../lib/");
- use Affelio::exception::TaintedInputException;
- use Affelio::misc::Debug qw(debug_print);
-
- ######################################################################
- sub new{
- my $class = shift;
- my %param = @_;
-
- my $self = {locale => "ja"};
- bless $self, $class;
-
- return($self);
- }
-
- ######################################################################
- sub PTN_through{
- my $self = shift;
- my $in = shift;
-
- $in =~ /(.*)/;
- return ($1);
- }
-
- ######################################################################
- sub PTN_visitor_type{
- my $self = shift;
- my $in = shift;
-
- $in =~ /([A-Za-z0-9]*)/;
- return ($1);
- }
-
- ######################################################################
- sub PTN_email{
- my $self = shift;
- my $in = shift;
-
- $in =~ /([A-Za-z0-9\.\+\_\-\@]*)/;
- return ($1);
- }
-
- ######################################################################
- sub PTN_password{
- my $self = shift;
- my $in = shift;
-
- return ($in);
- }
-
- ######################################################################
- sub PTN_num{
- my $self = shift;
- my $in = shift;
-
- $in =~ /(\d+)/;
- return ($1);
- }
-
-
- ######################################################################
- sub PTN_nickname{
- my $self = shift;
- my $in = shift;
-
- $in =~ /([A-Za-z0-9\-\_]*)/;
- return ($1);
- }
-
- ######################################################################
- sub PTN_word{
- my $self = shift;
- my $in = shift;
-
- $in =~ /([A-Za-z0-9\-\_\.]*)/;
- return ($1);
- }
-
- ######################################################################
- sub PTN_mode{
- my $self = shift;
- my $in = shift;
-
- $in =~ /([A-Za-z0-9\-\_]*)/;
- return ($1);
- }
-
- ######################################################################
- sub PTN_getcontent_content{
- my $self = shift;
- my $in = shift;
-
- $in =~ /([A-Za-z0-9\-\_\.\/]*)/;
- return ($1);
- }
-
- ######################################################################
- sub PTN_basefilename{
- my $self = shift;
- my $in = shift;
- $in =~ /([A-Za-z0-9\-\_]+\.[A-Za-z0-9]+)/;
-# debug_print("==============$1");
- return ($1);
- }
-
- ######################################################################
- sub PTN_jpg_filename{
- my $self = shift;
- my $in = shift;
- $in =~ /([A-Za-z0-9\-\_]*\.(jpg)|(JPG)|(JPEG)|(jpeg))/;
-# debug_print("==============$1");
- return ($1);
- }
-
- ######################################################################
- sub PTN_dirname{
- my $self = shift;
- my $in = shift;
- $in =~ /([A-Za-z0-9\-\_\.\/\s]*)/;
-# debug_print("==============$1");
- return ($1);
- }
-
-
-
- ######################################################################
- sub PTN{
- my $in = shift;
-
- if($in ne ""){
- if ($in =~ /([\w\-\_]+)/){
- return($1);
- }else{
- throw Affelio::exception::TaintedInputException("Tainted input!");
- }
- }
- }
-
- ######################################################################
- sub PTN_URL{
- my $self = shift;
- my $in = shift;
-
- my @http = $in =~ /s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+/g;#'
- return($http[0]);
- }
-
- ######################################################################
- sub translate_URL_to_HTML{
- my $self = shift;
- my $in = shift;
-
- $in =~ s/(s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+)/<A HREF="$1">$1<\/A>/g;#'
- return($in);
- }
-
-
- ######################################################################
- sub distill_URL{
- my $text = shift;
- if($text =~ /(s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+)/){ #'
- return($1);
- }else{
- return("");
- }
-
- }
-
- ######################################################################
- sub escape_HTML{
-
- }
-
- ######################################################################
- sub escape_filename {
- my $forbedden = '\\\/\*\?\|"<>:,;% ';
- my ($filename) = @_;
- $filename =~ s/([$forbedden])/'%' . unpack('H2', $1)/eg;
- return $filename;
- }
-
- ######################################################################
- sub delete_HTML{
- my $str = shift;
- my $text_regex = q{[^<]*};
- my $tag_regex = "";
- my $tag_regex_ = "";
- my $text_tmp="";
-
- my $result = '';
- while ($str =~ /($text_regex)($tag_regex)?/gso) {
- last if $1 eq '' and $2 eq '';
- $result .= $1;
- my $tag_tmp = $2;
-
- if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) {
- $str =~ /(.*?)(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$)/gsi;
- ($text_tmp = $1) =~ s/</&lt;/g;
- $text_tmp =~ s/>/&gt;/g;
- $result .= $text_tmp;
- }
- }
-
- return($result);
- }
-}
-1;