Menu
▾
▴
geniustrader-devel — participate in geniustrader development, ask for help, suggest improvements, etc
You can subscribe to this list here.
| 2000 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
(32) |
Oct
(144) |
Nov
(14) |
Dec
(44) |
| 2002 |
Jan
(16) |
Feb
|
Mar
|
Apr
|
May
|
Jun
(2) |
Jul
|
Aug
|
Sep
|
Oct
(65) |
Nov
(4) |
Dec
(30) |
| 2003 |
Jan
(84) |
Feb
(101) |
Mar
(58) |
Apr
(30) |
May
(138) |
Jun
(336) |
Jul
(36) |
Aug
(12) |
Sep
(8) |
Oct
(4) |
Nov
(12) |
Dec
(12) |
| 2004 |
Jan
(186) |
Feb
(274) |
Mar
(248) |
Apr
(18) |
May
(104) |
Jun
(48) |
Jul
(144) |
Aug
(98) |
Sep
(60) |
Oct
(72) |
Nov
(32) |
Dec
(130) |
| 2005 |
Jan
(84) |
Feb
(130) |
Mar
(50) |
Apr
(106) |
May
(240) |
Jun
(154) |
Jul
(66) |
Aug
(82) |
Sep
(36) |
Oct
(18) |
Nov
(14) |
Dec
(4) |
| 2006 |
Jan
(68) |
Feb
(2) |
Mar
(14) |
Apr
(6) |
May
|
Jun
|
Jul
|
Aug
(2) |
Sep
|
Oct
|
Nov
(50) |
Dec
(4) |
| 2007 |
Jan
(14) |
Feb
(42) |
Mar
(70) |
Apr
(30) |
May
(8) |
Jun
|
Jul
(2) |
Aug
(2) |
Sep
|
Oct
(88) |
Nov
(168) |
Dec
(2) |
| 2008 |
Jan
(56) |
Feb
(372) |
Mar
(446) |
Apr
(112) |
May
(144) |
Jun
(94) |
Jul
(208) |
Aug
(90) |
Sep
(26) |
Oct
(10) |
Nov
(2) |
Dec
|
| 2009 |
Jan
|
Feb
(8) |
Mar
|
Apr
(46) |
May
(188) |
Jun
(120) |
Jul
(448) |
Aug
(202) |
Sep
(4) |
Oct
(72) |
Nov
(154) |
Dec
(2) |
| 2010 |
Jan
(58) |
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
(68) |
Aug
(24) |
Sep
|
Oct
|
Nov
|
Dec
(11) |
| 2011 |
Jan
(6) |
Feb
(11) |
Mar
(8) |
Apr
(10) |
May
(4) |
Jun
|
Jul
|
Aug
(8) |
Sep
|
Oct
(3) |
Nov
(2) |
Dec
|
| 2012 |
Jan
|
Feb
(13) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(31) |
Aug
(21) |
Sep
(2) |
Oct
(1) |
Nov
(29) |
Dec
(17) |
| 2013 |
Jan
(2) |
Feb
|
Mar
|
Apr
(25) |
May
(1) |
Jun
|
Jul
|
Aug
(1) |
Sep
(3) |
Oct
(4) |
Nov
(11) |
Dec
|
| 2016 |
Jan
(1) |
Feb
(1) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2018 |
Jan
(3) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2020 |
Jan
|
Feb
|
Mar
|
Apr
(1) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(1) |
Oct
|
Nov
|
Dec
|
|
From: Tielman E. <tes...@ei...> - 2009-11-08 20:26:23
|
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
</head>
<body bgcolor="#ffffff" text="#000000">
<font face="sans-serif">Thanks Thomas.<br>
<br>
You're right DB::module is not set, but as far the documentation states
this is only used when using a Text file as datasource - I'm using a
mysql db. <br>
<br>
Kind regards,<br>
Tielman<br>
</font><br>
Thomas Weigert wrote:
<blockquote cite="mid:4AF...@ms..." type="cite">
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
<title></title>
>From the error message you are trying to load a module with an empty
name, see below. So you want to examine what module it is trying to
load and try to understand why the name is empty. I would guess that
you did not define DB::module in your options file which tells what
data base module to use to load your data....<br>
<br>
Th.<br>
<br>
Tielman Esterhuizen wrote:
<blockquote cite="mid:4AF...@ei..." type="cite"><font
face="sans-serif">Use of uninitialized value in concatenation (.) or
string at
../GT/Eval.pm line 87.<br>
Can't locate GT/DB/.pm in @INC (@INC contains: .. /etc/perl
/usr/local/lib/perl/5.8.8 /usr/local/share/perl/5.8.8 /usr/lib/perl5
/usr/share/perl5 /usr/lib/perl/5.8 /usr/share/perl/5.8
/usr/local/lib/site_perl .) at (eval 28) line 1.<br>
</font><font face="sans-serif"><br>
</font></blockquote>
</blockquote>
<br>
<pre class="moz-signature" cols="72">--
Tielman Esterhuizen
Consultant
Eirteic Consulting (Australia) Pty Ltd
Mobile: +61 (0) 406 538534
Office: +61 (0) 299 400288
Fax: +61 (0) 299400478
email: <a class="moz-txt-link-abbreviated" href="mailto:tie...@ei...">tie...@ei...</a>
web: <a class="moz-txt-link-freetext" href="http://www.eirteic.com">http://www.eirteic.com</a>
</pre>
</body>
</html>
|
|
From: Chia-liang K. <cl...@cl...> - 2009-11-08 14:51:01
|
Hi Thomas, 2009/11/7 Thomas Weigert <we...@ms...>: > From the recent checkins I assume that Chia Liang is now merging all the > mirror branches into the CPAN branch on geniustrader.org. We should thus > discontinue usage of the mirror, right? Yes, everything on the mirror has been merged to the CPAN branch of the primary repository. For people using git to submit patches, you can also clone/fork from git://github.com/clkao/finance-geniustrader.git without doing git svn again from the primary repository. Cheers, CLK |
|
From: Thomas W. <we...@ms...> - 2009-11-08 10:22:59
|
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type"> <title></title> </head> <body bgcolor="#ffffff" text="#000000"> >From the error message you are trying to load a module with an empty name, see below. So you want to examine what module it is trying to load and try to understand why the name is empty. I would guess that you did not define DB::module in your options file which tells what data base module to use to load your data....<br> <br> Th.<br> <br> Tielman Esterhuizen wrote: <blockquote cite="mid:4AF...@ei..." type="cite"><font face="sans-serif">Use of uninitialized value in concatenation (.) or string at ../GT/Eval.pm line 87.<br> Can't locate GT/DB/.pm in @INC (@INC contains: .. /etc/perl /usr/local/lib/perl/5.8.8 /usr/local/share/perl/5.8.8 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.8 /usr/share/perl/5.8 /usr/local/lib/site_perl .) at (eval 28) line 1.<br> </font><font face="sans-serif"><br> </font> </blockquote> </body> </html> |
|
From: Tielman E. <tes...@ei...> - 2009-11-08 06:13:10
|
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> </head> <body bgcolor="#ffffff" text="#000000"> <font face="sans-serif">G'day GTers!<br> <br> I've installed GT and configured the environment as per the "First use" page - everything seems to work great when I do the standard backtest using the 13000.txt data file.<br> <br> I have browsed through almost all of the documentation and find the project inspiring. I'm new to technical analysis / trading / but have a little Perl experience (just enough to get me in trouble).<br> <br> Now I've set up:<br> <br> 1. a mysql database with historical EOD data for some symbols.<br> 2. tested that Perl can read and write from the database (in fact I used Perl to populate the quotes table).<br> 3. Changed my options file to enable usage of said database (please see options contents below)<br> 4. When I attempt to run the following backtest I get an error. I found one such message in the archives where this is mentioned but the fix seems unrelated to my problem:<br> <br> $ ./backtest.pl TFS[30,7,7] W2_0_I0B <br> Use of uninitialized value in concatenation (.) or string at ../GT/Eval.pm line 87.<br> Can't locate GT/DB/.pm in @INC (@INC contains: .. /etc/perl /usr/local/lib/perl/5.8.8 /usr/local/share/perl/5.8.8 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.8 /usr/share/perl/5.8 /usr/local/lib/site_perl .) at (eval 28) line 1.<br> BEGIN failed--compilation aborted at (eval 28) line 1.<br> <br> </font><font face="sans-serif">(W2_0_I0B is a symbol in my quotes table.)<br> <br> My options file:<br> =======================================<br> DB::genericdbi::dbname eodb<br> DB::genericdbi::dbhost localhost<br> DB::genericdbi::dbport 3306<br> DB::genericdbi::dbuser myusername<br> DB::genericdbi::dbpasswd mypassword<br> DB::genericdbi::db mysql<br> DB::genericdbi::prices_sql SELECT period_open, period_high, period_low, period_close, volume, Concat(date, ' ', time) FROM quotes WHERE symbol = '$code' ORDER BY Concat(date, ' ', time) DESC LIMIT $limit<br> DB::genericdbi::name_sql SELECT symname from symbols WHERE symcode = '$code'<br> <br> Brokers::module SelfTrade<br> <br> Path::Font::Arial /usr/share/fonts/truetype/msttcorefonts/arial.ttf<br> Path::Font::Courier /usr/share/fonts/truetype/msttcorefonts/couri.ttf<br> Path::Font::Times /usr/share/fonts/truetype/msttcorefonts/times.ttf<br> <br> #Analysis::ReferenceTimeFrame year<br> Analysis::ReferenceTimeFrame day<br> <br> #Graphic::BackgroundColor black<br> #Graphic::ForegroundColor white<br> <br> Aliases::Global::TFS SY:TFS 50 10|CS:SY:TFS<br> Aliases::Global::TFS[] SY:TFS #1 #2|CS:SY:TFS #1|CS:Stop:Fixed #3<br> =============================================================<br> <br> I'm a little stuck with this but from looking at the archives it doesn't seem like I'm having a common problem (although I imagive someone's had the problem before).<br> <br> My mysql schema looks as follows:<br> <br> mysql> desc quotes;<br> +--------------+--------------+------+-----+---------+-------+<br> | Field | Type | Null | Key | Default | Extra |<br> +--------------+--------------+------+-----+---------+-------+<br> | uniqkey | varchar(64) | NO | PRI | NULL | | <br> | period_open | double | NO | | NULL | | <br> | period_high | double | NO | | NULL | | <br> | period_low | double | NO | | NULL | | <br> | period_close | double | NO | | NULL | | <br> | volume | double | NO | | NULL | | <br> | date | date | NO | | NULL | | <br> | time | time | YES | | NULL | | <br> | symbol | varchar(128) | NO | | NULL | | <br> +--------------+--------------+------+-----+---------+-------+<br> 9 rows in set (0.01 sec)<br> <br> mysql> desc symbols;<br> +---------+--------------+------+-----+---------+-------+<br> | Field | Type | Null | Key | Default | Extra |<br> +---------+--------------+------+-----+---------+-------+<br> | symcode | varchar(128) | NO | PRI | NULL | | <br> | symname | varchar(128) | NO | | NULL | | <br> +---------+--------------+------+-----+---------+-------+<br> <br> Any help would be appreciated if someone knows of a fix (or further tests that might help track down the problem).<br> <br> Tielman<br> </font> </body> </html> |
|
From: Thomas W. <we...@ms...> - 2009-11-07 09:39:17
|
RAS, as you know, this change has been made long time ago (I don't quite remember but probably more than a year). There have been no complaints about the removal of the XML interface. I believe that it is easy for experienced user to work around such a change by renaming and continuing to use the old script. However, for new users it is totally impossible if every script has a different set of parameters and ways to interact. You know how much people struggle with defining systems. Now tell them that for this script they have to define their system in a totally different way... That is a complete non-starter. While I usually agree with your conservative attitude towards changes, this is one where the conservative attitude becomes a barrier for acquiring new users and it really does not protect the old users in a meaningful way. All that said, we should now leverage the familiarity of fr....@ti... (sorry missed the name somewhere) with the XML interface to maybe include this interface in all scripts, if it turns out to be useful. We finally have a consistent interface to all scripts. I am totally against making it inconsistent again! Th. Robert A. Schmied wrote: > Thomas Weigert wrote: >> The backtest files where made consistent in their arguments. So please, >> if you find that there had been some mistakes in this convergence, >> highlight these and we shall fix it. But not by converting to the old >> version but to an improved version that remains consistent with the >> other scripts. >> > > the conservative among us might endorse an alternative methodology: > first do no harm > and > secondly consider each script a standalone application > > since this 'made consistent in their arguments' effort has been shown > in the past to be defective, primarily due to unintended consequences, > the change should be un-done by renaming the current 'improved' > backtest_multi.pl > to something other than backtest_multi.pl and the old original version > restored as backtest_multi.pl. then, if users of the original > backtest_multi.pl > want to embrace any of the improvements or make additional enhancements > that's fine, but that should be done on a consensus basis, grounded in an > adequately exposed and discussed testing methodology that shows the api > is unaffected or demonstrates the changes for all to consider. finally, > pod should be included and be consistent with the applications' > operation. > > but readers do note that i completely endorse the principle that > > gt applications should be consistent in their arguments > > however, it should be applied only when and where applicable. most > importantly it shouldn't change the user api of an *existing* script. > if it does and the author cannot make it backwards compatible with the > original api then the application should get an alternate name. > > the passage of time will demonstrate which of the two versions is the > most useful. > > ras > > > >> There is no usage of an xml format anywhere else, so we should avoid >> that or provide it as an alternative everywhere... >> >> Th. >> >> fr....@ti... wrote: >> >>> hi again, >>> >>> as i wrote in a previous post im still using an old version of GT. >>> Reading the history of mailing list i noticed that the >>> backtest_multi.pl was >>> changed because nobody know the format of xml file. I use the old >>> backtest_multi.pl quite a lot and can give examples of the xml file >>> format. >>> >>> I can use the new one without problems but the new format doesnt fit >>> to the >>> backtest_multi.pl logic: in backtest_multi.pl you need only one >>> MoneyManagement for all the systems, in >>> the old format you had a xml fileld different from the system >>> definition, in >>> the new one you have to define MM only on the last system line, >>> otherwise >>> backtest_multi.pl gives an error. >>> >>> before i change all my other programs that use the xml format id >>> like to know >>> if what i wrote will make restore the previous version of >>> backtest_multi.pl or >>> is not enough important. >>> >>> >>> >> >> >> > |
|
From: Robert A. S. <ra...@ac...> - 2009-11-06 22:20:26
|
Thomas Weigert wrote: > The backtest files where made consistent in their arguments. So please, > if you find that there had been some mistakes in this convergence, > highlight these and we shall fix it. But not by converting to the old > version but to an improved version that remains consistent with the > other scripts. > the conservative among us might endorse an alternative methodology: first do no harm and secondly consider each script a standalone application since this 'made consistent in their arguments' effort has been shown in the past to be defective, primarily due to unintended consequences, the change should be un-done by renaming the current 'improved' backtest_multi.pl to something other than backtest_multi.pl and the old original version restored as backtest_multi.pl. then, if users of the original backtest_multi.pl want to embrace any of the improvements or make additional enhancements that's fine, but that should be done on a consensus basis, grounded in an adequately exposed and discussed testing methodology that shows the api is unaffected or demonstrates the changes for all to consider. finally, pod should be included and be consistent with the applications' operation. but readers do note that i completely endorse the principle that gt applications should be consistent in their arguments however, it should be applied only when and where applicable. most importantly it shouldn't change the user api of an *existing* script. if it does and the author cannot make it backwards compatible with the original api then the application should get an alternate name. the passage of time will demonstrate which of the two versions is the most useful. ras > There is no usage of an xml format anywhere else, so we should avoid > that or provide it as an alternative everywhere... > > Th. > > fr....@ti... wrote: > >>hi again, >> >>as i wrote in a previous post im still using an old version of GT. >>Reading the history of mailing list i noticed that the backtest_multi.pl was >>changed because nobody know the format of xml file. I use the old >>backtest_multi.pl quite a lot and can give examples of the xml file format. >> >>I can use the new one without problems but the new format doesnt fit to the >>backtest_multi.pl logic: >>in backtest_multi.pl you need only one MoneyManagement for all the systems, in >>the old format you had a xml fileld different from the system definition, in >>the new one you have to define MM only on the last system line, otherwise >>backtest_multi.pl gives an error. >> >>before i change all my other programs that use the xml format id like to know >>if what i wrote will make restore the previous version of backtest_multi.pl or >>is not enough important. >> >> >> > > > |
|
From: Robert A. S. <ra...@ac...> - 2009-11-06 19:27:21
|
Bhaskar S. Manda wrote: > On Wed, Nov 4, 2009 at 3:01 PM, Robert A. Schmied <ra...@ac...> wrote: > > >>jecxz112 wrote: >> >> >>>Bhaskar S. Manda wrote >>> >>> >>>>There's no search capability there. You can always do a Google search as >>>>follows. >>>> site:geniustrader.org <search terms> >>>> >>Bhaskar -- thanks for that. it should be worked into the web site someplace >>... > > > > Hi Robert, > > The Google search is very helpful. A site-specific search could be > semantically richer, perhaps using tags. It appears however that > Alioth.Debian.org, to which migration has been proposed, doesn't seem to > have search capability in its mailing lists. > aloha Bhaskar i think having searchable archives would be of some benefit, but only if it is used. sometimes i get the impression users prefer to post a question rather than do the work needed to find the answer on their own. if you are serious about being willing to manage and maintain the gt mailing lists i suggest you contact raphael directly and make your pitch. between the two you might be able to figure a way to provide the capability where ever the lists wind up. ras |
|
From: Bhaskar S. M. <bha...@gm...> - 2009-11-06 18:27:57
|
On Wed, Nov 4, 2009 at 3:01 PM, Robert A. Schmied <ra...@ac...> wrote: > jecxz112 wrote: > >> Bhaskar S. Manda wrote >> >>> >>> There's no search capability there. You can always do a Google search as >>> follows. >>> site:geniustrader.org <search terms> >>> >> > Bhaskar -- thanks for that. it should be worked into the web site someplace > ... Hi Robert, The Google search is very helpful. A site-specific search could be semantically richer, perhaps using tags. It appears however that Alioth.Debian.org, to which migration has been proposed, doesn't seem to have search capability in its mailing lists. -- Bhaskar |
|
From: Thomas W. <we...@ms...> - 2009-11-06 18:20:49
|
The backtest files where made consistent in their arguments. So please, if you find that there had been some mistakes in this convergence, highlight these and we shall fix it. But not by converting to the old version but to an improved version that remains consistent with the other scripts. There is no usage of an xml format anywhere else, so we should avoid that or provide it as an alternative everywhere... Th. fr....@ti... wrote: > hi again, > > as i wrote in a previous post im still using an old version of GT. > Reading the history of mailing list i noticed that the backtest_multi.pl was > changed because nobody know the format of xml file. I use the old > backtest_multi.pl quite a lot and can give examples of the xml file format. > > I can use the new one without problems but the new format doesnt fit to the > backtest_multi.pl logic: > in backtest_multi.pl you need only one MoneyManagement for all the systems, in > the old format you had a xml fileld different from the system definition, in > the new one you have to define MM only on the last system line, otherwise > backtest_multi.pl gives an error. > > before i change all my other programs that use the xml format id like to know > if what i wrote will make restore the previous version of backtest_multi.pl or > is not enough important. > > > |
|
From: Thomas W. <we...@ms...> - 2009-11-06 18:19:22
|
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <meta content="text/html;charset=ISO-8859-15" http-equiv="Content-Type"> </head> <body bgcolor="#ffffff" text="#000000"> >From the recent checkins I assume that Chia Liang is now merging all the mirror branches into the CPAN branch on geniustrader.org. We should thus discontinue usage of the mirror, right?<br> <br> Th.<br> <br> Raphael Hertzog wrote: <blockquote cite="mid:20091106130824.GH27119@rivendell" type="cite"> <pre wrap="">Le dimanche 25 octobre 2009, Chia-liang Kao a écrit : </pre> <blockquote type="cite"> <pre wrap="">branch of thomas' mirror. Raphael, can I please get a commit bit for the current svn repository while we are still figuring out the project ownership issues to avoid divergence? </pre> </blockquote> <pre wrap=""><!----> I have granted an account (clkao) to Chia-liang Kao in the hope to not loose momentum in the project. It's a bit sad that the last discussions did not have a clear outcome. I hope you will all manage to cooperate in a constructive fashion. I have found Robert A. Schmied a bit conservative in the positions he took but it's understandable when you're using a software that works and you want to keep it working. That said, I agree that the confidence should come from automated non-regression tests and not from the fact that no changes were made. I hope you can all go forward in that direction. BTW, I don't mind renaming the modules to Finance::Geniustrader even if that's a bit verbose. Having the modules on CPAN will also allow usage of its request tracker if you don't move to a forge. It might be interesting. Cheers, </pre> </blockquote> </body> </html> |
|
From: <fr....@ti...> - 2009-11-06 16:52:46
|
hi again, as i wrote in a previous post im still using an old version of GT. Reading the history of mailing list i noticed that the backtest_multi.pl was changed because nobody know the format of xml file. I use the old backtest_multi.pl quite a lot and can give examples of the xml file format. I can use the new one without problems but the new format doesnt fit to the backtest_multi.pl logic: in backtest_multi.pl you need only one MoneyManagement for all the systems, in the old format you had a xml fileld different from the system definition, in the new one you have to define MM only on the last system line, otherwise backtest_multi.pl gives an error. before i change all my other programs that use the xml format id like to know if what i wrote will make restore the previous version of backtest_multi.pl or is not enough important. here are the 2 files for the same system definition you can see the use of MM old xml: <?xml version='1.0'?> <data> <system-manager> <system value='Swing:SwingCompleto4_3'></system> <of value='Inversione'></of> <tf value='SoloUnoAlGiornoNonDopo 10:20:00'></tf> <tf value='OneTradeMultiSystem'></tf> <cs value='CloseGain 3'></cs> <broker value='NoCosts'></broker> </system-manager> <system-manager> <system value='Swing:OutbarDay'></system> <of value='OutbarDay'></of> <tf value='NonDopo 16:10:00'></tf> <tf value='OneTradeMultiSystem'></tf> <cs value='CloseGain 3'></cs> <broker value='NoCosts'></broker> </system-manager> <system-manager> <system value='Swing:EstremoDoppioCross2'></system> <of value='OutbarDay'></of> <tf value='SoloUnoAlGiornoNonDopo 16:00:00'></tf> <tf value='OneTradeMultiSystem'></tf> <cs value='CloseGain 3'></cs> <broker value='NoCosts'></broker> </system-manager> <mm value='FixedSum 99000'></mm> <init value='100000'></init> <code value='AFF'></code> </data> new format: SY:Swing:SwingCompleto4_3|OF:Inversione|TF:SoloUnoAlGiornoNonDopo 10:20:00|TF:OneTradeMultiSystem|CS:CloseGain 3 SY:Swing:OutbarDay|OF:OutbarDay|TF:NonDopo 16:10:00|TF:OneTradeMultiSystem|CS:CloseGain 3 SY:Swing:EstremoDoppioCross2|OF:OutbarDay|TF:SoloUnoAlGiornoNonDopo 16:00:00|TF:OneTradeMultiSystem|CS:CloseGain 3|MM:FixedSum 99000 thx |
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:41:10
|
Author: clkao
Date: 2009-11-06 14:41:04 +0100 (Fri, 06 Nov 2009)
New Revision: 707
Modified:
branches/CPAN/lib/Finance/GeniusTrader/DB/Text.pm
branches/CPAN/lib/Finance/GeniusTrader/Prices.pm
Log:
Merge branch 'CPAN/topic/dbcache'
Modified: branches/CPAN/lib/Finance/GeniusTrader/DB/Text.pm
===================================================================
--- branches/CPAN/lib/Finance/GeniusTrader/DB/Text.pm 2009-11-06 13:40:02 UTC (rev 706)
+++ branches/CPAN/lib/Finance/GeniusTrader/DB/Text.pm 2009-11-06 13:41:04 UTC (rev 707)
@@ -5,7 +5,7 @@
# version 2 or (at your option) any later version.
# new version joao costa circa nov 07
-# $Id$
+# $Id: /mirror/geniustrader/trunk/GT/DB/Text.pm 11727 2008-06-10T04:43:34.636531Z thomas $
use strict;
our @ISA = qw(Finance::GeniusTrader::DB);
@@ -128,6 +128,7 @@
Finance::GeniusTrader::Conf::default('DB::Text::fields::high', '1');
Finance::GeniusTrader::Conf::default('DB::Text::fields::close', '3');
Finance::GeniusTrader::Conf::default('DB::Text::fields::volume', '4');
+ Finance::GeniusTrader::Conf::default('DB::Text::cache', '0');
$self->{'header_lines'} = Finance::GeniusTrader::Conf::get('DB::Text::header_lines');
$self->{'mark'} = Finance::GeniusTrader::Conf::get('DB::Text::marker');
@@ -139,6 +140,7 @@
$self->{'high'} = Finance::GeniusTrader::Conf::get('DB::Text::fields::high');
$self->{'close'} = Finance::GeniusTrader::Conf::get('DB::Text::fields::close');
$self->{'volume'} = Finance::GeniusTrader::Conf::get('DB::Text::fields::volume');
+ $self->{'use_cache'} = Finance::GeniusTrader::Conf::get('DB::Text::cache');
return bless $self, $class;
}
@@ -192,9 +194,23 @@
$extension =~ s/\$timeframe/$tfname/g;
my $file = $self->{'directory'} . "/$code" . $extension;
-
+ if ($self->{'use_cache'}) {
+ require Storable;
+ if (-f $file.".cache" && (stat($file.".cache"))[9] > (stat($file))[9]) {
+ my $cached = Storable::retrieve($file.".cache");
+ if (ref($cached) eq 'GT::Prices') {
+ bless $cached, 'Finance::GeniusTrader::Prices';
+ }
+ return $cached;
+ }
+ }
$prices->loadtxt($file, $self->{'mark'}, $self->{'date_format'},
$self->{'header_lines'}, %fields);
+
+ if ($self->{'use_cache'}) {
+ $prices->timestamp($_) for 0..$prices->count-1;
+ Storable::nstore($prices, $file.".cache");
+ }
return $prices;
}
Modified: branches/CPAN/lib/Finance/GeniusTrader/Prices.pm
===================================================================
--- branches/CPAN/lib/Finance/GeniusTrader/Prices.pm 2009-11-06 13:40:02 UTC (rev 706)
+++ branches/CPAN/lib/Finance/GeniusTrader/Prices.pm 2009-11-06 13:41:04 UTC (rev 707)
@@ -5,7 +5,7 @@
# version 2 or (at your option) any later version.
use strict;
-use vars qw(@ISA @EXPORT $FIRST $OPEN $HIGH $LOW $CLOSE $LAST $VOLUME $DATE);
+use vars qw(@ISA @EXPORT $FIRST $OPEN $HIGH $LOW $CLOSE $LAST $VOLUME $DATE $TIMESTAMP);
use Date::Calc qw(Decode_Date_US Decode_Date_EU Today);
#ALL# use Log::Log4perl qw(:easy);
@@ -21,6 +21,7 @@
$LAST = $CLOSE = 3;
$VOLUME = 4;
$DATE = 5;
+$TIMESTAMP = 6;
=head1 NAME
@@ -64,6 +65,12 @@
return $self->at($self->date($date));
}
+sub timestamp {
+ my ($self, $i) = @_;
+ return $self->{'prices'}[$i][$TIMESTAMP] ||=
+ Finance::GeniusTrader::DateTime::map_date_to_time($self->timeframe, $self->{'prices'}[$i][$DATE]);
+}
+
=item C<< $p->has_date('YYYY-MM-DD') >>
Return true if the object has prices for the corresponding date.
@@ -227,14 +234,13 @@
my $time = Finance::GeniusTrader::DateTime::map_date_to_time($self->timeframe, $date);
my $mindiff = $time;
my $mindate = '';
- foreach (@{$self->{'prices'}})
- {
- my $dtime = Finance::GeniusTrader::DateTime::map_date_to_time($self->timeframe, $_->[$DATE]);
+ for (my $i=0; $i < $self->count; ++$i) {
+ my $dtime = $self->timestamp($i);
my $diff = $dtime - $time;
next if ($diff < 0);
if ($diff < $mindiff)
{
- $mindate = $_->[$DATE];
+ $mindate = $self->at($i)->[$DATE];
$mindiff = $diff;
}
}
@@ -246,14 +252,13 @@
my $time = Finance::GeniusTrader::DateTime::map_date_to_time($self->timeframe, $date);
my $mindiff = $time;
my $mindate = '';
- foreach (@{$self->{'prices'}})
- {
- my $dtime = Finance::GeniusTrader::DateTime::map_date_to_time($self->timeframe, $_->[$DATE]);
+ for (my $i=0; $i < $self->count; ++$i) {
+ my $dtime = $self->timestamp($i);
my $diff = $time - $dtime;
next if ($diff < 0);
if ($diff < $mindiff)
{
- $mindate = $_->[$DATE];
+ $mindate = $self->at($i)->[$DATE];
$mindiff = $diff;
}
}
@@ -265,13 +270,12 @@
my $time = Finance::GeniusTrader::DateTime::map_date_to_time($self->timeframe, $date);
my $mindiff = $time;
my $mindate = '';
- foreach (@{$self->{'prices'}})
- {
- my $dtime = Finance::GeniusTrader::DateTime::map_date_to_time($self->timeframe, $_->[$DATE]);
+ for (my $i=0; $i < $self->count; ++$i) {
+ my $dtime = $self->timestamp($i);
my $diff = abs($time - $dtime);
if ($diff < $mindiff)
{
- $mindate = $_->[$DATE];
+ $mindate = $self->at($i)->[$DATE];
$mindiff = $diff;
}
}
|
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:40:07
|
Author: clkao
Date: 2009-11-06 14:40:02 +0100 (Fri, 06 Nov 2009)
New Revision: 706
Added:
branches/CPAN/t/cs/
branches/CPAN/t/cs/stop-fixed.t
branches/CPAN/t/data/TXExtreme_5min.txt
Log:
Add a failing test for ordering issues of multiple stop orders within position.
Added: branches/CPAN/t/cs/stop-fixed.t
===================================================================
--- branches/CPAN/t/cs/stop-fixed.t (rev 0)
+++ branches/CPAN/t/cs/stop-fixed.t 2009-11-06 13:40:02 UTC (rev 706)
@@ -0,0 +1,60 @@
+#!/usr/bin/perl -w
+use strict;
+use Finance::GeniusTrader::DateTime;
+use Finance::GeniusTrader::Calculator;
+use Finance::GeniusTrader::Prices;
+use Finance::GeniusTrader::BackTest;
+use Finance::GeniusTrader::PortfolioManager;
+use Finance::GeniusTrader::SystemManager;
+use Finance::GeniusTrader::Tools qw(resolve_alias);
+use Finance::GeniusTrader::Test
+ tests => 1,
+ gt_config => sub {
+ my $test_base = shift;
+ my $db_path = File::Spec->catdir($test_base, 'data');
+<<"EOF";
+DB::module Text
+DB::text::file_extension _\$timeframe.txt
+DB::text::directory $db_path
+Brokers::module NoCosts
+
+Aliases::Global::CBBTD[] SY:AlwaysInTheMarket \\
+ |OF:ChannelBreakout {I:G:MaxInPeriod #1 {I:Prices HIGH}} \\
+ {I:G:MinInPeriod #2 {I:Prices LOW }} \\
+ |CS:ChannelBreakout {I:G:Eval #3} \\
+ {I:G:Eval #4} \\
+ |CS:Stop:Fixed #5|MM:FixedShares 1 \\
+ |TF:MaxOpenTrades 1|TF:ShortOnly
+EOF
+ };
+
+my ($calc, $first, $last) = Finance::GeniusTrader::Tools::find_calculator(Finance::GeniusTrader::Test->gt_db, 'TXExtreme', $PERIOD_5MIN, 0, '2007-08-14 00:00:00', '2007-08-15 00:00:00');
+
+my $pf_manager = Finance::GeniusTrader::PortfolioManager->new;
+my $sys_manager = Finance::GeniusTrader::SystemManager->new;
+my $sysname = 'CBBTD[60,60,8000,9000,1]';
+my $alias = resolve_alias($sysname);
+$sys_manager->set_alias_name($sysname);
+$sysname = $alias;
+$sys_manager->setup_from_name($sysname);
+$pf_manager->setup_from_name($sysname);
+
+$pf_manager->finalize;
+$sys_manager->finalize;
+my $analysis = backtest_single($pf_manager, $sys_manager, undef, $calc, $first, $last);
+
+my $compact = [ map {
+ my $details = join( ',', map { $_->{'order'} . $_->price }
+ $_->list_detailed_orders );
+ [ $_->open_date, $_->close_date, $details ];
+} @{ $analysis->{portfolio}{history} } ];
+
+is_deeply($compact,
+ [ [
+ '2007-08-14 09:25:00',
+ '2007-08-14 10:05:00',
+ 'S8842,B8930.42'
+ ]
+ ]
+ );
+
Added: branches/CPAN/t/data/TXExtreme_5min.txt
===================================================================
--- branches/CPAN/t/data/TXExtreme_5min.txt (rev 0)
+++ branches/CPAN/t/data/TXExtreme_5min.txt 2009-11-06 13:40:02 UTC (rev 706)
@@ -0,0 +1,120 @@
+8896 8910 8875 8904 1469 2007-08-13 08:50
+8904 8919 8903 8908 988 2007-08-13 08:55
+8905 8909 8902 8907 502 2007-08-13 09:00
+8906 8923 8905 8915 1055 2007-08-13 09:05
+8914 8944 8912 8930 1876 2007-08-13 09:10
+8935 8960 8931 8957 1398 2007-08-13 09:15
+8957 8957 8938 8943 963 2007-08-13 09:20
+8943 8955 8930 8935 867 2007-08-13 09:25
+8934 8938 8917 8923 735 2007-08-13 09:30
+8923 8928 8910 8910 1034 2007-08-13 09:35
+8913 8930 8909 8926 896 2007-08-13 09:40
+8924 8932 8922 8928 653 2007-08-13 09:45
+8928 8938 8925 8930 704 2007-08-13 09:50
+8932 8933 8915 8924 703 2007-08-13 09:55
+8924 8928 8920 8925 242 2007-08-13 10:00
+8924 8939 8922 8938 490 2007-08-13 10:05
+8936 8938 8923 8923 293 2007-08-13 10:10
+8922 8925 8906 8915 967 2007-08-13 10:15
+8914 8925 8914 8915 400 2007-08-13 10:20
+8915 8932 8913 8928 564 2007-08-13 10:25
+8929 8934 8925 8934 357 2007-08-13 10:30
+8932 8934 8925 8927 338 2007-08-13 10:35
+8927 8930 8911 8912 532 2007-08-13 10:40
+8912 8918 8895 8899 819 2007-08-13 10:45
+8900 8908 8888 8897 663 2007-08-13 10:50
+8896 8915 8891 8914 621 2007-08-13 10:55
+8913 8919 8909 8916 627 2007-08-13 11:00
+8912 8916 8903 8911 286 2007-08-13 11:05
+8912 8913 8894 8894 413 2007-08-13 11:10
+8891 8907 8891 8895 413 2007-08-13 11:15
+8895 8899 8884 8899 813 2007-08-13 11:20
+8898 8907 8886 8905 652 2007-08-13 11:25
+8905 8905 8887 8893 601 2007-08-13 11:30
+8893 8896 8862 8876 1404 2007-08-13 11:35
+8877 8877 8851 8860 1389 2007-08-13 11:40
+8861 8871 8842 8868 1303 2007-08-13 11:45
+8871 8871 8843 8863 825 2007-08-13 11:50
+8863 8892 8857 8885 1008 2007-08-13 11:55
+8887 8889 8876 8878 568 2007-08-13 12:00
+8879 8894 8878 8889 611 2007-08-13 12:05
+8891 8908 8889 8906 967 2007-08-13 12:10
+8905 8928 8902 8928 1247 2007-08-13 12:15
+8926 8945 8925 8942 1311 2007-08-13 12:20
+8942 8960 8935 8937 1299 2007-08-13 12:25
+8934 8938 8918 8924 826 2007-08-13 12:30
+8925 8937 8920 8921 640 2007-08-13 12:35
+8918 8920 8905 8917 613 2007-08-13 12:40
+8917 8948 8917 8943 653 2007-08-13 12:45
+8945 8950 8936 8939 753 2007-08-13 12:50
+8938 8943 8923 8925 634 2007-08-13 12:55
+8924 8943 8923 8932 525 2007-08-13 13:00
+8934 8936 8923 8926 462 2007-08-13 13:05
+8926 8931 8905 8905 695 2007-08-13 13:10
+8905 8915 8891 8901 1154 2007-08-13 13:15
+8902 8928 8893 8920 1087 2007-08-13 13:20
+8918 8922 8910 8919 639 2007-08-13 13:25
+8919 8923 8914 8916 596 2007-08-13 13:30
+8915 8922 8901 8915 852 2007-08-13 13:35
+8916 8920 8911 8918 859 2007-08-13 13:40
+8925 8925 8925 8925 674 2007-08-13 13:45
+8860 8894 8860 8885 1049 2007-08-14 08:50
+8882 8887 8875 8883 648 2007-08-14 08:55
+8880 8884 8872 8879 481 2007-08-14 09:00
+8879 8889 8869 8879 1159 2007-08-14 09:05
+8880 8887 8876 8883 675 2007-08-14 09:10
+8879 8895 8871 8884 827 2007-08-14 09:15
+8884 8885 8853 8860 1264 2007-08-14 09:20
+8859 8860 8825 8832 1918 2007-08-14 09:25
+8830 8845 8825 8837 904 2007-08-14 09:30
+8837 8854 8837 8847 1035 2007-08-14 09:35
+8847 8857 8842 8849 721 2007-08-14 09:40
+8847 8855 8844 8850 614 2007-08-14 09:45
+8851 8854 8842 8843 779 2007-08-14 09:50
+8843 8850 8836 8848 598 2007-08-14 09:55
+8850 8878 8845 8870 908 2007-08-14 10:00
+8870 9019 8868 9019 3583 2007-08-14 10:05
+9004 9075 8953 8960 2606 2007-08-14 10:10
+8959 8960 8908 8956 2066 2007-08-14 10:15
+8961 8961 8931 8944 890 2007-08-14 10:20
+8945 8960 8913 8930 1126 2007-08-14 10:25
+8932 8959 8930 8959 813 2007-08-14 10:30
+8953 8958 8932 8940 653 2007-08-14 10:35
+8939 8951 8929 8946 541 2007-08-14 10:40
+8943 8947 8933 8941 400 2007-08-14 10:45
+8937 8950 8937 8942 407 2007-08-14 10:50
+8942 8946 8938 8945 201 2007-08-14 10:55
+8945 8948 8940 8947 428 2007-08-14 11:00
+8946 8955 8940 8948 687 2007-08-14 11:05
+8950 8970 8950 8970 918 2007-08-14 11:10
+8968 8987 8968 8985 1138 2007-08-14 11:15
+8983 9004 8981 8994 1346 2007-08-14 11:20
+8994 8995 8978 8987 768 2007-08-14 11:25
+8987 8989 8973 8981 658 2007-08-14 11:30
+8980 8994 8974 8984 646 2007-08-14 11:35
+8986 8988 8982 8985 469 2007-08-14 11:40
+8985 8986 8955 8961 974 2007-08-14 11:45
+8963 8969 8958 8967 729 2007-08-14 11:50
+8968 8980 8960 8978 768 2007-08-14 11:55
+8978 8983 8959 8973 742 2007-08-14 12:00
+8973 8975 8950 8950 891 2007-08-14 12:05
+8951 8963 8946 8950 696 2007-08-14 12:10
+8954 8968 8949 8964 751 2007-08-14 12:15
+8960 8968 8952 8964 711 2007-08-14 12:20
+8968 8968 8918 8920 1390 2007-08-14 12:25
+8918 8945 8912 8939 1098 2007-08-14 12:30
+8938 8949 8927 8945 649 2007-08-14 12:35
+8948 8952 8942 8947 635 2007-08-14 12:40
+8949 8953 8931 8931 770 2007-08-14 12:45
+8931 8945 8920 8930 876 2007-08-14 12:50
+8929 8930 8911 8917 1275 2007-08-14 12:55
+8917 8923 8890 8905 1428 2007-08-14 13:00
+8902 8909 8886 8906 1227 2007-08-14 13:05
+8901 8909 8895 8906 1108 2007-08-14 13:10
+8903 8907 8882 8885 887 2007-08-14 13:15
+8883 8906 8882 8903 769 2007-08-14 13:20
+8903 8908 8895 8908 620 2007-08-14 13:25
+8904 8907 8900 8905 601 2007-08-14 13:30
+8902 8908 8894 8897 790 2007-08-14 13:35
+8897 8903 8892 8901 856 2007-08-14 13:40
+8885 8885 8885 8885 523 2007-08-14 13:45
|
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:39:04
|
Author: clkao
Date: 2009-11-06 14:38:58 +0100 (Fri, 06 Nov 2009)
New Revision: 705
Added:
branches/CPAN/t/of/
branches/CPAN/t/of/channel-breakout.t
Log:
add a test for channel breakout order factory.
Added: branches/CPAN/t/of/channel-breakout.t
===================================================================
--- branches/CPAN/t/of/channel-breakout.t (rev 0)
+++ branches/CPAN/t/of/channel-breakout.t 2009-11-06 13:38:58 UTC (rev 705)
@@ -0,0 +1,126 @@
+#!/usr/bin/perl -w
+use strict;
+use Finance::GeniusTrader::DateTime;
+use Finance::GeniusTrader::Calculator;
+use Finance::GeniusTrader::Prices;
+use Finance::GeniusTrader::BackTest;
+use Finance::GeniusTrader::PortfolioManager;
+use Finance::GeniusTrader::SystemManager;
+use Finance::GeniusTrader::Tools qw(resolve_alias);
+use Finance::GeniusTrader::Test
+ tests => 1,
+ gt_config => sub {
+ my $test_base = shift;
+ my $db_path = File::Spec->catdir($test_base, 'data');
+<<"EOF";
+DB::module Text
+DB::text::file_extension _\$timeframe.txt
+DB::text::directory $db_path
+Brokers::module NoCosts
+
+Aliases::Global::CBBTD[] SY:AlwaysInTheMarket \\
+ |OF:ChannelBreakout {I:G:MaxInPeriod #1 {I:Prices HIGH}} \\
+ {I:G:MinInPeriod #2 {I:Prices LOW }} \\
+ |CS:ChannelBreakout {I:G:MinInPeriod #3 {I:Prices LOW }} \\
+ {I:G:MaxInPeriod #4 {I:Prices HIGH}} \\
+ |CS:Stop:Fixed #5|MM:FixedShares 1 \\
+ |TF:MaxOpenTrades 1
+EOF
+ };
+
+my ($calc, $first, $last) = Finance::GeniusTrader::Tools::find_calculator(Finance::GeniusTrader::Test->gt_db, 'TX', $DAY, 1);
+
+my $pf_manager = Finance::GeniusTrader::PortfolioManager->new;
+my $sys_manager = Finance::GeniusTrader::SystemManager->new;
+
+my $sysname = 'CBBTD[15,15,5,5,2]';
+my $alias = resolve_alias($sysname);
+$sys_manager->set_alias_name($sysname);
+$sysname = $alias;
+$sys_manager->setup_from_name($sysname);
+$pf_manager->setup_from_name($sysname);
+
+$pf_manager->finalize;
+$sys_manager->finalize;
+
+my $analysis = backtest_single($pf_manager, $sys_manager, undef, $calc, $first+15, $last);
+
+my $compact = [ map {
+ my $details = join( ',', map { $_->{'order'} . $_->price }
+ $_->list_detailed_orders );
+ [ $_->open_date, $_->close_date, $details ];
+} @{ $analysis->{portfolio}{history} } ];
+
+is_deeply( $compact,
+ [
+ [
+ '2009-02-11 00:00:00',
+ '2009-02-12 00:00:00',
+ 'B4552,S4460.96'
+ ],
+ [
+ '2009-02-13 00:00:00',
+ '2009-02-17 00:00:00',
+ 'B4578,S4486.44'
+ ],
+ [
+ '2009-03-03 00:00:00',
+ '2009-03-03 00:00:00',
+ 'S4270,B4355.4'
+ ],
+ [
+ '2009-03-05 00:00:00',
+ '2009-04-17 00:00:00',
+ 'B4590,S5696'
+ ],
+ [
+ '2009-05-04 00:00:00',
+ '2009-05-12 00:00:00',
+ 'B6363,S6412'
+ ],
+ [
+ '2009-05-19 00:00:00',
+ '2009-05-20 00:00:00',
+ 'B6720,S6585.6'
+ ],
+ [
+ '2009-05-25 00:00:00',
+ '2009-05-26 00:00:00',
+ 'B6804,S6667.92'
+ ],
+ [
+ '2009-05-27 00:00:00',
+ '2009-06-04 00:00:00',
+ 'B6837,S6700.26'
+ ],
+ [
+ '2009-06-09 00:00:00',
+ '2009-06-11 00:00:00',
+ 'S6402,B6530.04'
+ ],
+ [
+ '2009-06-15 00:00:00',
+ '2009-06-24 00:00:00',
+ 'S6335,B6294'
+ ],
+ [
+ '2009-07-02 00:00:00',
+ '2009-07-13 00:00:00',
+ 'B6558,S6527'
+ ],
+ [
+ '2009-07-15 00:00:00',
+ '2009-08-04 00:00:00',
+ 'B6778,S6870'
+ ],
+ [
+ '2009-08-20 00:00:00',
+ '2009-09-01 00:00:00',
+ 'S6702,B6827'
+ ],
+ [
+ '2009-09-03 00:00:00',
+ '2009-09-23 00:00:00',
+ 'B7112,S7375'
+ ]
+]);
|
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:38:11
|
Author: clkao
Date: 2009-11-06 14:38:09 +0100 (Fri, 06 Nov 2009)
New Revision: 704
Modified:
branches/CPAN/lib/Finance/GeniusTrader/Tools.pm
Log:
Merge branch 'CPAN/topic/alias'
* CPAN/topic/alias:
make alias arg >= 10 work.
Modified: branches/CPAN/lib/Finance/GeniusTrader/Tools.pm
===================================================================
--- branches/CPAN/lib/Finance/GeniusTrader/Tools.pm 2009-11-06 13:37:06 UTC (rev 703)
+++ branches/CPAN/lib/Finance/GeniusTrader/Tools.pm 2009-11-06 13:38:09 UTC (rev 704)
@@ -188,7 +188,7 @@
my $n = 1;
foreach (@param)
{
- $sysname =~ s/#$n/$_/g;
+ $sysname =~ s/#$n(\D)/$_$1/g;
$n++;
}
|
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:37:09
|
Author: clkao
Date: 2009-11-06 14:37:06 +0100 (Fri, 06 Nov 2009)
New Revision: 703
Added:
branches/CPAN/inc/
branches/CPAN/inc/Module/
branches/CPAN/inc/Module/AutoInstall.pm
branches/CPAN/inc/Module/Install.pm
branches/CPAN/inc/Module/Install/
branches/CPAN/inc/Module/Install/AuthorTests.pm
branches/CPAN/inc/Module/Install/AutoInstall.pm
branches/CPAN/inc/Module/Install/Base.pm
branches/CPAN/inc/Module/Install/Can.pm
branches/CPAN/inc/Module/Install/Fetch.pm
branches/CPAN/inc/Module/Install/Include.pm
branches/CPAN/inc/Module/Install/Makefile.pm
branches/CPAN/inc/Module/Install/Metadata.pm
branches/CPAN/inc/Module/Install/Win32.pm
branches/CPAN/inc/Module/Install/WriteAll.pm
branches/CPAN/inc/Test/
branches/CPAN/inc/Test/More.pm
branches/CPAN/xt/
branches/CPAN/xt/01-pod-coverage.t
branches/CPAN/xt/02-pod.t
branches/CPAN/xt/03-boilerplate.t
branches/CPAN/xt/04-critic.t
Removed:
branches/CPAN/t/01-pod-coverage.t
branches/CPAN/t/02-pod.t
branches/CPAN/t/03-boilerplate.t
branches/CPAN/t/04-critic.t
Log:
move author tests to xt and let module::install decide if they should be run.
Added: branches/CPAN/inc/Module/AutoInstall.pm
===================================================================
--- branches/CPAN/inc/Module/AutoInstall.pm (rev 0)
+++ branches/CPAN/inc/Module/AutoInstall.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,805 @@
+#line 1
+package Module::AutoInstall;
+
+use strict;
+use Cwd ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.03';
+}
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
+my (
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+);
+my ( $PostambleActions, $PostambleUsed );
+
+# See if it's a testing or non-interactive session
+_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
+_init();
+
+sub _accept_default {
+ $AcceptDefault = shift;
+}
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [
+ $Config
+ ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ : ()
+ ],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (
+ @ARGV,
+ split(
+ /[\s\t]+/,
+ $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
+ )
+ )
+ {
+ if ( $arg =~ /^--config=(.*)$/ ) {
+ $Config = [ split( ',', $1 ) ];
+ }
+ elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--default(?:deps)?$/ ) {
+ $AcceptDefault = 1;
+ }
+ elsif ( $arg =~ /^--check(?:deps)?$/ ) {
+ $CheckOnly = 1;
+ }
+ elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
+ $SkipInstall = 1;
+ }
+ elsif ( $arg =~ /^--test(?:only)?$/ ) {
+ $TestOnly = 1;
+ }
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ( $prompt, $default ) = @_;
+ my $y = ( $default =~ /^[Yy]/ );
+
+ print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version " . $class->VERSION . "\n";
+ print "*** Checking for Perl dependencies...\n";
+
+ my $cwd = Cwd::cwd();
+
+ $Config = [];
+
+ my $maxlen = length(
+ (
+ sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map {
+ ref($_)
+ ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
+ : ''
+ }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
+ )[0]
+ );
+
+ # We want to know if we're under CPAN early to avoid prompting, but
+ # if we aren't going to try and install anything anyway then skip the
+ # check entirely since we don't want to have to load (and configure)
+ # an old CPAN just for a cosmetic message
+
+ $UnderCPAN = _check_lock(1) unless $SkipInstall;
+
+ while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
+ my ( @required, @tests, @skiptests );
+ my $default = 1;
+ my $conflict = 0;
+
+ if ( $feature =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to( $modules, @_ ) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ( $modules =~ /^all$/i ) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
+
+ unshift @$modules, -default => &{ shift(@$modules) }
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+
+ while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
+ if ( $mod =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ $default = $arg if ( $option eq 'default' );
+ $conflict = $arg if ( $option eq 'conflict' );
+ @tests = @{$arg} if ( $option eq 'tests' );
+ @skiptests = @{$arg} if ( $option eq 'skiptests' );
+
+ next;
+ }
+
+ printf( "- %-${maxlen}s ...", $mod );
+
+ if ( $arg and $arg =~ /^\D/ ) {
+ unshift @$modules, $arg;
+ $arg = 0;
+ }
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ my $cur = _load($mod);
+ if (_version_cmp ($cur, $arg) >= 0)
+ {
+ print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ if (not defined $cur) # indeed missing
+ {
+ print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ }
+ else
+ {
+ # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+ print "too old. ($cur < $arg)\n";
+ }
+
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ( $feature eq '-core' or $core_all );
+
+ if (
+ !$SkipInstall
+ and (
+ $CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
+ or _prompt(
+ qq{==> Auto-install the }
+ . ( @required / 2 )
+ . ( $mandatory ? ' mandatory' : ' optional' )
+ . qq{ module(s) from CPAN?},
+ $default ? 'y' : 'n',
+ ) =~ /^[Yy]/
+ )
+ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif ( !$SkipInstall
+ and $default
+ and $mandatory
+ and
+ _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
+ =~ /^[Nn]/ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+ require Config;
+ print
+"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n"
+ if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+}
+
+sub _running_under {
+ my $thing = shift;
+ print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+}
+
+# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
+# if we are, then we simply let it taking care of our dependencies
+sub _check_lock {
+ return unless @Missing or @_;
+
+ my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
+ if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
+ return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+ }
+
+ require CPAN;
+
+ if ($CPAN::VERSION > '1.89') {
+ if ($cpan_env) {
+ return _running_under('CPAN');
+ }
+ return; # CPAN.pm new enough, don't need to check further
+ }
+
+ # last ditch attempt, this -will- configure CPAN, very sorry
+
+ _load_cpan(1); # force initialize even though it's already loaded
+
+ # Find the CPAN lock-file
+ my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
+ return unless -f $lock;
+
+ # Check the lock
+ local *LOCK;
+ return unless open(LOCK, $lock);
+
+ if (
+ ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
+ and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
+ ) {
+ print <<'END_MESSAGE';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+ }
+
+ close LOCK;
+ return;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
+
+ my ( @modules, @installed );
+ while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+
+ # grep out those already installed
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ return @installed unless @modules; # nothing to do
+ return @installed if _check_lock(); # defer to the CPAN shell
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
+ push @newmod, ( $k => $v ) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
+ _install_cpanplus( \@modules, \@config );
+ } else {
+ _install_cpan( \@modules, \@config );
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{ +shift };
+ my @config = _cpanplus_config( @{ +shift } );
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless $conf->can('conf') # 0.05x+ with "sudo" support
+ or _can_write($conf->_get_build('base')); # 0.04x
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+
+ } else {
+ # 0.02 and below uses a scalar
+ $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ }
+ $conf->set_conf( makeflags => $makeflags );
+ $conf->set_conf( prereqs => 1 );
+
+
+
+ while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
+ $conf->set_conf( $key, $val );
+ }
+
+ my $modtree = $cp->module_tree;
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ] );
+
+ if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ } else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ } else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _cpanplus_config {
+ my @config = ();
+ while ( @_ ) {
+ my ($key, $value) = (shift(), shift());
+ if ( $key eq 'prerequisites_policy' ) {
+ if ( $value eq 'follow' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
+ } elsif ( $value eq 'ask' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
+ } elsif ( $value eq 'ignore' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
+ } else {
+ die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
+ }
+ } else {
+ die "*** Cannot convert option $key to CPANPLUS version.\n";
+ }
+ }
+ return @config;
+}
+
+sub _install_cpan {
+ my @modules = @{ +shift };
+ my @config = @{ +shift };
+ my $installed = 0;
+ my %args;
+
+ _load_cpan();
+ require Config;
+
+ if (CPAN->VERSION < 1.80) {
+ # no "sudo" support, probe for writableness
+ return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
+ and _can_write( $Config::Config{sitelib} );
+ }
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} =
+ join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
+ ( $args{$opt} = $arg, next )
+ if $opt =~ /^force$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand( Module => $pkg );
+ my $success = 0;
+
+ if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
+ : CPAN::Shell->install($pkg);
+ $rv ||= eval {
+ $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
+ ->{install}
+ if $CPAN::META;
+ };
+
+ if ( $rv eq 'YES' ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'}
+ or _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
+
+ return ( index( $cwd, $cpan ) > -1 );
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return
+ if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
+
+ if (
+ _prompt( "==> A newer version of $class ($ver) is required. Install?",
+ 'y' ) =~ /^[Nn]/
+ )
+ {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install( [], $class, $ver );
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
+ qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir( $path, 0755 ) unless -e $path;
+
+ return 1 if -w $path;
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (
+ eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
+ qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?),
+ ((-t STDIN) ? 'y' : 'n')
+ ) =~ /^[Yy]/
+ )
+ {
+
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join( ',', @Missing );
+ my $config = join( ',',
+ UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ return
+ unless system( 'sudo', $^X, $0, "--config=$config",
+ "--installdeps=$missing" );
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(
+ qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/;
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # class/instance doesn't matter
+ my $file = $mod;
+
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+
+ local $@;
+ return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
+}
+
+# Load CPAN.pm and it's configuration
+sub _load_cpan {
+ return if $CPAN::VERSION and $CPAN::Config and not @_;
+ require CPAN;
+ if ( $CPAN::HandleConfig::VERSION ) {
+ # Newer versions of CPAN have a HandleConfig module
+ CPAN::HandleConfig->load;
+ } else {
+ # Older versions had the load method in Config directly
+ CPAN::Config->load;
+ }
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+# return values same as <=>
+sub _version_cmp {
+ my ( $cur, $min ) = @_;
+ return -1 unless defined $cur; # if 0 keep comparing
+ return 1 unless $min;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
+ if ( ( $version::VERSION or defined( _load('version') )) and
+ version->can('new')
+ ) {
+
+ # use version.pm if it is installed.
+ return version->new($cur) <=> version->new($min);
+ }
+ elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
+ {
+
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return Sort::Versions::versioncmp( $cur, $min );
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n"
+ . "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return $cur <=> $min;
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} =
+ [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join( ' ',
+ grep { !exists( $DisabledTests{$_} ) }
+ map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
+
+ my $missing = join( ',', @Missing );
+ my $config =
+ join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ $PostambleActions = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from Module::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+
+ return <<"END_MAKE";
+
+config :: installdeps
+\t\$(NOECHO) \$(NOOP)
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+END_MAKE
+
+}
+
+1;
+
+__END__
+
+#line 1056
Added: branches/CPAN/inc/Module/Install/AuthorTests.pm
===================================================================
--- branches/CPAN/inc/Module/Install/AuthorTests.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/AuthorTests.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,59 @@
+#line 1
+package Module::Install::AuthorTests;
+
+use 5.005;
+use strict;
+use Module::Install::Base;
+use Carp ();
+
+#line 16
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.002';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+#line 42
+
+sub author_tests {
+ my ($self, @dirs) = @_;
+ _add_author_tests($self, \@dirs, 0);
+}
+
+#line 56
+
+sub recursive_author_tests {
+ my ($self, @dirs) = @_;
+ _add_author_tests($self, \@dirs, 1);
+}
+
+sub _wanted {
+ my $href = shift;
+ sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
+}
+
+sub _add_author_tests {
+ my ($self, $dirs, $recurse) = @_;
+ return unless $Module::Install::AUTHOR;
+
+ my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
+
+ # XXX: pick a default, later -- rjbs, 2008-02-24
+ my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
+ @dirs = grep { -d } @dirs;
+
+ if ($recurse) {
+ require File::Find;
+ my %test_dir;
+ File::Find::find(_wanted(\%test_dir), @dirs);
+ $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
+ } else {
+ $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
+ }
+}
+
+#line 107
+
+1;
Added: branches/CPAN/inc/Module/Install/AutoInstall.pm
===================================================================
--- branches/CPAN/inc/Module/Install/AutoInstall.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/AutoInstall.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,61 @@
+#line 1
+package Module::Install::AutoInstall;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ my @config = @_;
+
+ # We'll need Module::AutoInstall
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall->import(
+ (@config ? (-config => \@config) : ()),
+ (@core ? (-core => \@core) : ()),
+ $self->features,
+ );
+
+ $self->makemaker_args( Module::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ Module::AutoInstall::postamble()
+ );
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install(@_);
+ Module::AutoInstall::do_install();
+}
+
+1;
Added: branches/CPAN/inc/Module/Install/Base.pm
===================================================================
--- branches/CPAN/inc/Module/Install/Base.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/Base.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,78 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '0.91';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ $_[0]->admin->VERSION;
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 154
Added: branches/CPAN/inc/Module/Install/Can.pm
===================================================================
--- branches/CPAN/inc/Module/Install/Can.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/Can.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,81 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 156
Added: branches/CPAN/inc/Module/Install/Fetch.pm
===================================================================
--- branches/CPAN/inc/Module/Install/Fetch.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/Fetch.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'ano...@ex...');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
Added: branches/CPAN/inc/Module/Install/Include.pm
===================================================================
--- branches/CPAN/inc/Module/Install/Include.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/Include.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,34 @@
+#line 1
+package Module::Install::Include;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub include {
+ shift()->admin->include(@_);
+}
+
+sub include_deps {
+ shift()->admin->include_deps(@_);
+}
+
+sub auto_include {
+ shift()->admin->auto_include(@_);
+}
+
+sub auto_include_deps {
+ shift()->admin->auto_include_deps(@_);
+}
+
+sub auto_include_dependent_dists {
+ shift()->admin->auto_include_dependent_dists(@_);
+}
+
+1;
Added: branches/CPAN/inc/Module/Install/Makefile.pm
===================================================================
--- branches/CPAN/inc/Module/Install/Makefile.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/Makefile.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,268 @@
+#line 1
+package Module::Install::Makefile;
+
+use strict 'vars';
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # In automated testing, always use defaults
+ if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ local $ENV{PERL_MM_USE_DEFAULT} = 1;
+ goto &ExtUtils::MakeMaker::prompt;
+ } else {
+ goto &ExtUtils::MakeMaker::prompt;
+ }
+}
+
+sub makemaker_args {
+ my $self = shift;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ %$args = ( %$args, @_ );
+ return $args;
+}
+
+# For mm args that take multiple space-seperated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = sShift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{name} = defined $args->{$name}
+ ? join( ' ', $args->{name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+my %test_dir = ();
+
+sub _wanted_t {
+ /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
+}
+
+sub tests_recursive {
+ my $self = shift;
+ if ( $self->tests ) {
+ die "tests_recursive will not work if tests are already defined";
+ }
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ %test_dir = ();
+ require File::Find;
+ File::Find::find( \&_wanted_t, $dir );
+ $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
+
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # MakeMaker can complain about module versions that include
+ # an underscore, even though its own version may contain one!
+ # Hence the funny regexp to get rid of it. See RT #35800
+ # for details.
+ $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ } else {
+ # Allow legacy-compatibility with 5.005 by depending on the
+ # most recent EU:MM that supported 5.005.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ }
+
+ # Generate the MakeMaker params
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{VERSION} = $self->version;
+ $args->{NAME} =~ s/-/::/g;
+ if ( $self->tests ) {
+ $args->{test} = { TESTS => $self->tests };
+ }
+ if ( $] >= 5.005 ) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = $self->author;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
+ $args->{NO_META} = 1;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ $args->{SIGN} = 1;
+ }
+ unless ( $self->is_admin ) {
+ delete $args->{SIGN};
+ }
+
+ # Merge both kinds of requires into prereq_pm
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ }
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires, $self->requires)
+ );
+
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
+ # merge both kinds of requires into prereq_pm
+ my $subdirs = ($args->{DIR} ||= []);
+ if ($self->bundles) {
+ foreach my $bundle (@{ $self->bundles }) {
+ my ($file, $dir) = @$bundle;
+ push @$subdirs, $dir if -d $dir;
+ delete $prereq->{$file};
+ }
+ }
+
+ if ( my $perl_version = $self->perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ $args->{INSTALLDIRS} = $self->installdirs;
+
+ my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+
+ my $user_preop = delete $args{dist}->{PREOP};
+ if (my $preop = $self->admin->preop($user_preop)) {
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ my $makefile = do { local $/; <MAKEFILE> };
+ close MAKEFILE or die $!;
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 394
Added: branches/CPAN/inc/Module/Install/Metadata.pm
===================================================================
--- branches/CPAN/inc/Module/Install/Metadata.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/Metadata.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,624 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+my @boolean_keys = qw{
+ sign
+};
+
+my @scalar_keys = qw{
+ name
+ module_name
+ abstract
+ author
+ version
+ distribution_type
+ tests
+ installdirs
+};
+
+my @tuple_keys = qw{
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
+};
+
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+my @array_keys = qw{
+ keywords
+};
+
+sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
+ *$key = sub {
+ my $self = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+ return $self;
+ };
+}
+
+foreach my $key ( @scalar_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
+ return $self;
+ };
+}
+
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}->{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}->{resources} };
+ }
+ return $self->{values}->{resources}->{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} unless @_;
+ my @added;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @added, [ $module, $version ];
+ }
+ push @{ $self->{values}->{$key} }, @added;
+ return map {@$_} @added;
+ };
+}
+
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
+ }
+ $self->{values}->{resources};
+}
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub dynamic_config {
+ my $self = shift;
+ unless ( @_ ) {
+ warn "You MUST provide an explicit true/false value to dynamic_config\n";
+ return $self;
+ }
+ $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+ return 1;
+}
+
+sub perl_version {
+ my $self = shift;
+ return $self->{values}->{perl_version} unless @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Normalize the version
+ $version = $self->_perl_version($version);
+
+ # We don't support the reall old versions
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+
+ $self->{values}->{perl_version} = $version;
+}
+
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
+ }
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless $self->author;
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
+
+ return 1;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}->{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}->{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML::Tiny', 0 );
+
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+sub version_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
+}
+
+sub abstract_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ \s* ;
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ if (
+ Module::Install::_read($_[0]) =~ m/
+ ^
+ (?:use|require) \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ my $perl_version = $1;
+ $perl_version =~ s{_}{}g;
+ $self->perl_version($perl_version);
+ } else {
+ warn "Cannot determine perl version info from $_[0]\n";
+ return;
+ }
+}
+
+sub author_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ $self->author($author);
+ } else {
+ warn "Cannot determine author info from $_[0]\n";
+ }
+}
+
+sub license_from {
+ my $self = shift;
+ if (
+ Module::Install::_read($_[0]) =~ m/
+ (
+ =head \d \s+
+ (?:licen[cs]e|licensing|copyright|legal)\b
+ .*?
+ )
+ (=head\\d.*|=cut.*|)
+ \z
+ /ixms ) {
+ my $license_text = $1;
+ my @phrases = (
+ 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s{\s+}{\\s+}g;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ $self->license($license);
+ return 1;
+ }
+ }
+ }
+
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+}
+
+sub _extract_bugtracker {
+ my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = _extract_bugtracker($content);
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than on rt.cpan.org link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+ my $v = $_[-1];
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+ $v =~ s/(\.\d\d\d)000$/$1/;
+ $v =~ s/_.+$//;
+ if ( ref($v) ) {
+ # Numify
+ $v = $v + 0;
+ }
+ return $v;
+}
+
+
+
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+ die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+ my $self = shift;
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
+ # Merge the perl version into the dependencies
+ my $val = $self->Meta->{values};
+ my $perl = delete $val->{perl_version};
+ if ( $perl ) {
+ $val->{requires} ||= [];
+ my $requires = $val->{requires};
+
+ # Canonize to three-dot version after Perl 5.6
+ if ( $perl >= 5.006 ) {
+ $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
+ }
+ unshift @$requires, [ perl => $perl ];
+ }
+
+ # Load the advisory META.yml file
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my $meta = $yaml[0];
+
+ # Overwrite the non-configure dependency hashs
+ delete $meta->{requires};
+ delete $meta->{build_requires};
+ delete $meta->{recommends};
+ if ( exists $val->{requires} ) {
+ $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+ }
+ if ( exists $val->{build_requires} ) {
+ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
+ }
+
+ return $meta;
+}
+
+1;
Added: branches/CPAN/inc/Module/Install/Win32.pm
===================================================================
--- branches/CPAN/inc/Module/Install/Win32.pm (rev 0)
+++ branches/CPAN/inc/Module/Install/Win32.pm 2009-11-06 13:37:06 UTC (rev 703)
@@ -0,0 +1,64 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ die <<'END_MESSAGE' unless $rv;
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+
+}
+
+1;
Added: branches/CPAN/inc/Module/Install/WriteAll.pm
...
[truncated message content] |
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:35:10
|
Author: clkao Date: 2009-11-06 14:35:06 +0100 (Fri, 06 Nov 2009) New Revision: 702 Modified: branches/CPAN/Makefile.PL Log: Categorized dependencies and author tests. Modified: branches/CPAN/Makefile.PL =================================================================== --- branches/CPAN/Makefile.PL 2009-11-06 13:34:23 UTC (rev 701) +++ branches/CPAN/Makefile.PL 2009-11-06 13:35:06 UTC (rev 702) @@ -11,6 +11,46 @@ no_index directory => 'docs'; no_index directory => 'website'; +requires 'Date::Calc'; +requires 'XML::LibXML'; +requires 'Compress::Zlib'; + +feature 'Charting with GD', + 'GD' => 0; + +feature 'Charting with Image::Magick', + -default => 0, + 'Image::Magick' => 0; + +feature 'Charting with SVG', + -default => 0, + 'SVG' => 0; + +feature 'Charting with PostScript', + -default => 0, + 'PostScript::Simple' => 0; + +feature 'HTML Report', + -default => 0, + 'HTML::Mason' => 0; + +feature 'HTTP DB Backend', + -default => 0, + 'LWP' => 0; + +feature 'DBI DB Backend', + -default => 0, + 'DBI' => 0; + +feature 'PostgreSql Backend', + -default => 0, + 'DBI' => 0, + 'DBD::pg' => 0; + +tests 't/*.t t/*/*.t t/*/*/*.t t/*/*/*/*.t t/*/*/*/*/*.t'; +author_tests 'xt'; + +auto_include; auto_install; WriteAll; |
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:34:28
|
Author: clkao
Date: 2009-11-06 14:34:23 +0100 (Fri, 06 Nov 2009)
New Revision: 701
Modified:
branches/CPAN/lib/Finance/GeniusTrader/DB/HTTP.pm
Log:
Fix loadtxt() usage in Finance::GeniusTrader::DB::HTTP.
Submitted by Yen-Ming Lee <le...@le...>
Modified: branches/CPAN/lib/Finance/GeniusTrader/DB/HTTP.pm
===================================================================
--- branches/CPAN/lib/Finance/GeniusTrader/DB/HTTP.pm 2009-11-06 13:33:06 UTC (rev 700)
+++ branches/CPAN/lib/Finance/GeniusTrader/DB/HTTP.pm 2009-11-06 13:34:23 UTC (rev 701)
@@ -269,7 +269,7 @@
print CACHE $res->content;
close CACHE;
my $new_prices = Finance::GeniusTrader::Prices->new();
- $new_prices->loadtxt("$cache_file.tmp", $self->{'mark'}, $self->{'date_format'}, %{$self->{'fields'}});
+ $new_prices->loadtxt("$cache_file.tmp", $self->{'mark'}, $self->{'date_format'}, $self->{'header_lines'}, %{$self->{'fields'}});
$new_prices->set_timeframe($DAY);
for(my $i = 0; $i < $new_prices->count(); $i++) {
if ($prices->has_date($new_prices->at($i)->[$DATE])) {
|
|
From: GeniusTrader S. <ra...@ge...> - 2009-11-06 14:33:11
|
Author: clkao
Date: 2009-11-06 14:33:06 +0100 (Fri, 06 Nov 2009)
New Revision: 700
Added:
branches/CPAN/lib/Finance/GeniusTrader/Test.pm
branches/CPAN/t/data/TX_5min.txt
branches/CPAN/t/data/TX_day.txt
branches/CPAN/t/prices/
branches/CPAN/t/prices/basic.t
Log:
add basic prices tests and initial sketch of test helpers.
Added: branches/CPAN/lib/Finance/GeniusTrader/Test.pm
===================================================================
--- branches/CPAN/lib/Finance/GeniusTrader/Test.pm (rev 0)
+++ branches/CPAN/lib/Finance/GeniusTrader/Test.pm 2009-11-06 13:33:06 UTC (rev 700)
@@ -0,0 +1,66 @@
+package Finance::GeniusTrader::Test;
+use strict;
+use warnings;
+use base 'Test::More';
+use FindBin;
+use File::Temp;
+use Finance::GeniusTrader::Conf ();
+use Finance::GeniusTrader::Eval ();
+our @EXPORT = qw(play_prices_until);
+
+=head1 NAME
+
+Finance::GeniusTrader::Test - Test helpers for Finance::GeniusTrader
+
+=head1 SYNOPSIS
+
+ use Finance::GeniusTrader::Test
+ tests => 1,
+ gt_config => sub {
+ my $test_base = shift;
+ my $db_path = File::Spec->catdir($test_base, 'data');
+ return "DB::module Text\nDB::text::directory $db_path\n"
+ };
+
+ my ($calc, $first, $last) = Finance::GeniusTrader::Tools::find_calculator(Finance::GeniusTrader::Test->gt_db, 'TX', $PERIOD_5MIN, 1)
+ ok($calc);
+
+=head1 DESCRIPTION
+
+This module provides helper functions for writing GT tests.
+
+=cut
+
+my ($gt_options, $gt_db);
+sub import_extra {
+ my ($class, $args) = @_;
+
+ $class->setup(@$args);
+ Test::More->export_to_level(2);
+}
+
+sub setup {
+ my ($class, %args) = @_;
+ my ($test_base) = $FindBin::Bin =~ m{(.*/t/)};
+ my $dir = File::Spec->catdir($test_base, 'data');
+ $class->prepare_gt_conf($dir, $args{gt_config}->($test_base));
+ Finance::GeniusTrader::Conf::load($class->gt_options);
+ return;
+}
+
+sub gt_options {
+ my ($class) = @_;
+ $gt_options ||= File::Temp->new;
+}
+
+sub gt_db {
+ $gt_db ||= Finance::GeniusTrader::Eval::create_db_object();
+}
+
+sub prepare_gt_conf {
+ my ($self, $db_path, $gt_config) = @_;
+ open my $fh, '>', $self->gt_options or die $!;
+ print $fh $gt_config;
+}
+
+1;
Added: branches/CPAN/t/data/TX_5min.txt
===================================================================
--- branches/CPAN/t/data/TX_5min.txt (rev 0)
+++ branches/CPAN/t/data/TX_5min.txt 2009-11-06 13:33:06 UTC (rev 700)
@@ -0,0 +1,180 @@
+7538 7614 7522 7596 3758 2009-10-01 08:50:00
+7595 7600 7519 7559 2461 2009-10-01 08:55:00
+7559 7567 7553 7564 744 2009-10-01 09:00:00
+7562 7573 7543 7549 1405 2009-10-01 09:05:00
+7548 7570 7538 7567 1483 2009-10-01 09:10:00
+7567 7570 7548 7557 943 2009-10-01 09:15:00
+7558 7586 7556 7569 1736 2009-10-01 09:20:00
+7569 7576 7525 7530 1747 2009-10-01 09:25:00
+7530 7545 7518 7525 1800 2009-10-01 09:30:00
+7526 7542 7520 7535 1046 2009-10-01 09:35:00
+7535 7543 7531 7541 464 2009-10-01 09:40:00
+7541 7543 7522 7523 662 2009-10-01 09:45:00
+7523 7541 7522 7538 760 2009-10-01 09:50:00
+7537 7541 7531 7533 346 2009-10-01 09:55:00
+7533 7540 7505 7506 1306 2009-10-01 10:00:00
+7506 7519 7495 7502 1758 2009-10-01 10:05:00
+7504 7514 7500 7509 808 2009-10-01 10:10:00
+7509 7515 7509 7511 577 2009-10-01 10:15:00
+7509 7522 7507 7518 679 2009-10-01 10:20:00
+7519 7520 7512 7515 400 2009-10-01 10:25:00
+7515 7519 7511 7517 352 2009-10-01 10:30:00
+7517 7529 7516 7523 551 2009-10-01 10:35:00
+7523 7525 7509 7511 630 2009-10-01 10:40:00
+7512 7512 7484 7487 1252 2009-10-01 10:45:00
+7487 7495 7478 7489 1371 2009-10-01 10:50:00
+7488 7502 7482 7499 1003 2009-10-01 10:55:00
+7498 7500 7494 7496 429 2009-10-01 11:00:00
+7498 7500 7496 7498 315 2009-10-01 11:05:00
+7499 7499 7464 7471 1342 2009-10-01 11:10:00
+7471 7480 7455 7466 1365 2009-10-01 11:15:00
+7466 7482 7461 7480 1063 2009-10-01 11:20:00
+7479 7495 7476 7492 914 2009-10-01 11:25:00
+7491 7492 7486 7488 425 2009-10-01 11:30:00
+7488 7502 7486 7500 1018 2009-10-01 11:35:00
+7500 7502 7495 7501 590 2009-10-01 11:40:00
+7501 7518 7498 7513 1217 2009-10-01 11:45:00
+7511 7516 7508 7511 565 2009-10-01 11:50:00
+7511 7512 7504 7510 390 2009-10-01 11:55:00
+7510 7517 7509 7512 583 2009-10-01 12:00:00
+7512 7522 7511 7518 599 2009-10-01 12:05:00
+7519 7520 7508 7510 471 2009-10-01 12:10:00
+7510 7516 7509 7516 314 2009-10-01 12:15:00
+7515 7516 7510 7513 280 2009-10-01 12:20:00
+7511 7535 7511 7534 1270 2009-10-01 12:25:00
+7534 7535 7528 7532 787 2009-10-01 12:30:00
+7532 7542 7517 7520 1084 2009-10-01 12:35:00
+7520 7523 7516 7521 504 2009-10-01 12:40:00
+7521 7522 7514 7520 356 2009-10-01 12:45:00
+7521 7528 7518 7526 440 2009-10-01 12:50:00
+7526 7531 7521 7528 516 2009-10-01 12:55:00
+7528 7531 7524 7529 343 2009-10-01 13:00:00
+7529 7530 7522 7527 353 2009-10-01 13:05:00
+7527 7528 7521 7524 302 2009-10-01 13:10:00
+7525 7525 7518 7521 361 2009-10-01 13:15:00
+7521 7524 7516 7519 329 2009-10-01 13:20:00
+7519 7521 7517 7519 376 2009-10-01 13:25:00
+7518 7527 7518 7527 525 2009-10-01 13:30:00
+7527 7537 7524 7535 1133 2009-10-01 13:35:00
+7534 7538 7534 7537 567 2009-10-01 13:40:00
+7537 7540 7534 7538 939 2009-10-01 13:45:00
+7418 7423 7380 7419 2868 2009-10-02 08:50:00
+7419 7420 7408 7412 794 2009-10-02 08:55:00
+7415 7421 7412 7421 620 2009-10-02 09:00:00
+7420 7425 7402 7419 1757 2009-10-02 09:05:00
+7419 7433 7418 7423 1321 2009-10-02 09:10:00
+7422 7435 7422 7434 980 2009-10-02 09:15:00
+7433 7437 7420 7424 877 2009-10-02 09:20:00
+7424 7430 7423 7428 507 2009-10-02 09:25:00
+7427 7429 7413 7414 639 2009-10-02 09:30:00
+7414 7420 7408 7419 748 2009-10-02 09:35:00
+7419 7429 7418 7429 652 2009-10-02 09:40:00
+7429 7431 7423 7423 765 2009-10-02 09:45:00
+7426 7433 7422 7424 642 2009-10-02 09:50:00
+7424 7448 7422 7444 1382 2009-10-02 09:55:00
+7444 7447 7438 7445 1027 2009-10-02 10:00:00
+7444 7450 7440 7441 952 2009-10-02 10:05:00
+7440 7448 7438 7438 540 2009-10-02 10:10:00
+7438 7442 7432 7433 720 2009-10-02 10:15:00
+7433 7437 7432 7433 260 2009-10-02 10:20:00
+7434 7442 7432 7440 380 2009-10-02 10:25:00
+7440 7444 7437 7441 354 2009-10-02 10:30:00
+7441 7441 7432 7435 330 2009-10-02 10:35:00
+7435 7435 7424 7426 521 2009-10-02 10:40:00
+7427 7431 7422 7427 566 2009-10-02 10:45:00
+7428 7428 7420 7424 506 2009-10-02 10:50:00
+7424 7425 7414 7421 598 2009-10-02 10:55:00
+7420 7429 7417 7428 423 2009-10-02 11:00:00
+7428 7434 7427 7431 535 2009-10-02 11:05:00
+7430 7436 7428 7431 377 2009-10-02 11:10:00
+7431 7431 7426 7427 224 2009-10-02 11:15:00
+7427 7428 7423 7425 267 2009-10-02 11:20:00
+7425 7430 7424 7428 221 2009-10-02 11:25:00
+7427 7435 7427 7432 339 2009-10-02 11:30:00
+7432 7433 7414 7421 646 2009-10-02 11:35:00
+7421 7425 7408 7414 979 2009-10-02 11:40:00
+7414 7420 7411 7413 483 2009-10-02 11:45:00
+7412 7417 7387 7391 1722 2009-10-02 11:50:00
+7391 7403 7387 7402 1149 2009-10-02 11:55:00
+7402 7408 7398 7403 550 2009-10-02 12:00:00
+7403 7406 7401 7405 371 2009-10-02 12:05:00
+7405 7412 7404 7408 637 2009-10-02 12:10:00
+7408 7413 7407 7410 357 2009-10-02 12:15:00
+7409 7410 7405 7408 275 2009-10-02 12:20:00
+7408 7410 7397 7400 586 2009-10-02 12:25:00
+7400 7408 7397 7408 417 2009-10-02 12:30:00
+7407 7408 7395 7398 424 2009-10-02 12:35:00
+7399 7400 7390 7395 716 2009-10-02 12:40:00
+7394 7404 7393 7399 540 2009-10-02 12:45:00
+7398 7400 7391 7396 335 2009-10-02 12:50:00
+7396 7408 7396 7406 362 2009-10-02 12:55:00
+7404 7406 7394 7396 327 2009-10-02 13:00:00
+7395 7397 7385 7393 966 2009-10-02 13:05:00
+7393 7395 7360 7362 2284 2009-10-02 13:10:00
+7363 7372 7357 7367 1301 2009-10-02 13:15:00
+7368 7371 7344 7348 1534 2009-10-02 13:20:00
+7346 7367 7346 7366 1203 2009-10-02 13:25:00
+7366 7373 7364 7371 957 2009-10-02 13:30:00
+7369 7377 7367 7367 1067 2009-10-02 13:35:00
+7368 7370 7366 7369 595 2009-10-02 13:40:00
+7368 7370 7351 7352 1084 2009-10-02 13:45:00
+7358 7368 7346 7355 1108 2009-10-05 08:50:00
+7356 7363 7354 7359 485 2009-10-05 08:55:00
+7359 7366 7358 7365 529 2009-10-05 09:00:00
+7366 7376 7353 7356 1182 2009-10-05 09:05:00
+7356 7375 7353 7374 977 2009-10-05 09:10:00
+7375 7386 7372 7385 1108 2009-10-05 09:15:00
+7384 7388 7375 7376 1005 2009-10-05 09:20:00
+7377 7381 7372 7379 548 2009-10-05 09:25:00
+7378 7386 7371 7374 862 2009-10-05 09:30:00
+7374 7376 7353 7354 882 2009-10-05 09:35:00
+7355 7356 7331 7343 2073 2009-10-05 09:40:00
+7343 7348 7338 7338 861 2009-10-05 09:45:00
+7338 7345 7326 7330 1493 2009-10-05 09:50:00
+7331 7345 7329 7343 883 2009-10-05 09:55:00
+7343 7348 7341 7347 617 2009-10-05 10:00:00
+7345 7357 7343 7353 968 2009-10-05 10:05:00
+7353 7363 7352 7355 779 2009-10-05 10:10:00
+7358 7358 7351 7354 485 2009-10-05 10:15:00
+7353 7360 7353 7359 485 2009-10-05 10:20:00
+7359 7363 7354 7361 417 2009-10-05 10:25:00
+7360 7371 7360 7369 811 2009-10-05 10:30:00
+7369 7370 7355 7356 690 2009-10-05 10:35:00
+7355 7356 7350 7354 461 2009-10-05 10:40:00
+7354 7362 7352 7362 412 2009-10-05 10:45:00
+7362 7374 7361 7368 813 2009-10-05 10:50:00
+7368 7369 7363 7368 356 2009-10-05 10:55:00
+7368 7370 7364 7366 419 2009-10-05 11:00:00
+7366 7367 7358 7365 349 2009-10-05 11:05:00
+7365 7373 7362 7369 336 2009-10-05 11:10:00
+7369 7372 7352 7355 667 2009-10-05 11:15:00
+7353 7358 7350 7355 510 2009-10-05 11:20:00
+7355 7361 7355 7360 249 2009-10-05 11:25:00
+7358 7360 7353 7357 269 2009-10-05 11:30:00
+7355 7366 7355 7361 365 2009-10-05 11:35:00
+7361 7368 7359 7364 260 2009-10-05 11:40:00
+7364 7368 7362 7364 315 2009-10-05 11:45:00
+7365 7365 7354 7355 290 2009-10-05 11:50:00
+7355 7365 7353 7361 394 2009-10-05 11:55:00
+7361 7368 7358 7366 272 2009-10-05 12:00:00
+7364 7366 7359 7366 224 2009-10-05 12:05:00
+7366 7366 7348 7352 739 2009-10-05 12:10:00
+7352 7355 7345 7347 730 2009-10-05 12:15:00
+7347 7356 7345 7352 441 2009-10-05 12:20:00
+7351 7353 7348 7352 377 2009-10-05 12:25:00
+7352 7360 7346 7359 519 2009-10-05 12:30:00
+7358 7359 7353 7357 206 2009-10-05 12:35:00
+7356 7357 7353 7355 160 2009-10-05 12:40:00
+7357 7357 7348 7353 267 2009-10-05 12:45:00
+7353 7356 7352 7355 169 2009-10-05 12:50:00
+7355 7355 7349 7354 201 2009-10-05 12:55:00
+7353 7354 7344 7346 405 2009-10-05 13:00:00
+7346 7356 7346 7353 475 2009-10-05 13:05:00
+7352 7373 7348 7367 1031 2009-10-05 13:10:00
+7368 7383 7366 7381 1395 2009-10-05 13:15:00
+7380 7383 7371 7373 658 2009-10-05 13:20:00
+7372 7379 7371 7372 447 2009-10-05 13:25:00
+7372 7378 7372 7376 392 2009-10-05 13:30:00
+7377 7397 7375 7396 1650 2009-10-05 13:35:00
+7396 7398 7391 7392 696 2009-10-05 13:40:00
+7392 7394 7390 7392 888 2009-10-05 13:45:00
Added: branches/CPAN/t/data/TX_day.txt
===================================================================
--- branches/CPAN/t/data/TX_day.txt (rev 0)
+++ branches/CPAN/t/data/TX_day.txt 2009-11-06 13:33:06 UTC (rev 700)
@@ -0,0 +1,191 @@
+4722 4797 4634 4670 97901 2009-01-05
+4699 4735 4638 4706 90329 2009-01-06
+4758 4802 4711 4752 90885 2009-01-07
+4650 4650 4434 4452 95701 2009-01-08
+4447 4495 4405 4421 90308 2009-01-09
+4362 4425 4344 4374 56215 2009-01-10
+4386 4472 4350 4429 93281 2009-01-12
+4361 4524 4360 4518 93835 2009-01-13
+4490 4552 4478 4510 82268 2009-01-14
+4222 4300 4222 4239 75818 2009-01-15
+4277 4329 4250 4323 78421 2009-01-16
+4330 4358 4306 4349 38490 2009-01-17
+4378 4394 4325 4357 58908 2009-01-19
+4266 4269 4205 4240 52093 2009-01-20
+4114 4265 4113 4254 36615 2009-01-21
+4199 4199 4106 4161 50727 2009-02-02
+4168 4328 4161 4275 77684 2009-02-03
+4327 4375 4285 4351 68432 2009-02-04
+4315 4389 4269 4270 82511 2009-02-05
+4362 4479 4356 4443 94693 2009-02-06
+4500 4522 4425 4456 71256 2009-02-09
+4456 4499 4435 4497 60664 2009-02-10
+4385 4578 4372 4558 91929 2009-02-11
+4520 4564 4398 4445 112991 2009-02-12
+4459 4590 4451 4571 109267 2009-02-13
+4569 4588 4534 4575 69481 2009-02-16
+4521 4559 4437 4494 91320 2009-02-17
+4455 4519 4426 4517 45601 2009-02-18
+4411 4524 4334 4468 118698 2009-02-19
+4405 4453 4345 4363 105149 2009-02-20
+4332 4433 4296 4426 102528 2009-02-23
+4327 4395 4313 4381 83737 2009-02-24
+4435 4520 4408 4466 105000 2009-02-25
+4520 4538 4440 4477 89516 2009-02-26
+4472 4528 4452 4510 73633 2009-02-27
+4422 4459 4303 4331 101313 2009-03-02
+4270 4377 4238 4367 104158 2009-03-03
+4336 4516 4322 4511 109861 2009-03-04
+4541 4646 4539 4595 120308 2009-03-05
+4550 4638 4540 4628 109500 2009-03-06
+4672 4675 4543 4624 93692 2009-03-09
+4601 4669 4567 4656 91653 2009-03-10
+4775 4785 4715 4758 77516 2009-03-11
+4752 4779 4724 4748 66848 2009-03-12
+4820 4942 4813 4900 98336 2009-03-13
+4938 4985 4907 4962 79029 2009-03-16
+4966 5070 4946 5057 94430 2009-03-17
+5082 5096 5024 5067 59723 2009-03-18
+5045 5105 4975 4980 105836 2009-03-19
+5006 5040 4922 4950 106431 2009-03-20
+5032 5132 4991 5131 95403 2009-03-23
+5201 5270 5188 5262 99502 2009-03-24
+5254 5389 5232 5360 114172 2009-03-25
+5349 5434 5317 5385 130922 2009-03-26
+5434 5454 5336 5353 110172 2009-03-27
+5346 5360 5143 5175 111500 2009-03-30
+5225 5295 5175 5201 105649 2009-03-31
+5228 5344 5222 5314 135958 2009-04-01
+5400 5517 5400 5511 115854 2009-04-02
+5562 5567 5475 5509 103180 2009-04-03
+5228 5344 5222 5314 135958 2009-04-01
+5400 5517 5400 5511 115854 2009-04-02
+5562 5567 5475 5509 103180 2009-04-03
+5560 5619 5493 5525 105000 2009-04-06
+5503 5587 5464 5583 97735 2009-04-07
+5501 5583 5416 5456 134387 2009-04-08
+5538 5718 5525 5712 113141 2009-04-09
+5762 5830 5696 5827 127509 2009-04-10
+5835 5876 5786 5846 108378 2009-04-13
+5825 5901 5785 5858 106808 2009-04-14
+5858 5895 5782 5861 57688 2009-04-15
+5999 6047 5950 5994 112966 2009-04-16
+6046 6060 5684 5775 150477 2009-04-17
+5772 5815 5668 5765 128665 2009-04-20
+5667 5899 5654 5896 132016 2009-04-21
+5865 5928 5833 5847 115857 2009-04-22
+5870 5906 5755 5901 138442 2009-04-23
+5915 5998 5791 5904 146131 2009-04-24
+5930 5950 5676 5710 147704 2009-04-27
+5766 5784 5576 5580 159423 2009-04-28
+5648 5664 5584 5623 109869 2009-04-29
+6015 6015 5995 6015 29390 2009-04-30
+6363 6436 6301 6436 22625 2009-05-04
+6637 6720 6426 6542 88812 2009-05-05
+6510 6585 6412 6536 69129 2009-05-06
+6606 6630 6446 6613 63095 2009-05-07
+6570 6598 6506 6572 53559 2009-05-08
+6549 6697 6522 6597 57457 2009-05-11
+6562 6586 6385 6447 70303 2009-05-12
+6454 6499 6420 6469 46343 2009-05-13
+6355 6419 6315 6321 50271 2009-05-14
+6372 6509 6356 6476 55158 2009-05-15
+6424 6573 6402 6561 59080 2009-05-18
+6715 6804 6623 6693 57033 2009-05-19
+6710 6745 6585 6697 44349 2009-05-20
+6629 6695 6605 6671 50918 2009-05-21
+6605 6732 6595 6692 52362 2009-05-22
+6751 6837 6647 6724 62862 2009-05-25
+6700 6761 6633 6646 51842 2009-05-26
+6720 6997 6699 6932 67252 2009-05-27
+6980 7010 6900 6954 44319 2009-06-01
+7037 7050 6864 6916 50692 2009-06-02
+6928 6933 6842 6898 45281 2009-06-03
+6860 6897 6696 6784 62484 2009-06-04
+6811 6827 6735 6790 42618 2009-06-05
+6777 6853 6775 6833 24331 2009-06-06
+6865 6884 6612 6643 55151 2009-06-08
+6668 6668 6390 6413 68367 2009-06-09
+6458 6504 6385 6459 52021 2009-06-10
+6490 6545 6335 6516 71080 2009-06-11
+6530 6558 6411 6437 59688 2009-06-12
+6390 6390 6174 6208 66134 2009-06-15
+6173 6251 6133 6208 57409 2009-06-16
+6218 6294 6195 6204 36186 2009-06-17
+6130 6205 5994 6090 69820 2009-06-18
+6090 6150 6045 6138 53631 2009-06-19
+6137 6264 6075 6206 55117 2009-06-22
+6088 6150 6059 6072 45975 2009-06-23
+6089 6494 6073 6311 81506 2009-06-24
+6306 6427 6295 6389 59640 2009-06-25
+6405 6432 6361 6391 43370 2009-06-26
+6415 6436 6305 6345 52417 2009-06-29
+6421 6450 6301 6383 54441 2009-06-30
+6414 6546 6361 6517 60505 2009-07-01
+6525 6626 6517 6590 53579 2009-07-02
+6547 6633 6520 6602 51175 2009-07-03
+6619 6631 6527 6588 50896 2009-07-06
+6588 6710 6578 6665 53945 2009-07-07
+6621 6637 6558 6627 49200 2009-07-08
+6627 6778 6625 6724 55739 2009-07-09
+6735 6755 6676 6755 41518 2009-07-10
+6739 6765 6443 6469 63531 2009-07-13
+6540 6609 6507 6580 42098 2009-07-14
+6630 6782 6625 6763 38079 2009-07-15
+6748 6785 6661 6709 49770 2009-07-16
+6736 6802 6700 6756 44506 2009-07-17
+6839 6884 6758 6859 49020 2009-07-20
+6900 6912 6795 6874 50201 2009-07-21
+6870 6959 6847 6885 51782 2009-07-22
+6873 6955 6818 6881 52525 2009-07-23
+6950 6963 6875 6897 40805 2009-07-24
+6950 7010 6896 6967 44098 2009-07-27
+6962 7088 6951 7080 46486 2009-07-28
+7099 7132 7021 7037 46488 2009-07-29
+7025 7043 6870 6963 56923 2009-07-30
+7009 7083 6955 7028 51697 2009-07-31
+7024 7028 6907 6982 50784 2009-08-03
+7056 7070 6821 6881 64869 2009-08-04
+6882 6948 6749 6772 62294 2009-08-05
+6799 6833 6702 6803 65360 2009-08-06
+6820 6854 6733 6814 49508 2009-08-10
+6818 6895 6755 6895 49451 2009-08-11
+6849 6898 6815 6839 44392 2009-08-12
+6865 7031 6862 7013 56310 2009-08-13
+7049 7112 7020 7063 43262 2009-08-14
+7010 7034 6899 6914 50005 2009-08-17
+6900 6908 6723 6817 60792 2009-08-18
+6824 6844 6786 6795 26378 2009-08-19
+6722 6733 6590 6693 59789 2009-08-20
+6700 6770 6553 6592 65748 2009-08-21
+6754 6835 6711 6808 53809 2009-08-24
+6798 6827 6742 6760 49378 2009-08-25
+6785 6802 6616 6703 69760 2009-08-26
+6673 6727 6610 6645 57862 2009-08-27
+6677 6810 6656 6754 59739 2009-08-28
+6765 6808 6701 6756 51772 2009-08-31
+6757 7034 6736 7027 69884 2009-09-01
+6951 7049 6937 7026 57760 2009-09-02
+7020 7123 6979 7094 59981 2009-09-03
+7121 7169 7071 7155 53819 2009-09-04
+7186 7227 7145 7221 44856 2009-09-07
+7250 7367 7181 7316 65856 2009-09-08
+7316 7344 7248 7257 45571 2009-09-09
+7334 7758 7285 7360 91628 2009-09-10
+7329 7370 7291 7353 38067 2009-09-11
+7307 7344 7204 7252 51978 2009-09-14
+7289 7385 7253 7357 43744 2009-09-15
+7428 7460 7375 7444 32370 2009-09-16
+7500 7517 7436 7466 51018 2009-09-17
+7441 7502 7408 7467 40269 2009-09-18
+7481 7556 7398 7466 51237 2009-09-21
+7484 7506 7425 7454 35882 2009-09-22
+7460 7520 7311 7347 64331 2009-09-23
+7364 7375 7235 7295 52521 2009-09-24
+7250 7340 7235 7338 44558 2009-09-25
+7276 7327 7215 7280 43336 2009-09-28
+7330 7431 7328 7405 47839 2009-09-29
+7427 7515 7411 7493 46605 2009-09-30
+7538 7614 7455 7538 52071 2009-10-01
+7418 7450 7344 7352 45504 2009-10-02
+7358 7398 7326 7392 38020 2009-10-05
Added: branches/CPAN/t/prices/basic.t
===================================================================
--- branches/CPAN/t/prices/basic.t (rev 0)
+++ branches/CPAN/t/prices/basic.t 2009-11-06 13:33:06 UTC (rev 700)
@@ -0,0 +1,52 @@
+#!/usr/bin/perl -w
+use strict;
+use Finance::GeniusTrader::DateTime;
+use Finance::GeniusTrader::Calculator;
+use Finance::GeniusTrader::Prices;
+use Finance::GeniusTrader::Test
+ tests => 23,
+ gt_config => sub {
+ my $test_base = shift;
+ my $db_path = File::Spec->catdir($test_base, 'data');
+<<"EOF";
+DB::module Text
+DB::text::file_extension _\$timeframe.txt
+DB::text::directory $db_path
+EOF
+ };
+
+# 5min
+{
+ my ($calc, $first, $last) = Finance::GeniusTrader::Tools::find_calculator(Finance::GeniusTrader::Test->gt_db, 'TX', $PERIOD_5MIN, 1);
+
+ ok($calc);
+ is($first, 0);
+ is($last, 179);
+ is($calc->prices->count, 180);
+ is($calc->prices->at(179)->[$DATE], '2009-10-05 13:45:00');
+ ok( !$calc->prices->has_date('2009-10-05 08:45:00') );
+ ok( $calc->prices->has_date('2009-10-05 08:50:00') );
+ is( $calc->prices->date('2009-10-05 08:45:00'), undef );
+ is( $calc->prices->date('2009-10-05 08:50:00'), 120 );
+ my $p = $calc->prices->at_date('2009-10-05 08:50:00');
+ is( $p->[$DATE], '2009-10-05 08:50:00' );
+ is( $p->[$OPEN], 7358);
+ is( $p->[$HIGH], 7368);
+ is( $p->[$LOW], 7346);
+ is( $p->[$CLOSE], 7355);
+}
+
+# day
+{
+ my ($calc, $first, $last) = Finance::GeniusTrader::Tools::find_calculator(Finance::GeniusTrader::Test->gt_db, 'TX', $DAY, 1);
+ ok($calc);
+ is($first, 0);
+ is($last, 190);
+ is($calc->prices->count, 191);
+ is($calc->prices->at(190)->[$DATE], '2009-10-05 00:00:00');
+ ok( !$calc->prices->has_date('2009-10-03') );
+ ok( $calc->prices->has_date('2009-10-05 00:00:00') );
+ is( $calc->prices->date('2009-10-03'), undef );
+ is( $calc->prices->date('2009-10-05 00:00:00'), 190 );
+
+}
|
|
From: Raphael H. <ra...@ou...> - 2009-11-06 14:17:00
|
Le dimanche 25 octobre 2009, Chia-liang Kao a écrit : > branch of thomas' mirror. Raphael, can I please get a commit bit for > the current svn repository while we are still figuring out the project > ownership issues to avoid divergence? I have granted an account (clkao) to Chia-liang Kao in the hope to not loose momentum in the project. It's a bit sad that the last discussions did not have a clear outcome. I hope you will all manage to cooperate in a constructive fashion. I have found Robert A. Schmied a bit conservative in the positions he took but it's understandable when you're using a software that works and you want to keep it working. That said, I agree that the confidence should come from automated non-regression tests and not from the fact that no changes were made. I hope you can all go forward in that direction. BTW, I don't mind renaming the modules to Finance::Geniustrader even if that's a bit verbose. Having the modules on CPAN will also allow usage of its request tracker if you don't move to a forge. It might be interesting. Cheers, -- Raphaël Hertzog -+- http://www.ouaza.com Freexian : des développeurs Debian au service des entreprises http://www.freexian.com |
|
From: Chia-liang K. <cl...@cl...> - 2009-11-05 13:29:09
|
2009/11/5 Thomas Weigert <we...@ms...>:
> I think this warrants a broader examination.
>
> I think that prices, if they need to be matched precisely, should not be
> implemented as floating point numbers, or if we do so, they should be
> compared using an epsilon region.
>
> But it might be best to treat prices as fixed point numbers, to ensure
> that we can make exact comparisons?
+1, as this also enables more precise behaviour for things like
CS:Fixed:Stop, which might be doing a stop order on an impossible
fractional price, which should be rounded according to the minimum
fluctuation.
I think a tradable item ("code", in GT term) should define its minimum
fluctuation, and that unit should be in an integer value internally
for processing.
> In either case, a systematic review of the use of prices is warranted....
>
> Th.
>
> Robert A. Schmied wrote:
>> fr....@ti... wrote:
>>> Hello,
>>> i'm new to this mailing list, i started using GT at the
>>> beginning of this year but i didnt realize the project was going on,
>>> so i used the older version and i modified it a little bit.
>>> Now that i discoved the svn version im switching to it.
>>>
>>> One of the things that i changed on the library that seems not
>>> corrected in the svn version is a little bug using the >= and <=
>>> operators in floating context.
>>>
>>> The problem is that if you create the order using for the price
>>> ($order->price) a division like ($var/100)*100, the $order->price
>>> will not be exactly $var but $var ą 0.000....01 (this is a known perl
>>> problem)
>>> and the is_executed function could return false if the $order->price
>>> is equal to the HIGH or the LOW of the bar.
>>>
>>> In particular i created 2 functions in Tools.pm and changed all the
>>> <= and >= with these functions in
>>>
>>> Portfolio/Order.pm
>>> is_executed function
>>> lines 372 373 389 394 402 403 408 409
>>>
>>> I dont know if this problem is present in other part of GT but i
>>> fixed only in Order.pm
>>>
>>> If someone is interested in the problem i can send the
>>> Portfolio/Order.pm and Tools.pm modified.
>>>
>>> I hope this is usefull.
>>>
>>> PS: im using the http://www.geniustrader.org/wws/compose_mail/devel
>>> to write this post but i cant attach anything here.Is possible to
>>> send a post
>>> from thunderbird?
>>>
>>> thx
>>
>>
>> aloha fr.gamberale
>>
>> your observation could very well be the cause of many of the odd
>> results one
>> sees from time to time.
>>
>> as there are three (at least) gt branches on the svn at
>> http://geniustrader.org/
>> you need to identify the one you're using so we can get on the same
>> page (or at
>> least identify it as a reference).
>>
>> as far as sharing your fixes you can either post differences or the
>> complete files.
>> differences might be the preferred method, but it probably doesn't
>> matter much.
>> see man page diff(1) and/or info diff for details on how to create
>> difference files.
>> for reference diff -u orig_file changed_file. there are probably diff
>> equivalents
>> built-in in svn, but i don't know about them, so you are on your own
>> there.
>>
>> if you have subscribed to the gt devel mailing list you should be able
>> to post
>> messages with attachments to the list with any email client. see the
>> gt website
>> (http://geniustrader.org/) main page 'Mailing lists' section. for
>> reference you
>> post to de...@ge....
>>
>> ciao
>>
>> ras
>>
>
|
|
From: <fr....@ti...> - 2009-11-05 13:09:05
|
Hi again,
im using the 699 svn version
here the Order.pm and Tools.pm differences
--- GeniusTraderSvn699Originale/GT/Tools.pm 2009-10-16 12:48:34.000000000
+0200
+++ Tools.pm 2009-10-28 14:46:21.000000000 +0100
@@ -16,10 +16,10 @@
extract_object_number
resolve_alias resolve_object_alias long_name short_name
isin_checksum isin_validate isin_create_from_local
- get_timeframe_data parse_date_str find_calculator check_dates
+ get_timeframe_data parse_date_str find_calculator check_dates
f_eq f_ge f_le
);
%EXPORT_TAGS = ("math" => [qw(min max PI sign)],
- "generic" => [qw(extract_object_number)],
+ "generic" => [qw(extract_object_number f_eq f_ge f_le)],
"conf" => [qw(resolve_alias resolve_object_alias long_name
short_name)],
"isin" => [qw(isin_checksum isin_validate isin_create_from_local)],
"timeframe" => [qw(get_timeframe_data parse_date_str
find_calculator check_dates)]
@@ -785,4 +785,24 @@
=back
=cut
+
+sub f_eq {
+ my( $float1, $float2, $delta ) = @_;
+ $delta ||= 0.000001; # default value of delta
+ abs( $float1 - $float2 ) < $delta
+}
+
+sub f_ge {
+ my( $float1, $float2, $delta ) = @_;
+ $delta ||= 0.000001; # default value of delta
+ $float1 > $float2 - $delta
+}
+
+sub f_le {
+ my( $float1, $float2, $delta ) = @_;
+ $delta ||= 0.000001; # default value of delta
+ $float1 < $float2 + $delta
+}
+
+
1;
--- GeniusTraderSvn699Originale/GT/Portfolio/Order.pm 2009-10-16
12:48:33.000000000 +0200
+++ Order.pm 2009-11-05 12:04:58.000000000 +0100
@@ -7,10 +7,11 @@
our @ISA = qw(GT::Serializable);
use strict;
+#use warnings;
#ALL# use Log::Log4perl qw(:easy);
use GT::Prices;
use GT::Serializable;
-
+use GT::Tools qw(:generic);
=head1 NAME
GT::Portfolio::Order - An order within the portfolio
@@ -52,6 +53,7 @@
return $self;
}
+
=item C<< $o->set_sell_order() >>
=item C<< $o->set_buy_order() >>
@@ -186,6 +188,7 @@
sub price { $_[0]->{'price'} }
sub second_price { $_[0]->{'price2'} }
+
=item C<< $o->set_source($source) >>
=item C<< $o->source() >>
@@ -350,8 +353,8 @@
$price = $calc->prices->at($i - 1)->[$CLOSE] if ($i >= 1);
} elsif ($self->is_type_limited) {
# At limited price
- if (($self->price >= $prices->[$LOW]) &&
- ($self->price <= $prices->[$HIGH]))
+ if (f_ge($self->price,$prices->[$LOW]) &&
+ f_le($self->price,$prices->[$HIGH]))
{
$price = $self->price;
} else
@@ -367,12 +370,12 @@
} elsif ($self->is_type_stop) {
# On stop (conditional order)
if (($self->is_buy_order) &&
- ($prices->[$HIGH] >= $self->price))
+ f_ge($prices->[$HIGH],$self->price))
{
$price = ($prices->[$FIRST] > $self->price) ?
$prices->[$FIRST] : $self->price;
} elsif (($self->is_sell_order) &&
- ($prices->[$LOW] <= $self->price))
+ f_le($prices->[$LOW],$self->price))
{
$price = ($prices->[$FIRST] < $self->price) ?
$prices->[$FIRST] : $self->price;
@@ -380,14 +383,14 @@
} elsif ($self->is_type_stop_limited) {
# On stop (conditional order)
if (($self->is_buy_order) &&
- ($prices->[$HIGH] >= $self->price) &&
- ($prices->[$LOW] <= $self->second_price))
+ f_ge($prices->[$HIGH],$self->price) &&
+ f_le($prices->[$LOW],$self->second_price))
{
$price = ($prices->[$HIGH] < $self->second_price) ?
$prices->[$HIGH] : $self->second_price;
} elsif (($self->is_sell_order) &&
- ($prices->[$LOW] <= $self->price) &&
- ($prices->[$HIGH] >= $self->second_price))
+ f_le($prices->[$LOW],$self->price) &&
+ f_ge($prices->[$HIGH],$self->second_price))
{
$price = ($prices->[$LOW] > $self->second_price) ?
$prices->[$LOW] : $self->second_price;
fg
Robert A. Schmied ha scritto:
> fr....@ti... wrote:
>> Hello,
>> i'm new to this mailing list, i started using GT at the beginning of
this year but i didnt realize the project was going on, so i used the older
version and i modified it a little bit.
>> Now that i discoved the svn version im switching to it.
>>
>> One of the things that i changed on the library that seems not corrected in
the svn version is a little bug using the >= and <= operators in floating
context.
>>
>> The problem is that if you create the order using for the price
($order->price) a division like ($var/100)*100, the $order->price will not be
exactly $var but $var ± 0.000....01 (this is a known perl problem)
>> and the is_executed function could return false if the $order->price is
equal to the HIGH or the LOW of the bar.
>>
>> In particular i created 2 functions in Tools.pm and changed all the <= and
>= with these functions in
>>
>> Portfolio/Order.pm
>> is_executed function
>> lines 372 373 389 394 402 403 408 409
>>
>> I dont know if this problem is present in other part of GT but i fixed only
in Order.pm
>>
>> If someone is interested in the problem i can send the Portfolio/Order.pm
and Tools.pm modified.
>>
>> I hope this is usefull.
>>
>> PS: im using the http://www.geniustrader.org/wws/compose_mail/devel to write
this post but i cant attach anything here.Is possible to send a post
>> from thunderbird?
>>
>> thx
>
>
> aloha fr.gamberale
>
> your observation could very well be the cause of many of the odd results one
> sees from time to time.
>
> as there are three (at least) gt branches on the svn at
http://geniustrader.org/
> you need to identify the one you're using so we can get on the same page (or
at
> least identify it as a reference).
>
> as far as sharing your fixes you can either post differences or the complete
files.
> differences might be the preferred method, but it probably doesn't matter
much.
> see man page diff(1) and/or info diff for details on how to create difference
files.
> for reference diff -u orig_file changed_file. there are probably diff
equivalents
> built-in in svn, but i don't know about them, so you are on your own there.
>
> if you have subscribed to the gt devel mailing list you should be able to
post
> messages with attachments to the list with any email client. see the gt
website
> (http://geniustrader.org/) main page 'Mailing lists' section. for reference
you
> post to de...@ge....
>
> ciao
>
> ras
|
|
From: Robert A. S. <ra...@ac...> - 2009-11-05 05:11:09
|
jecxz112 wrote: > Robert A. Schmied wrote: > >> >> to see the trading activity you need to add -display-trades > > Thank you very much for your help; it is very much appreciated, because the > learning curve is rather steep from a standing start. > > Right now I am simply trying to figure out what GT can do and how, > before actually using it > for anything useful. aloha jecxz112 gt does take a bit of time to learn, and it has different uses depending on how you tend to invest and/or trade securities. as i tend more towards investing, meaning very low frequency trading, graphic.pl and a few technical analysis plots are my usual stock in trade. frankly i've found very little use for the backtests and the systematic approach that gt provides. but on the other hand, scan.pl and with a well defined trading system description can be used to good benefit to flag securities that have tripped a flag of some kind without having to look at a chart. see perldoc graphic.pl and perldoc scan.pl for examples of these apps, and do read the documentation files in GT/Docs, yell if you run into trouble. ras > > BTW, in my graphing example I also should have omitted the double quotes > as Ubuntu created the .png > file with double quotes at the start and end of the file name. > But I got a graph, so I was happy :-) > |
|
From: jecxz112 <jec...@te...> - 2009-11-04 23:28:02
|
Robert A. Schmied wrote: > > to see the trading activity you need to add -display-trades Thank you very much for your help; it is very much appreciated, because the learning curve is rather steep from a standing start. Right now I am simply trying to figure out what GT can do and how, before actually using it for anything useful. BTW, in my graphing example I also should have omitted the double quotes as Ubuntu created the .png file with double quotes at the start and end of the file name. But I got a graph, so I was happy :-) -- Fight Spam - report it with wxSR http://www.columbinehoney.net/wxSR.shtml |
|
From: jecxz112 <jec...@te...> - 2009-11-04 23:20:09
|
Robert A. Schmied wrote:
> jecxz112 wrote:
>
>>
>> All of those packages were installed on Ubuntu - and I finally by
>> trial and error found some fonts
>> that seemed to do the trick.
>> For the record:
>> /usr/share/fonts/truetype/freefonts/ FreeSans.ttf - FreeMono.ttf and
>> FreeSerif.ttf.
>
> so for Ubuntu linux you needed lines something like the following
> in your $HOME/.gt/options file?
>
> Path::Font::Arial /usr/share/fonts/truetype/freefonts/FreeSans.ttf
> Path::Font::Courier /usr/share/fonts/truetype/freefonts/FreeMono.ttf
> Path::Font::Times /usr/share/fonts/truetype/freefonts/FreeSerif.ttf
That is correct
>
> note the gt wiki page 'The user config file' (gt webpage box upper right)
> discusses the $HOME/.gt/options file in some detail and specifically
> addresses Ubuntu linux fonts. if these notes are mis-leading or wrong
> you can correct them yourself provided you register and login.
I'm far too new at this to dare edit wikis unannounced ;-)
In fact I have not been to the wiki as yet, though I will now have a
look there as well.
>
>>
>> Also, FWIW, the page first_use.html shows
>>
>> $ ./backtest.pl 'TFS[30,7,7]' 13000 | less
>>
>> As a test. On my machine, I needed to omit the ticks.
>
> the ticks are only *needed* if your shell considers something
> in the string being quoted as a shell meta-character.
> the culprit in this case are the square brackets (e.g. []),
> in other cases it may be the curly brackets (e.g. {}). if you
> has embedded spaces they also would need to be escaped ...
> of course you can quote (in other words escape) the shell
> meta-characters with a leading backslash (e.g. \)
>
> % ./backtest.pl TFS\[30,7,7\] 13000
>
> the csh is one shell that needs both squares and curlys escaped.
> here, bash, sh, and ksh don't care about the squares. i didn't
> look at the curlys.
>
> the perplexing bit is that you had to remove them for ./backtest.pl
> to work. i'm not seeing that here with any of the tested shells. maybe
> there's an argument cleanup that removes them internally that is still
> missing from the gt trunk version?
>
> you do have the TFS[] alias defined in your $HOME/.gt/options file
> something like this?
>
> Aliases::Global::TFS[] SY:TFS #1 #2|CS:SY:TFS #1|CS:Stop:Fixed #3
Yes I triple checked that line
>
> and you are using the correct quote character (e.g. ')?
I believe Ubuntu is running bash.
I tried them both and eventually without; I have Ubuntu on some machines
mainly
for convenience because I need some of the features it offers and which
Windows
does not; other than that most of my time is spent under Windows, which
is why
the Linux way was my second try after failing with the Windows install
and why I
was having such a time with it.
I'm sure for people running Linux, already long ago have installed many
of the
prerequisites for other reasons, but on a very new and clean system,
things are
different.
--
Fight Spam - report it with wxSR
http://www.columbinehoney.net/wxSR.shtml
|
54 messages has been excluded from this view by a project administrator.
